Implement ALT (somewhat incompletely for now, owing to CIF limitations)

fco2/GenerateC.hs

@@ -838,11 +838,11 @@ genProcess p = case p of
   A.While m e p -> genWhile e p
   A.Par m pm ps -> genPar pm ps
   A.ParRep m pm r p -> genParRep pm r p
-  --A.Processor m e p
-  --A.Alt m b s
+  A.Processor m e p -> missing "PROCESSOR not supported"
+  A.Alt m b s -> genAlt b s
   A.ProcCall m n as -> genProcCall n as
-  _ -> missing $ "genProcess " ++ show p
 
+--{{{  assignment
 genAssign :: [A.Variable] -> A.ExpressionList -> CGen ()
 genAssign vs el
     = case el of
@@ -867,7 +867,8 @@ genAssign vs el
                                    tell [" = ", n, ";\n"])
                     (zip vs ns)
                tell ["}\n"]
-
+--}}}
+--{{{  input
 genInput :: A.Variable -> A.InputMode -> CGen ()
 genInput c im
     =  do ps <- get
@@ -932,7 +933,8 @@ genTimerWait e
     =  do tell ["ProcTimeAfter ("]
           genExpression e
           tell [");\n"]
-
+--}}}
+--{{{  output
 genOutput :: A.Variable -> [A.OutputItem] -> CGen ()
 genOutput c ois = sequence_ $ map (genOutputItem c) ois
 
@@ -949,10 +951,12 @@ genOutputCase c tag ois
           genName proto
           tell [");\n"]
           genOutput c ois
-
+--}}}
+--{{{  stop
 genStop :: CGen ()
 genStop = tell ["SetErr ();\n"]
-
+--}}}
+--{{{  if
 -- FIXME: This could be special-cased to generate if ... else if ... for bits
 -- that aren't replicated and don't have specs.
 -- FIXME: As with CASE, this could use a flag to detect whether to generate the STOP.
@@ -974,7 +978,8 @@ genIfBody label (A.OnlyC m (A.Choice m' e p))
           tell ["goto ", label, ";\n"]
           tell ["}\n"]
 genIfBody label (A.Several m ss) = sequence_ $ map (genIfBody label) ss
-
+--}}}
+--{{{  case
 genCase :: A.Expression -> A.Structured -> CGen ()
 genCase e s
     =  do tell ["switch ("]
@@ -1006,7 +1011,8 @@ genCaseBody coll (A.OnlyO _ (A.Else _ p))
 genCaseBody coll (A.Several _ ss)
     =  do seens <- mapM (genCaseBody coll) ss
           return $ or seens
-
+--}}}
+--{{{  while
 genWhile :: A.Expression -> A.Process -> CGen ()
 genWhile e p
     =  do tell ["while ("]
@@ -1014,7 +1020,8 @@ genWhile e p
           tell [") {\n"]
           genProcess p
           tell ["}\n"]
-
+--}}}
+--{{{  par
 genPar :: A.ParMode -> [A.Process] -> CGen ()
 genPar pm ps
     =  do pids <- mapM (\_ -> makeNonce "pid") ps
@@ -1059,7 +1066,98 @@ genProcAlloc (A.ProcCall m n as)
           tell [", ", show stackSize, ", ", show $ numCArgs as]
           genActuals as
           tell [")"]
+--}}}
+--{{{  alt
+-- FIXME This will always generate a dynamic array -- we'd need a pass to tell
+-- if all the replicator sizes were constant.
+-- The code it generates is really not very nice; it would be better if CIF
+-- exposed the enable/wait/disable instructions.
+genAlt :: Bool -> A.Structured -> CGen ()
+genAlt isPri s
+    =  do chans <- makeNonce "channels"
+          count <- makeNonce "count"
+          tell ["int ", count, " = 1;\n"]
+          tell ["{\n"]
+          genAltSize count s
+          tell ["}\n"]
+          tell ["Channel *", chans, "[", count, "];\n"]
+          tell [count, " = 0;\n"]
+          tell ["{\n"]
+          genAltEnable chans count s
+          tell ["}\n"]
+          tell [chans, "[", count, "] = NULL;\n"]
+          fired <- makeNonce "fired"
+          label <- makeNonce "end"
+          tell ["int ", fired, " = "]
+          tell [if isPri then "ProcProcPriAltList" else "ProcAltList"]
+          tell [" (", chans, ");\n"]
+          tell [count, " = 0;\n"]
+          tell ["{\n"]
+          genAltDisable fired count label s
+          tell ["}\n"]
+          tell [label, ":\n;\n"]
 
+genAltSize :: String -> A.Structured -> CGen ()
+genAltSize count (A.Rep _ rep s) = genReplicator rep (genAltSize count s)
+genAltSize count (A.Spec _ spec s) = genSpec spec (genAltSize count s)
+genAltSize count (A.OnlyA _ alt)
+    = case alt of
+        A.Alternative _ _ _ _ -> tell [count, "++;\n"]
+        A.AlternativeCond _ _ _ _ _ -> tell [count, "++;\n"]
+        A.AlternativeSkip _ _ _ -> return ()
+genAltSize count (A.Several _ ss) = sequence_ $ map (genAltSize count) ss
+
+genAltEnable :: String -> String -> A.Structured -> CGen ()
+genAltEnable chans count (A.Rep _ rep s) = genReplicator rep (genAltEnable chans count s)
+genAltEnable chans count (A.Spec _ spec s) = genSpec spec (genAltEnable chans count s)
+genAltEnable chans count (A.OnlyA _ alt)
+    = case alt of
+        A.Alternative _ c _ _ ->
+          do tell [chans, "[", count, "++] = "]
+             genVariable c
+             tell [";\n"]
+        A.AlternativeCond _ e c _ _ ->
+          do tell ["if ("]
+             genExpression e
+             tell [") {\n"]
+             tell [chans, "[", count, "++] = "]
+             genVariable c
+             tell [";\n"]
+             tell ["}\n"]
+        A.AlternativeSkip _ _ _ -> return ()
+genAltEnable chans count (A.Several _ ss) = sequence_ $ map (genAltEnable chans count) ss
+
+genAltDisable :: String -> String -> String -> A.Structured -> CGen ()
+genAltDisable fired count label (A.Rep _ rep s) = genReplicator rep (genAltDisable fired count label s)
+genAltDisable fired count label (A.Spec _ spec s) = genSpec spec (genAltDisable fired count label s)
+genAltDisable fired count label (A.OnlyA _ alt)
+    = case alt of
+        A.Alternative _ c im p ->
+          do tell ["if (", fired, " == ", count, "++) {\n"]
+             genInput c im
+             genProcess p
+             tell ["goto ", label, ";\n"]
+             tell ["}\n"]
+        A.AlternativeCond _ e c im p ->
+          do tell ["if (("]
+             genExpression e
+             tell [") && ", fired, " == ", count, "++) {\n"]
+             genInput c im
+             genProcess p
+             tell ["goto ", label, ";\n"]
+             tell ["}\n"]
+        -- FIXME This doesn't do anything useful yet, since CIF doesn't do SKIP guards.
+        A.AlternativeSkip _ e p ->
+          do tell ["if (("]
+             genExpression e
+             tell [") && ", fired, " == -1) {\n"]
+             genProcess p
+             tell ["goto ", label, ";\n"]
+             tell ["}\n"]
+             missing "SKIP guards not supported"
+genAltDisable fired count label (A.Several _ ss) = sequence_ $ map (genAltDisable fired count label) ss
+--}}}
+--{{{  proc call
 genProcCall :: A.Name -> [A.Actual] -> CGen ()
 genProcCall n as
     =  do genName n
@@ -1067,4 +1165,5 @@ genProcCall n as
           genActuals as
           tell [");\n"]
 --}}}
+--}}}
 

fco2/testcases/alt.occ

@@ -0,0 +1,25 @@
+PROC P ()
+  CHAN OF INT c, d:
+  [10]CHAN OF INT cs, ds:
+  BOOL b, bb:
+  [10]BOOL bs:
+  ALT
+    INT x:
+    c ? x
+      SKIP
+    INT y:
+    b & d ? y
+      SKIP
+    ALT i = 0 FOR SIZE cs
+      INT p:
+      cs[i] ? p
+        SKIP
+    ALT i = 0 FOR SIZE ds
+      INT q:
+      bs[i] & ds[i] ? q
+        SKIP
+    bb & SKIP
+      SKIP
+    TRUE & SKIP
+      STOP
+:

fco2/testcases/simple-alt.occ

@@ -0,0 +1,24 @@
+PROC send (VAL BYTE b, VAL INT delay, CHAN OF BYTE c)
+  TIMER tim:
+  INT t:
+  WHILE TRUE
+    SEQ
+      tim ? t
+      tim ? AFTER t PLUS delay
+      c ! b
+:
+PROC plex ([]CHAN OF BYTE cs, CHAN OF BYTE out)
+  WHILE TRUE
+    ALT i = 0 FOR SIZE cs
+      BYTE b:
+      cs[i] ? b
+        out ! b
+:
+PROC main (CHAN OF BYTE in, out, err)
+  [3]CHAN OF BYTE cs:
+  PAR
+    send ('x', 100000, cs[0])
+    send ('y', 200000, cs[1])
+    send ('z', 300000, cs[2])
+    plex (cs, out)
+: