From 23e3261e4d7693cc2d4d91316bc4a8d9c1e004a5 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Fri, 20 Apr 2007 01:13:00 +0000 Subject: [PATCH] Use the new ALT interface in CIF, and have a generic function for Structureds --- fco2/GenerateC.hs | 227 +++++++++++++++++++++++++-------------------- fco2/fco_support.h | 5 +- 2 files changed, 127 insertions(+), 105 deletions(-) diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index 2748258..f7f5dc9 100644 --- a/fco2/GenerateC.hs +++ b/fco2/GenerateC.hs @@ -102,6 +102,26 @@ overArray name (A.Array ds _) func p sequence_ [tell ["}\n"] | i <- indices] Nothing -> return () + +-- | Generate code for one of the Structured types. +genStructured :: A.Structured -> (A.Structured -> CGen ()) -> CGen () +genStructured (A.Rep _ rep s) def = genReplicator rep (genStructured s def) +genStructured (A.Spec _ spec s) def = genSpec spec (genStructured s def) +genStructured (A.Several _ ss) def = sequence_ [genStructured s def | s <- ss] +genStructured s def = def s + +data InputType = ITTimerRead | ITTimerAfter | ITOther + +inputType :: A.Variable -> A.InputMode -> CGen InputType +inputType c im + = do ps <- get + t <- checkJust $ typeOfVariable ps c + return $ case t of + A.Timer -> + case im of + A.InputSimple _ _ -> ITTimerRead + A.InputAfter _ _ -> ITTimerAfter + _ -> ITOther --}}} --{{{ names @@ -417,8 +437,7 @@ genDyadic A.Less e f = genSimpleDyadic "<" e f genDyadic A.More e f = genSimpleDyadic ">" e f genDyadic A.LessEq e f = genSimpleDyadic "<=" e f genDyadic A.MoreEq e f = genSimpleDyadic ">=" e f -genDyadic A.After e f - = genEitherDyadic "occam_after" (genFuncDyadic "occam_unchecked_after") e f +genDyadic A.After e f = genFuncDyadic "occam_after" e f --}}} --{{{ input/output items @@ -930,21 +949,19 @@ genInputCase c s -- This handles specs in a slightly odd way, because we can't insert specs into -- the body of a switch. genInputCaseBody :: A.Name -> A.Variable -> CGen () -> A.Structured -> CGen () -genInputCaseBody proto c coll (A.Spec _ spec s) - = genInputCaseBody proto c (genSpec spec coll) s -genInputCaseBody proto c coll (A.OnlyV _ (A.Variant _ n iis p)) - = do tell ["case "] - genName n - tell ["_"] - genName proto - tell [": {\n"] - coll - sequence_ $ map (genInputItem c) iis - genProcess p - tell ["break;\n"] - tell ["}\n"] -genInputCaseBody proto c coll (A.Several _ ss) - = sequence_ $ map (genInputCaseBody proto c coll) ss +genInputCaseBody proto c coll s = genStructured s doV + where + doV (A.OnlyV _ (A.Variant _ n iis p)) + = do tell ["case "] + genName n + tell ["_"] + genName proto + tell [": {\n"] + coll + sequence_ $ map (genInputItem c) iis + genProcess p + tell ["break;\n"] + tell ["}\n"] genTimerRead :: A.Variable -> A.Variable -> CGen () genTimerRead c v @@ -996,16 +1013,15 @@ genIf s tell [label, ":\n;\n"] genIfBody :: String -> A.Structured -> CGen () -genIfBody label (A.Rep m rep s) = genReplicator rep (genIfBody label s) -genIfBody label (A.Spec m spec s) = genSpec spec (genIfBody label s) -genIfBody label (A.OnlyC m (A.Choice m' e p)) - = do tell ["if ("] - genExpression e - tell [") {\n"] - genProcess p - tell ["goto ", label, ";\n"] - tell ["}\n"] -genIfBody label (A.Several m ss) = sequence_ $ map (genIfBody label) ss +genIfBody label s = genStructured s doC + where + doC (A.OnlyC m (A.Choice m' e p)) + = do tell ["if ("] + genExpression e + tell [") {\n"] + genProcess p + tell ["goto ", label, ";\n"] + tell ["}\n"] --}}} --{{{ case genCase :: A.Expression -> A.Structured -> CGen () @@ -1096,94 +1112,103 @@ genProcAlloc (A.ProcCall m n 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"] + = do tell ["AltStart ();\n"] tell ["{\n"] - genAltSize count s + genAltEnable s tell ["}\n"] - tell ["Channel *", chans, "[", count, "];\n"] - tell [count, " = 0;\n"] + -- Like occ21, this is always a PRI ALT, so we can use it for both. + tell ["AltWait ();\n"] + id <- makeNonce "alt_id" + tell ["int ", id, " = 0;\n"] tell ["{\n"] - genAltEnable chans count s + genAltDisable id 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"] + fired <- makeNonce "alt_fired" + tell ["int ", fired, " = AltEnd ();\n"] + tell [id, " = 0;\n"] + label <- makeNonce "alt_end" tell ["{\n"] - genAltDisable fired count label s + genAltProcesses id fired 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 +withIf :: A.Expression -> CGen () -> CGen () +withIf cond body + = do tell ["if ("] + genExpression cond + tell [") {\n"] + body + tell ["}\n"] -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 +genAltEnable :: A.Structured -> CGen () +genAltEnable s = genStructured s doA + where + doA (A.OnlyA _ alt) + = case alt of + A.Alternative _ c im _ -> doIn c im + A.AlternativeCond _ e c im _ -> withIf e $ doIn c im + A.AlternativeSkip _ e _ -> withIf e $ tell ["AltEnableSkip ();\n"] -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 + doIn c im + = do t <- inputType c im + case t of + ITTimerRead -> missing "timer read in ALT" + ITTimerAfter -> + do let time = case im of A.InputAfter _ e -> e + tell ["AltEnableTimer ("] + genExpression time + tell [");\n"] + ITOther -> + do tell ["AltEnableChannel ("] + genVariable c + tell [");\n"] + +genAltDisable :: String -> A.Structured -> CGen () +genAltDisable id s = genStructured s doA + where + doA (A.OnlyA _ alt) + = case alt of + A.Alternative _ c im _ -> doIn c im + A.AlternativeCond _ e c im _ -> withIf e $ doIn c im + A.AlternativeSkip _ e _ -> withIf e $ tell ["AltDisableSkip (", id, "++);\n"] + + doIn c im + = do t <- inputType c im + case t of + ITTimerRead -> missing "timer read in ALT" + ITTimerAfter -> + do let time = case im of A.InputAfter _ e -> e + tell ["AltDisableTimer (", id, "++, "] + genExpression time + tell [");\n"] + ITOther -> + do tell ["AltDisableChannel (", id, "++, "] + genVariable c + tell [");\n"] + +genAltProcesses :: String -> String -> String -> A.Structured -> CGen () +genAltProcesses id fired label s = genStructured s doA + where + doA (A.OnlyA _ alt) + = case alt of + A.Alternative _ c im p -> doIn c im p + A.AlternativeCond _ e c im p -> withIf e $ doIn c im p + A.AlternativeSkip _ e p -> withIf e $ doCheck (genProcess p) + + doIn c im p + = do t <- inputType c im + case t of + ITTimerRead -> missing "timer read in ALT" + ITTimerAfter -> doCheck (genProcess p) + ITOther -> doCheck (genInput c im >> genProcess p) + + doCheck body + = do tell ["if (", id, "++ == ", fired, ") {\n"] + body 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 () diff --git a/fco2/fco_support.h b/fco2/fco_support.h index dbbf5f3..cbf69e6 100644 --- a/fco2/fco_support.h +++ b/fco2/fco_support.h @@ -56,10 +56,7 @@ static int occam_rem (int a, int b) { } return a % b; } -static bool occam_after (int a, int b) { - return (a - b) > 0; -} -#define occam_unchecked_after (a, b) \ +#define occam_after (a, b) \ (((a) - (b)) > 0) #endif