diff options
Diffstat (limited to 'codegen.hs')
| -rw-r--r-- | codegen.hs | 53 |
1 files changed, 44 insertions, 9 deletions
@@ -210,7 +210,25 @@ genGlobalVars (Program decs) = liftM (mapMaybe id) $ mapM gen decs gen (DecFunction rt n a _) = do setGlobalFunction n n (TypeFunc rt (map fst a)) return Nothing - gen _ = return Nothing + gen (DecExtern t@(TypeFunc rt ats) n) = do + setGlobalFunction n n t + argnames <- sequence $ replicate (length ats) (getNewName "arg") + return $ Just $ A.GlobalDefinition $ + A.functionDefaults { + A.G.returnType = toLLVMType rt, + A.G.name = A.Name n, + A.G.parameters = ([A.Parameter (toLLVMType at) (A.Name an) [] | (at,an) <- zip ats argnames], False), + A.G.basicBlocks = [] + } + gen (DecExtern t n) = do + setGlobalVar n n t + return $ Just $ A.GlobalDefinition $ + A.globalVariableDefaults { + A.G.name = A.Name n, + A.G.type' = toLLVMType t, + A.G.initializer = Nothing + } + gen (DecTypedef _ _) = return Nothing genStringLiterals :: CGMonad [A.Definition] genStringLiterals = liftM stringLiterals get >>= return . map gen @@ -229,27 +247,44 @@ genFunctions (Program decs) = liftM (mapMaybe id) $ mapM gen decs gen :: Declaration -> CGMonad (Maybe A.Definition) gen dec@(DecFunction rettype name args body) = do setCurrentFunction dec - firstbb <- genBlock' body + state $ \s -> ((), s { + allBlocks = Map.empty, + variables = Map.empty + }) + firstbb <- genFunctionBlock body args cleanupTrampolines blockmap <- liftM allBlocks get let bbs' = map snd $ filter (\x -> fst x /= firstbb) $ Map.toList blockmap bbs = fromJust (Map.lookup firstbb blockmap) : bbs' - state $ \s -> ((), s {allBlocks = Map.empty}) return $ Just $ A.GlobalDefinition $ A.functionDefaults { A.G.returnType = toLLVMType rettype, A.G.name = A.Name name, - A.G.parameters = ([A.Parameter (toLLVMType t) (A.Name n) [] | (t,n) <- args], False), + A.G.parameters = ([A.Parameter (toLLVMType t) (A.Name ("farg_"++n)) [] | (t,n) <- args], False), A.G.basicBlocks = bbs } gen _ = return Nothing -genBlock' :: Block -> CGMonad LLName -genBlock' bl = do +genFunctionBlock :: Block -> [(Type,Name)] -> CGMonad LLName +genFunctionBlock bl args = do + firstbb <- newBlock + let prepArg :: (Type,Name) -> CGMonad () + prepArg (t,n) = do + label <- addInstr $ A.Alloca (toLLVMType t) Nothing 0 [] + void $ addInstr $ A.Store False (A.LocalReference (A.ptr (toLLVMType t)) (A.Name label)) + (A.LocalReference (toLLVMType t) (A.Name ("farg_"++n))) + Nothing 0 [] + setVar n label t + sequence_ $ map prepArg args + termbb <- newBlock setTerminator $ A.Unreachable [] - genBlock bl termbb + + bodybb <- genBlock bl termbb + changeBlock firstbb + setTerminator $ A.Br (A.Name bodybb) [] + return firstbb genBlock :: Block -> LLName -- name of BasicBlock following this Block @@ -378,8 +413,8 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do return $ A.LocalReference (toLLVMType t) (A.Name label) Equal -> do sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2)) - trace ("Shared type for Equal of " ++ pshow e1 ++ " and " ++ pshow e2 ++ " is: " ++ pshow sharedType) - $ return () + -- trace ("Shared type for Equal of " ++ pshow e1 ++ " and " ++ pshow e2 ++ " is: " ++ pshow sharedType) + -- $ return () e1op' <- castOperand e1op sharedType e2op' <- castOperand e2op sharedType label <- case sharedType of |