diff --git a/lang/m2/comp/Version.c b/lang/m2/comp/Version.c index 037046d2e..4d0bd0fad 100644 --- a/lang/m2/comp/Version.c +++ b/lang/m2/comp/Version.c @@ -1 +1 @@ -static char Version[] = "ACK Modula-2 compiler Version 0.15"; +static char Version[] = "ACK Modula-2 compiler Version 0.16"; diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index b469a606b..d17a3ca8b 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -314,11 +314,23 @@ ChkExLinkOrName(expp) assert(df->df_kind == D_CONST); expp->nd_token = df->con_const; expp->nd_lineno = ln; + if (expp->nd_class == Set) { + register int i = + (unsigned) expp->nd_type->tp_size / + (unsigned) word_size; + register arith *p, *q; + + p = expp->nd_set; + q = (arith *) Malloc((unsigned) i * sizeof(arith)); + expp->nd_set = q; + while (i--) *q++ = *p++; + } } } if (!(df->df_kind & D_VALUE)) { Xerror(expp, "value expected", df); + return 0; } if (df->df_kind == D_PROCEDURE) { @@ -663,7 +675,10 @@ ChkCall(expp) variable. */ } - else node_error(left, "procedure, type, or function expected"); + else { + node_error(left, "procedure, type, or function expected"); + left->nd_type = error_type; + } } return ChkProcCall(expp); } @@ -865,6 +880,12 @@ ChkUnOper(expp) register struct node *right = expp->nd_right; register struct type *tpr; + if (expp->nd_symb == '(') { + *expp = *right; + free_node(right); + return ChkExpression(expp); + } + expp->nd_type = error_type; if (! ChkExpression(right)) return 0; expp->nd_type = tpr = BaseType(right->nd_type); MkCoercion(&(expp->nd_right), tpr); @@ -877,11 +898,6 @@ ChkUnOper(expp) if (!(tpr->tp_fund & T_NUMERIC)) break; /* fall through */ - case '(': - *expp = *right; - free_node(right); - return 1; - case '-': if (tpr->tp_fund & T_INTORCARD) { if (tpr == intorcard_type || tpr == card_type) { @@ -894,13 +910,10 @@ ChkUnOper(expp) } else if (tpr->tp_fund == T_REAL) { if (right->nd_class == Value) { - if (*(right->nd_REL) == '-') (right->nd_REL)++; - else (right->nd_REL)--; - expp->nd_class = Value; - expp->nd_symb = REAL; - expp->nd_REL = right->nd_REL; + *expp = *right; + if (*(expp->nd_REL) == '-') (expp->nd_REL)++; + else (expp->nd_REL)--; FreeNode(right); - expp->nd_right = 0; } return 1; } @@ -946,6 +959,7 @@ ChkStandard(expp) struct node *arg = expp; register struct node *left = expp->nd_left; register struct def *edf = left->nd_def; + struct type *basetype; int free_it = 0; assert(left->nd_class == Def); @@ -954,13 +968,18 @@ ChkStandard(expp) switch(edf->df_value.df_stdname) { case S_ABS: if (!(left = getarg(&arg, T_NUMERIC, 0, edf))) return 0; - MkCoercion(&(arg->nd_left), BaseType(left->nd_type)); + basetype = BaseType(left->nd_type); + MkCoercion(&(arg->nd_left), basetype); left = arg->nd_left; expp->nd_type = left->nd_type; if (left->nd_class == Value && expp->nd_type->tp_fund != T_REAL) { cstcall(expp, S_ABS); } + else if (basetype->tp_fund != T_INTEGER && + basetype->tp_fund != T_REAL) { + free_it = 1; + } break; case S_CAP: diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index 4fa5c8c78..81113271f 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -154,6 +154,8 @@ CodeExpr(nd, ds, true_label, false_label) for (; i; i--) { C_loc(*--st); } + free((char *) nd->nd_set); + nd->nd_set = 0; CodeSet(nd); } break; diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index 66e4fc7f3..1238e6bb3 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -486,7 +486,8 @@ WalkStat(nd, exit_label) case FOR: { - arith tmp = 0; + arith tmp = NewInt(); + arith tmp2; register struct node *fnd; int good_forvar; label l1 = ++text_label; @@ -506,10 +507,8 @@ WalkStat(nd, exit_label) bstp = BaseType(nd->nd_type); uns = bstp->tp_fund != T_INTEGER; C_dup(int_size); - RangeCheck(left->nd_left->nd_type, nd->nd_type); CodeDStore(nd); CodePExpr(fnd); - tmp = NewInt(); C_stl(tmp); C_lol(tmp); if (uns) C_cmu(int_size); @@ -534,7 +533,18 @@ WalkStat(nd, exit_label) nd->nd_def->df_flags |= D_FORLOOP; C_df_ilb(l1); } + if (! options['R']) { + tmp2 = NewInt(); + ForLoopVarExpr(nd); + C_stl(tmp2); + } WalkNode(right, exit_label); + if (! options['R']) { + C_lol(tmp2); + ForLoopVarExpr(nd); + C_cal("_forloopchk"); + FreeInt(tmp2); + } nd->nd_def->df_flags &= ~D_FORLOOP; if (good_forvar && stepsize) { C_lol(tmp); @@ -546,7 +556,7 @@ WalkStat(nd, exit_label) C_loc(left->nd_INT); ForLoopVarExpr(nd); C_adu(int_size); - RangeCheck(bstp, nd->nd_type); + RangeCheck(nd->nd_type, bstp); CodeDStore(nd); } C_bra(l1); @@ -736,7 +746,7 @@ DoForInit(nd) tpl = left->nd_left->nd_type; tpr = left->nd_right->nd_type; if (!ChkAssCompat(&(left->nd_left), df->df_type, "FOR statement") || - !ChkAssCompat(&(left->nd_right), df->df_type,"FOR statement")) { + !ChkAssCompat(&(left->nd_right), BaseType(df->df_type), "FOR statement")) { return 1; } if (!TstCompat(df->df_type, tpl) || @@ -788,6 +798,8 @@ RegisterMessages(df) register struct def *df; { register struct type *tp; + arith sz; + int regtype = -1; for (; df; df = df->df_nextinscope) { if (df->df_kind == D_VARIABLE && !(df->df_flags & D_NOREG)) { @@ -796,15 +808,16 @@ RegisterMessages(df) tp = BaseType(df->df_type); if ((df->df_flags & D_VARPAR) || (tp->tp_fund & (T_POINTER|T_HIDDEN|T_EQUAL))) { - C_ms_reg(df->var_off, pointer_size, - reg_pointer, 0); + sz = pointer_size; + regtype = reg_pointer; } else if (tp->tp_fund & T_NUMERIC) { - C_ms_reg(df->var_off, - tp->tp_size, - tp->tp_fund == T_REAL ? - reg_float : reg_any, - 0); + sz = tp->tp_size; + regtype = tp->tp_fund == T_REAL ? + reg_float : reg_any; + } + if (regtype >= 0) { + C_ms_reg(df->var_off, sz, regtype, 0); } } }