Added a command line option to indicate that there is no main PROC

This commit is contained in:
Neil Brown 2009-04-01 15:29:22 +00:00
parent 219bfd9ce1
commit abce001bab
4 changed files with 63 additions and 48 deletions

View File

@ -69,6 +69,7 @@ optionsNoWarnings =
, Option [] ["run-indent"] (NoArg $ optRunIndent) "run indent on source before compilation (will full mode)" , Option [] ["run-indent"] (NoArg $ optRunIndent) "run indent on source before compilation (will full mode)"
, Option [] ["frontend"] (ReqArg optFrontend "FRONTEND") "language frontend (options: occam, rain)" , Option [] ["frontend"] (ReqArg optFrontend "FRONTEND") "language frontend (options: occam, rain)"
, Option [] ["mode"] (ReqArg optMode "MODE") "select mode (options: flowgraph, lex, html, parse, compile, post-c, full)" , Option [] ["mode"] (ReqArg optMode "MODE") "select mode (options: flowgraph, lex, html, parse, compile, post-c, full)"
, Option [] ["no-main"] (NoArg optNoMain) "file has no main process; do not link either"
, Option ['o'] ["output"] (ReqArg optOutput "FILE") "output file (default \"-\")" , Option ['o'] ["output"] (ReqArg optOutput "FILE") "output file (default \"-\")"
, Option [] ["sanity-check"] (ReqArg optSanityCheck "SETTING") "internal sanity check (options: on, off)" , Option [] ["sanity-check"] (ReqArg optSanityCheck "SETTING") "internal sanity check (options: on, off)"
, Option [] ["occam2-mobility"] (ReqArg optClassicOccamMobility "SETTING") "occam2 implicit mobility (EXPERIMENTAL) (options: on, off)" , Option [] ["occam2-mobility"] (ReqArg optClassicOccamMobility "SETTING") "occam2 implicit mobility (EXPERIMENTAL) (options: on, off)"
@ -132,6 +133,9 @@ optKeepTemporaries ps = return $ ps { csKeepTemporaries = True }
optRunIndent :: OptFunc optRunIndent :: OptFunc
optRunIndent ps = return $ ps { csRunIndent = True } optRunIndent ps = return $ ps { csRunIndent = True }
optNoMain :: OptFunc
optNoMain ps = return $ ps { csHasMain = False }
optStackSize :: String -> OptFunc optStackSize :: String -> OptFunc
optStackSize s ps = return $ ps { csUnknownStackSize = read s } optStackSize s ps = return $ ps { csUnknownStackSize = read s }
@ -261,6 +265,8 @@ compileFull inputFile moutputFile
when (csRunIndent optsPS) $ when (csRunIndent optsPS) $
exec $ "indent " ++ cFile exec $ "indent " ++ cFile
shouldLink <- lift getCompState >>* csHasMain
case csBackend optsPS of case csBackend optsPS of
BackendC -> BackendC ->
let sFile = outputFile ++ ".s" let sFile = outputFile ++ ".s"
@ -280,6 +286,7 @@ compileFull inputFile moutputFile
-- Compile this new "post" C file into an object file -- Compile this new "post" C file into an object file
exec $ cCommand postCFile postOFile (csCompilerFlags optsPS) exec $ cCommand postCFile postOFile (csCompilerFlags optsPS)
-- Link the object files into a binary -- Link the object files into a binary
when shouldLink $
exec $ cLinkCommand [oFile, postOFile] outputFile (csCompilerLinkFlags optsPS) exec $ cLinkCommand [oFile, postOFile] outputFile (csCompilerLinkFlags optsPS)
-- For C++, just compile the source file directly into a binary -- For C++, just compile the source file directly into a binary

View File

