diff options
author | tomsmeding <tom.smeding@gmail.com> | 2017-01-29 22:29:24 +0100 |
---|---|---|
committer | tomsmeding <tom.smeding@gmail.com> | 2017-01-29 22:29:24 +0100 |
commit | 8f444b0c2a6d468a596949926eccf1edf932d4df (patch) | |
tree | a55eb16637d0c7f0ebb3fa4f4ab7dbb80cf8af40 /codegen.hs | |
parent | ce13c3ff2b64e1bfde13f735d871ea0a0e58a145 (diff) |
Calling external functions!
- Call extern-declared functions
- Parse 'c'har literals
- Correctly make function arguments into local variables
- Fix error message in check.hs (new line 153)
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 |