diff --git a/Main.hs b/Main.hs index ef5268d..abb53f8 100644 --- a/Main.hs +++ b/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 -> diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 2ec6bd9..9ed76d2 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -163,10 +163,6 @@ cgenTopLevel headerName s = do tell ["#define occam_INT_size ", show cIntSize,"\n"] tell ["#include \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 diff --git a/data/CompState.hs b/data/CompState.hs index daa965a..329ef1d 100644 --- a/data/CompState.hs +++ b/data/CompState.hs @@ -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, diff --git a/frontends/PreprocessOccam.hs b/frontends/PreprocessOccam.hs index 911d656..d58c315 100644 --- a/frontends/PreprocessOccam.hs +++ b/frontends/PreprocessOccam.hs @@ -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