diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index b9f0682..19052a9 100644 --- a/fco2/GenerateC.hs +++ b/fco2/GenerateC.hs @@ -29,6 +29,13 @@ module GenerateC where -- immediately inside another spec (which'd require some extra boolean -- arguments to find out). +-- FIXME: If the assembler-analysis approach to working out process sizes +-- works, then we can put the sizes in variables in a separate object file and +-- only generate/compile that after we've done the main one. + +-- FIXME: Before code generation, have a pass that resolves all the DATA TYPE +-- .. IS directives to their real types. + import Data.List import Data.Maybe import Control.Monad.Writer @@ -154,6 +161,7 @@ genDeclType am t case t of A.Array _ _ -> return () A.Chan _ -> return () + A.UserDataType _ -> tell [" *"] _ -> when (am == A.Abbrev) $ tell [" *"] genDecl :: A.AbbrevMode -> A.Type -> A.Name -> CGen () @@ -181,11 +189,9 @@ genSubscript (A.Subscript m e) p tell ["["] genExpression e tell ["]"] --- FIXME: Either this needs to be -> in some circumstances, or we should always --- generate records as & and use -> -- probably the latter. genSubscript (A.SubscriptField m n) p = do p - tell ["."] + tell ["->"] genName n genSubscript s p = missing $ "genSubscript " ++ show s --}}} @@ -222,23 +228,35 @@ convStringStar c = [c] --{{{ variables {- - Original Abbrev - ValAbbrev +The various types are generated like this: -INT x: x x *x int x; int *x; -[10]INT xs: xs[i] xs[i] xs[i] int xs[10]; int *xs; - xs xs xs + ================= Use ================= + Original ValAbbrev Abbrev + -------------------------------------- +INT x: int x; int x; int *x; + x x x *x +[10]INT xs: int xs[10]; int *xs; int *xs; + xs xs xs xs + xs[i] xs[i] xs[i] xs[i] - Original Abbrev +MYREC r: MYREC r; MYREC *r; MYREC *r; + r &r r r + r[F] (&r)->F (r)->F (r)->F +[10]MYREC rs: MYREC rs[10]; MYREC *rs; MYREC *rs; + rs rs rs rs + rs[i] &rs[i] &rs[i] &rs[i] + rs[i][F] (&rs[i])->F (&rs[i])->F (&rs[i])->F + -- depending on what F is -- if it's another record... -CHAN OF INT c: c &c c Channel c; Channel *c; -[10]CHAN OF INT cs: cs[i] cs[i] cs[i] Channel *cs[10]; Channel **cs; - cs cs cs +CHAN OF INT c: Channel c; Channel *c; + c &c c +[10]CHAN OF INT cs: Channel **cs; Channel **cs; + cs cs cs + cs[i] cs[i] cs[i] -[2][2]INT xss: xss[i][j] xss[i][j] xss[i][j] - xss xss xss -[2][2]CHAN INT css: css[i][j] css[i][j] css[i][j] - css css css +Should treat record fields as if they're Originals. + +FIXME: Deal with multidimensional arrays, which are (slightly) more awkward again. I suspect there's probably a nicer way of doing this, but as a translation of the above table this isn't too horrible... @@ -249,26 +267,21 @@ genVariable v am <- checkJust $ abbrevModeOfVariable ps v t <- checkJust $ typeOfVariable ps v - let isArray = case t of - A.Array _ _ -> True - _ -> False - let isSubbed = case v of - A.SubscriptedVariable _ _ _ -> True - _ -> False - let isChan = case stripArrayType t of - A.Chan _ -> True - _ -> False - - when ((am == A.Abbrev) && (not (isChan || isArray || isSubbed))) $ - tell ["*"] - - when ((am == A.Original) && isChan && not (isArray || isSubbed)) $ - tell ["&"] + let prefix = case (am, t) of + (_, A.Array _ _) -> "" + (A.Original, A.Chan _) -> "&" + (A.Abbrev, A.Chan _) -> "" + (A.Original, A.UserDataType _) -> "&" + (A.Abbrev, A.UserDataType _) -> "" + (A.Abbrev, _) -> "*" + _ -> "" + when (prefix /= "") $ tell ["(", prefix] inner v + when (prefix /= "") $ tell [")"] where - inner (A.Variable m n) = genName n - inner (A.SubscriptedVariable m s v) = genSubscript s (inner v) + inner (A.Variable _ n) = genName n + inner (A.SubscriptedVariable _ s v) = genSubscript s (genVariable v) --}}} --{{{ expressions @@ -482,6 +495,8 @@ abbrevVariable am (A.Array _ _) v = (genVariable v, Just $ do { genVariable v; tell ["_sizes"] }) abbrevVariable am (A.Chan _) v = (genVariable v, Nothing) +abbrevVariable am (A.UserDataType _) v + = (genVariable v, Nothing) abbrevVariable am t v = (do { when (am == A.Abbrev) $ tell ["&"]; genVariable v }, Nothing) @@ -644,16 +659,16 @@ introduceSpec (n, A.IsChannelArray m t cs) tell ["};\n"] --introduceSpec (n, A.DataType m t) introduceSpec (n, A.DataTypeRecord _ b fs) - = do when b $ missing "packed record" - tell ["typedef struct {\n"] + = do tell ["typedef struct {\n"] sequence_ [case t of _ -> do declareType t tell [" "] genName n - tell [";"] + tell [";\n"] | (n, t) <- fs] tell ["} "] + when b $ tell ["occam_struct_packed "] genName n tell [";\n"] introduceSpec (n, A.Protocol _ _) = return () diff --git a/fco2/Parse.hs b/fco2/Parse.hs index b5a660b..0c81497 100644 --- a/fco2/Parse.hs +++ b/fco2/Parse.hs @@ -257,21 +257,28 @@ maybeSubscripted prodName inner subscripter typer = do m <- md v <- inner t <- typer v - subs <- many (postSubscript t) + subs <- postSubscripts t return $ foldl (\var sub -> subscripter m sub var) v subs prodName +postSubscripts :: A.Type -> OccParser [A.Subscript] +postSubscripts t + = (do sub <- postSubscript t + t' <- pSubscriptType sub t + rest <- postSubscripts t' + return $ sub : rest) + <|> return [] + postSubscript :: A.Type -> OccParser A.Subscript postSubscript t = do m <- md - sLeft case t of A.UserDataType _ -> - do f <- fieldName + do f <- tryXV sLeft fieldName sRight return $ A.SubscriptField m f A.Array _ _ -> - do e <- intExpr + do e <- tryXV sLeft intExpr sRight return $ A.Subscript m e _ -> @@ -364,14 +371,17 @@ checkMaybe msg op pTypeOf :: (ParseState -> a -> Maybe b) -> a -> OccParser b pTypeOf f item = do st <- getState - case f st item of - Just t -> return t - Nothing -> fail "cannot compute type" + checkMaybe "cannot compute type" $ f st item pTypeOfVariable = pTypeOf typeOfVariable pTypeOfLiteral = pTypeOf typeOfLiteral pTypeOfExpression = pTypeOf typeOfExpression pSpecTypeOfName = pTypeOf specTypeOfName + +pSubscriptType :: A.Subscript -> A.Type -> OccParser A.Type +pSubscriptType sub t + = do st <- getState + checkMaybe "cannot subscript type" $ subscriptType st sub t --}}} --{{{ name scoping diff --git a/fco2/Types.hs b/fco2/Types.hs index c61cf82..b64236d 100644 --- a/fco2/Types.hs +++ b/fco2/Types.hs @@ -58,7 +58,14 @@ typeOfVariable ps (A.SubscriptedVariable m s v) abbrevModeOfVariable :: ParseState -> A.Variable -> Maybe A.AbbrevMode abbrevModeOfVariable ps (A.Variable _ n) = abbrevModeOfName ps n -abbrevModeOfVariable ps (A.SubscriptedVariable _ _ v) = abbrevModeOfVariable ps v +abbrevModeOfVariable ps (A.SubscriptedVariable _ sub v) + = do am <- abbrevModeOfVariable ps v + return $ case (am, sub) of + (A.ValAbbrev, A.Subscript _ _) -> A.ValAbbrev + (_, A.Subscript _ _) -> A.Original + (A.ValAbbrev, A.SubscriptField _ _) -> A.ValAbbrev + (_, A.SubscriptField _ _) -> A.Original + _ -> am dyadicIsBoolean :: A.DyadicOp -> Bool dyadicIsBoolean A.Eq = True diff --git a/fco2/fco_support.h b/fco2/fco_support.h index 10a208e..eaebe11 100644 --- a/fco2/fco_support.h +++ b/fco2/fco_support.h @@ -28,6 +28,12 @@ #define occam_mostneg_double -DBL_MAX #define occam_mostpos_double DBL_MAX +#ifdef __GNUC__ +#define occam_struct_packed __attribute__ ((packed)) +#else +#warning No PACKED implementation for this compiler +#endif + /* FIXME All of these need to check for overflow and report errors appropriately. */ static int occam_add (int a, int b) { return a + b; diff --git a/fco2/testcases/records.occ b/fco2/testcases/records.occ index fdb24cc..c9f6278 100644 --- a/fco2/testcases/records.occ +++ b/fco2/testcases/records.occ @@ -25,6 +25,7 @@ PROC T (VAL PLAIN.REC rec) PROC P () PLAIN.REC plain: PACKED.REC packed: + [10]PLAIN.REC array: SEQ plain[i] := 42 plain[b] := FALSE @@ -34,6 +35,24 @@ PROC P () packed[b] := FALSE Q (packed[i], packed[b]) R (packed[i], packed[b]) + array[5][i] := 42 + Q (array[5][i], array[5][b]) S (plain) T (plain) + S (array[5]) + T (array[5]) + PLAIN.REC abbrev IS plain: + SEQ + abbrev[i] := 42 + S (abbrev) + T (abbrev) + VAL PLAIN.REC val.ab IS plain: + SEQ + packed[i] := val.ab[i] + T (val.ab) + []PLAIN.REC arr.ab IS array: + SEQ + arr.ab[0][i] := 42 + S (arr.ab[0]) + T (arr.ab[0]) :