Added a command line option to indicate that there is no main PROC
This commit is contained in:
Neil Brown
parent
219bfd9ce1
commit
abce001bab
9
Main.hs
9
Main.hs
|
|
@ -69,6 +69,7 @@ optionsNoWarnings =
|
|||
, 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 [] ["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 [] ["sanity-check"] (ReqArg optSanityCheck "SETTING") "internal sanity check (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 ps = return $ ps { csRunIndent = True }
|
||||
|
||||
optNoMain :: OptFunc
|
||||
optNoMain ps = return $ ps { csHasMain = False }
|
||||
|
||||
optStackSize :: String -> OptFunc
|
||||
optStackSize s ps = return $ ps { csUnknownStackSize = read s }
|
||||
|
||||
|
|
@ -261,6 +265,8 @@ compileFull inputFile moutputFile
|
|||
when (csRunIndent optsPS) $
|
||||
exec $ "indent " ++ cFile
|
||||
|
||||
shouldLink <- lift getCompState >>* csHasMain
|
||||
|
||||
case csBackend optsPS of
|
||||
BackendC ->
|
||||
let sFile = outputFile ++ ".s"
|
||||
|
|
@ -280,7 +286,8 @@ compileFull inputFile moutputFile
|
|||
-- Compile this new "post" C file into an object file
|
||||
exec $ cCommand postCFile postOFile (csCompilerFlags optsPS)
|
||||
-- Link the object files into a binary
|
||||
exec $ cLinkCommand [oFile, postOFile] outputFile (csCompilerLinkFlags optsPS)
|
||||
when shouldLink $
|
||||
exec $ cLinkCommand [oFile, postOFile] outputFile (csCompilerLinkFlags optsPS)
|
||||
|
||||
-- For C++, just compile the source file directly into a binary
|
||||
BackendCPPCSP ->
|
||||
|
|
|
|||
|
|
@ -163,10 +163,6 @@ cgenTopLevel headerName s
|
|||
= do tell ["#define occam_INT_size ", show cIntSize,"\n"]
|
||||
tell ["#include <tock_support_cif.h>\n"]
|
||||
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)
|
||||
(listify (const True :: A.Specification -> Bool) s)
|
||||
|
|
@ -179,9 +175,12 @@ cgenTopLevel headerName s
|
|||
{A.ndName = n
|
||||
,A.ndSpecType=A.Proc _ (_,A.Recursive) _ _
|
||||
} <- Map.elems $ csNames cs]]
|
||||
tell ["extern int "]
|
||||
genName tlpName
|
||||
tell ["_stack_size;\n"]
|
||||
|
||||
when (csHasMain cs) $ do
|
||||
(tlpName, tlpChans) <- tlpInterface
|
||||
tell ["extern int "]
|
||||
genName tlpName
|
||||
tell ["_stack_size;\n"]
|
||||
|
||||
-- Forward declarations of externals:
|
||||
sequence_ [tell ["extern void ", mungeExternalName n, "(int*);"]
|
||||
|
|
@ -189,48 +188,55 @@ cgenTopLevel headerName s
|
|||
|
||||
call genStructured s (\m _ -> tell ["\n#error Invalid top-level item: ", show m])
|
||||
|
||||
tell ["void tock_main (Workspace wptr) {\n"]
|
||||
sequence_ [do tell [" Channel ", c, ";\n"]
|
||||
tell [" ChanInit (wptr, &", c, ");\n"]
|
||||
| c <- chans ++ killChans]
|
||||
tell ["\n"]
|
||||
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]
|
||||
|
||||
funcs <- sequence [genTLPHandler tc c kc ws
|
||||
|
||||
tell ["void tock_main (Workspace wptr) {\n"]
|
||||
sequence_ [do tell [" Channel ", c, ";\n"]
|
||||
tell [" ChanInit (wptr, &", c, ");\n"]
|
||||
| c <- chans ++ killChans]
|
||||
tell ["\n"]
|
||||
|
||||
funcs <- sequence [genTLPHandler tc c kc ws
|
||||
| (tc, c, kc, ws) <- zip4 tlpChans chans killChans workspaces]
|
||||
|
||||
tell [" LightProcBarrier bar;\n\
|
||||
\ LightProcBarrierInit (wptr, &bar, ", show $ length chans, ");\n"]
|
||||
tell [" LightProcBarrier bar;\n\
|
||||
\ LightProcBarrierInit (wptr, &bar, ", show $ length chans, ");\n"]
|
||||
|
||||
sequence_ [tell [" LightProcStart (wptr, &bar, ", ws, ", (Process) ", func, ");\n"]
|
||||
| (ws, func) <- zip workspaces funcs]
|
||||
sequence_ [tell [" LightProcStart (wptr, &bar, ", ws, ", (Process) ", func, ");\n"]
|
||||
| (ws, func) <- zip workspaces funcs]
|
||||
|
||||
tell ["\n\
|
||||
\ "]
|
||||
genName tlpName
|
||||
tell [" (wptr"]
|
||||
sequence_ [tell [", &", c] | c <- chans]
|
||||
tell [");\n\
|
||||
\\n"]
|
||||
sequence_ [tell [" ", func, "_kill (wptr, &", kc, ");\n"]
|
||||
| (func, kc) <- zip funcs killChans]
|
||||
tell ["\n\
|
||||
\ "]
|
||||
genName tlpName
|
||||
tell [" (wptr"]
|
||||
sequence_ [tell [", &", c] | c <- chans]
|
||||
tell [");\n\
|
||||
\\n"]
|
||||
sequence_ [tell [" ", func, "_kill (wptr, &", kc, ");\n"]
|
||||
| (func, kc) <- zip funcs killChans]
|
||||
|
||||
let uses_stdin = if TLPIn `elem` (map snd tlpChans) then "true" else "false"
|
||||
tell [" LightProcBarrierWait (wptr, &bar);\n\
|
||||
\\n\
|
||||
\ Shutdown (wptr);\n\
|
||||
\}\n\
|
||||
\\n\
|
||||
\int main (int argc, char *argv[]) {\n\
|
||||
\ tock_init_ccsp (", uses_stdin, ");\n\
|
||||
\\n\
|
||||
\ Workspace p = ProcAllocInitial (0, "]
|
||||
genName tlpName
|
||||
tell ["_stack_size + 512);\n\
|
||||
\ ProcStartInitial (p, tock_main);\n\
|
||||
\\n\
|
||||
\ // NOTREACHED\n\
|
||||
\ return 0;\n\
|
||||
\}\n"]
|
||||
let uses_stdin = if TLPIn `elem` (map snd tlpChans) then "true" else "false"
|
||||
tell [" LightProcBarrierWait (wptr, &bar);\n\
|
||||
\\n\
|
||||
\ Shutdown (wptr);\n\
|
||||
\}\n\
|
||||
\\n\
|
||||
\int main (int argc, char *argv[]) {\n\
|
||||
\ tock_init_ccsp (", uses_stdin, ");\n\
|
||||
\\n\
|
||||
\ Workspace p = ProcAllocInitial (0, "]
|
||||
genName tlpName
|
||||
tell ["_stack_size + 512);\n\
|
||||
\ ProcStartInitial (p, tock_main);\n\
|
||||
\\n\
|
||||
\ // NOTREACHED\n\
|
||||
\ return 0;\n\
|
||||
\}\n"]
|
||||
where
|
||||
dropPath = reverse . takeWhile (/= '/') . reverse
|
||||
|
||||
|
|
|
|||
|
|
@ -98,6 +98,7 @@ data CompState = CompState {
|
|||
csMode :: CompMode,
|
||||
csBackend :: CompBackend,
|
||||
csFrontend :: CompFrontend,
|
||||
csHasMain :: Bool,
|
||||
csCompilerFlags :: String,
|
||||
csCompilerLinkFlags :: String,
|
||||
csSanityCheck :: Bool,
|
||||
|
|
@ -147,6 +148,7 @@ emptyState = CompState {
|
|||
csMode = ModeFull,
|
||||
csBackend = BackendC,
|
||||
csFrontend = FrontendOccam,
|
||||
csHasMain = True,
|
||||
csCompilerFlags = "",
|
||||
csCompilerLinkFlags = "",
|
||||
csSanityCheck = False,
|
||||
|
|
|
|||
|
|
@ -191,14 +191,14 @@ handleUse m [modName]
|
|||
put $ cs { csUsedFiles = Set.insert incName (csUsedFiles cs) }
|
||||
if Set.member incName (csUsedFiles cs)
|
||||
then return return
|
||||
else handleInclude m [incName]
|
||||
else handleInclude m [incName ++ ".inc"]
|
||||
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 mod
|
||||
= if ".occ" `isSuffixOf` mod || ".inc" `isSuffixOf` mod
|
||||
then mod
|
||||
else mod ++ ".occ"
|
||||
then (reverse . drop 4 . reverse) mod
|
||||
else mod
|
||||
|
||||
-- | Handle the @#DEFINE@ directive.
|
||||
handleDefine :: DirectiveFunc
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user