@ -163,10 +163,6 @@ cgenTopLevel headerName s
= do tell ["#define occam_INT_size ", show cIntSize,"\n"] = do tell ["#define occam_INT_size ", show cIntSize,"\n"]
tell ["#include <tock_support_cif.h>\n"] tell ["#include <tock_support_cif.h>\n"]
cs <- getCompState cs <- getCompState
(tlpName, tlpChans) <- tlpInterface
chans <- sequence [csmLift $ makeNonce "tlp_channel" | _ <- tlpChans]
killChans <- sequence [csmLift $ makeNonce "tlp_channel_kill" | _ <- tlpChans]
workspaces <- sequence [csmLift $ makeNonce "tlp_channel_ws" | _ <- tlpChans]
tellToHeader $ sequence_ $ map (call genForwardDeclaration) tellToHeader $ sequence_ $ map (call genForwardDeclaration)
(listify (const True :: A.Specification -> Bool) s) (listify (const True :: A.Specification -> Bool) s)
@ -179,6 +175,9 @@ cgenTopLevel headerName s
{A.ndName = n {A.ndName = n
,A.ndSpecType=A.Proc _ (_,A.Recursive) _ _ ,A.ndSpecType=A.Proc _ (_,A.Recursive) _ _
} <- Map.elems $ csNames cs]] } <- Map.elems $ csNames cs]]
when (csHasMain cs) $ do
(tlpName, tlpChans) <- tlpInterface
tell ["extern int "] tell ["extern int "]
genName tlpName genName tlpName
tell ["_stack_size;\n"] tell ["_stack_size;\n"]
@ -189,6 +188,13 @@ cgenTopLevel headerName s
call genStructured s (\m _ -> tell ["\n#error Invalid top-level item: ", show m]) call genStructured s (\m _ -> tell ["\n#error Invalid top-level item: ", show m])
when (csHasMain cs) $ do
(tlpName, tlpChans) <- tlpInterface
chans <- sequence [csmLift $ makeNonce "tlp_channel" | _ <- tlpChans]
killChans <- sequence [csmLift $ makeNonce "tlp_channel_kill" | _ <- tlpChans]
workspaces <- sequence [csmLift $ makeNonce "tlp_channel_ws" | _ <- tlpChans]
tell ["void tock_main (Workspace wptr) {\n"] tell ["void tock_main (Workspace wptr) {\n"]
sequence_ [do tell [" Channel ", c, ";\n"] sequence_ [do tell [" Channel ", c, ";\n"]
tell [" ChanInit (wptr, &", c, ");\n"] tell [" ChanInit (wptr, &", c, ");\n"]

View File

@ -98,6 +98,7 @@ data CompState = CompState {
csMode :: CompMode, csMode :: CompMode,
csBackend :: CompBackend, csBackend :: CompBackend,
csFrontend :: CompFrontend, csFrontend :: CompFrontend,
csHasMain :: Bool,
csCompilerFlags :: String, csCompilerFlags :: String,
csCompilerLinkFlags :: String, csCompilerLinkFlags :: String,
csSanityCheck :: Bool, csSanityCheck :: Bool,
@ -147,6 +148,7 @@ emptyState = CompState {
csMode = ModeFull, csMode = ModeFull,
csBackend = BackendC, csBackend = BackendC,
csFrontend = FrontendOccam, csFrontend = FrontendOccam,
csHasMain = True,
csCompilerFlags = "", csCompilerFlags = "",
csCompilerLinkFlags = "", csCompilerLinkFlags = "",
csSanityCheck = False, csSanityCheck = False,

View File

@ -191,14 +191,14 @@ handleUse m [modName]
put $ cs { csUsedFiles = Set.insert incName (csUsedFiles cs) } put $ cs { csUsedFiles = Set.insert incName (csUsedFiles cs) }
if Set.member incName (csUsedFiles cs) if Set.member incName (csUsedFiles cs)
then return return then return return
else handleInclude m [incName] else handleInclude m [incName ++ ".inc"]
where where
-- | If a module name doesn't already have a suffix, add one. -- | If a module name has a suffix, strip it
mangleModName :: String -> String mangleModName :: String -> String
mangleModName mod mangleModName mod
= if ".occ" `isSuffixOf` mod || ".inc" `isSuffixOf` mod = if ".occ" `isSuffixOf` mod || ".inc" `isSuffixOf` mod
then mod then (reverse . drop 4 . reverse) mod
else mod ++ ".occ" else mod
-- | Handle the @#DEFINE@ directive. -- | Handle the @#DEFINE@ directive.
handleDefine :: DirectiveFunc handleDefine :: DirectiveFunc