From 5a89e1722ceb4492e934525019a1b2db0a369dc6 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Fri, 27 Apr 2007 03:01:32 +0000 Subject: [PATCH] Initial RETYPES/RESHAPES support --- fco2/EvalConstants.hs | 11 +++++++ fco2/GenerateC.hs | 51 +++++++++++++++++++++++++++++++-- fco2/Parse.hs | 17 +++++++++++ fco2/TODO | 13 +++++++-- fco2/Types.hs | 50 ++++++++++++++++++++++++++++++++ fco2/testcases/_bad_retype2.occ | 5 ++++ fco2/testcases/retypes.occ | 21 ++++++++++++++ 7 files changed, 163 insertions(+), 5 deletions(-) create mode 100644 fco2/testcases/_bad_retype2.occ create mode 100644 fco2/testcases/retypes.occ diff --git a/fco2/EvalConstants.hs b/fco2/EvalConstants.hs index 4b9a006..8e3886f 100644 --- a/fco2/EvalConstants.hs +++ b/fco2/EvalConstants.hs @@ -143,6 +143,17 @@ evalExpression (A.ExprVariable _ (A.Variable _ n)) Nothing -> throwError $ "non-constant variable " ++ show n ++ " used" evalExpression (A.True _) = return $ OccBool True evalExpression (A.False _) = return $ OccBool False +evalExpression (A.BytesInExpr _ e) + = do t <- typeOfExpression e + b <- bytesInType t + case b of + BIJust n -> return $ OccInt (fromIntegral $ n) + _ -> throwError $ "BYTESIN non-constant-size expression " ++ show e ++ " used" +evalExpression (A.BytesInType _ t) + = do b <- bytesInType t + case b of + BIJust n -> return $ OccInt (fromIntegral $ n) + _ -> throwError $ "BYTESIN non-constant-size type " ++ show t ++ " used" evalExpression _ = throwError "bad expression" evalMonadic :: A.MonadicOp -> OccValue -> EvalM OccValue diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index 214ebeb..d2be734 100644 --- a/fco2/GenerateC.hs +++ b/fco2/GenerateC.hs @@ -669,6 +669,45 @@ abbrevVariable am (A.UserDataType _) v abbrevVariable am t v = (genVariableAM v am, noSize) +-- | Generate the size part of a RETYPES/RESHAPES abbrevation of a variable. +genRetypeSizes :: A.AbbrevMode -> A.Type -> A.Name -> A.Type -> A.Variable -> CGen () +genRetypeSizes am destT destN srcT srcV + = case (destT, srcT) of + -- An array -- figure out the new dimensions. + (A.Array destDS destSubT, _) -> + do destBI <- bytesInType destT + srcBI <- bytesInType srcT + case (srcBI, destBI) of + -- Straightforward cases where we know the original size. + (_, BIJust _) -> declareArraySizes destDS (genName destN) + (BIJust srcBytes, BIOneFree destBytes _) -> + declareArraySizes [case d of + A.UnknownDimension -> + A.Dimension (srcBytes `div` destBytes) + _ -> d + | d <- destDS] + (genName destN) + -- The awkward case: the original size is dynamic, so we + -- need to compute the missing dimension at runtime. + (BIOneFree srcBytes srcNum, BIOneFree destBytes _) -> + do tell ["const int "] + genName destN + tell ["_sizes[] = { "] + let dims = [case d of + A.UnknownDimension -> + do tell ["("] + genVariable srcV + tell ["_sizes[", show srcNum, "]"] + tell [" * ", show srcBytes] + tell [") / ", show destBytes] + A.Dimension n -> tell [show n] + | d <- destDS] + sequence_ $ intersperse genComma dims + tell ["};\n"] + _ -> missing "dynamic size" + -- Not an array we're generating -- no need for sizes. + (_, _) -> return () + -- | Generate the right-hand side of an abbreviation of an expression. abbrevExpression :: A.AbbrevMode -> A.Type -> A.Expression -> (CGen (), A.Name -> CGen ()) abbrevExpression am t@(A.Array _ _) e @@ -852,8 +891,16 @@ introduceSpec (A.Specification _ n (A.Proc _ fs p)) tell [") {\n"] genProcess p tell ["}\n"] -introduceSpec (A.Specification _ n (A.Function _ _ _ _)) = missing "introduceSpec function" ---introduceSpec (A.Specification _ n (A.Retypes _ am t v)) +introduceSpec (A.Specification _ n (A.Retypes _ am t v)) + = do origT <- typeOfVariable v + let (rhs, rhsSizes) = abbrevVariable am origT v + genDecl am t n + tell [" = ("] + genDeclType am t + tell [") "] + rhs + tell [";\n"] + genRetypeSizes am t n origT v --introduceSpec (A.Specification _ n (A.RetypesExpr _ am t e)) introduceSpec n = missing $ "introduceSpec " ++ show n diff --git a/fco2/Parse.hs b/fco2/Parse.hs index fc88136..45f7f7c 100644 --- a/fco2/Parse.hs +++ b/fco2/Parse.hs @@ -1205,15 +1205,32 @@ retypesAbbrev v <- variable sColon eol + origT <- typeOfVariable v + checkRetypes origT s return $ A.Specification m n $ A.Retypes m A.Abbrev s v <|> do m <- md (s, n) <- tryXVVX sVAL specifier newVariableName (sRETYPES <|> sRESHAPES) e <- expression sColon eol + origT <- typeOfExpression e + checkRetypes origT s return $ A.Specification m n $ A.RetypesExpr m A.ValAbbrev s e "RETYPES/RESHAPES abbreviation" +-- | Check that a RETYPES/RESHAPES is safe. +checkRetypes :: A.Type -> A.Type -> OccParser () +checkRetypes fromT toT + = do bf <- bytesInType fromT + bt <- bytesInType toT + let ok = case (bf, bt) of + (BIJust a, BIJust b) -> a == b + (BIJust a, BIOneFree b _) -> (b <= a) && (a `mod` b == 0) + (BIOneFree a _, BIOneFree b _) -> (b <= a) && (a `mod` b == 0) + _ -> False + when (not ok) $ + fail $ "cannot prove that RETYPES/RESHAPES is safe" + dataSpecifier :: OccParser A.Type dataSpecifier = dataType diff --git a/fco2/TODO b/fco2/TODO index 588df1e..d2014b0 100644 --- a/fco2/TODO +++ b/fco2/TODO @@ -36,6 +36,16 @@ default behaviour that simplifies expressions inside another one. Output item expressions should be pulled up to variables. +RETYPES of expressions should be converted to RETYPES of variables. + +Pulling up won't work correctly for things like: + IF i = 0 FOR 5 + some.func (i) + ... +This will require some thought (and probably some AST changes to insert an +artifical place to pull up to -- perhaps just a more flexible Specification +type). + Before code generation, have a pass that resolves all the DATA TYPE .. IS directives to their real types. @@ -47,9 +57,6 @@ calls have been removed, and so on. ## C backend -Array outputs of dynamically-sized slices won't work (genBytesInType needs to -know the size of the array it's dealing with). - We could have genSpec generate {} around specs if it's not immediately inside another spec (which'd require some extra boolean arguments to find out). diff --git a/fco2/Types.hs b/fco2/Types.hs index 3799b9a..aa2bb4f 100644 --- a/fco2/Types.hs +++ b/fco2/Types.hs @@ -42,6 +42,9 @@ typeOfRecordField (A.UserDataType rec) field _ -> die "not record type" typeOfRecordField _ _ = die "not record type" +-- | Apply a subscript to a type, and return what the type is after it's been +-- subscripted. +-- FIXME This needs to replace the first dimension in array types. subscriptType :: (PSM m, Die m) => A.Subscript -> A.Type -> m A.Type subscriptType (A.SubscriptFromFor _ _ _) t = return t subscriptType (A.SubscriptFrom _ _) t = return t @@ -241,3 +244,50 @@ simplifyType (A.Port t) simplifyType t = return t --}}} +--{{{ sizes of types +-- | The size in bytes of a data type. +data BytesInResult = + BIJust Int -- ^ Just that many bytes. + | BIOneFree Int Int -- ^ An array type; A bytes, times unknown dimension B. + | BIUnknown -- ^ No idea. + +-- | Return the size in bytes of a data type. +bytesInType :: (PSM m, Die m) => A.Type -> m BytesInResult +bytesInType A.Byte = return $ BIJust 1 +-- FIXME This is tied to the backend we're using (as is the constant folder). +bytesInType A.Int = return $ BIJust 4 +bytesInType A.Int16 = return $ BIJust 2 +bytesInType A.Int32 = return $ BIJust 4 +bytesInType A.Int64 = return $ BIJust 8 +bytesInType A.Real32 = return $ BIJust 4 +bytesInType A.Real64 = return $ BIJust 8 +bytesInType a@(A.Array _ _) = bytesInArray 0 a + where + bytesInArray :: (PSM m, Die m) => Int -> A.Type -> m BytesInResult + bytesInArray num (A.Array [] t) = bytesInType t + bytesInArray num (A.Array (d:ds) t) + = do ts <- bytesInArray (num + 1) (A.Array ds t) + case (d, ts) of + (A.Dimension n, BIJust m) -> return $ BIJust (n * m) + (A.Dimension n, BIOneFree m x) -> return $ BIOneFree (n * m) x + (A.UnknownDimension, BIJust m) -> return $ BIOneFree m num + (_, _) -> return $ BIUnknown +bytesInType (A.UserDataType n) + = do st <- specTypeOfName n + case st of + -- We can only do this for *packed* records -- for normal records, + -- the compiler might insert padding. + (A.DataTypeRecord _ True nts) -> bytesInList nts + _ -> return $ BIUnknown + where + bytesInList :: (PSM m, Die m) => [(A.Name, A.Type)] -> m BytesInResult + bytesInList [] = return $ BIJust 0 + bytesInList ((_, t):rest) + = do bi <- bytesInType t + br <- bytesInList rest + case (bi, br) of + (BIJust a, BIJust b) -> return $ BIJust (a + b) + (_, _) -> return BIUnknown +bytesInType _ = return $ BIUnknown +--}}} + diff --git a/fco2/testcases/_bad_retype2.occ b/fco2/testcases/_bad_retype2.occ new file mode 100644 index 0000000..8e04c71 --- /dev/null +++ b/fco2/testcases/_bad_retype2.occ @@ -0,0 +1,5 @@ +PROC P () + INT x: + REAL64 z RETYPES x: + SKIP +: diff --git a/fco2/testcases/retypes.occ b/fco2/testcases/retypes.occ new file mode 100644 index 0000000..983d391 --- /dev/null +++ b/fco2/testcases/retypes.occ @@ -0,0 +1,21 @@ +DATA TYPE FOO + PACKED RECORD + INT16 l: + INT16 r: +: +PROC P () + INT a, b: + SEQ + a := 42 + INT32 aa RETYPES a: + b := INT aa + [4]BYTE aa RETYPES a: + b := INT aa[0] + []INT16 aa RETYPES a: + SEQ + b := INT aa[0] + []BYTE aaa RETYPES aa: + b := INT aaa[0] + FOO f RETYPES a: + b := INT f[l] +: