diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index a045cfc..1c77460 100644 --- a/fco2/GenerateC.hs +++ b/fco2/GenerateC.hs @@ -53,6 +53,14 @@ genTopLevel :: A.Process -> CGen () genTopLevel p = do tell ["#include \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"] --}}} diff --git a/fco2/Makefile b/fco2/Makefile index 6e04625..0707890 100644 --- a/fco2/Makefile +++ b/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) diff --git a/fco2/Parse.hs b/fco2/Parse.hs index 3c9feb5..e9c9d9f 100644 --- a/fco2/Parse.hs +++ b/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 diff --git a/fco2/ParseState.hs b/fco2/ParseState.hs index 35f12d5..fc4335d 100644 --- a/fco2/ParseState.hs +++ b/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. diff --git a/fco2/kroc-wrapper-c.c b/fco2/kroc-wrapper-c.c new file mode 100644 index 0000000..fd275bc --- /dev/null +++ b/fco2/kroc-wrapper-c.c @@ -0,0 +1,15 @@ +/* KRoC wrapper to run FCO-generated CIF program */ + +#include + +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]); +} diff --git a/fco2/kroc-wrapper.occ b/fco2/kroc-wrapper.occ new file mode 100644 index 0000000..df68147 --- /dev/null +++ b/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) +: