TLP support, KRoC wrapper to link against, and Process *me support -- commstime works :)

fco2/GenerateC.hs

@@ -53,6 +53,14 @@ genTopLevel :: A.Process -> CGen ()
 genTopLevel p
     =  do tell ["#include <fco_support.h>\n"]
           genProcess p
+
+          ps <- get
+          let mainName = fromJust $ psMainName ps
+          tell ["void fco_main (Process *me, Channel *in, Channel *out, Channel *err) {\n"]
+          genName mainName
+          -- FIXME This should depend on what interface it's actually got.
+          tell [" (me, in, out, err);\n"]
+          tell ["}\n"]
 --}}}
 
 --{{{  utilities
@@ -571,7 +579,7 @@ introduceSpec (n, A.IsChannelArray m t cs)
 introduceSpec (n, A.Proc m fs p)
     =  do tell ["void "]
           genName n
-          tell [" ("]
+          tell [" (Process *me"]
           genFormals fs
           tell [") {\n"]
           genProcess p
@@ -591,8 +599,11 @@ removeSpec _ = return ()
 --}}}
 
 --{{{  actuals/formals
+prefixComma :: [CGen ()] -> CGen ()
+prefixComma cs = sequence_ [genComma >> c | c <- cs]
+
 genActuals :: [(A.Actual, A.Formal)] -> CGen ()
-genActuals afs = sequence_ $ intersperse genComma (map genActual afs)
+genActuals afs = prefixComma (map genActual afs)
 
 genActual :: (A.Actual, A.Formal) -> CGen ()
 genActual (actual, A.Formal am t _)
@@ -620,7 +631,7 @@ numCArgs (A.Formal _ (A.Array _ _) _:fs) = 2 + numCArgs fs
 numCArgs (_:fs) = 1 + numCArgs fs
 
 genFormals :: [A.Formal] -> CGen ()
-genFormals fs = sequence_ $ intersperse genComma (map genFormal fs)
+genFormals fs = prefixComma (map genFormal fs)
 
 genFormal :: A.Formal -> CGen ()
 genFormal (A.Formal am t n)
@@ -769,8 +780,7 @@ genProcAlloc (pid, A.ProcCall m n as)
           -- FIXME stack size fixed here
           let stackSize = 4096
           tell [", ", show stackSize, ", ", show $ numCArgs fs]
-          sequence_ $ map (\a -> do tell [", "]
-                                    genActual a) (zip as fs)
+          genActuals (zip as fs)
           tell [");\n"]
 
 genProcCall :: A.Name -> [A.Actual] -> CGen ()
@@ -778,7 +788,7 @@ genProcCall n as
     =  do genName n
           ps <- get
           let fs = case fromJust $ specTypeOfName ps n of A.Proc _ fs _ -> fs
-          tell [" ("]
+          tell [" (me"]
           genActuals (zip as fs)
           tell [");\n"]
 --}}}

fco2/Makefile

@@ -20,11 +20,13 @@ sources = \
 $(targets): $(sources)
 	ghc -fglasgow-exts -o fco --make Main
 
+CFLAGS = -g -std=gnu99 -Wall `kroc --cflags` `kroc --ccincpath`
+
 %.fco.c: %.occ fco
 	./fco $< >$@
 
-%.fco.o: %.fco.c
-	gcc -g -std=gnu99 -Wall `kroc --cflags` `kroc --ccincpath` -c $<
+%.fco: %.fco.o kroc-wrapper-c.o kroc-wrapper.occ
+	kroc -o $@ kroc-wrapper.occ $< kroc-wrapper-c.o -lcif
 
 tests = $(wildcard testcases/*.occ)
 

fco2/Parse.hs

@@ -909,7 +909,7 @@ process
     <|> parallel
     <|> altProcess
     <|> procInstance
-    <|> do { m <- md; sMainMarker; eol; return $ A.Main m }
+    <|> mainProcess
     <|> handleSpecs (allocation <|> specification) process A.ProcSpec
     <?> "process"
 
@@ -1222,6 +1222,17 @@ actual (A.Formal am t n)
     where
       an = A.nameName n
 --}}}
+--{{{ main process
+mainProcess :: OccParser A.Process
+mainProcess
+    =  do m <- md
+          sMainMarker
+          eol
+          -- Find the last thing that was defined; it should be a PROC of the right type.
+          -- FIXME We should check that it's using a valid TLP interface.
+          updateState $ (\ps -> ps { psMainName = Just $ snd $ head $ psLocalNames ps })
+          return $ A.Main m
+--}}}
 --}}}
 --{{{ top-level forms
 -- This is only really true once we've tacked a process onto the bottom; a

fco2/ParseState.hs

@@ -14,7 +14,8 @@ data ParseState = ParseState {
     psNames :: [(String, A.NameDef)],
     psNameCounter :: Int,
     psNonceCounter :: Int,
-    psPulledItems :: [A.Process -> A.Process]
+    psPulledItems :: [A.Process -> A.Process],
+    psMainName :: Maybe A.Name
   }
   deriving (Show, Data, Typeable)
 
@@ -27,7 +28,8 @@ emptyState = ParseState {
     psNames = [],
     psNameCounter = 0,
     psNonceCounter = 0,
-    psPulledItems = []
+    psPulledItems = [],
+    psMainName = Nothing
   }
 
 -- | Add the definition of a name.

fco2/kroc-wrapper-c.c

@@ -0,0 +1,15 @@
+/* KRoC wrapper to run FCO-generated CIF program */
+
+#include <cifccsp.h>
+
+extern void fco_main (Process *me, Channel *in, Channel *out, Channel *err);
+
+void _fco_main_init (int *ws) {
+	Process *p = ProcAlloc (fco_main, 4096, 3,
+	                        (Channel *) ws[1], (Channel *) ws[2], (Channel *) ws[3]);
+	*((int *) ws[0]) = (int) p;
+}
+
+void _fco_main_free (int *ws) {
+	ProcAllocClean ((Process *) ws[0]);
+}

fco2/kroc-wrapper.occ

@@ -0,0 +1,14 @@
+-- KRoC wrapper to run FCO-generated CIF program
+
+#INCLUDE "cifccsp.inc"
+
+#PRAGMA EXTERNAL "PROC C.fco.main.init (INT raddr, CHAN BYTE in?, out!, err!) = 0"
+#PRAGMA EXTERNAL "PROC C.fco.main.free (VAL INT raddr) = 0"
+
+PROC kroc.main (CHAN BYTE in?, out!, err!)
+  INT addr:
+  SEQ
+    C.fco.main.init (addr, in?, out!, err!)
+    cifccsp.startprocess (addr)
+    C.fco.main.free (addr)
+: