suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Reworked how stack sizes are calculated, and changed how we use them in the build process

Browse Source 
Now that we support separate compilation, some of the stack sizes for PROCs depend on the stack sizes of other PROCs that were compiled in different files.  We can't just assume the default 512 bytes for these "foreign" PROCs, because that often won't be enough.  So instead, we must make the stack sizes for the current PROCs depend on (i.e. use in the calculation) the stack sizes of the foreign PROCs.

This dependence adds some issues though.  We cannot declare in one C file a const int that depends on the value of an extern const int from another C file (not valid C, it seems).  So instead, we move all the stack size declarations to header files, and use #includes and the preprocessor to make sure that the stack sizes are statically determined.

This in turn simplifies the build process in some ways.  These headers only need to be compiled by the .occ file that has the main process, by including them all into a C file and compiling that as before.  It means that each .occ file only has one .o file resulting (plus two C headers*, and a .inc file) so linking is a bit less confusing.

* I am keeping the two C headers for now, rather than appending the sizes one to the normal header, because I'm not entirely sure whether having one header that the C file depends on may trigger a recompilation that we don't want in some build systems.  I can always merge them later if that's not a valid worry.
This commit is contained in:
Neil Brown 2009-04-03 12:24:53 +00:00
parent 9bf32e339d
commit b803b1ec91
3 changed files with 133 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
Main.hs
View File

@ -265,12 +265,11 @@ compileFull inputFile moutputFile
when (csRunIndent optsPS) $
exec $ "indent " ++ cFile
shouldLink <- lift getCompState >>* csHasMain
case csBackend optsPS of
BackendC ->
let sFile = outputFile ++ ".s"
oFile = outputFile ++ ".o"
postHFile = outputFile ++ "_post.h"
postCFile = outputFile ++ "_post.c"
postOFile = outputFile ++ "_post.o"
occFile = outputFile ++ "_wrapper.occ"
@ -281,20 +280,20 @@ compileFull inputFile moutputFile
exec $ cAsmCommand cFile sFile (csCompilerFlags optsPS)
exec $ cCommand sFile oFile (csCompilerFlags optsPS)
-- Analyse the assembly for stack sizes, and output a
-- "post" C file
lift $ withOutputFile postCFile $ \h -> postCAnalyse sFile ((h,intErr),intErr)
-- Compile this new "post" C file into an object file
exec $ cCommand postCFile postOFile (csCompilerFlags optsPS)
-- "post" H file
lift $ withOutputFile postHFile $ \h -> postCAnalyse sFile ((h,intErr),intErr)
cs <- lift getCompState
let otherOFiles = concat [[usedFile ++ ".tock.o"
,usedFile ++ ".tock_post.o"
]
| usedFile <- Set.toList $ csUsedFiles cs]
when (csHasMain optsPS) $ do
lift $ withOutputFile postCFile $ \h -> liftIO $ hPutStr h $
"#include \"" ++ postHFile ++ "\"\n"
-- Compile this new "post" C file into an object file
exec $ cCommand postCFile postOFile (csCompilerFlags optsPS)
-- Link the object files into a binary
when shouldLink $
let otherOFiles = [usedFile ++ ".tock.o"
| usedFile <- Set.toList $ csUsedFiles cs]
-- Link the object files into a binary
exec $ cLinkCommand (oFile : postOFile : otherOFiles) outputFile (csCompilerLinkFlags optsPS)
-- For C++, just compile the source file directly into a binary

141
backends/AnalyseAsm.hs
View File

