some more fixes

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";

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)++;
+				*expp = *right;
-				else (right->nd_REL)--;
+				if (*(expp->nd_REL) == '-') (expp->nd_REL)++;
-				expp->nd_class = Value;
+				else (expp->nd_REL)--;
-				expp->nd_symb = REAL;
-				expp->nd_REL = right->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:

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;

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,
+				sz = pointer_size;
-					 reg_pointer, 0);
+				regtype = reg_pointer;
 			}
 			else if (tp->tp_fund & T_NUMERIC) {
-				C_ms_reg(df->var_off,
+				sz = tp->tp_size;
-					 tp->tp_size,
+				regtype = tp->tp_fund == T_REAL ?
-					 tp->tp_fund == T_REAL ?
+					    reg_float : reg_any;
-					    reg_float : reg_any,
+			}
-					 0);
+			if (regtype >= 0) {
+				C_ms_reg(df->var_off, sz, regtype, 0);
 			}
 		}
 	}