suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial RETYPES/RESHAPES support

Browse Source
This commit is contained in:
Adam Sampson 2007-04-27 03:01:32 +00:00
parent 7507bd21dc
commit 5a89e1722c
7 changed files with 163 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
fco2/EvalConstants.hs
View File

@ -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

51
fco2/GenerateC.hs
View File

@ -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

17
fco2/Parse.hs
View File

@ -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

13
fco2/TODO
View File

@ -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).

50
fco2/Types.hs
View File

@ -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
--}}}

5
fco2/testcases/_bad_retype2.occ Normal file
View File

@ -0,0 +1,5 @@
PROC P ()
INT x:
REAL64 z RETYPES x:
SKIP
:

21
fco2/testcases/retypes.occ Normal file
View File

@ -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]
: