diff --git a/Main.hs b/Main.hs index 1198774..6a686d7 100644 --- a/Main.hs +++ b/Main.hs @@ -453,8 +453,10 @@ postCAnalyse :: String -> ((Handle, Handle), String) -> PassM () postCAnalyse fn ((outHandle, _), _) = do asm <- liftIO $ readFile fn + names <- needStackSizes + progress "Analysing assembly" - output <- analyseAsm asm + output <- analyseAsm (Just $ map A.nameName names) asm liftIO $ hPutStr outHandle output diff --git a/backends/AnalyseAsm.hs b/backends/AnalyseAsm.hs index 3eb6a0e..7e51b9c 100644 --- a/backends/AnalyseAsm.hs +++ b/backends/AnalyseAsm.hs @@ -186,8 +186,8 @@ addCalls unknownSize return $ localStack + maximum (0 : calledStacks) -- | Analyse assembler and return C source defining sizes. -analyseAsm :: String -> PassM String -analyseAsm asm +analyseAsm :: Maybe [String] -> String -> PassM String +analyseAsm mprocs asm = do let stream = parseAsm asm veryDebug $ pshow stream cs <- getCompState @@ -196,7 +196,11 @@ analyseAsm asm debug $ concat [printf " %-40s %5d %5d %s\n" func (fiStack fi) (fiTotalStack fi) (concat $ intersperse " " $ Set.toList $ fiCalls fi) - | (func, fi) <- Map.toList info] + | (func, fi) <- Map.toList $ filterNames info] let lines = ["const int " ++ func ++ "_stack_size = " ++ show (fiTotalStack fi) ++ ";\n" - | (func, fi) <- Map.toList info] + | (func, fi) <- Map.toList $ filterNames info] return $ concat lines + where + filterNames = case mprocs of + Nothing -> id + Just m -> (`Map.intersection` (Map.fromList (zip m (repeat ())))) diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index ff2fcdb..8f3e588 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -34,6 +34,7 @@ module GenerateC , genName , genRightB , genStatic + , needStackSizes , justOnly , withIf ) where @@ -159,6 +160,20 @@ cgenOps = GenOps { generateC :: (Handle, Handle) -> String -> A.AST -> PassM () generateC = generate cgenOps +needStackSizes :: (CSMR m, Die m) => m [A.Name] +needStackSizes + = do cs <- getCompState + main <- if csHasMain cs + then tlpInterface >>* fst >>* singleton + else return [] + return $ nub $ (Set.toList $ csParProcs cs `Set.difference` + Set.fromList (map (A.Name emptyMeta . fst) (csExternals cs))) + ++ [A.Name emptyMeta n + | A.NameDef {A.ndName = n + ,A.ndSpecType=A.Proc _ (_,A.Recursive) _ _ + } <- Map.elems $ csNames cs] + ++ main + cgenTopLevel :: String -> A.AST -> CGen () cgenTopLevel headerName s = do tell ["#define occam_INT_size ", show cIntSize,"\n"] @@ -180,13 +195,9 @@ cgenTopLevel headerName s sequence_ [tell ["#include \"", usedFile, ".tock.h\"\n"] | usedFile <- Set.toList $ csUsedFiles cs] + nss <- needStackSizes sequence_ [tell ["extern int "] >> genName n >> tell ["_stack_size;\n"] - | n <- (Set.toList $ csParProcs cs `Set.difference` - Set.fromList (map (A.Name emptyMeta . fst) (csExternals cs))) - ++ [A.Name emptyMeta n | A.NameDef - {A.ndName = n - ,A.ndSpecType=A.Proc _ (_,A.Recursive) _ _ - } <- Map.elems $ csNames cs]] + | n <- nss] when (csHasMain cs) $ do (tlpName, tlpChans) <- tlpInterface