From 896fec3fc56f742b14424c304d76641d99fa74b3 Mon Sep 17 00:00:00 2001 From: ceriel Date: Thu, 26 Nov 1987 14:15:24 +0000 Subject: [PATCH] version with better overflow checking --- lang/m2/comp/LLlex.c | 33 +++-- lang/m2/comp/chk_expr.c | 7 +- lang/m2/comp/code.c | 40 +++++- lang/m2/comp/const.h | 2 - lang/m2/comp/cstoper.c | 298 ++++++++++++++++++++++++++++----------- lang/m2/comp/declar.g | 3 +- lang/m2/comp/type.H | 3 +- lang/m2/comp/type.c | 2 +- lang/m2/libm2/ChkCards.e | 85 ++++++++++- 9 files changed, 364 insertions(+), 109 deletions(-) diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c index 64d2d8060..4d48ebd9e 100644 --- a/lang/m2/comp/LLlex.c +++ b/lang/m2/comp/LLlex.c @@ -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 '..' diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index e77b89f67..60a125b6d 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -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; diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index ec27c5170..abfe60f9f 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -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); diff --git a/lang/m2/comp/const.h b/lang/m2/comp/const.h index 6f6662620..9c7f590ef 100644 --- a/lang/m2/comp/const.h +++ b/lang/m2/comp/const.h @@ -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 */ diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c index 0c6a06a60..adbfade27 100644 --- a/lang/m2/comp/cstoper.c +++ b/lang/m2/comp/cstoper.c @@ -27,13 +27,27 @@ 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; } diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index d71ce2001..b0d5e286e 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -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"); } } diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H index b218a7f58..9d04c7796 100644 --- a/lang/m2/comp/type.H +++ b/lang/m2/comp/type.H @@ -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) diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 22496d844..663efc150 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -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) { diff --git a/lang/m2/libm2/ChkCards.e b/lang/m2/libm2/ChkCards.e index 906efacdd..be7e8bd58 100644 --- a/lang/m2/libm2/ChkCards.e +++ b/lang/m2/libm2/ChkCards.e @@ -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 @@ -19,6 +28,25 @@ 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 @@ -37,3 +65,58 @@ 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 -- 2.34.1