Range check type conversions, and implement arithmetic ops for all basic types
This commit is contained in:
Adam Sampson
parent
127e2f8aec
commit
3d4a1d1020
|
|
@ -176,14 +176,27 @@ genDecl am t n
|
|||
--}}}
|
||||
|
||||
--{{{ conversions
|
||||
genConversion :: A.ConversionMode -> A.Type -> A.Expression -> CGen ()
|
||||
genConversion A.DefaultConversion t e
|
||||
genConversion :: Meta -> A.ConversionMode -> A.Type -> A.Expression -> CGen ()
|
||||
genConversion m A.DefaultConversion t e
|
||||
= do tell ["(("]
|
||||
genType t
|
||||
tell [") "]
|
||||
genExpression e
|
||||
ps <- get
|
||||
let origT = fromJust $ typeOfExpression ps e
|
||||
if isSafeConversion origT t
|
||||
then genExpression e
|
||||
else do genTypeSymbol "range_check" origT
|
||||
tell [" ("]
|
||||
genTypeSymbol "mostneg" t
|
||||
tell [", "]
|
||||
genTypeSymbol "mostpos" t
|
||||
tell [", "]
|
||||
genExpression e
|
||||
tell [", "]
|
||||
genMeta m
|
||||
tell [")"]
|
||||
tell [")"]
|
||||
genConversion cm t e = missing $ "genConversion " ++ show cm
|
||||
genConversion m cm t e = missing $ "genConversion " ++ show cm
|
||||
--}}}
|
||||
|
||||
--{{{ literals
|
||||
|
|
@ -347,8 +360,8 @@ genArraySubscript v es
|
|||
genExpression :: A.Expression -> CGen ()
|
||||
genExpression (A.Monadic m op e) = genMonadic m op e
|
||||
genExpression (A.Dyadic m op e f) = genDyadic m op e f
|
||||
genExpression (A.MostPos m t) = genTypeConstant "mostpos" t
|
||||
genExpression (A.MostNeg m t) = genTypeConstant "mostneg" t
|
||||
genExpression (A.MostPos m t) = genTypeSymbol "mostpos" t
|
||||
genExpression (A.MostNeg m t) = genTypeSymbol "mostneg" t
|
||||
--genExpression (A.SizeType m t)
|
||||
genExpression (A.SizeExpr m e)
|
||||
= do genExpression e
|
||||
|
|
@ -356,7 +369,7 @@ genExpression (A.SizeExpr m e)
|
|||
genExpression (A.SizeVariable m v)
|
||||
= do genVariable v
|
||||
tell ["_sizes[0]"]
|
||||
genExpression (A.Conversion m cm t e) = genConversion cm t e
|
||||
genExpression (A.Conversion m cm t e) = genConversion m cm t e
|
||||
genExpression (A.ExprVariable m v) = genVariable v
|
||||
genExpression (A.ExprLiteral m l) = genLiteral l
|
||||
genExpression (A.True m) = tell ["true"]
|
||||
|
|
@ -368,11 +381,11 @@ genExpression (A.BytesInType m t) = genBytesInType t
|
|||
--genExpression (A.OffsetOf m t n)
|
||||
genExpression t = missing $ "genExpression " ++ show t
|
||||
|
||||
genTypeConstant :: String -> A.Type -> CGen ()
|
||||
genTypeConstant s t
|
||||
genTypeSymbol :: String -> A.Type -> CGen ()
|
||||
genTypeSymbol s t
|
||||
= case scalarType t of
|
||||
Just ct -> tell ["occam_", s, "_", ct]
|
||||
Nothing -> missing $ "genTypeConstant " ++ show t
|
||||
Nothing -> missing $ "genTypeSymbol " ++ show t
|
||||
--}}}
|
||||
|
||||
--{{{ operators
|
||||
|
|
@ -397,7 +410,10 @@ genSimpleDyadic s e f
|
|||
|
||||
genFuncDyadic :: Meta -> String -> A.Expression -> A.Expression -> CGen ()
|
||||
genFuncDyadic m s e f
|
||||
= do tell [s, " ("]
|
||||
= do ps <- get
|
||||
let t = fromJust $ typeOfExpression ps e
|
||||
genTypeSymbol s t
|
||||
tell [" ("]
|
||||
genExpression e
|
||||
tell [", "]
|
||||
genExpression f
|
||||
|
|
@ -406,11 +422,11 @@ genFuncDyadic m s e f
|
|||
tell [")"]
|
||||
|
||||
genDyadic :: Meta -> A.DyadicOp -> A.Expression -> A.Expression -> CGen ()
|
||||
genDyadic m A.Add e f = genFuncDyadic m "occam_add" e f
|
||||
genDyadic m A.Subtr e f = genFuncDyadic m "occam_subtr" e f
|
||||
genDyadic m A.Mul e f = genFuncDyadic m "occam_mul" e f
|
||||
genDyadic m A.Div e f = genFuncDyadic m "occam_div" e f
|
||||
genDyadic m A.Rem e f = genFuncDyadic m "occam_rem" e f
|
||||
genDyadic m A.Add e f = genFuncDyadic m "add" e f
|
||||
genDyadic m A.Subtr e f = genFuncDyadic m "subtr" e f
|
||||
genDyadic m A.Mul e f = genFuncDyadic m "mul" e f
|
||||
genDyadic m A.Div e f = genFuncDyadic m "div" e f
|
||||
genDyadic m A.Rem e f = genFuncDyadic m "rem" e f
|
||||
genDyadic _ A.Plus e f = genSimpleDyadic "+" e f
|
||||
genDyadic _ A.Minus e f = genSimpleDyadic "-" e f
|
||||
genDyadic _ A.Times e f = genSimpleDyadic "*" e f
|
||||
|
|
@ -425,7 +441,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 m A.After e f = genFuncDyadic m "occam_after" e f
|
||||
genDyadic m A.After e f = genFuncDyadic m "after" e f
|
||||
--}}}
|
||||
|
||||
--{{{ input/output items
|
||||
|
|
|
|||
|
|
@ -61,9 +61,6 @@ calls have been removed, and so on.
|
|||
|
||||
Multidimensional array literals won't work.
|
||||
|
||||
Array indexing needs to be checked against the bounds (which'll do away with a
|
||||
lot of the "_sizes unused" warnings).
|
||||
|
||||
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).
|
||||
|
||||
|
|
@ -90,6 +87,8 @@ time.
|
|||
The operator functions need to have the type name attached -- they'll only work
|
||||
for INT at the moment.
|
||||
|
||||
Real-to-integer conversions don't work correctly.
|
||||
|
||||
## Long-term
|
||||
|
||||
If we have constant folding, we're three-quarters of the way towards having an
|
||||
|
|
|
|||
|
|
@ -158,3 +158,28 @@ metaOfExpression e = head $ gmapQ (mkQ emptyMeta findMeta) e
|
|||
where
|
||||
findMeta :: Meta -> Meta
|
||||
findMeta m = m
|
||||
|
||||
-- | Will a conversion between two types always succeed?
|
||||
isSafeConversion :: A.Type -> A.Type -> Bool
|
||||
isSafeConversion fromT toT = (fromP /= -1) && (toP /= -1) && (fromP <= toP)
|
||||
where
|
||||
fromP = precNum fromT
|
||||
toP = precNum toT
|
||||
|
||||
precNum :: A.Type -> Int
|
||||
precNum t = precNum' t 0 convPrec
|
||||
|
||||
precNum' :: A.Type -> Int -> [[A.Type]] -> Int
|
||||
precNum' _ n [] = (-1)
|
||||
precNum' t n (tl:tls)
|
||||
= if t `elem` tl then n
|
||||
else precNum' t (n + 1) tls
|
||||
|
||||
convPrec :: [[A.Type]]
|
||||
convPrec
|
||||
= [ [A.Bool]
|
||||
, [A.Byte]
|
||||
, [A.Int16]
|
||||
, [A.Int, A.Int32]
|
||||
, [A.Int64]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* C99 support definitions for FCO. */
|
||||
// C99 support definitions for FCO.
|
||||
|
||||
#ifndef FCO_SUPPORT_H
|
||||
#define FCO_SUPPORT_H
|
||||
|
|
@ -31,8 +31,11 @@
|
|||
|
||||
#ifdef __GNUC__
|
||||
#define occam_struct_packed __attribute__ ((packed))
|
||||
#define occam_unused __attribute__ ((unused))
|
||||
#else
|
||||
#warning No PACKED implementation for this compiler
|
||||
#warning No PACKED (or other compiler specials) implementation for this compiler
|
||||
#define occam_struct_packed
|
||||
#define occam_unused
|
||||
#endif
|
||||
|
||||
#define occam_stop(pos, format, args...) \
|
||||
|
|
@ -41,6 +44,7 @@
|
|||
SetErr (); \
|
||||
} while (0)
|
||||
|
||||
static int occam_check_slice (int, int, int, const char *) occam_unused;
|
||||
static int occam_check_slice (int start, int count, int limit, const char *pos) {
|
||||
int end = start + count;
|
||||
if (end < 0 || end > limit) {
|
||||
|
|
@ -48,6 +52,7 @@ static int occam_check_slice (int start, int count, int limit, const char *pos)
|
|||
}
|
||||
return count;
|
||||
}
|
||||
static int occam_check_index (int, int, const char *) occam_unused;
|
||||
static int occam_check_index (int i, int limit, const char *pos) {
|
||||
if (i < 0 || i >= limit) {
|
||||
occam_stop (pos, "invalid array index %d (should be 0 <= i < %d)", i, limit);
|
||||
|
|
@ -55,29 +60,121 @@ static int occam_check_index (int i, int limit, const char *pos) {
|
|||
return i;
|
||||
}
|
||||
|
||||
/* FIXME All of these need to check for overflow and report errors appropriately. */
|
||||
static int occam_add (int a, int b, const char *pos) {
|
||||
return a + b;
|
||||
}
|
||||
static int occam_subtr (int a, int b, const char *pos) {
|
||||
return a - b;
|
||||
}
|
||||
static int occam_mul (int a, int b, const char *pos) {
|
||||
return a * b;
|
||||
}
|
||||
static int occam_div (int a, int b, const char *pos) {
|
||||
if (b == 0) {
|
||||
occam_stop (pos, "divide by zero");
|
||||
#define MAKE_RANGE_CHECK(type, format) \
|
||||
static type occam_range_check_##type (type, type, type, const char *) occam_unused; \
|
||||
static type occam_range_check_##type (type lower, type upper, type n, const char *pos) { \
|
||||
if (n < lower || n > upper) { \
|
||||
occam_stop (pos, "invalid value in conversion " format " (should be " format " <= i <= " format ")", n, lower, upper); \
|
||||
} \
|
||||
return n; \
|
||||
}
|
||||
return a / b;
|
||||
}
|
||||
static int occam_rem (int a, int b, const char *pos) {
|
||||
if (b == 0) {
|
||||
occam_stop (pos, "modulo by zero");
|
||||
// FIXME All of these need to check for overflow and report errors appropriately.
|
||||
#define MAKE_ADD(type) \
|
||||
static type occam_add_##type (type, type, const char *) occam_unused; \
|
||||
static type occam_add_##type (type a, type b, const char *pos) { \
|
||||
return a + b; \
|
||||
}
|
||||
return a % b;
|
||||
}
|
||||
#define occam_after (a, b, pos) \
|
||||
(((a) - (b)) > 0)
|
||||
#define MAKE_SUBTR(type) \
|
||||
static type occam_subtr_##type (type, type, const char *) occam_unused; \
|
||||
static type occam_subtr_##type (type a, type b, const char *pos) { \
|
||||
return a - b; \
|
||||
}
|
||||
#define MAKE_MUL(type) \
|
||||
static type occam_mul_##type (type, type, const char *) occam_unused; \
|
||||
static type occam_mul_##type (type a, type b, const char *pos) { \
|
||||
return a * b; \
|
||||
}
|
||||
#define MAKE_DIV(type) \
|
||||
static type occam_div_##type (type, type, const char *) occam_unused; \
|
||||
static type occam_div_##type (type a, type b, const char *pos) { \
|
||||
if (b == 0) { \
|
||||
occam_stop (pos, "divide by zero"); \
|
||||
} \
|
||||
return a / b; \
|
||||
}
|
||||
#define MAKE_REM(type) \
|
||||
static type occam_rem_##type (type, type, const char *) occam_unused; \
|
||||
static type occam_rem_##type (type a, type b, const char *pos) { \
|
||||
if (b == 0) { \
|
||||
occam_stop (pos, "modulo by zero"); \
|
||||
} \
|
||||
return a % b; \
|
||||
}
|
||||
#define MAKE_AFTER(type) \
|
||||
static bool occam_after_##type (type, type) occam_unused; \
|
||||
static bool occam_after_##type (type a, type b) { \
|
||||
return (a - b) > 0; \
|
||||
}
|
||||
|
||||
//{{{ char
|
||||
MAKE_RANGE_CHECK(char, "%d")
|
||||
MAKE_ADD(char)
|
||||
MAKE_SUBTR(char)
|
||||
MAKE_MUL(char)
|
||||
MAKE_DIV(char)
|
||||
MAKE_REM(char)
|
||||
MAKE_AFTER(char)
|
||||
//}}}
|
||||
//{{{ int16_t
|
||||
MAKE_RANGE_CHECK(int16_t, "%d")
|
||||
MAKE_ADD(int16_t)
|
||||
MAKE_SUBTR(int16_t)
|
||||
MAKE_MUL(int16_t)
|
||||
MAKE_DIV(int16_t)
|
||||
MAKE_REM(int16_t)
|
||||
MAKE_AFTER(int16_t)
|
||||
//}}}
|
||||
//{{{ int
|
||||
MAKE_RANGE_CHECK(int, "%d")
|
||||
MAKE_ADD(int)
|
||||
MAKE_SUBTR(int)
|
||||
MAKE_MUL(int)
|
||||
MAKE_DIV(int)
|
||||
MAKE_REM(int)
|
||||
MAKE_AFTER(int)
|
||||
//}}}
|
||||
//{{{ int32_t
|
||||
MAKE_RANGE_CHECK(int32_t, "%d")
|
||||
MAKE_ADD(int32_t)
|
||||
MAKE_SUBTR(int32_t)
|
||||
MAKE_MUL(int32_t)
|
||||
MAKE_DIV(int32_t)
|
||||
MAKE_REM(int32_t)
|
||||
MAKE_AFTER(int32_t)
|
||||
//}}}
|
||||
//{{{ int64_t
|
||||
MAKE_RANGE_CHECK(int64_t, "%lld")
|
||||
MAKE_ADD(int64_t)
|
||||
MAKE_SUBTR(int64_t)
|
||||
MAKE_MUL(int64_t)
|
||||
MAKE_DIV(int64_t)
|
||||
MAKE_REM(int64_t)
|
||||
MAKE_AFTER(int64_t)
|
||||
//}}}
|
||||
// FIXME range checks for float and double shouldn't work this way
|
||||
//{{{ float
|
||||
MAKE_RANGE_CHECK(float, "%d")
|
||||
MAKE_ADD(float)
|
||||
MAKE_SUBTR(float)
|
||||
MAKE_MUL(float)
|
||||
MAKE_DIV(float)
|
||||
MAKE_AFTER(float)
|
||||
//}}}
|
||||
//{{{ double
|
||||
MAKE_RANGE_CHECK(double, "%d")
|
||||
MAKE_ADD(double)
|
||||
MAKE_SUBTR(double)
|
||||
MAKE_MUL(double)
|
||||
MAKE_DIV(double)
|
||||
MAKE_AFTER(double)
|
||||
//}}}
|
||||
|
||||
#undef MAKE_RANGE_CHECK
|
||||
#undef MAKE_ADD
|
||||
#undef MAKE_SUBTR
|
||||
#undef MAKE_MUL
|
||||
#undef MAKE_DIV
|
||||
#undef MAKE_REM
|
||||
#undef MAKE_AFTER
|
||||
|
||||
#endif
|
||||
|
|
|
|||
16
fco2/testcases/conversions.occ
Normal file
16
fco2/testcases/conversions.occ
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
PROC P (CHAN OF BYTE in, out, err)
|
||||
BYTE c:
|
||||
INT i:
|
||||
INT64 ll:
|
||||
SEQ
|
||||
c, i, ll := 25, 2500, 25000000000
|
||||
c := BYTE c
|
||||
c := BYTE i
|
||||
c := BYTE ll
|
||||
i := INT c
|
||||
i := INT i
|
||||
i := INT ll
|
||||
ll := INT64 c
|
||||
ll := INT64 i
|
||||
ll := INT64 ll
|
||||
:
|
||||
Loading…
Reference in New Issue
Block a user