diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index b4fc8c3..6333bd6 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -118,7 +118,6 @@ cgenOps = GenOps { genSpecMode = cgenSpecMode, genStop = cgenStop, genStructured = cgenStructured, - genTLPChannel = cgenTLPChannel, genTimerRead = cgenTimerRead, genTimerWait = cgenTimerWait, genTopLevel = cgenTopLevel, @@ -141,42 +140,54 @@ cgenOps = GenOps { generateC :: Handle -> A.AST -> PassM () generateC = generate cgenOps -cgenTLPChannel :: TLPChannel -> CGen () -cgenTLPChannel TLPIn = tell ["in"] -cgenTLPChannel TLPOut = tell ["out"] -cgenTLPChannel TLPError = tell ["err"] - cgenTopLevel :: A.AST -> CGen () cgenTopLevel s = do tell ["#include \n"] cs <- getCompState - (tlpName, chans) <- tlpInterface + (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] sequence_ $ map (call genForwardDeclaration) (listify (const True :: A.Specification -> Bool) s) - sequence_ [do tell ["extern int " ++ nameString n ++ "_wrapper_stack_size;\n"] + sequence_ [do tell ["extern int ", nameString n, "_wrapper_stack_size;\n"] cgenProcWrapper n - | n <- tlpName : (Set.toList $ csParProcs cs)] + | n <- Set.toList $ csParProcs cs] + tell ["extern int "] + genName tlpName + tell ["_stack_size;\n"] call genStructured s (\m _ -> tell ["\n#error Invalid top-level item: ", show m]) - tell ["void tock_main (Workspace wptr) {\n\ - \ Workspace tlp = ProcAlloc (wptr, ", show $ length chans, ", "] - genName tlpName - tell ["_wrapper_stack_size);\n"] - sequence_ [do tell [" ProcParam (wptr, tlp, " ++ show i ++ ", "] - call genTLPChannel c - tell [");\n"] - | (i, (_, c)) <- zip [(0 :: Int)..] chans] + 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"] + + sequence_ [tell [" LightProcStart (wptr, &bar, ", ws, ", (Process) ", func, ");\n"] + | (ws, func) <- zip workspaces funcs] tell ["\n\ - \ LightProcBarrier bar;\n\ - \ LightProcBarrierInit (wptr, &bar, 1);\n\ - \ LightProcStart (wptr, &bar, tlp, (Process) "] + \ "] genName tlpName - tell ["_wrapper);\n\ - \ LightProcBarrierWait (wptr, &bar);\n\ + tell [" (wptr"] + sequence_ [tell [", &", c] | c <- chans] + tell [");\n\ + \\n\ + \ bool b = true;\n"] + sequence_ [tell [" ChanOut (wptr, &", kc, ", &b, sizeof b);\n"] + | kc <- killChans] + + tell [" LightProcBarrierWait (wptr, &bar);\n\ \ Shutdown (wptr);\n\ \}\n\ \\n\ @@ -184,12 +195,30 @@ cgenTopLevel s \ if (!ccsp_init ())\n\ \ return 1;\n\ \\n\ - \ Workspace p = ProcAllocInitial (0, 512);\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 + -- | Allocate a TLP channel handler process, and return the function that + -- implements it. + genTLPHandler :: (A.Direction, TLPChannel) -> String -> String -> String -> CGen String + genTLPHandler (_, tc) c kc ws + = do tell [" Workspace ", ws, " = ProcAlloc (wptr, 3, 1024);\n\ + \ ProcParam (wptr, ", ws, ", 0, &", c, ");\n\ + \ ProcParam (wptr, ", ws, ", 1, &", kc, ");\n\ + \ ProcParam (wptr, ", ws, ", 2, ", fp, ");\n\ + \\n"] + return func + where + (fp, func) = case tc of + TLPIn -> ("stdin", "tock_tlp_input") + TLPOut -> ("stdout", "tock_tlp_output") + TLPError -> ("stderr", "tock_tlp_output") --}}} --{{{ utilities diff --git a/backends/GenerateCBased.hs b/backends/GenerateCBased.hs index 5e66954..64b437d 100644 --- a/backends/GenerateCBased.hs +++ b/backends/GenerateCBased.hs @@ -30,7 +30,6 @@ import Errors import Metadata import Pass import qualified Properties as Prop -import TLP cCppCommonPreReq :: [Property] cCppCommonPreReq = @@ -166,7 +165,6 @@ data GenOps = GenOps { -- | Generates a STOP process that uses the given Meta tag and message as its printed message. genStop :: Meta -> String -> CGen (), genStructured :: forall a. Data a => A.Structured a -> (Meta -> a -> CGen ()) -> CGen (), - genTLPChannel :: TLPChannel -> CGen (), genTimerRead :: A.Variable -> A.Variable -> CGen (), genTimerWait :: A.Expression -> CGen (), genTopLevel :: A.AST -> CGen (), diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index 741645f..43ee885 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -146,11 +146,14 @@ cppgenTopLevel s where tlpChannel :: (A.Direction,TLPChannel) -> CGen() tlpChannel (dir,c) = case dir of - A.DirUnknown -> tell ["&"] >> chanName - A.DirInput -> chanName >> tell [" .reader() "] - A.DirOutput -> chanName >> tell [" .writer() "] + A.DirUnknown -> tell ["&", chanName] + A.DirInput -> tell [chanName, ".reader() "] + A.DirOutput -> tell [chanName, ".writer() "] where - chanName = call genTLPChannel c + chanName = case c of + TLPIn -> "in" + TLPOut -> "out" + TLPError -> "err" --}}} diff --git a/support/tock_support_cif.h b/support/tock_support_cif.h index 168859a..f56b641 100644 --- a/support/tock_support_cif.h +++ b/support/tock_support_cif.h @@ -20,6 +20,7 @@ #define TOCK_SUPPORT_CIF_H #include +#include //{{{ occam_stop #define occam_stop(pos, nargs, format, args...) \ @@ -42,4 +43,40 @@ static inline void tock_init_chan_array (Channel *pointTo, Channel **pointFrom, } //}}} +//{{{ top-level process interface +static void tock_tlp_input (Workspace wptr) occam_unused; +static void tock_tlp_input (Workspace wptr) { + Channel *out = ProcGetParam (wptr, 0, Channel *); + Channel *kill = ProcGetParam (wptr, 1, Channel *); + FILE *in = ProcGetParam (wptr, 2, FILE *); + + // FIXME: Implement using killable BSC +} + +static void tock_tlp_output (Workspace wptr) occam_unused; +static void tock_tlp_output (Workspace wptr) { + Channel *in = ProcGetParam (wptr, 0, Channel *); + Channel *kill = ProcGetParam (wptr, 1, Channel *); + FILE *out = ProcGetParam (wptr, 2, FILE *); + + while (true) { + switch (ProcAlt (wptr, in, kill, NULL)) { + case 0: { + uint8_t ch; + ChanIn (wptr, in, &ch, sizeof ch); + ExternalCallN (fputc, 2, ch, out); + + break; + } + case 1: { + bool b; + ChanIn (wptr, kill, &b, sizeof b); + + return; + } + } + } +} +//}}} + #endif