version with better overflow checking
authorceriel <none@none>
Thu, 26 Nov 1987 14:15:24 +0000 (14:15 +0000)
committerceriel <none@none>
Thu, 26 Nov 1987 14:15:24 +0000 (14:15 +0000)
lang/m2/comp/LLlex.c
lang/m2/comp/chk_expr.c
lang/m2/comp/code.c
lang/m2/comp/const.h
lang/m2/comp/cstoper.c
lang/m2/comp/declar.g
lang/m2/comp/type.H
lang/m2/comp/type.c
lang/m2/libm2/ChkCards.e

index 64d2d80..4d48ebd 100644 (file)
@@ -461,7 +461,9 @@ again:
                                base = 8;
                                /* Fall through */
                                
-                       case End:
+                       case End: {
+                               int sgnswtch = 0;
+
                                *np = '\0';
                                if (np >= &buf[NUMSIZE]) {
                                        tk->TOK_INT = 1;
@@ -470,27 +472,38 @@ again:
                                else {
                                        np = &buf[1];
                                        while (*np == '0') np++;
-                                       tk->TOK_INT = str2long(np, base);
-                                       if (strlen(np) > 14 /* ??? */ ||
-                                           tk->TOK_INT < 0) {
-lexwarning(W_ORDINARY, "overflow in constant");
+                                       tk->TOK_INT = 0;
+                                       while (*np) {
+                                               arith old = tk->TOK_INT;
+
+                                               tk->TOK_INT = tk->TOK_INT*base
+                                                       + (*np++ - '0');
+                                               sgnswtch += (old < 0) ^
+                                                           (tk->TOK_INT < 0);
                                        }
                                }
-                               if (ch == 'C' && base == 8) {
+                               toktype = card_type;
+                               if (sgnswtch >= 2) {
+lexwarning(W_ORDINARY, "overflow in constant");
+                               }
+                               else if (ch == 'C' && base == 8) {
                                        toktype = char_type;
-                                       if (tk->TOK_INT<0 || tk->TOK_INT>255) {
+                                       if (sgnswtch != 0 || tk->TOK_INT>255) {
 lexwarning(W_ORDINARY, "character constant out of range");
                                        }
                                }
                                else if (ch == 'D' && base == 10) {
+                                       if (sgnswtch != 0) {
+lexwarning(W_ORDINARY, "overflow in constant");
+                                       }
                                        toktype = longint_type;
                                }
-                               else if (tk->TOK_INT>=0 &&
-                                        tk->TOK_INT<=max_int) {
+                               else if (sgnswtch == 0 &&
+                                        tk->TOK_INT<=max_int[(int)word_size]) {
                                        toktype = intorcard_type;
                                }
-                               else    toktype = card_type;
                                return tk->tk_symb = INTEGER;
+                               }
 
                        case OptReal:
                                /*      The '.' could be the first of the '..'
index e77b89f..60a125b 100644 (file)
@@ -103,7 +103,7 @@ MkCoercion(pnd, tp)
                        }
                        break;
                case T_INTEGER:  {
-                       long i = ~int_mask[(int)(tp->tp_size)];
+                       long i = ~max_int[(int)(tp->tp_size)];
                        long j = nd->nd_INT & i;
 
                        if ((nd_tp->tp_fund == T_INTEGER &&
@@ -896,7 +896,10 @@ ChkBinOper(expp)
        }
        else if ( tpl->tp_fund != T_REAL &&
                  left->nd_class == Value && right->nd_class == Value) {
-               cstbin(expp);
+               if (expp->nd_left->nd_type->tp_fund == T_INTEGER) {
+                       cstibin(expp);
+               }
+               else    cstubin(expp);
        }
 
        return 1;
index ec27c51..abfe60f 100644 (file)
@@ -474,6 +474,28 @@ CodePString(nd, tp)
        C_loi(szarg);
 }
 
+static
+subu(sz)
+       arith sz;
+{
+       if (options['R']) C_sbu(sz);
+       else {
+               C_cal(sz == word_size ? "subu" : "subul");
+               C_asp(sz);
+       }
+}
+
+static
+addu(sz)
+       arith sz;
+{
+       if (options['R']) C_adu(sz);
+       else {
+               C_cal(sz == word_size ? "addu" : "addul");
+               C_asp(sz);
+       }
+}
+
 CodeStd(nd)
        t_node *nd;
 {
@@ -559,11 +581,11 @@ CodeStd(nd)
                }
                if (std == S_DEC) {
                        if (tp->tp_fund == T_INTEGER) C_sbi(size);
-                       else    C_sbu(size);
+                       else    subu(size);
                }
                else {
                        if (tp->tp_fund == T_INTEGER) C_adi(size);
-                       else    C_adu(size);
+                       else    addu(size);
                }
                if (size == word_size) {
                        RangeCheck(left->nd_type, tp->tp_fund == T_INTEGER ?
@@ -673,7 +695,7 @@ CodeOper(expr, true_label, false_label)
                case T_EQUAL:
                case T_CARDINAL:
                case T_INTORCARD:
-                       C_adu(tp->tp_size);
+                       addu(tp->tp_size);
                        break;
                case T_SET:
                        C_ior(tp->tp_size);
@@ -695,7 +717,7 @@ CodeOper(expr, true_label, false_label)
                case T_EQUAL:
                case T_CARDINAL:
                case T_INTORCARD:
-                       C_sbu(tp->tp_size);
+                       subu(tp->tp_size);
                        break;
                case T_SET:
                        C_com(tp->tp_size);
@@ -715,7 +737,15 @@ CodeOper(expr, true_label, false_label)
                case T_EQUAL:
                case T_CARDINAL:
                case T_INTORCARD:
-                       C_mlu(tp->tp_size);
+                       if (options['R']) {
+                               C_mlu(tp->tp_size);
+                       }
+                       else {
+                               C_cal(tp->tp_size <= word_size ?
+                                       "mulu" :
+                                       "mulul");
+                               C_asp(tp->tp_size);
+                       }
                        break;
                case T_REAL:
                        C_mlf(tp->tp_size);
index 6f66626..9c7f590 100644 (file)
@@ -13,7 +13,5 @@ extern long
        mach_long_sign; /* sign bit of the machine long */
 extern int
        mach_long_size; /* size of long on this machine == sizeof(long) */
-extern arith
-       max_int;        /* maximum integer on target machine    */
 extern unsigned int
        wrd_bits;       /* Number of bits in a word */
index 0c6a06a..adbfade 100644 (file)
 long mach_long_sign;   /* sign bit of the machine long */
 int mach_long_size;    /* size of long on this machine == sizeof(long) */
 long full_mask[MAXSIZE];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */
-long int_mask[MAXSIZE];        /* int_mask[1] == 0x7F, int_mask[2] == 0x7FFF, .. */
-arith max_int;         /* maximum integer on target machine    */
+long max_int[MAXSIZE]; /* max_int[1] == 0x7F, max_int[2] == 0x7FFF, .. */
+long min_int[MAXSIZE]; /* min_int[1] == 0xFFFFFF80, min_int[2] = 0xFFFF8000,
+                          ...
+                       */
 unsigned int wrd_bits; /* number of bits in a word */
 
 extern char options[];
 
-static char ovflow[] = "overflow in constant expression";
+overflow(expp)
+       t_node *expp;
+{
+       node_warning(expp, W_ORDINARY, "overflow in constant expression");
+}
+       
+arith
+ar_abs(i)
+       arith i;
+{
+
+       return i < 0 ? -i : i;
+}
 
 cstunary(expp)
        register t_node *expp;
@@ -50,8 +64,8 @@ cstunary(expp)
        */
 
        case '-':
-               if (right->nd_INT < -int_mask[(int)(right->nd_type->tp_size)])
-                       node_warning(expp, W_ORDINARY, ovflow);
+               if (right->nd_INT == min_int[(int)(right->nd_type->tp_size)])
+                       overflow(expp);
                
                expp->nd_INT = -right->nd_INT;
                break;
@@ -73,62 +87,170 @@ cstunary(expp)
 }
 
 STATIC
-divide(pdiv, prem, uns)
+divide(pdiv, prem)
        arith *pdiv, *prem;
 {
-       /*      Divide *pdiv by *prem, and store result in *pdiv,
+       /*      Unsigned divide *pdiv by *prem, and store result in *pdiv,
                remainder in *prem
        */
        register arith o1 = *pdiv;
        register arith o2 = *prem;
 
-       if (uns)        {
-               /*      this is more of a problem than you might
-                       think on C compilers which do not have
-                       unsigned long.
-               */
-               if (o2 & mach_long_sign)        {/* o2 > max_long */
-                       if (! (o1 >= 0 || o1 < o2)) {
-                               /*      this is the unsigned test
-                                       o1 < o2 for o2 > max_long
-                               */
-                               *prem = o2 - o1;
-                               *pdiv = 1;
-                       }
-                       else {
-                               *pdiv = 0;
-                       }
+       /*      this is more of a problem than you might
+               think on C compilers which do not have
+               unsigned long.
+       */
+       if (o2 & mach_long_sign)        {/* o2 > max_long */
+               if (! (o1 >= 0 || o1 < o2)) {
+                       /*      this is the unsigned test
+                               o1 < o2 for o2 > max_long
+                       */
+                       *prem = o2 - o1;
+                       *pdiv = 1;
                }
-               else    {               /* o2 <= max_long */
-                       long half, bit, hdiv, hrem, rem;
-
-                       half = (o1 >> 1) & ~mach_long_sign;
-                       bit = o1 & 01;
-                       /*      now o1 == 2 * half + bit
-                               and half <= max_long
-                               and bit <= max_long
+               else {
+                       *pdiv = 0;
+               }
+       }
+       else    {               /* o2 <= max_long */
+               long half, bit, hdiv, hrem, rem;
+
+               half = (o1 >> 1) & ~mach_long_sign;
+               bit = o1 & 01;
+               /*      now o1 == 2 * half + bit
+                       and half <= max_long
+                       and bit <= max_long
+               */
+               hdiv = half / o2;
+               hrem = half % o2;
+               rem = 2 * hrem + bit;
+               *pdiv = 2*hdiv;
+               *prem = rem;
+               if (rem < 0 || rem >= o2) {
+                       /*      that is the unsigned compare
+                               rem >= o2 for o2 <= max_long
                        */
-                       hdiv = half / o2;
-                       hrem = half % o2;
-                       rem = 2 * hrem + bit;
-                       *pdiv = 2*hdiv;
-                       *prem = rem;
-                       if (rem < 0 || rem >= o2) {
-                               /*      that is the unsigned compare
-                                       rem >= o2 for o2 <= max_long
-                               */
-                               *pdiv += 1;
-                               *prem -= o2;
-                       }
+                       *pdiv += 1;
+                       *prem -= o2;
                }
        }
-       else {
-               *pdiv = o1 / o2;                /* ??? */
-               *prem = o1 - *pdiv * o2;
+}
+
+cstibin(expp)
+       register t_node *expp;
+{
+       /*      The binary operation in "expp" is performed on the constant
+               expressions below it, and the result restored in expp.
+               This version is for INTEGER expressions.
+       */
+       arith o1 = expp->nd_left->nd_INT;
+       arith o2 = expp->nd_right->nd_INT;
+       register int sz = expp->nd_type->tp_size;
+
+       assert(expp->nd_class == Oper);
+       assert(expp->nd_left->nd_class == Value);
+       assert(expp->nd_right->nd_class == Value);
+
+       switch (expp->nd_symb)  {
+       case '*':
+               if (o1 == 0 || o2 == 0) {
+                       o1 = 0;
+                       break;
+               }
+               if ((o1 > 0 && o2 > 0) || (o1 < 0 && o2 < 0)) {
+                       if (o1 == min_int[sz] ||
+                           o2 == min_int[sz] ||
+                           max_int[sz] / ar_abs(o1) < ar_abs(o2)) overflow(expp);
+               }
+               else if (o1 > 0) {
+                       if (min_int[sz] / o1 > o2) overflow(expp);
+               }
+               else if (min_int[sz] / o2 > o1) overflow(expp);
+               o1 *= o2;
+               break;
+
+       case DIV:
+               if (o2 == 0)    {
+                       node_error(expp, "division by 0");
+                       return;
+               }
+               o1 /= o2;       /* ??? */
+               break;
+
+       case MOD:
+               if (o2 == 0)    {
+                       node_error(expp, "modulo by 0");
+                       return;
+               }
+               o1 %= o2;       /* ??? */
+               break;
+
+       case '+':
+               if (o1 > 0 && o2 > 0) {
+                       if (max_int[sz] - o1 < o2) overflow(expp);
+               }
+               else if (o1 < 0 && o2 < 0) {
+                       if (min_int[sz] - o1 > o2) overflow(expp);
+               }
+               o1 += o2;
+               break;
+
+       case '-':
+               if (o1 >= 0 && o2 < 0) {
+                       if (max_int[sz] + o2 < o1) overflow(expp);
+               }
+               else if (o1 < 0 && o2 >= 0) {
+                       if (min_int[sz] + o2 > o1) overflow(expp);
+               }
+               o1 -= o2;
+               break;
+
+       case '<':
+               {       arith tmp = o1;
+                       
+                       o1 = o2;
+                       o2 = tmp;
+               }
+               /* Fall through */
+
+       case '>':
+               o1 = (o1 > o2);
+               break;
+
+       case LESSEQUAL:
+               {       arith tmp = o1;
+                       
+                       o1 = o2;
+                       o2 = tmp;
+               }
+               /* Fall through */
+
+       case GREATEREQUAL:
+               o1 = chk_bounds(o2, o1, T_INTEGER);
+               break;
+
+       case '=':
+               o1 = (o1 == o2);
+               break;
+
+       case '#':
+               o1 = (o1 != o2);
+               break;
+
+       default:
+               crash("(cstibin)");
        }
+
+       expp->nd_class = Value;
+       expp->nd_token = expp->nd_right->nd_token;
+       expp->nd_INT = o1;
+       CutSize(expp);
+       FreeNode(expp->nd_left);
+       FreeNode(expp->nd_right);
+       expp->nd_left = expp->nd_right = 0;
 }
 
-cstbin(expp)
+cstubin(expp)
        register t_node *expp;
 {
        /*      The binary operation in "expp" is performed on the constant
@@ -137,7 +259,8 @@ cstbin(expp)
        */
        arith o1 = expp->nd_left->nd_INT;
        arith o2 = expp->nd_right->nd_INT;
-       register int uns = expp->nd_left->nd_type != int_type;
+       register int sz = expp->nd_type->tp_size;
+       arith tmp1, tmp2;
 
        assert(expp->nd_class == Oper);
        assert(expp->nd_left->nd_class == Value);
@@ -145,6 +268,14 @@ cstbin(expp)
 
        switch (expp->nd_symb)  {
        case '*':
+               if (o1 == 0 || o2 == 0) {
+                       o1 = 0;
+                       break;
+               }
+               tmp1 = full_mask[sz];
+               tmp2 = o2;
+               divide(&tmp1, &tmp2);
+               if (! chk_bounds(o1, tmp1, T_CARDINAL)) overflow(expp);
                o1 *= o2;
                break;
 
@@ -153,7 +284,7 @@ cstbin(expp)
                        node_error(expp, "division by 0");
                        return;
                }
-               divide(&o1, &o2, uns);
+               divide(&o1, &o2);
                break;
 
        case MOD:
@@ -161,19 +292,28 @@ cstbin(expp)
                        node_error(expp, "modulo by 0");
                        return;
                }
-               divide(&o1, &o2, uns);
+               divide(&o1, &o2);
                o1 = o2;
                break;
 
        case '+':
+               if (! chk_bounds(o2, full_mask[sz] - o1, T_CARDINAL)) {
+                       overflow(expp);
+               }
                o1 += o2;
                break;
 
        case '-':
-               o1 -= o2;
-               if (expp->nd_type->tp_fund == T_INTORCARD) {
-                       if (o1 < 0) expp->nd_type = int_type;
+               if (! chk_bounds(o2, o1, T_CARDINAL)) {
+                       if (expp->nd_type->tp_fund == T_INTORCARD) {
+                               expp->nd_type = int_type;
+                               if (! chk_bounds(min_int[sz], o1 - o2, T_CARDINAL)) {
+                                       overflow();
+                               }
+                       }
+                       else    overflow();
                }
+               o1 -= o2;
                break;
 
        case '<':
@@ -185,14 +325,7 @@ cstbin(expp)
                /* Fall through */
 
        case '>':
-               if (uns)        {
-                       o1 = (o1 & mach_long_sign ?
-                               (o2 & mach_long_sign ? o1 > o2 : 1) :
-                               (o2 & mach_long_sign ? 0 : o1 > o2)
-                       );
-               }
-               else
-                       o1 = (o1 > o2);
+               o1 = ! chk_bounds(o1, o2, T_CARDINAL);
                break;
 
        case LESSEQUAL:
@@ -204,7 +337,7 @@ cstbin(expp)
                /* Fall through */
 
        case GREATEREQUAL:
-               o1 = chk_bounds(o2, o1, uns ? T_CARDINAL : T_INTEGER);
+               o1 = chk_bounds(o2, o1, T_CARDINAL);
                break;
 
        case '=':
@@ -225,7 +358,7 @@ cstbin(expp)
                break;
 
        default:
-               crash("(cstbin)");
+               crash("(cstubin)");
        }
 
        expp->nd_class = Value;
@@ -361,7 +494,12 @@ cstcall(expp, call)
        expp->nd_symb = INTEGER;
        switch(call) {
        case S_ABS:
-               if (expr->nd_INT < 0) expp->nd_INT = - expr->nd_INT;
+               if (expr->nd_INT < 0) {
+                       if (expr->nd_INT <= min_int[(int)(tp->tp_size)]) {
+                               overflow(expr);
+                       }
+                       expp->nd_INT = - expr->nd_INT;
+               }
                else expp->nd_INT = expr->nd_INT;
                CutSize(expp);
                break;
@@ -375,7 +513,7 @@ cstcall(expp, call)
 
        case S_MAX:
                if (tp->tp_fund == T_INTEGER) {
-                       expp->nd_INT = int_mask[(int)(tp->tp_size)];
+                       expp->nd_INT = max_int[(int)(tp->tp_size)];
                }
                else if (tp == card_type) {
                        expp->nd_INT = full_mask[(int)(int_size)];
@@ -388,8 +526,7 @@ cstcall(expp, call)
 
        case S_MIN:
                if (tp->tp_fund == T_INTEGER) {
-                       expp->nd_INT = -int_mask[(int)(tp->tp_size)];
-                       if (! options['s']) expp->nd_INT--;
+                       expp->nd_INT = min_int[(int)(tp->tp_size)];
                }
                else if (tp->tp_fund == T_SUBRANGE) {
                        expp->nd_INT = tp->sub_lb;
@@ -419,30 +556,18 @@ CutSize(expr)
        /*      The constant value of the expression expr is made to
                conform to the size of the type of the expression.
        */
-       register arith o1 = expr->nd_INT;
        register t_type *tp = BaseType(expr->nd_type);
-       int uns;
-       int size = tp->tp_size;
 
        assert(expr->nd_class == Value);
-       uns = (tp->tp_fund & (T_CARDINAL|T_CHAR));
-       if (uns) {
-               if (o1 & ~full_mask[size]) {
-                       node_warning(expr, W_ORDINARY, ovflow);
-                       o1 &= full_mask[size];
-               }
+       if (tp->tp_fund != T_INTEGER) {
+               expr->nd_INT &= full_mask[tp->tp_size];
        }
        else {
-               int nbits = (int) (mach_long_size - size) * 8;
-               long remainder = o1 & ~int_mask[size];
+               int nbits = (int) (mach_long_size - tp->tp_size) * 8;
 
-               if (remainder != 0 && remainder != ~int_mask[size]) {
-                       node_warning(expr, W_ORDINARY, ovflow);
-                       o1 <<= nbits;
-                       o1 >>= nbits;
-               }
+               expr->nd_INT <<= nbits;
+               expr->nd_INT >>= nbits;
        }
-       expr->nd_INT = o1;
 }
 
 InitCst()
@@ -455,7 +580,9 @@ InitCst()
                if (i == MAXSIZE)
                        fatal("array full_mask too small for this machine");
                full_mask[i] = bt;
-               int_mask[i] = bt & ~(1L << ((i << 3) - 1));
+               max_int[i] = bt & ~(1L << ((i << 3) - 1));
+               min_int[i] = - max_int[i];
+               if (! options['s']) min_int[i]--;
        }
        mach_long_size = i;
        mach_long_sign = 1L << (mach_long_size * 8 - 1);
@@ -463,6 +590,5 @@ InitCst()
                fatal("sizeof (long) insufficient on this machine");
        }
 
-       max_int = int_mask[(int)int_size];
        wrd_bits = 8 * (unsigned) word_size;
 }
index d71ce20..b0d5e28 100644 (file)
@@ -404,7 +404,8 @@ CaseLabels(t_type **ptp; register t_node **pnd;)
                                ChkCompat(pnd, *ptp, "case label");
                          }
                          nd = *pnd;
-                         if (! (nd->nd_type->tp_fund & T_DISCRETE)) {
+                         if (! (nd->nd_type->tp_fund & T_DISCRETE) ||
+                             nd->nd_type->tp_size > word_size) {
                                node_error(nd, "illegal type in case label");
                          }
                        }
index b218a7f..9d04c77 100644 (file)
@@ -212,7 +212,8 @@ extern t_type
 #define        IsConstructed(tpx)      ((tpx)->tp_fund & T_CONSTRUCTED)
 
 extern long full_mask[];
-extern long int_mask[];
+extern long max_int[];
+extern long min_int[];
 
 #define fit(n, i)      (((n) + ((arith)0x80<<(((i)-1)*8)) & ~full_mask[(i)]) == 0)
 #define ufit(n, i)     (((n) & ~full_mask[(i)]) == 0)
index 22496d8..663efc1 100644 (file)
@@ -305,7 +305,7 @@ chk_basesubrange(tp, base)
                error("illegal base for a subrange");
        }
        else if (base == int_type && tp->tp_next == card_type &&
-                (tp->sub_ub > max_int || tp->sub_ub < 0)) {
+                (tp->sub_ub > max_int[(int) word_size] || tp->sub_ub < 0)) {
                error("upperbound to large for type INTEGER");
        }
        else if (base != tp->tp_next && base != int_type) {
index 906efac..be7e8bd 100644 (file)
@@ -2,13 +2,22 @@
 
  mes 2,EM_WSIZE,EM_PSIZE
 
+ exp $addu
+ exp $subu
+ exp $mulu
+#if EM_WSIZE < EM_LSIZE
+ exp $addul
+ exp $subul
+ exp $mulul
+#endif
+
  pro $addu,0
  loc -1
  lol 0
  sbu EM_WSIZE
  lol EM_WSIZE
  cmu EM_WSIZE
- zle *1
+ zge *1
  loc M2_UOVFL
  trp
 1
  ret 0
  end 0
 
+#if EM_WSIZE < EM_LSIZE
+ pro $addul,0
+ ldc -1
+ ldl 0
+ sbu EM_LSIZE
+ ldl EM_LSIZE
+ cmu EM_LSIZE
+ zge *1
+ loc M2_UOVFL
+ trp
+1
+ ldl 0
+ ldl EM_LSIZE
+ adu EM_LSIZE
+ sdl EM_LSIZE
+ ret 0
+ end 0
+#endif
+
  pro $mulu,0
  lol 0
  zeq *1
  stl EM_WSIZE
  ret 0
  end 0
+
+#if EM_WSIZE < EM_LSIZE
+ pro $mulul,0
+ ldl 0
+ ldc 0
+ cmu EM_LSIZE
+ zeq *1
+ ldc -1
+ ldl 0
+ dvu EM_LSIZE
+ ldl EM_LSIZE
+ cmu EM_LSIZE
+ zle *1
+ loc M2_UOVFL
+ trp
+1
+ ldl 0
+ ldl EM_LSIZE
+ mlu EM_LSIZE
+ sdl EM_LSIZE
+ ret 0
+ end 0
+#endif
+
+ pro $subu,0
+ lol EM_WSIZE
+ lol 0
+ cmu EM_WSIZE
+ zge *1
+ loc M2_UOVFL
+ trp
+1
+ lol EM_WSIZE
+ lol 0
+ sbu EM_WSIZE
+ stl EM_WSIZE
+ ret 0
+ end 0
+
+#if EM_WSIZE < EM_LSIZE
+ pro $subul,0
+ ldl EM_LSIZE
+ ldl 0
+ cmu EM_LSIZE
+ zge *1
+ loc M2_UOVFL
+ trp
+1
+ ldl EM_LSIZE
+ ldl 0
+ sbu EM_LSIZE
+ sdl EM_LSIZE
+ ret 0
+ end 0
+#endif