summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--codegen.hs31
-rw-r--r--nl/test_string.nl1
2 files changed, 27 insertions, 5 deletions
diff --git a/codegen.hs b/codegen.hs
index b9f822a..9a8bf1c 100644
--- a/codegen.hs
+++ b/codegen.hs
@@ -254,7 +254,7 @@ genFunctions (Program decs) = liftM (mapMaybe id) $ mapM gen decs
allBlocks = Map.empty,
variables = Map.empty
})
- firstbb <- genFunctionBlock body args
+ firstbb <- genFunctionBlock body (rettype, name) args
cleanupTrampolines
blockmap <- liftM allBlocks get
let bbs' = map snd $ filter (\x -> fst x /= firstbb) $ Map.toList blockmap
@@ -269,8 +269,8 @@ genFunctions (Program decs) = liftM (mapMaybe id) $ mapM gen decs
-genFunctionBlock :: Block -> [(Type,Name)] -> CGMonad LLName
-genFunctionBlock bl args = do
+genFunctionBlock :: Block -> (Type, Name) -> [(Type, Name)] -> CGMonad LLName
+genFunctionBlock bl (rettype, fname) args = do
firstbb <- newBlock
let prepArg :: (Type,Name) -> CGMonad ()
prepArg (t,n) = do
@@ -282,15 +282,24 @@ genFunctionBlock bl args = do
sequence_ $ map prepArg args
termbb <- newBlock
- setTerminator $ A.Unreachable []
+ setTerminator $ if rettype == TypeVoid then A.Ret Nothing [] else A.Unreachable []
bodybb <- genBlock bl termbb
changeBlock firstbb
setTerminator $ A.Br (A.Name bodybb) []
+
+ if rettype /= TypeVoid
+ then whenM (bbIsReferenced termbb) $ throwError $
+ "Control reaches end of non-void function '" ++ fname ++ "'"
+ else return ()
+
if length args > 0
then return firstbb
else return bodybb
+whenM :: (Monad m) => m Bool -> m a -> m ()
+whenM cond value = cond >>= \c -> if c then void value else return ()
+
genBlock :: Block
-> LLName -- name of BasicBlock following this Block
-> CGMonad LLName -- name of first BasicBlock
@@ -628,6 +637,20 @@ cleanupTrampolines = do
| otherwise = A.Name x
changeName _ _ (A.UnName _) = undefined
+bbIsReferenced :: LLName -> CGMonad Bool
+bbIsReferenced bb = do
+ bbs <- liftM allBlocks get
+ return $ any checkBlock bbs
+ where
+ checkBlock :: A.BasicBlock -> Bool
+ checkBlock (A.BasicBlock name instrs (_ A.:= term)) = checkBlock (A.BasicBlock name instrs (A.Do term))
+ checkBlock (A.BasicBlock _ _ (A.Do term)) = case term of
+ (A.Ret _ _) -> False
+ (A.CondBr _ (A.Name d1) (A.Name d2) _) -> d1 == bb || d2 == bb
+ (A.Br (A.Name d) _) -> d == bb
+ (A.Unreachable _) -> False
+ _ -> undefined
+
toLLVMType :: Type -> A.Type
toLLVMType (TypeInt s) = A.IntegerType $ fromIntegral s
diff --git a/nl/test_string.nl b/nl/test_string.nl
index ccba9a1..d120b48 100644
--- a/nl/test_string.nl
+++ b/nl/test_string.nl
@@ -6,7 +6,6 @@ extern func void(int) putchar;
void f(char c) {
putchar(c);
- return;
}
int main(int argc, ptr(string) argv) {