Implement TLP output channels using a CIF helper process.

Input channels will be similar, but are stubbed out for now.

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 <tock_support_cif.h>\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

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 (),

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"
 
 --}}}
 

support/tock_support_cif.h

@@ -20,6 +20,7 @@
 #define TOCK_SUPPORT_CIF_H
 
 #include <cif.h>
+#include <stdio.h>
 
 //{{{  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