@ -41,6 +41,7 @@ import CompState
import Errors
import Pass
import PrettyShow
import Utils
-- | Interesting things that we might find in the assembly source.
data AsmItem =
@ -103,10 +104,24 @@ parseAsm :: String -> [AsmItem]
parseAsm asm
= catMaybes [parseAsmLine l | l <- lines asm]
data StackInfo
= Fixed Int
| Remote String
| Max [StackInfo]
| Plus StackInfo StackInfo
deriving (Show, Data, Typeable)
findAllDependencies :: StackInfo -> Set.Set String
findAllDependencies (Remote s) = Set.singleton s
findAllDependencies (Max as) = foldl Set.union Set.empty $ map findAllDependencies as
findAllDependencies (Plus a b) = findAllDependencies a `Set.union` findAllDependencies b
findAllDependencies _ = Set.empty
-- | Information about defined functions.
data FunctionInfo = FunctionInfo {
fiStack :: Int
, fiTotalStack :: Int
, fiTotalStack :: Maybe StackInfo
, fiCalls :: Set.Set String
}
deriving (Show, Data, Typeable)
@ -114,13 +129,16 @@ data FunctionInfo = FunctionInfo {
emptyFI :: FunctionInfo
emptyFI = FunctionInfo {
fiStack = 0
, fiTotalStack = -1
, fiTotalStack = Nothing
, fiCalls = Set.empty
}
-- | Monad for `AnalyseAsm` operations.
type AAM = StateT (Map.Map String FunctionInfo) PassM
instance CSMR AAM where
getCompState = lift getCompState
-- | Collect information about each function that's been defined.
collectInfo :: [AsmItem] -> AAM ()
collectInfo ais = collectInfo' ais ""
@ -156,34 +174,67 @@ baseStackSize :: Int
baseStackSize = 32
-- | Add the stack sizes for called functions to their callers.
addCalls :: Int -> AAM ()
addCalls unknownSize
addCalls :: [String] -> Int -> AAM ()
addCalls knownProcs unknownSize
= do fmap <- get
sequence_ $ map computeStack (Map.keys fmap)
sequence_ $ map (computeStack True) (Map.keys fmap)
where
computeStack :: String -> AAM Int
computeStack func
computeStack :: Bool -> String -> AAM StackInfo
computeStack processUser func
= do fmap <- get
let fi = Map.findWithDefault emptyFI func fmap
let tstack = fiTotalStack fi
tstack' <- if Map.member func fmap
then (if tstack == -1
then userFunc fi
else return tstack)
tstack' <- if Map.member func fmap && processUser
then (case tstack of
Nothing -> userFunc fi
Just x -> return x)
else systemFunc func
modify $ Map.insert func (fi { fiTotalStack = tstack' })
when processUser $ modify $ Map.insert func (fi { fiTotalStack = Just tstack' })
return tstack'
systemFunc :: String -> AAM Int
systemFunc :: String -> AAM StackInfo
systemFunc func
= do lift $ warnPlainP WarnInternal $ "Unknown function " ++ func ++ "; allocating " ++ show unknownSize ++ " bytes stack"
return unknownSize
= do cs <- getCompState
fmap <- get
if func `elem` (map fst (csExternals cs) ++ knownProcs)
then do return $ Remote $ func
else do lift $ warnPlainP WarnInternal $ "Unknown function " ++ func
++ "; allocating " ++ show unknownSize ++ " bytes stack"
return $ Fixed unknownSize
userFunc :: FunctionInfo -> AAM Int
userFunc :: FunctionInfo -> AAM StackInfo
userFunc fi
= do let localStack = fiStack fi + baseStackSize
calledStacks <- mapM computeStack $ Set.toList $ fiCalls fi
return $ localStack + maximum (0 : calledStacks)
calledStacks <- mapM (computeStack False) $ Set.toList $ fiCalls fi
return $ Fixed localStack `Plus` Max (Fixed 0 : calledStacks)
-- I don't think we can use sortBy here because we only have a partial ordering,
-- not a total ordering (transitivity, for one, isn't automatic).
--
-- So our plan is as follows. We calculate all the dependencies for each item.
-- We put all the items with no dependents first, and then we recurse, removing
-- all the no-dependent items from the dependencies of the others.
dependenceSort :: Set.Set String -> [(String, FunctionInfo)] -> [(String, FunctionInfo)]
dependenceSort ofInterest origItems = map fst $ dependenceSort' itemsWithDependents
where
itemsWithDependents = [(item, ofInterest `Set.intersection`
(maybe Set.empty findAllDependencies $ fiTotalStack $ snd item)) | item <- origItems]
dependenceSort' :: [((String, FunctionInfo), Set.Set String)]
-> [((String, FunctionInfo), Set.Set String)]
dependenceSort' [] = []
dependenceSort' items
| null firstItems -- Infinite loop if we don't stop it:
= error $ "Cyclic dependencies in stack sizes: "
++ show [n ++ " depends on " ++ show deps | ((n, _), deps) <- rest]
| otherwise
= firstItems ++ dependenceSort' [(item, deps `Set.difference` ignore)
| (item, deps) <- rest]
where
(firstItems, rest) = partition (Set.null . snd) items
ignore = Set.fromList $ map (fst . fst) firstItems
-- | Analyse assembler and return C source defining sizes.
analyseAsm :: Maybe [String] -> String -> PassM String
@ -191,16 +242,54 @@ analyseAsm mprocs asm
= do let stream = parseAsm asm
veryDebug $ pshow stream
cs <- getCompState
info <- execStateT (collectInfo stream >> addCalls (csUnknownStackSize cs)) Map.empty
let unique = concat [if c `elem` (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'])
then [c]
else '_' : show (ord c)
| c <- csCurrentFile cs]
info <- execStateT (collectInfo stream >> addCalls (fromMaybe [] mprocs) (csUnknownStackSize cs)) Map.empty
debug $ "Analysed function information:"
debug $ concat [printf " %-40s %5d %5d %s\n"
func (fiStack fi) (fiTotalStack fi)
(concat $ intersperse " " $ Set.toList $ fiCalls fi)
| (func, fi) <- Map.toList $ filterNames info]
let lines = ["const int " ++ func ++ "_stack_size = " ++ show (fiTotalStack fi) ++ ";\n"
| (func, fi) <- Map.toList $ filterNames info]
return $ concat lines
-- debug $ concat [printf " %-40s %5d %5d %s\n"
-- func (fiStack fi) (fiTotalStack fi)
-- (concat $ intersperse " " $ Set.toList $ fiCalls fi)
-- | (func, fi) <- Map.toList $ filterNames info]
let lines = -- Can't remember if max is a standard function so let's make our own:
"#ifndef TOCK_MAX\n#define TOCK_MAX(x,y) ((x) > (y) ? (x) : (y))\n#endif\n" :
["#include \"" ++ f ++ ".tock_post.h\"\n"
| f <- Set.toList $ csUsedFiles cs] ++
["#define " ++ func ++ "_stack_size_CPP "
++ maybe "#error Unknown!" toC (fiTotalStack fi) ++ "\n"
++ "const int " ++ func ++ "_stack_size = " ++ func ++ "_stack_size_CPP;\n"
| (func, fi) <- dependenceSort (maybe Set.empty Set.fromList mprocs) $ Map.toList $ filterNames info]
return $ "#ifndef INCLUDED_" ++ unique ++ "\n#define INCLUDED_" ++ unique
++ "\n" ++ concat lines ++ "\n#endif\n"
where
filterNames = case mprocs of
Nothing -> id
Just m -> (`Map.intersection` (Map.fromList (zip m (repeat ()))))
findAllPlus :: StackInfo -> (Int, [StackInfo])
findAllPlus (Fixed n) = (n, [])
findAllPlus (Plus a b) = findAllPlus a `with` findAllPlus b
where
with (m, as) (n, bs) = (m + n, as ++ bs)
findAllPlus a = (0, [a])
-- Without the simplifications in this function, the nesting of TOCK_MAX (and
-- its exponentially-sized expansion) was blowing the mind of the C compiler,
-- and the memory of my machine.
toC :: StackInfo -> String
toC (Fixed n) = show n
toC (Remote s) = s ++ "_stack_size_CPP"
toC x@(Plus {}) = let (m, as) = findAllPlus x in
(if m == 0 then id else \x -> "(" ++ show m ++ "+" ++ x ++ ")") $
concat (intersperse "+" $ map toC as)
toC (Max as) = foldl makeMax (show fixed) (map toC other)
where
fixed = maximum [n | Fixed n <- as]
other = filter isNotFixed as
makeMax a b = "TOCK_MAX(" ++ a ++ "," ++ b ++ ")"
isNotFixed (Fixed {}) = False
isNotFixed _ = True

16
backends/GenerateC.hs
View File

@ -164,16 +164,12 @@ 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
return $ nub $ ([A.Name emptyMeta $ nameString $ A.Name emptyMeta n
| A.NameDef {A.ndName = n
,A.ndSpecType=A.Proc {}
} <- Map.elems $ csNames cs]
)
\\ (map (A.Name emptyMeta . nameString . A.Name emptyMeta . fst) (csExternals cs))
cgenTopLevel :: String -> A.AST -> CGen ()
cgenTopLevel headerName s