From 3d4a1d102009918f7b5fefbd545a0eda1512d64e Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Mon, 23 Apr 2007 23:17:36 +0000
Subject: [PATCH] Range check type conversions, and implement arithmetic ops
 for all basic types

---
 fco2/GenerateC.hs              |  50 ++++++++----
 fco2/TODO                      |   5 +-
 fco2/Types.hs                  |  25 ++++++
 fco2/fco_support.h             | 145 +++++++++++++++++++++++++++------
 fco2/testcases/conversions.occ |  16 ++++
 5 files changed, 197 insertions(+), 44 deletions(-)
 create mode 100644 fco2/testcases/conversions.occ

diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs
index b5b12e5..4ca5f64 100644
--- a/fco2/GenerateC.hs
+++ b/fco2/GenerateC.hs
@@ -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
diff --git a/fco2/TODO b/fco2/TODO
index 604a3d9..4e859d7 100644
--- a/fco2/TODO
+++ b/fco2/TODO
@@ -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
diff --git a/fco2/Types.hs b/fco2/Types.hs
index e72fc23..89f5b38 100644
--- a/fco2/Types.hs
+++ b/fco2/Types.hs
@@ -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]
+          ]
diff --git a/fco2/fco_support.h b/fco2/fco_support.h
index c78e78c..bc77dcd 100644
--- a/fco2/fco_support.h
+++ b/fco2/fco_support.h
@@ -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
diff --git a/fco2/testcases/conversions.occ b/fco2/testcases/conversions.occ
new file mode 100644
index 0000000..ff540b2
--- /dev/null
+++ b/fco2/testcases/conversions.occ
@@ -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
+: