diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index 31818f391..2bf6fec87 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -45,8 +45,9 @@ Xerror(nd, mess, edf) if (edf->df_kind != D_ERROR) { node_error(nd,"\"%s\": %s", edf->df_idf->id_text, mess); } + return; } - else node_error(nd, "%s", mess); + node_error(nd, "%s", mess); } int @@ -277,9 +278,24 @@ node_error(expp, "standard or local procedures may not be assigned"); } STATIC int -ChkElement(expp, tp, set, level) +ChkEl(expr, tp) + register struct node *expr; + struct type *tp; +{ + if (!ChkExpression(expr)) return 0; + + if (!TstCompat(tp, expr->nd_type)) { + node_error(expr, "set element has incompatible type"); + return 0; + } + + return 1; +} + +STATIC int +ChkElement(expp, tp, set) struct node **expp; - register struct type *tp; + struct type *tp; arith **set; { /* Check elements of a set. This routine may call itself @@ -289,66 +305,50 @@ ChkElement(expp, tp, set, level) register struct node *expr = *expp; register struct node *left = expr->nd_left; register struct node *right = expr->nd_right; - register arith i; + register unsigned int i; + arith lo, hi, low, high; if (expr->nd_class == Link && expr->nd_symb == UPTO) { /* { ... , expr1 .. expr2, ... } First check expr1 and expr2, and try to compute them. */ - if (!ChkElement(&(expr->nd_left), tp, set, 1) || - !ChkElement(&(expr->nd_right), tp, set, 1)) { + if (! (ChkEl(left, tp) & ChkEl(right, tp))) { return 0; } - if (left->nd_class == Value && right->nd_class == Value) { - /* We have a constant range. Put all elements in the - set - */ - - if (left->nd_INT > right->nd_INT) { -node_error(expr, "lower bound exceeds upper bound in range"); - return 0; - } - - for (i=left->nd_INT; i<=right->nd_INT; i++) { - (*set)[i/wrd_bits] |= (1<<(i%wrd_bits)); - } - FreeNode(expr); - *expp = 0; + if (!(left->nd_class == Value && right->nd_class == Value)) { + return 1; } + /* We have a constant range. Put all elements in the + set + */ - return 1; + low = left->nd_INT; + high = right->nd_INT; } - - /* Here, a single element is checked - */ - if (!ChkExpression(expr)) return 0; - - if (!TstCompat(tp, expr->nd_type)) { - node_error(expr, "set element has incompatible type"); + else { + if (! ChkEl(expr, tp)) return 0; + if (expr->nd_class != Value) { + return 1; + } + low = high = expr->nd_INT; + } + if (low > high) { + node_error(expr, "lower bound exceeds upper bound in range"); return 0; } - if (expr->nd_class == Value) { - /* a constant element - */ - arith low, high; - - i = expr->nd_INT; - getbounds(tp, &low, &high); - - if (i < low || i > high) { - node_error(expr, "set element out of range"); - return 0; - } - - if (! level) { - (*set)[i/wrd_bits] |= (1 << (i%wrd_bits)); - FreeNode(expr); - *expp = 0; - } + getbounds(tp, &lo, &hi); + if (low < lo || high > hi) { + node_error(expr, "set element out of range"); + return 0; } + for (i=(unsigned)low; i<= (unsigned)high; i++) { + (*set)[i/wrd_bits] |= (1<<(i%wrd_bits)); + } + FreeNode(expr); + *expp = 0; return 1; } @@ -407,7 +407,7 @@ ChkSet(expp) assert(nd->nd_class == Link && nd->nd_symb == ','); if (!ChkElement(&(nd->nd_left), ElementType(tp), - &(expp->nd_set), 0)) { + &(expp->nd_set))) { retval = 0; } if (nd->nd_left) expp->nd_class = Xset; @@ -1172,6 +1172,7 @@ ChkCast(expp, left) is no problem as such values take a word on the EM stack anyway. */ + register struct type *lefttype = left->nd_type; register struct node *arg = expp->nd_right; if ((! arg) || arg->nd_right) { @@ -1182,23 +1183,21 @@ ChkCast(expp, left) arg = arg->nd_left; if (! ChkExpression(arg)) return 0; - if (arg->nd_type->tp_size != left->nd_type->tp_size && + if (arg->nd_type->tp_size != lefttype->tp_size && (arg->nd_type->tp_size > word_size || - left->nd_type->tp_size > word_size)) { + lefttype->tp_size > word_size)) { Xerror(expp, "unequal sizes in type cast", left->nd_def); } if (arg->nd_class == Value) { - struct type *tp = left->nd_type; - FreeNode(left); expp->nd_right->nd_left = 0; FreeNode(expp->nd_right); expp->nd_left = expp->nd_right = 0; *expp = *arg; - expp->nd_type = tp; + expp->nd_type = lefttype; } - else expp->nd_type = left->nd_type; + else expp->nd_type = lefttype; return 1; } diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index a2ca1bb98..0c83f7006 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -36,24 +36,25 @@ extern int proclevel; int fp_used; CodeConst(cst, size) - arith cst, size; + arith cst; + int size; { /* Generate code to push constant "cst" with size "size" */ - if (size <= word_size) { + if (size <= (int) word_size) { C_loc(cst); } - else if (size == dword_size) { + else if (size == (int) dword_size) { C_ldc(cst); } else { crash("(CodeConst)"); /* C_df_dlb(++data_label); - C_rom_icon(long2str((long) cst), size); + C_rom_icon(long2str((long) cst), (arith) size); C_lae_dlb(data_label, (arith) 0); - C_loi(size); + C_loi((arith) size); */ } } @@ -64,12 +65,11 @@ CodeString(nd) if (nd->nd_type->tp_fund != T_STRING) { /* Character constant */ C_loc(nd->nd_INT); + return; } - else { - C_df_dlb(++data_label); - C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1)); - C_lae_dlb(data_label, (arith) 0); - } + C_df_dlb(++data_label); + C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1)); + C_lae_dlb(data_label, (arith) 0); } CodeExpr(nd, ds, true_label, false_label) @@ -111,15 +111,15 @@ CodeExpr(nd, ds, true_label, false_label) switch(nd->nd_symb) { case REAL: C_df_dlb(++data_label); - C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size); + C_rom_fcon(nd->nd_REL, tp->tp_size); C_lae_dlb(data_label, (arith) 0); - C_loi(nd->nd_type->tp_size); + C_loi(tp->tp_size); break; case STRING: CodeString(nd); break; case INTEGER: - CodeConst(nd->nd_INT, tp->tp_size); + CodeConst(nd->nd_INT, (int) (tp->tp_size)); break; default: crash("Value error"); @@ -134,11 +134,11 @@ CodeExpr(nd, ds, true_label, false_label) case Xset: case Set: { - register int i = tp->tp_size / word_size; + register unsigned i = (unsigned) (tp->tp_size) / (int) word_size; register arith *st = nd->nd_set + i; ds->dsg_kind = DSG_LOADED; - for (; i > 0; i--) { + for (; i; i--) { C_loc(*--st); } CodeSet(nd); @@ -282,6 +282,7 @@ CodeCall(nd) and result is already done. */ register struct node *left = nd->nd_left; + register struct def *df; register struct node *right = nd->nd_right; register struct type *result_tp; @@ -307,7 +308,7 @@ CodeCall(nd) switch(left->nd_class) { case Def: { - register struct def *df = left->nd_def; + df = left->nd_def; if (df->df_kind == D_PROCEDURE) { int level = df->df_scope->sc_level; @@ -516,9 +517,28 @@ CodeStd(nd) CodePExpr(left); break; - case S_TRUNCD: - case S_TRUNC: case S_FLOAT: + CodePExpr(left); + RangeCheck(card_type, left->nd_type); + CodeCoercion(tp, nd->nd_type); + break; + + case S_TRUNC: { + label lb = ++text_label; + + CodePExpr(left); + C_dup(tp->tp_size); + C_zrf(tp->tp_size); + C_cmf(tp->tp_size); + C_zge(lb); + C_loc((arith) ECONV); + C_trp(); + C_df_ilb(lb); + CodeCoercion(tp, nd->nd_type); + } + break; + + case S_TRUNCD: case S_FLOATD: case S_LONG: case S_SHORT: @@ -816,11 +836,11 @@ CodeOper(expr, true_label, false_label) if (true_label != NO_LABEL) { compare(expr->nd_symb, true_label); C_bra(false_label); + break; } - else { - truthvalue(expr->nd_symb); - } + truthvalue(expr->nd_symb); break; + case IN: /* In this case, evaluate right hand side first! The INN instruction expects the bit number on top of the diff --git a/lang/m2/comp/const.h b/lang/m2/comp/const.h index b143b2c1b..8af8e609f 100644 --- a/lang/m2/comp/const.h +++ b/lang/m2/comp/const.h @@ -16,5 +16,6 @@ extern int extern arith max_int, /* maximum integer on target machine */ max_unsigned, /* maximum unsigned on target machine */ - max_longint, /* maximum longint on target machine */ + max_longint; /* maximum longint 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 27ccad906..e867818cb 100644 --- a/lang/m2/comp/cstoper.c +++ b/lang/m2/comp/cstoper.c @@ -30,7 +30,7 @@ long full_mask[MAXSIZE];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */ arith max_int; /* maximum integer on target machine */ arith max_unsigned; /* maximum unsigned on target machine */ arith max_longint; /* maximum longint on target machine */ -arith wrd_bits; /* number of bits in a word */ +unsigned int wrd_bits; /* number of bits in a word */ extern char options[]; @@ -42,7 +42,7 @@ cstunary(expp) /* The unary operation in "expp" is performed on the constant expression below it, and the result restored in expp. */ - register arith o1 = expp->nd_right->nd_INT; + register struct node *right = expp->nd_right; switch(expp->nd_symb) { /* Should not get here @@ -51,7 +51,7 @@ cstunary(expp) */ case '-': - o1 = -o1; + expp->nd_INT = -right->nd_INT; if (expp->nd_type->tp_fund == T_INTORCARD) { expp->nd_type = int_type; } @@ -59,7 +59,7 @@ cstunary(expp) case NOT: case '~': - o1 = !o1; + expp->nd_INT = !right->nd_INT; break; default: @@ -67,10 +67,9 @@ cstunary(expp) } expp->nd_class = Value; - expp->nd_token = expp->nd_right->nd_token; - expp->nd_INT = o1; + expp->nd_symb = right->nd_symb; CutSize(expp); - FreeNode(expp->nd_right); + FreeNode(right); expp->nd_right = 0; } @@ -247,21 +246,23 @@ cstset(expp) { register arith *set1, *set2; arith *resultset = 0; - register int setsize, j; + register unsigned int setsize; + register int j; assert(expp->nd_right->nd_class == Set); assert(expp->nd_symb == IN || expp->nd_left->nd_class == Set); set2 = expp->nd_right->nd_set; - setsize = expp->nd_right->nd_type->tp_size / word_size; + setsize = (unsigned) expp->nd_right->nd_type->tp_size / (unsigned) word_size; if (expp->nd_symb == IN) { - arith i; + unsigned i; assert(expp->nd_left->nd_class == Value); i = expp->nd_left->nd_INT; expp->nd_class = Value; - expp->nd_INT = (i >= 0 && i < setsize * wrd_bits && + expp->nd_INT = (expp->nd_left->nd_INT >= 0 && + expp->nd_left->nd_INT < setsize * wrd_bits && (set2[i / wrd_bits] & (1 << (i % wrd_bits)))); free((char *) set2); expp->nd_symb = INTEGER; @@ -531,5 +532,5 @@ InitCst() max_int = full_mask[int_size] & ~(1L << (int_size * 8 - 1)); max_unsigned = full_mask[int_size]; max_longint = full_mask[long_size] & ~(1L << (long_size * 8 - 1)); - wrd_bits = 8 * word_size; + wrd_bits = 8 * (unsigned) word_size; } diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c index cb2ee3333..e8a0eeeeb 100644 --- a/lang/m2/comp/desig.c +++ b/lang/m2/comp/desig.c @@ -33,42 +33,54 @@ extern int proclevel; struct desig InitDesig = {DSG_INIT, 0, 0, 0}; -int C_ste_dnam(), C_sde_dnam(), C_loe_dnam(), C_lde_dnam(); -int C_stl(), C_sdl(), C_lol(), C_ldl(); - -#define WRD 0 -#define DWRD 1 -#define LD 0 -#define STR 1 - -static int (*lcl_ld_and_str[2][2])() = { -{ C_lol, C_stl }, -{ C_ldl, C_sdl } -}; - -static int (*ext_ld_and_str[2][2])() = { -{ C_loe_dnam, C_ste_dnam }, -{ C_lde_dnam, C_sde_dnam } -}; - int -DoLoadOrStore(ds, size, LoadOrStoreFlag) +WordOrDouble(ds, size) register struct desig *ds; arith size; { - int sz; - - if (ds->dsg_offset % word_size != 0) return 0; - - if (size == word_size) sz = WRD; - else if (size == dword_size) sz = DWRD; - else return 0; + return ((int) (ds->dsg_offset) % (int) word_size == 0 && + ( (int) size == (int) word_size || + (int) size == (int) dword_size)); +} +int +DoLoad(ds, size) + register struct desig *ds; + arith size; +{ + if (! WordOrDouble(ds, size)) return 0; if (ds->dsg_name) { - (*(ext_ld_and_str[sz][LoadOrStoreFlag]))(ds->dsg_name, ds->dsg_offset); + if ((int) size == (int) word_size) { + C_loe_dnam(ds->dsg_name, ds->dsg_offset); + } + else C_lde_dnam(ds->dsg_name, ds->dsg_offset); } else { - (*(lcl_ld_and_str[sz][LoadOrStoreFlag]))(ds->dsg_offset); + if ((int) size == (int) word_size) { + C_lol(ds->dsg_offset); + } + else C_ldl(ds->dsg_offset); + } + return 1; +} + +int +DoStore(ds, size) + register struct desig *ds; + arith size; +{ + if (! WordOrDouble(ds, size)) return 0; + if (ds->dsg_name) { + if ((int) size == (int) word_size) { + C_ste_dnam(ds->dsg_name, ds->dsg_offset); + } + else C_sde_dnam(ds->dsg_name, ds->dsg_offset); + } + else { + if ((int) size == (int) word_size) { + C_stl(ds->dsg_offset); + } + else C_sdl(ds->dsg_offset); } return 1; } @@ -88,15 +100,15 @@ properly(ds, size, al) with DSG_FIXED. */ - arith szmodword = size % word_size; /* 0 if multiple of wordsize */ - arith wordmodsz = word_size % size; /* 0 if dividor of wordsize */ + int szmodword = (int) size % (int) word_size; /* 0 if multiple of wordsize */ + int wordmodsz = word_size % size; /* 0 if dividor of wordsize */ if (szmodword && wordmodsz) return 0; if (al >= word_align) return 1; if (szmodword && al >= szmodword) return 1; return ds->dsg_kind == DSG_FIXED && - ((! szmodword && ds->dsg_offset % word_align == 0) || + ((! szmodword && (int) (ds->dsg_offset) % word_align == 0) || (! wordmodsz && ds->dsg_offset % size == 0)); } @@ -114,7 +126,7 @@ CodeValue(ds, tp) break; case DSG_FIXED: - if (DoLoadOrStore(ds, tp->tp_size, LD)) break; + if (DoLoad(ds, tp->tp_size)) break; /* Fall through */ case DSG_PLOADED: case DSG_PFIXED: @@ -167,7 +179,7 @@ CodeStore(ds, tp) save = *ds; switch(ds->dsg_kind) { case DSG_FIXED: - if (DoLoadOrStore(ds, tp->tp_size, STR)) break; + if (DoStore(ds, tp->tp_size)) break; /* Fall through */ case DSG_PLOADED: case DSG_PFIXED: @@ -242,7 +254,8 @@ CodeMove(rhs, left, rtp) case DSG_PLOADED: case DSG_PFIXED: CodeAddress(rhs); - if (tp->tp_size % word_size == 0 && tp->tp_align >= word_size) { + if ((int) (tp->tp_size) % (int) word_size == 0 && + tp->tp_align >= (int) word_size) { CodeDesig(left, lhs); CodeAddress(lhs); C_blm(tp->tp_size); @@ -254,12 +267,13 @@ CodeMove(rhs, left, rtp) case DSG_FIXED: CodeDesig(left, lhs); if (lhs->dsg_kind == DSG_FIXED && - lhs->dsg_offset % word_size == - rhs->dsg_offset % word_size) { + (int) (lhs->dsg_offset) % (int) word_size == + (int) (rhs->dsg_offset) % (int) word_size) { register int sz; arith size = tp->tp_size; - while (size && (sz = (lhs->dsg_offset % word_size))) { + while (size && + (sz = ((int)(lhs->dsg_offset) % (int)word_size))) { /* First copy up to word-aligned boundaries */ @@ -282,7 +296,7 @@ CodeMove(rhs, left, rtp) lhs->dsg_offset += sz; size -= sz; } - else for (sz = dword_size; sz; sz -= word_size) { + else for (sz = (int) dword_size; sz; sz -= (int) word_size) { while (size >= sz) { /* Then copy dwords, words. Depend on peephole optimizer @@ -306,7 +320,8 @@ CodeMove(rhs, left, rtp) CodeAddress(lhs); loadedflag = 1; } - if (tp->tp_size % word_size == 0 && tp->tp_align >= word_size) { + if ((int)(tp->tp_size) % (int) word_size == 0 && + tp->tp_align >= word_size) { CodeAddress(rhs); if (loadedflag) C_exg(pointer_size); else CodeAddress(lhs); @@ -359,7 +374,7 @@ CodeAddress(ds) break; case DSG_PFIXED: - DoLoadOrStore(ds, word_size, LD); + DoLoad(ds, word_size); break; case DSG_INDEXED: @@ -445,7 +460,7 @@ CodeVarDesig(df, ds) /* the programmer specified an address in the declaration of the variable. Generate code to push the address. */ - CodeConst(df->var_off, pointer_size); + CodeConst(df->var_off, (int) pointer_size); ds->dsg_kind = DSG_PLOADED; ds->dsg_offset = 0; return; diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c index 725d2ba73..ab155b679 100644 --- a/lang/m2/comp/options.c +++ b/lang/m2/comp/options.c @@ -80,19 +80,22 @@ DoOption(text) break; case 'W': - while (*text) { - switch(*text++) { - case 'O': - warning_classes |= W_OLDFASHIONED; - break; - case 'R': - warning_classes |= W_STRICT; - break; - case 'W': - warning_classes |= W_ORDINARY; - break; + if (*text) { + while (*text) { + switch(*text++) { + case 'O': + warning_classes |= W_OLDFASHIONED; + break; + case 'R': + warning_classes |= W_STRICT; + break; + case 'W': + warning_classes |= W_ORDINARY; + break; + } } } + else warning_classes = W_OLDFASHIONED|W_STRICT|W_ORDINARY; break; case 'M': { /* maximum identifier length */ diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index ecb245073..b4289d4ed 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -452,7 +452,7 @@ set_type(tp) getbounds(tp, &lb, &ub); - if (lb < 0 || ub > maxset-1) { + if (lb < 0 || ub > maxset-1 || (sizeof(int)==2 && ub > 65535)) { error("set type limits exceeded"); return error_type; }