diff options
| -rw-r--r-- | codegen.hs | 31 | ||||
| -rw-r--r-- | nl/test_string.nl | 1 |
2 files changed, 27 insertions, 5 deletions
@@ -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) { |