Added a command line option to indicate that there is no main PROC
This commit is contained in:
parent
219bfd9ce1
commit
abce001bab
7
Main.hs
7
Main.hs
|
@ -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
|
||||||
|
|
|
@ -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"]
|
||||||
|
|
|
@ -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,
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user