From: ceriel <none@none>
Date: Thu, 26 Jun 1986 09:39:36 +0000 (+0000)
Subject: newer version
X-Git-Tag: release-5-5~5275
X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=bcfca75b5612bd80f9bb576bf682c99182a19b96;p=ack.git

newer version
---

diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index e6d968bfe..f4caf84bf 100644
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -97,26 +97,26 @@ symbol2str.o: Lpars.h
 tokenname.o: Lpars.h idf.h tokenname.h
 idf.o: idf.h
 input.o: f_info.h input.h inputtype.h
-type.o: LLlex.h const.h debug.h def.h idf.h maxset.h node.h scope.h target_sizes.h type.h
+type.o: LLlex.h const.h debug.h def.h idf.h maxset.h node.h scope.h target_sizes.h type.h walk.h
 def.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
 scope.o: LLlex.h debug.h def.h idf.h node.h scope.h type.h
 misc.o: LLlex.h f_info.h idf.h misc.h node.h
 enter.o: LLlex.h debug.h def.h idf.h main.h node.h scope.h type.h
 defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h inputtype.h main.h scope.h
-typequiv.o: LLlex.h def.h node.h type.h
+typequiv.o: LLlex.h debug.h def.h node.h type.h
 node.o: LLlex.h debug.h def.h node.h type.h
 cstoper.o: LLlex.h Lpars.h debug.h idf.h node.h standards.h target_sizes.h type.h
 chk_expr.o: LLlex.h Lpars.h chk_expr.h const.h debug.h def.h idf.h node.h scope.h standards.h type.h
 options.o: idfsize.h main.h ndir.h type.h
 walk.o: LLlex.h Lpars.h chk_expr.h debug.h def.h desig.h f_info.h idf.h main.h node.h scope.h type.h walk.h
-casestat.o: LLlex.h Lpars.h debug.h density.h desig.h node.h type.h
+casestat.o: LLlex.h Lpars.h debug.h density.h desig.h node.h type.h walk.h
 desig.o: LLlex.h debug.h def.h desig.h node.h scope.h type.h
-code.o: LLlex.h Lpars.h debug.h def.h desig.h node.h scope.h standards.h type.h
-tmpvar.o: debug.h def.h scope.h type.h
+code.o: LLlex.h Lpars.h debug.h def.h desig.h node.h scope.h standards.h type.h walk.h
+tmpvar.o: debug.h def.h main.h scope.h type.h
 lookup.o: LLlex.h debug.h def.h idf.h node.h scope.h
 tokenfile.o: Lpars.h
 program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
-declar.o: LLlex.h Lpars.h debug.h def.h idf.h main.h misc.h node.h scope.h type.h
+declar.o: LLlex.h Lpars.h chk_expr.h debug.h def.h idf.h main.h misc.h node.h scope.h type.h
 expression.o: LLlex.h Lpars.h chk_expr.h const.h debug.h def.h idf.h node.h type.h
 statement.o: LLlex.h Lpars.h def.h idf.h node.h scope.h type.h
 Lpars.o: Lpars.h
diff --git a/lang/m2/comp/Parameters b/lang/m2/comp/Parameters
index 82e019a8d..acda8568f 100644
--- a/lang/m2/comp/Parameters
+++ b/lang/m2/comp/Parameters
@@ -49,9 +49,9 @@
 #define DEBUG		1	/* perform various self-tests		*/
 extern char options[];
 #ifdef DEBUG
-#define DO_DEBUG(n, x)	((n) <= options['D'] && (x))
+#define DO_DEBUG(y, x)	((y) && (x))
 #else
-#define DO_DEBUG(n, x)
+#define DO_DEBUG(y, x)
 #endif DEBUG
 
 !File: inputtype.h
diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index e5db28b98..1d8b93d08 100644
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -27,11 +27,87 @@ static char *RcsId = "$Header$";
 
 extern char *symbol2str();
 
+int
+chk_variable(expp)
+	register struct node *expp;
+{
+
+	if (! chk_designator(expp)) return 0;
+
+	if (expp->nd_class == Def &&
+	    !(expp->nd_def->df_kind & (D_FIELD|D_VARIABLE))) {
+		node_error(expp, "variable expected");
+		return 0;
+	}
+
+	return 1;
+}
+
+STATIC int
+chk_arrow(expp)
+	register struct node *expp;
+{
+	register struct type *tp;
+
+	assert(expp->nd_class == Arrow);
+	assert(expp->nd_symb == '^');
+
+	expp->nd_type = error_type;
+
+	if (! chk_variable(expp->nd_right)) return 0;
+
+	tp = expp->nd_right->nd_type;
+
+	if (tp->tp_fund != T_POINTER) {
+		node_error(expp, "illegal operand for unary operator \"%s\"",
+			symbol2str(expp->nd_symb));
+		return 0;
+	}
+
+	expp->nd_type = PointedtoType(tp);
+	return 1;
+}
+
 STATIC int
 chk_arr(expp)
-	struct node *expp;
+	register struct node *expp;
 {
-	return chk_designator(expp, VARIABLE, D_USED);
+	register struct type *tpl, *tpr;
+
+	assert(expp->nd_class == Arrsel);
+	assert(expp->nd_symb == '[');
+
+	expp->nd_type = error_type;
+
+	if ( 
+	     !chk_variable(expp->nd_left)
+	   ||
+	     !chk_expr(expp->nd_right)
+	   ||
+	     expp->nd_left->nd_type == error_type
+	   )	return 0;
+
+	tpl = expp->nd_left->nd_type;
+	tpr = expp->nd_right->nd_type;
+
+	if (tpl->tp_fund != T_ARRAY) {
+		node_error(expp, "array index not belonging to an ARRAY");
+		return 0;
+	}
+
+	/* Type of the index must be assignment compatible with
+	   the index type of the array (Def 8.1).
+	   However, the index type of a conformant array is not specified.
+	   Either INTEGER or CARDINAL seems reasonable.
+	*/
+	if (IsConformantArray(tpl) ? !TstAssCompat(card_type, tpr)
+				   : !TstAssCompat(IndexType(tpl), tpr)) {
+		node_error(expp, "incompatible index type");
+		return 0;
+	}
+
+	expp->nd_type = tpl->arr_elem;
+	return 1;
 }
 
 STATIC int
@@ -54,24 +130,107 @@ STATIC int
 chk_linkorname(expp)
 	register struct node *expp;
 {
-	if (chk_designator(expp, VALUE, D_USED)) {
-		if (expp->nd_class == Def &&
-		    expp->nd_def->df_kind == D_PROCEDURE) {
-			/* Check that this procedure is one that we
-			   may take the address from.
-			*/
-			if (expp->nd_def->df_type == std_type ||
-			    expp->nd_def->df_scope->sc_level > 0) {
-				/* Address of standard or nested procedure
-				   taken.
+	register struct def *df;
+
+	if (expp->nd_class == Name) {
+		expp->nd_def = lookfor(expp, CurrVis, 1);
+		expp->nd_class = Def;
+		expp->nd_type = expp->nd_def->df_type;
+	}
+	else if (expp->nd_class == Link) {
+		register struct node *left = expp->nd_left;
+
+		assert(expp->nd_symb == '.');
+
+		if (! chk_designator(left)) return 0;
+
+		if (left->nd_type->tp_fund != T_RECORD ||
+		    (left->nd_class == Def &&
+		     !(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD))
+		    )
+		   ) {
+			node_error(left, "illegal selection");
+			return 0;
+		}
+
+		if (!(df = lookup(expp->nd_IDF, left->nd_type->rec_scope))) {
+			id_not_declared(expp);
+			return 0;
+		}
+		else {
+			expp->nd_def = df;
+			expp->nd_type = df->df_type;
+			expp->nd_class = LinkDef;
+			if (!(df->df_flags & (D_EXPORTED|D_QEXPORTED))) {
+				/* Fields of a record are always D_QEXPORTED,
+				   so ...
 				*/
-node_error(expp, "it is illegal to take the address of a standard or local procedure");
+node_error(expp, "identifier \"%s\" not exported from qualifying module",
+df->df_idf->id_text);
 				return 0;
 			}
 		}
-		return 1;
+
+		if (left->nd_class == Def &&
+		    left->nd_def->df_kind == D_MODULE) {
+			expp->nd_class = Def;
+			FreeNode(left);
+			expp->nd_left = 0;
+		}
+		else	return 1;
 	}
-	return 0;
+
+	assert(expp->nd_class == Def);
+
+	df = expp->nd_def;
+
+	if (df->df_kind & (D_ENUM | D_CONST)) {
+		if (df->df_kind == D_ENUM) {
+			expp->nd_class = Value;
+			expp->nd_INT = df->enm_val;
+			expp->nd_symb = INTEGER;
+		}
+		else  {
+			unsigned int ln;
+
+			assert(df->df_kind == D_CONST);
+			ln = expp->nd_lineno;
+			*expp = *(df->con_const);
+			expp->nd_lineno = ln;
+		}
+	}
+
+	return 1;
+}
+
+STATIC int
+chk_ex_linkorname(expp)
+	register struct node *expp;
+{
+	register struct def *df;
+
+	if (! chk_linkorname(expp)) return 0;
+	if (expp->nd_class != Def) return 1;
+	df = expp->nd_def;
+
+	if (!(df->df_kind & (D_ENUM|D_CONST|D_PROCEDURE|D_FIELD|D_VARIABLE|D_PROCHEAD))) {
+		node_error(expp, "value expected");
+	}
+
+	if (df->df_kind == D_PROCEDURE) {
+		/* Check that this procedure is one that we
+		   may take the address from.
+		*/
+		if (df->df_type == std_type || df->df_scope->sc_level > 0) {
+			/* Address of standard or nested procedure
+			   taken.
+			*/
+node_error(expp, "it is illegal to take the address of a standard or local procedure");
+			return 0;
+		}
+	}
+
+	return 1;
 }
 
 STATIC int
@@ -186,7 +345,7 @@ chk_set(expp)
 	if (nd = expp->nd_left) {
 		/* A type was given. Check it out
 		*/
-		if (! chk_designator(nd, 0, D_USED)) return 0;
+		if (! chk_designator(nd)) return 0;
 
 		assert(nd->nd_class == Def);
 		df = nd->nd_def;
@@ -224,7 +383,7 @@ node_error(expp, "specifier does not represent a set type");
 	while (nd) {
 		assert(nd->nd_class == Link && nd->nd_symb == ',');
 
-		if (!chk_el(nd->nd_left, tp->next, &set)) return 0;
+		if (!chk_el(nd->nd_left, ElementType(tp), &set)) return 0;
 		nd = nd->nd_right;
 	}
 
@@ -268,13 +427,11 @@ getarg(argp, bases, designator)
 	left = arg->nd_left;
 
 	if ((!designator && !chk_expr(left)) ||
-	    (designator &&
-	     !chk_designator(left, VARIABLE, D_USED|D_NOREG))) {
+	    (designator && !chk_variable(left))) {
 		return 0;
 	}
 
-	tp = left->nd_type;
-	if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
+	tp = BaseType(left->nd_type);
 
 	if (bases && !(tp->tp_fund & bases)) {
 		node_error(arg, "unexpected type");
@@ -297,7 +454,7 @@ getname(argp, kinds)
 	}
 
 	arg = arg->nd_right;
-	if (! chk_designator(arg->nd_left, 0, D_REFERRED)) return 0;
+	if (! chk_designator(arg->nd_left)) return 0;
 
 	if (arg->nd_left->nd_class != Def && arg->nd_left->nd_class != LinkDef) {
 		node_error(arg, "identifier expected");
@@ -325,7 +482,7 @@ chk_proccall(expp)
 
 	left = expp->nd_left;
 	arg = expp;
-	expp->nd_type = left->nd_type->next;
+	expp->nd_type = ResultType(left->nd_type);
 
 	for (param = ParamList(left->nd_type); param; param = param->next) {
 		if (!(left = getarg(&arg, 0, IsVarParam(param)))) return 0;
@@ -358,12 +515,14 @@ chk_call(expp)
 		it may also be a cast or a standard procedure call.
 	*/
 	register struct node *left;
+	STATIC int chk_std();
+	STATIC int chk_cast();
 
 	/* First, get the name of the function or procedure
 	*/
 	expp->nd_type = error_type;
 	left = expp->nd_left;
-	if (! chk_designator(left, 0, D_USED)) return 0;
+	if (! chk_designator(left)) return 0;
 
 	if (IsCast(left)) {
 		/* It was a type cast. This is of course not portable.
@@ -390,192 +549,6 @@ chk_call(expp)
 	return 0;
 }
 
-STATIC int
-FlagCheck(expp, df, flag)
-	struct node *expp;
-	struct def *df;
-{
-	/*	See the routine "chk_designator" for an explanation of
-		"flag". Here, a definition "df" is checked against it.
-	*/
-
-	if (df->df_kind == D_ERROR) return 0;
-
-	if ((flag & VARIABLE) &&
-	    !(df->df_kind & (D_FIELD|D_VARIABLE))) {
-		node_error(expp, "variable expected");
-		return 0;
-	}
-
-	if ((flag & HASSELECTORS) &&
-	    ( !(df->df_kind & (D_VARIABLE|D_FIELD|D_MODULE)) ||
-	      df->df_type->tp_fund != T_RECORD)) {
-		node_error(expp, "illegal selection");
-		return 0;
-	}
-
-	if ((flag & VALUE) &&
-	    ( !(df->df_kind & (D_VARIABLE|D_FIELD|D_CONST|D_ENUM|D_PROCEDURE)))) {
-		node_error(expp, "value expected");
-		return 0;
-	}
-
-	return 1;
-}
-
-int
-chk_designator(expp, flag, dflags)
-	register struct node *expp;
-{
-	/*	Find the name indicated by "expp", starting from the current
-		scope.  "flag" indicates the kind of designator we expect:
-		It contains the flags VARIABLE, indicating that the result must
-		be something that can be assigned to.
-		It may also contain the flag VALUE, indicating that a
-		value is expected. In this case, VARIABLE may not be set.
-		Also contained may be the flag HASSELECTORS, indicating that
-		the result must have selectors.
-		"dflags" contains some flags that must be set at the definition
-		found.
-	*/
-	register struct def *df;
-	register struct type *tp;
-
-	if (expp->nd_class == Def || expp->nd_class == LinkDef) {
-		expp->nd_def->df_flags |= dflags;
-		return 1;
-	}
-
-	expp->nd_type = error_type;
-
-	if (expp->nd_class == Name) {
-		expp->nd_def = lookfor(expp, CurrVis, 1);
-		expp->nd_class = Def;
-		expp->nd_type = expp->nd_def->df_type;
-	}
-	else if (expp->nd_class == Link) {
-		register struct node *left = expp->nd_left;
-
-		assert(expp->nd_symb == '.');
-
-		if (! chk_designator(left,
-				     HASSELECTORS,
-				     dflags)) return 0;
-
-		tp = left->nd_type;
-		assert(tp->tp_fund == T_RECORD);
-
-		if (!(df = lookup(expp->nd_IDF, tp->rec_scope))) {
-			id_not_declared(expp);
-			return 0;
-		}
-		else {
-			expp->nd_def = df;
-			expp->nd_type = df->df_type;
-			expp->nd_class = LinkDef;
-			if (!(df->df_flags & (D_EXPORTED|D_QEXPORTED))) {
-				/* Fields of a record are always D_QEXPORTED,
-				   so ...
-				*/
-node_error(expp, "identifier \"%s\" not exported from qualifying module",
-df->df_idf->id_text);
-				return 0;
-			}
-		}
-
-		if (left->nd_class == Def &&
-		    left->nd_def->df_kind == D_MODULE) {
-			expp->nd_class = Def;
-			FreeNode(left);
-			expp->nd_left = 0;
-		}
-		else {
-			return FlagCheck(expp, df, flag);
-		}
-	}
-
-	if (expp->nd_class == Def) {
-		df = expp->nd_def;
-
-		if (! FlagCheck(expp, df, flag)) return 0;
-
-		if (df->df_kind & (D_ENUM | D_CONST)) {
-			if (df->df_kind == D_ENUM) {
-				expp->nd_class = Value;
-				expp->nd_INT = df->enm_val;
-				expp->nd_symb = INTEGER;
-			}
-			else  {
-				unsigned int ln;
-
-				assert(df->df_kind == D_CONST);
-				ln = expp->nd_lineno;
-				*expp = *(df->con_const);
-				expp->nd_lineno = ln;
-			}
-		}
-
-		df->df_flags |= dflags;
-
-		return 1;
-	}
-
-	if (expp->nd_class == Arrsel) {
-		struct type *tpl, *tpr;
-
-		assert(expp->nd_symb == '[');
-
-		if ( 
-		     !chk_designator(expp->nd_left, VARIABLE, dflags)
-		   ||
-		     !chk_expr(expp->nd_right)
-		   ||
-		     expp->nd_left->nd_type == error_type
-		   )	return 0;
-
-		tpr = expp->nd_right->nd_type;
-		tpl = expp->nd_left->nd_type;
-
-		if (tpl->tp_fund != T_ARRAY) {
-			node_error(expp,
-				   "array index not belonging to an ARRAY");
-			return 0;
-		}
-
-		/* Type of the index must be assignment compatible with
-		   the index type of the array (Def 8.1)
-		*/
-		if ((tpl->next && !TstAssCompat(tpl->next, tpr)) ||
-		    (!tpl->next && !TstAssCompat(intorcard_type, tpr))) {
-			node_error(expp, "incompatible index type");
-			return 0;
-		}
-
-		expp->nd_type = tpl->arr_elem;
-		return 1;
-	}
-
-	if (expp->nd_class == Arrow) {
-		assert(expp->nd_symb == '^');
-
-		if (! chk_designator(expp->nd_right, VARIABLE, dflags)) {
-			return 0;
-		}
-
-		if (expp->nd_right->nd_type->tp_fund != T_POINTER) {
-node_error(expp, "illegal operand for unary operator \"%s\"",
-symbol2str(expp->nd_symb));
-			return 0;
-		}
-
-		expp->nd_type = expp->nd_right->nd_type->next;
-		return 1;
-	}
-
-	node_error(expp, "designator expected");
-	return 0;
-}
-
 STATIC struct type *
 ResultOfOperation(operator, tp)
 	struct type *tp;
@@ -663,11 +636,8 @@ chk_oper(expp)
 
 	if (!chk_expr(left) || !chk_expr(right)) return 0;
 
-	tpl = left->nd_type;
-	tpr = right->nd_type;
-
-	if (tpl->tp_fund == T_SUBRANGE) tpl = tpl->next;
-	if (tpr->tp_fund == T_SUBRANGE) tpr = tpr->next;
+	tpl = BaseType(left->nd_type);
+	tpr = BaseType(right->nd_type);
 
 	if (tpl == intorcard_type) {
 		if (tpr == int_type || tpr == card_type) {
@@ -688,7 +658,7 @@ chk_oper(expp)
 node_error(expp, "RHS of IN operator not a SET type");
 			return 0;
 		}
-		if (!TstAssCompat(tpl, tpr->next)) {
+		if (!TstAssCompat(tpl, ElementType(tpr))) {
 			/* Assignment compatible ???
 			   I don't know! Should we be allowed to check
 			   if a CARDINAL is a member of a BITSET???
@@ -746,8 +716,7 @@ chk_uoper(expp)
 
 	if (! chk_expr(right)) return 0;
 
-	tpr = right->nd_type;
-	if (tpr->tp_fund == T_SUBRANGE) tpr = tpr->next;
+	tpr = BaseType(right->nd_type);
 	expp->nd_type = tpr;
 
 	switch(expp->nd_symb) {
@@ -809,8 +778,6 @@ getvariable(argp)
 	struct node **argp;
 {
 	register struct node *arg = *argp;
-	register struct def *df;
-	register struct node *left;
 
 	arg = arg->nd_right;
 	if (!arg) {
@@ -818,29 +785,13 @@ getvariable(argp)
 		return 0;
 	}
 
-	left = arg->nd_left;
-
-	if (! chk_designator(left, 0, D_REFERRED)) return 0;
-	if (left->nd_class == Arrsel || left->nd_class == Arrow) {
-		*argp = arg;
-		return left;
-	}
-
-	df = 0;
-	if (left->nd_class == LinkDef || left->nd_class == Def) {
-		df = left->nd_def;
-	}
-
-	if (!df || !(df->df_kind & (D_VARIABLE|D_FIELD))) {
-		node_error(arg, "variable expected");
-		return 0;
-	}
+	if (! chk_variable(arg->nd_left)) return 0;
 
 	*argp = arg;
-	return left;
+	return arg->nd_left;
 }
 
-int
+STATIC int
 chk_std(expp, left)
 	register struct node *expp, *left;
 {
@@ -852,8 +803,6 @@ chk_std(expp, left)
 	assert(left->nd_class == Def);
 	std = left->nd_def->df_value.df_stdname;
 
-DO_DEBUG(3,debug("standard name \"%s\", %d",left->nd_def->df_idf->id_text,std));
-
 	switch(std) {
 	case S_ABS:
 		if (!(left = getarg(&arg, T_NUMERIC, 0))) return 0;
@@ -883,13 +832,15 @@ DO_DEBUG(3,debug("standard name \"%s\", %d",left->nd_def->df_idf->id_text,std));
 
 	case S_HIGH:
 		if (!(left = getarg(&arg, T_ARRAY, 0))) return 0;
-		expp->nd_type = left->nd_type->next;
-		if (!expp->nd_type) {
-			/* A dynamic array has no explicit index type
+		if (IsConformantArray(left->nd_type)) {
+			/* A conformant array has no explicit index type
 			*/
-			expp->nd_type = intorcard_type;
+			expp->nd_type = card_type;
+		}
+		else {
+			expp->nd_type = IndexType(left->nd_type);
+			cstcall(expp, S_MAX);
 		}
-		else	cstcall(expp, S_MAX);
 		break;
 
 	case S_MAX:
@@ -942,7 +893,7 @@ DO_DEBUG(3,debug("standard name \"%s\", %d",left->nd_def->df_idf->id_text,std));
 			struct token dt;
 			struct node *nd;
 
-			dt.TOK_INT = left->nd_type->next->tp_size;
+			dt.TOK_INT = PointedtoType(left->nd_type)->tp_size;
 			dt.tk_symb = INTEGER;
 			dt.tk_lineno = left->nd_lineno;
 			nd = MkLeaf(Value, &dt);
@@ -978,7 +929,6 @@ DO_DEBUG(3,debug("standard name \"%s\", %d",left->nd_def->df_idf->id_text,std));
 
 		if (!(left = getname(&arg, D_ISTYPE))) return 0;
 		tp = left->nd_def->df_type;
-		if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
 		if (!(tp->tp_fund & T_DISCRETE)) {
 			node_error(arg, "unexpected type");
 			return 0;
@@ -1028,7 +978,7 @@ node_error(arg, "EXCL and INCL expect a SET parameter");
 			return 0;
 		}
 		if (!(left = getarg(&arg, T_DISCRETE, 0))) return 0;
-		if (!TstAssCompat(tp->next, left->nd_type)) {
+		if (!TstAssCompat(ElementType(tp), left->nd_type)) {
 			/* What type of compatibility do we want here?
 			   apparently assignment compatibility! ??? ???
 			*/
@@ -1050,6 +1000,7 @@ node_error(arg, "EXCL and INCL expect a SET parameter");
 	return 1;
 }
 
+STATIC int
 chk_cast(expp, left)
 	register struct node *expp, *left;
 {
@@ -1109,20 +1060,51 @@ TryToString(nd, tp)
 	}
 }
 
+STATIC int
+no_desig(expp)
+	struct node *expp;
+{
+	node_error(expp, "designator expected");
+	return 0;
+}
+
+STATIC int
+done_before(expp)
+	struct node *expp;
+{
+	return 1;
+}
+
 extern int	NodeCrash();
 
-int (*ChkTable[])() = {
+int (*ExprChkTable[])() = {
 	chk_value,
 	chk_arr,
 	chk_oper,
 	chk_uoper,
-	chk_arr,
+	chk_arrow,
 	chk_call,
-	chk_linkorname,
+	chk_ex_linkorname,
 	NodeCrash,
 	chk_set,
 	NodeCrash,
 	NodeCrash,
-	chk_linkorname,
+	chk_ex_linkorname,
 	NodeCrash
 };
+
+int (*DesigChkTable[])() = {
+	chk_value,
+	chk_arr,
+	no_desig,
+	no_desig,
+	chk_arrow,
+	no_desig,
+	chk_linkorname,
+	NodeCrash,
+	no_desig,
+	done_before,
+	NodeCrash,
+	chk_linkorname,
+	done_before
+};
diff --git a/lang/m2/comp/chk_expr.h b/lang/m2/comp/chk_expr.h
index 6b4422b39..d24ed6454 100644
--- a/lang/m2/comp/chk_expr.h
+++ b/lang/m2/comp/chk_expr.h
@@ -2,8 +2,12 @@
 
 /* $Header$ */
 
-extern int	(*ChkTable[])();	/* table of expression checking
+extern int	(*ExprChkTable[])();	/* table of expression checking
+					   functions, indexed by node class
+					*/
+extern int	(*DesigChkTable[])();	/* table of designator checking
 					   functions, indexed by node class
 					*/
 
-#define	chk_expr(expp)	((*ChkTable[(expp)->nd_class])(expp))
+#define	chk_expr(expp)	((*ExprChkTable[(expp)->nd_class])(expp))
+#define chk_designator(expp)	((*DesigChkTable[(expp)->nd_class])(expp))
diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index 5d3c66a4c..60b6c6a4b 100644
--- a/lang/m2/comp/code.c
+++ b/lang/m2/comp/code.c
@@ -193,8 +193,8 @@ CodeCoercion(t1, t2)
 {
 	register int fund1, fund2;
 
-	if (t1->tp_fund == T_SUBRANGE) t1 = t1->next;
-	if (t2->tp_fund == T_SUBRANGE) t2 = t2->next;
+	t1 = BaseType(t1);
+	t2 = BaseType(t2);
 	if (t1 == t2) return;
 	if ((fund1 = t1->tp_fund) == T_WORD) fund1 = T_INTEGER;
 	if ((fund2 = t2->tp_fund) == T_WORD) fund2 = T_INTEGER;
@@ -368,7 +368,7 @@ CodeParameters(param, arg)
 			C_loc(left->nd_type->tp_size / word_size - 1);
 		}
 		else {
-			tp = left->nd_type->next;
+			tp = IndexType(left->nd_type);
 			if (tp->tp_fund == T_SUBRANGE) {
 				C_loc(tp->sub_ub - tp->sub_lb);
 			}
@@ -402,8 +402,7 @@ CodeStd(nd)
 
 	if (arg) {
 		left = arg->nd_left;
-		tp = left->nd_type;
-		if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
+		tp = BaseType(left->nd_type);
 		arg = arg->nd_right;
 	}
 
@@ -736,8 +735,7 @@ CodeOper(expr, true_label, false_label)
 	case '#':
 		Operands(leftop, rightop);
 		CodeCoercion(rightop->nd_type, leftop->nd_type);
-		tp = leftop->nd_type;	/* Not the result type! */
-		if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
+		tp = BaseType(leftop->nd_type);	/* Not the result type! */
 		switch (tp->tp_fund)	{
 		case T_INTEGER:
 			C_cmi(tp->tp_size);
@@ -970,13 +968,14 @@ CodeEl(nd, tp)
 	register struct node *nd;
 	register struct type *tp;
 {
+	register struct type *eltype = ElementType(tp);
 
 	if (nd->nd_class == Link && nd->nd_symb == UPTO) {
 		C_loc(tp->tp_size);	/* push size */
-		if (tp->next->tp_fund == T_SUBRANGE) {
-			C_loc(tp->next->sub_ub);
+		if (eltype->tp_fund == T_SUBRANGE) {
+			C_loc(eltype->sub_ub);
 		}
-		else	C_loc((arith) (tp->next->enm_ncst - 1));
+		else	C_loc((arith) (eltype->enm_ncst - 1));
 		Operands(nd->nd_left, nd->nd_right);
 		C_cal("_LtoUset");	/* library routine to fill set */
 		C_asp(4 * word_size);
diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c
index 120793c34..30ac8c7ab 100644
--- a/lang/m2/comp/cstoper.c
+++ b/lang/m2/comp/cstoper.c
@@ -466,12 +466,11 @@ CutSize(expr)
 		conform to the size of the type of the expression.
 	*/
 	arith o1 = expr->nd_INT;
-	struct type *tp = expr->nd_type;
+	struct type *tp = BaseType(expr->nd_type);
 	int uns;
 	int size = tp->tp_size;
 
 	assert(expr->nd_class == Value);
-	if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
 	uns = (tp->tp_fund & (T_CARDINAL|T_CHAR));
 	if (uns) {
 		if (o1 & ~full_mask[size]) {
diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index e6381115c..3b1bc590c 100644
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -20,6 +20,7 @@ static char *RcsId = "$Header$";
 #include	"node.h"
 #include	"misc.h"
 #include	"main.h"
+#include	"chk_expr.h"
 
 int		proclevel = 0;		/* nesting level of procedures */
 int		return_occurred;	/* set if a return occurred in a
@@ -52,25 +53,27 @@ error("function procedure does not return a value", df->df_idf->id_text);
 
 ProcedureHeading(struct def **pdf; int type;)
 {
-	struct type *tp = 0;
 	struct paramlist *params = 0;
+	struct type *tp = 0;
 	register struct def *df;
 	struct def *DeclProc();
+	arith NBytesParams;
 } :
 	PROCEDURE IDENT
 		{
 		  df = DeclProc(type);
-		  tp = construct_type(T_PROCEDURE, tp);
 		  if (proclevel > 1) {
 			/* Room for static link
 			*/
-			tp->prc_nbpar = pointer_size;
+			NBytesParams = pointer_size;
 		  }
-		  else	tp->prc_nbpar = 0;
+		  else	NBytesParams = 0;
 		}
-	FormalParameters(&params, &(tp->next), &(tp->prc_nbpar))?
+	FormalParameters(&params, &tp, &NBytesParams)?
 		{
+		  tp = construct_type(T_PROCEDURE, tp);
 		  tp->prc_params = params;
+		  tp->prc_nbpar = NBytesParams;
 		  if (df->df_type) {
 			/* We already saw a definition of this type
 			   in the definition module.
@@ -85,15 +88,10 @@ error("inconsistent procedure declaration for \"%s\"", df->df_idf->id_text);
 
 		  if (type == D_PROCHEAD) close_scope(0);
 
-		  DO_DEBUG(1, type == D_PROCEDURE && 
-				(print("proc %s:", df->df_idf->id_text),
-				 DumpType(tp), print("\n")));
 		}
 ;
 
-block(struct node **pnd;)
-{
-}:
+block(struct node **pnd;) :
 	declaration*
 	[
 		BEGIN
@@ -130,7 +128,6 @@ FormalParameters(struct paramlist **pr;
 		]*
 	]?
 	')'
-			{ *tp = 0; }
 	[	':' qualident(D_ISTYPE, &df, "type", (struct node **) 0)
 			{ *tp = df->df_type;
 			}
@@ -142,31 +139,45 @@ FPSection(struct paramlist **ppr; arith *parmaddr;)
 	struct node *FPList;
 	struct type *tp;
 	int VARp = D_VALPAR;
+	struct paramlist *p = 0;
 } :
 	[
 		VAR	{ VARp = D_VARPAR; }
 	]?
-	IdentList(&FPList) ':' FormalType(&tp)
-			{ EnterParamList(ppr, FPList, tp, VARp, parmaddr); }
+	IdentList(&FPList) ':' FormalType(&p, 0)
+			{ EnterParamList(ppr, FPList, p->par_def->df_type,
+					 VARp, parmaddr);
+			  free_def(p->par_def);
+			  free_paramlist(p);
+			}
 ;
 
-FormalType(struct type **ptp;)
+FormalType(struct paramlist **ppr; int VARp;)
 {
-	struct def *df;
-	int ARRAYflag = 0;
+	struct def *df1;
+	register struct def *df;
+	int ARRAYflag;
 	register struct type *tp;
+	register struct paramlist *p = new_paramlist();
 	extern arith ArrayElSize();
 } :
 	[ ARRAY OF	{ ARRAYflag = 1; }
-	]?
-	qualident(D_ISTYPE, &df, "type", (struct node **) 0)
-		{ if (ARRAYflag) {
-			*ptp = tp = construct_type(T_ARRAY, NULLTYPE);
+	|		{ ARRAYflag = 0; }
+	]
+	qualident(D_ISTYPE, &df1, "type", (struct node **) 0)
+		{ df = df1;
+		  if (ARRAYflag) {
+			tp = construct_type(T_ARRAY, NULLTYPE);
 			tp->arr_elem = df->df_type;
 			tp->arr_elsize = ArrayElSize(df->df_type);
 			tp->tp_align = lcm(word_align, pointer_align);
 		  }
-		  else	*ptp = df->df_type;
+		  else	tp = df->df_type;
+		  p->next = *ppr;
+		  *ppr = p;
+		  p->par_def = df = new_def();
+		  df->df_type = tp;
+		  df->df_flags = VARp;
 		}
 ;
 
@@ -362,7 +373,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 				{ warning("Old fashioned Modula-2 syntax!");
 				  id = gen_anon_idf();
 				  df = ill_df;
-				  if (chk_designator(nd, 0, D_REFERRED) &&
+				  if (chk_designator(nd) &&
 				      (nd->nd_class != Def ||
 				       !(nd->nd_def->df_kind &
 					 (D_ERROR|D_ISTYPE)))) {
@@ -513,8 +524,6 @@ ProcedureType(struct type **ptp;)
 FormalTypeList(struct paramlist **ppr; struct type **ptp;)
 {
 	struct def *df;
-	struct type *tp;
-	struct paramlist *p;
 	int VARp;
 } :
 	'('		{ *ppr = 0; }
@@ -522,25 +531,13 @@ FormalTypeList(struct paramlist **ppr; struct type **ptp;)
 		[ VAR	{ VARp = D_VARPAR; }
 		|	{ VARp = D_VALPAR; }
 		]
-		FormalType(&tp)
-			{ *ppr = p = new_paramlist();
-			  p->next = 0;
-			  p->par_def = df = new_def();
-			  df->df_type = tp;
-			  df->df_flags = VARp;
-			}
+		FormalType(ppr, VARp)
 		[
 			','
 			[ VAR	{VARp = D_VARPAR; }
 			|	{VARp = D_VALPAR; }
 			] 
-			FormalType(&tp)
-				{ p = new_paramlist();
-				  p->next = *ppr; *ppr = p;
-			  	  p->par_def = df = new_def();
-			  	  df->df_type = tp;
-			  	  df->df_flags = VARp;
-				}
+			FormalType(ppr, VARp)
 		]*
 	]?
 	')'
diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c
index 1696facd5..99013dbda 100644
--- a/lang/m2/comp/defmodule.c
+++ b/lang/m2/comp/defmodule.c
@@ -38,7 +38,7 @@ GetFile(name)
 		fatal("Could'nt find a DEFINITION MODULE for \"%s\"", name);
 	}
 	LineNumber = 1;
-	DO_DEBUG(1, debug("File %s : %ld characters", FileName, sys_filesize(FileName)));
+	DO_DEBUG(options['F'], debug("File %s : %ld characters", FileName, sys_filesize(FileName)));
 }
 
 struct def *
diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g
index 3adfc1603..53673a472 100644
--- a/lang/m2/comp/expression.g
+++ b/lang/m2/comp/expression.g
@@ -48,7 +48,7 @@ qualident(int types;
 		{ if (types) {
 			df = ill_df;
 
-			if (chk_designator(nd, 0, D_REFERRED)) {
+			if (chk_designator(nd)) {
 			    if (nd->nd_class != Def) {
 				node_error(nd, "%s expected", str);
 			    }
@@ -98,14 +98,14 @@ ConstExpression(struct node **pnd;):
 	 * Changed rule in new Modula-2.
 	 * Check that the expression is a constant expression and evaluate!
 	 */
-		{ DO_DEBUG(3,
-		     ( debug("Constant expression:"),
-		       PrNode(*pnd)));
+		{ DO_DEBUG(options['X'], print("CONSTANT EXPRESSION\n"));
+		  DO_DEBUG(options['X'], PrNode(*pnd, 0));
 		  if (chk_expr(*pnd) &&
 		      ((*pnd)->nd_class != Set && (*pnd)->nd_class != Value)) {
 			error("Constant expression expected");
 		  }
-		  DO_DEBUG(3, PrNode(*pnd));
+		  DO_DEBUG(options['X'], print("RESULTS IN\n"));
+		  DO_DEBUG(options['X'], PrNode(*pnd, 0));
 		}
 ;
 
diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c
index 5ca3138ed..405737189 100644
--- a/lang/m2/comp/main.c
+++ b/lang/m2/comp/main.c
@@ -52,9 +52,6 @@ main(argc, argv)
 		fprint(STDERR, "%s: Use a file argument\n", ProgName);
 		return 1;
 	}
-#ifdef DEBUG
-	DO_DEBUG(1, debug("Debugging level: %d", options['D']));
-#endif DEBUG
 	return !Compile(Nargv[1], Nargv[2]);
 }
 
@@ -63,8 +60,6 @@ Compile(src, dst)
 {
 	extern struct tokenname tkidf[];
 
-	DO_DEBUG(1, debug("Filename : %s", src));
-	DO_DEBUG(1, (!dst || debug("Targetfile: %s", dst)));
 	if (! InsertFile(src, (char **) 0, &src)) {
 		fprint(STDERR,"%s: cannot open %s\n", ProgName, src);
 		return 0;
@@ -98,6 +93,7 @@ Compile(src, dst)
 	C_ms_src((arith) (LineNumber - 1), FileName);
 	close_scope(SC_REVERSE);
 	if (!err_occurred) {
+		C_exp(Defined->mod_vis->sc_scope->sc_name);
 		WalkModule(Defined);
 		if (fp_used) {
 			C_ms_flt();
diff --git a/lang/m2/comp/node.c b/lang/m2/comp/node.c
index f8ea57b1e..6f16617c8 100644
--- a/lang/m2/comp/node.c
+++ b/lang/m2/comp/node.c
@@ -35,7 +35,6 @@ MkNode(class, left, right, token)
 	nd->nd_token = *token;
 	nd->nd_class = class;
 	nd->nd_type = error_type;
-	DO_DEBUG(4,(debug("Create node:"), PrNode(nd)));
 	return nd;
 }
 
@@ -74,23 +73,29 @@ NodeCrash(expp)
 
 extern char *symbol2str();
 
-STATIC
-printnode(nd)
-	register struct node *nd;
+indnt(lvl)
 {
-	fprint(STDERR, "(");
-	if (nd) {
-		printnode(nd->nd_left);
-		fprint(STDERR, " %s ", symbol2str(nd->nd_symb));
-		printnode(nd->nd_right);
+	while (lvl--) {
+		print("  ");
 	}
-	fprint(STDERR, ")");
 }
 
-PrNode(nd)
-	struct node *nd;
+printnode(nd, lvl)
+	register struct node *nd;
 {
-	printnode(nd);
-	fprint(STDERR, "\n");
+	indnt(lvl);
+	print("C: %d; T: %s\n", nd->nd_class, symbol2str(nd->nd_symb));
+}
+
+PrNode(nd, lvl)
+	register struct node *nd;
+{
+	if (! nd) {
+		indnt(lvl); print("<nilnode>\n");
+		return;
+	}
+	PrNode(nd->nd_left, lvl + 1);
+	printnode(nd, lvl);
+	PrNode(nd->nd_right, lvl + 1);
 }
 #endif DEBUG
diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g
index 9ee7cec46..60ffc705d 100644
--- a/lang/m2/comp/program.g
+++ b/lang/m2/comp/program.g
@@ -127,8 +127,6 @@ DefinitionModule
 			  df->df_type = standard_type(T_RECORD, 0, (arith) 0);
 			  df->df_type->rec_scope = df->mod_vis->sc_scope;
 			  DefinitionModule++;
-			  DO_DEBUG(1, debug("Definition module \"%s\" %d",
-					id->id_text, DefinitionModule));
 			}
 	';'
 	import(0)* 
@@ -209,7 +207,7 @@ ProgramModule
 			df = define(id, CurrentScope, D_MODULE);
 			open_scope(CLOSEDSCOPE);
 			df->mod_vis = CurrVis;
-			CurrentScope->sc_name = id->id_text;
+			CurrentScope->sc_name = "_M2M";
 		  }
 		  Defined = df;
 		  CurrentScope->sc_definedby = df;
diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C
index 2cd6d34ae..737cbd40a 100644
--- a/lang/m2/comp/scope.C
+++ b/lang/m2/comp/scope.C
@@ -218,7 +218,7 @@ close_scope(flag)
 
 	if (flag) {
 		if (sc->sc_forw) rem_forwards(sc->sc_forw);
-		DO_DEBUG(2, PrScopeDef(sc->sc_def));
+		DO_DEBUG(options['S'], PrScopeDef(sc->sc_def));
 		if (flag & SC_CHKPROC) chk_proc(sc->sc_def);
 		if (flag & SC_CHKFORW) chk_forw(&(sc->sc_def));
 		if (flag & SC_REVERSE) Reverse(&(sc->sc_def));
diff --git a/lang/m2/comp/statement.g b/lang/m2/comp/statement.g
index fadb5e056..7728d2dee 100644
--- a/lang/m2/comp/statement.g
+++ b/lang/m2/comp/statement.g
@@ -5,6 +5,7 @@
 static char *RcsId = "$Header$";
 #endif
 
+#include	<assert.h>
 #include	<em_arith.h>
 #include	<em_label.h>
 
@@ -240,12 +241,12 @@ ReturnStatement(struct node **pnd;)
 			{ if (scopeclosed(CurrentScope)) {
 error("a module body has no result value");
 			  }
-			  else if (! df->df_type->next) {
+			  else if (! ResultType(df->df_type)) {
 error("procedure \"%s\" has no result value", df->df_idf->id_text);
 			  }
 			}
 	|
-			{ if (df->df_type->next) {
+			{ if (ResultType(df->df_type)) {
 error("procedure \"%s\" must return a value", df->df_idf->id_text);
 			  }
 			}
diff --git a/lang/m2/comp/tmpvar.C b/lang/m2/comp/tmpvar.C
index f63627052..10338d112 100644
--- a/lang/m2/comp/tmpvar.C
+++ b/lang/m2/comp/tmpvar.C
@@ -22,6 +22,7 @@ static char *RcsId = "$Header$";
 #include	"def.h"
 #include	"type.h"
 #include	"scope.h"
+#include	"main.h"
 
 struct tmpvar {
 	struct tmpvar	*next;
@@ -45,7 +46,7 @@ NewInt()
 	if (!TmpInts) {
 		offset = - WA(align(int_size - ProcScope->sc_off, int_align));
 		ProcScope->sc_off = offset;
-		C_ms_reg(offset, int_size, reg_any, 0);
+		if (! options['n']) C_ms_reg(offset, int_size, reg_any, 0);
 	}
 	else {
 		tmp = TmpInts;
@@ -65,7 +66,7 @@ NewPtr()
 	if (!TmpPtrs) {
 		offset = - WA(align(pointer_size - ProcScope->sc_off, pointer_align));
 		ProcScope->sc_off = offset;
-		C_ms_reg(offset, pointer_size, reg_pointer, 0);
+		if (! options['n']) C_ms_reg(offset, pointer_size, reg_pointer, 0);
 	}
 	else {
 		tmp = TmpPtrs;
diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H
index 129b8def8..c20e7a152 100644
--- a/lang/m2/comp/type.H
+++ b/lang/m2/comp/type.H
@@ -134,10 +134,19 @@ struct type
 #define NULLTYPE ((struct type *) 0)
 
 #define IsConformantArray(tpx)	((tpx)->tp_fund==T_ARRAY && (tpx)->next==0)
-#define bounded(tpx)	((tpx)->tp_fund & T_INDEX)
-#define complex(tpx)	((tpx)->tp_fund & (T_RECORD|T_ARRAY))
-#define WA(sz)		(align(sz, (int) word_size))
-#define ResultType(tpx)	(assert((tpx)->tp_fund == T_PROCEDURE), (tpx)->next)
-#define ParamList(tpx)	(assert((tpx)->tp_fund == T_PROCEDURE),\
+#define bounded(tpx)		((tpx)->tp_fund & T_INDEX)
+#define complex(tpx)		((tpx)->tp_fund & (T_RECORD|T_ARRAY))
+#define WA(sz)			(align(sz, (int) word_size))
+#define ResultType(tpx)		(assert((tpx)->tp_fund == T_PROCEDURE),\
+					(tpx)->next)
+#define ParamList(tpx)		(assert((tpx)->tp_fund == T_PROCEDURE),\
 					(tpx)->prc_params)
+#define IndexType(tpx)		(assert((tpx)->tp_fund == T_ARRAY),\
+					(tpx)->next)
+#define ElementType(tpx)	(assert((tpx)->tp_fund == T_SET),\
+					(tpx)->next)
+#define PointedtoType(tpx)	(assert((tpx)->tp_fund == T_POINTER),\
+					(tpx)->next)
+#define BaseType(tpx)		((tpx)->tp_fund == T_SUBRANGE ? (tpx)->next\
+							      : (tpx))
 #define	IsConstructed(tpx)	((tpx)->tp_fund & T_CONSTRUCTED)
diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index ff0b48501..13584d02a 100644
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -225,22 +225,22 @@ chk_basesubrange(tp, base)
 		if (base->sub_lb > tp->sub_lb || base->sub_ub < tp->sub_ub) {
 			error("Base type has insufficient range");
 		}
-		base = base->next;
+		base = BaseType(base);
 	}
 
 	if (base->tp_fund & (T_ENUMERATION|T_CHAR)) {
-		if (tp->next != base) {
+		if (BaseType(tp) != base) {
 			error("Specified base does not conform");
 		}
 	}
 	else if (base != card_type && base != int_type) {
 		error("Illegal base for a subrange");
 	}
-	else if (base == int_type && tp->next == card_type &&
+	else if (base == int_type && BaseType(tp) == card_type &&
 		 (tp->sub_ub > max_int || tp->sub_ub < 0)) {
 		error("Upperbound to large for type INTEGER");
 	}
-	else if (base != tp->next && base != int_type) {
+	else if (base != BaseType(tp) && base != int_type) {
 		error("Specified base does not conform");
 	}
 
@@ -257,15 +257,13 @@ subr_type(lb, ub)
 		indicated by "lb" and "ub", but first perform some
 		checks
 	*/
-	register struct type *tp = lb->nd_type, *res;
+	register struct type *tp = BaseType(lb->nd_type), *res;
 
 	if (!TstCompat(lb->nd_type, ub->nd_type)) {
 		node_error(ub, "Types of subrange bounds not equal");
 		return error_type;
 	}
 
-	if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
-
 	if (tp == intorcard_type) {
 		/* Lower bound >= 0; in this case, the base type is CARDINAL,
 		   according to the language definition, par. 6.3
@@ -397,7 +395,7 @@ ArraySizes(tp)
 {
 	/*	Assign sizes to an array type, and check index type
 	*/
-	register struct type *index_type = tp->next;
+	register struct type *index_type = IndexType(tp);
 	register struct type *elem_type = tp->arr_elem;
 	arith lo, hi;
 
diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c
index 76a66ce1b..0e1d4ce73 100644
--- a/lang/m2/comp/typequiv.c
+++ b/lang/m2/comp/typequiv.c
@@ -67,7 +67,7 @@ TstProcEquiv(tp1, tp2)
 
 	/* First check if the result types are equivalent
 	*/
-	if (! TstTypeEquiv(tp1->next, tp2->next)) return 0;
+	if (! TstTypeEquiv(ResultType(tp1), ResultType(tp2))) return 0;
 
 	p1 = ParamList(tp1);
 	p2 = ParamList(tp2);
@@ -94,8 +94,8 @@ TstCompat(tp1, tp2)
 
 	if (TstTypeEquiv(tp1, tp2)) return 1;
 
-	if (tp1->tp_fund == T_SUBRANGE) tp1 = tp1->next;
-	if (tp2->tp_fund == T_SUBRANGE) tp2 = tp2->next;
+	tp1 = BaseType(tp1);
+	tp2 = BaseType(tp2);
 
 	return	tp1 == tp2
 	    ||
@@ -138,8 +138,8 @@ TstAssCompat(tp1, tp2)
 
 	if (TstCompat(tp1, tp2)) return 1;
 
-	if (tp1->tp_fund == T_SUBRANGE) tp1 = tp1->next;
-	if (tp2->tp_fund == T_SUBRANGE) tp2 = tp2->next;
+	tp1 = BaseType(tp1);
+	tp2 = BaseType(tp2);
 
 	if ((tp1->tp_fund & T_INTORCARD) &&
 	    (tp2->tp_fund & T_INTORCARD)) return 1;
@@ -149,14 +149,14 @@ TstAssCompat(tp1, tp2)
 		*/
 		arith size;
 
-		if (!(tp = tp1->next)) return 0;
+		if (IsConformantArray(tp1)) return 0;
 
+		tp = IndexType(tp1);
 		if (tp->tp_fund == T_SUBRANGE) {
 			size = tp->sub_ub - tp->sub_lb + 1;
 		}
 		else	size = tp->enm_ncst;
-	    	tp1 = tp1->arr_elem;
-		if (tp1->tp_fund == T_SUBRANGE) tp1 = tp1->next;
+	    	tp1 = BaseType(tp1->arr_elem);
 	    	return
 			tp1 == char_type
 		    &&	(tp2->tp_fund  == T_STRING && size >= tp2->tp_size)
diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index c314c157b..7a5b9bc20 100644
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -61,21 +61,12 @@ WalkModule(module)
 		Also generate code for its body.
 	*/
 	register struct scope *sc;
-	struct scopelist *vis;
+	struct scopelist *savevis = CurrVis;
 
-	vis = CurrVis;
 	CurrVis = module->mod_vis;
 	sc = CurrentScope;
 
-	if (!proclevel && module == Defined) {
-		/* This module is a global module. Export the name of its
-		   initialization routine
-		*/
-		if (state == PROGRAM) C_exp("main");
-		else C_exp(sc->sc_name);
-	}
-
-	/* Now, walk through it's local definitions
+	/* Walk through it's local definitions
 	*/
 	WalkDef(sc->sc_def);
 
@@ -85,15 +76,15 @@ WalkModule(module)
 	*/
 	sc->sc_off = 0;
 	text_label = 1;
-	ProcScope = CurrentScope;	
-	C_pro_narg(state==PROGRAM && module==Defined ? "main" : sc->sc_name);
+	ProcScope = sc;	
+	C_pro_narg(sc->sc_name);
 	DoProfil();
 	if (module == Defined) {
 		/* Body of implementation or program module.
 		   Call initialization routines of imported modules.
 		   Also prevent recursive calls of this one.
 		*/
-		struct node *nd;
+		register struct node *nd;
 
 		if (state == IMPLEMENTATION) {
 			label l1 = ++data_label;
@@ -108,14 +99,13 @@ WalkModule(module)
 			C_ste_dlb(l1, (arith) 0);
 		}
 
-		nd = Modules;
-		while (nd) {
+		for (nd = Modules; nd; nd = nd->next) {
 			C_cal(nd->nd_IDF->id_text);
-			nd = nd->next;
 		}
 	}
 	MkCalls(sc->sc_def);
 	proclevel++;
+	DO_DEBUG(options['X'], PrNode(module->mod_body, 0));
 	WalkNode(module->mod_body, (label) 0);
 	C_df_ilb((label) 1);
 	C_ret((arith) 0);
@@ -123,14 +113,14 @@ WalkModule(module)
 	proclevel--;
 	TmpClose();
 
-	CurrVis = vis;
+	CurrVis = savevis;
 }
 
 WalkProcedure(procedure)
 	register struct def *procedure;
 {
 	/*	Walk through the definition of a procedure and all its
-		local definitions
+		local definitions, checking and generating code.
 	*/
 	struct scopelist *savevis = CurrVis;
 	register struct scope *sc;
@@ -141,7 +131,7 @@ WalkProcedure(procedure)
 	proclevel++;
 	CurrVis = procedure->prc_vis;
 	ProcScope = sc = CurrentScope;
-	
+
 	/* Generate code for all local modules and procedures
 	*/
 	WalkDef(sc->sc_def);
@@ -182,6 +172,7 @@ WalkProcedure(procedure)
 		C_bss_cst(tp->tp_size, (arith) 0, 0);
 	}
 
+	DO_DEBUG(options['X'], PrNode(procedure->prc_body, 0));
 	WalkNode(procedure->prc_body, (label) 0);
 	C_ret((arith) 0);
 	if (tp) {
@@ -195,7 +186,7 @@ WalkProcedure(procedure)
 		else	C_ret(WA(tp->tp_size));
 	}
 
-	RegisterMessages(sc->sc_def);
+	if (! options['n']) RegisterMessages(sc->sc_def);
 	C_end(-sc->sc_off);
 	TmpClose();
 	CurrVis = savevis;
@@ -372,18 +363,20 @@ WalkStat(nd, lab)
 			}
 			C_bra(l1);
 			C_df_ilb(l2);
+			CheckAssign(nd->nd_type, int_type);
+			CodeDStore(nd);
 			WalkNode(right, lab);
-			C_loc(left->nd_INT);
 			CodePExpr(nd);
+			C_loc(left->nd_INT);
 			C_adi(int_size);
-			CodeDStore(nd);
 			C_df_ilb(l1);
-			CodePExpr(nd);
+			C_dup(int_size);
 			if (tmp) C_lol(tmp); else C_loc(fnd->nd_INT);
 			if (left->nd_INT > 0) {
 				C_ble(l2);
 			}
 			else	C_bge(l2);
+			C_asp(int_size);
 			if (tmp) FreeInt(tmp);
 		}
 		break;
@@ -498,8 +491,6 @@ WalkExpr(nd)
 	/*	Check an expression and generate code for it
 	*/
 
-	DO_DEBUG(1, (DumpTree(nd), print("\n")));
-
 	if (! chk_expr(nd)) return;
 
 	CodePExpr(nd);
@@ -512,9 +503,7 @@ WalkDesignator(nd, ds)
 	/*	Check designator and generate code for it
 	*/
 
-	DO_DEBUG(1, (DumpTree(nd), print("\n")));
-
-	if (! chk_designator(nd, VARIABLE, D_DEFINED)) return;
+	if (! chk_variable(nd)) return;
 
 	*ds = InitDesig;
 	CodeDesig(nd, ds);
@@ -529,7 +518,7 @@ DoForInit(nd, left)
 	nd->nd_class = Name;
 	nd->nd_symb = IDENT;
 
-	if (! chk_designator(nd, VARIABLE, D_DEFINED) ||
+	if (! chk_variable(nd) ||
 	    ! chk_expr(left->nd_left) ||
 	    ! chk_expr(left->nd_right)) return 0;
 
@@ -574,7 +563,6 @@ node_warning(nd, "old-fashioned! compatibility required in FOR statement");
 	}
 
 	CodePExpr(left->nd_left);
-	CodeDStore(nd);
 
 	return 1;
 }
@@ -587,7 +575,7 @@ DoAssign(nd, left, right)
 	struct desig dsl, dsr;
 
 	if (!chk_expr(right)) return;
-	if (! chk_designator(left, VARIABLE, D_DEFINED)) return;
+	if (! chk_variable(left)) return;
 	TryToString(right, left->nd_type);
 	dsr = InitDesig;
 	CodeExpr(right, &dsr, NO_LABEL, NO_LABEL);
@@ -613,15 +601,19 @@ DoAssign(nd, left, right)
 RegisterMessages(df)
 	register struct def *df;
 {
-	struct type *tp;
+	register struct type *tp;
 
 	for (; df; df = df->df_nextinscope) {
 		if (df->df_kind == D_VARIABLE && !(df->df_flags & D_NOREG)) {
 			/* Examine type and size
 			*/
-			tp = df->df_type;
-			if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
-			if ((tp->tp_fund & T_NUMERIC) &&
+			tp = BaseType(df->df_type);
+			if ((df->df_flags & D_VARPAR) ||
+				 tp->tp_fund == T_POINTER) {
+				C_ms_reg(df->var_off, pointer_size,
+					 reg_pointer, 0);
+			}
+			else if ((tp->tp_fund & T_NUMERIC) &&
 			     tp->tp_size <= dword_size) {
 				C_ms_reg(df->var_off,
 					 tp->tp_size,
@@ -629,46 +621,6 @@ RegisterMessages(df)
 					    reg_float : reg_any,
 					 0);
 			}
-			else if ((df->df_flags & D_VARPAR) ||
-				 tp->tp_fund == T_POINTER) {
-				C_ms_reg(df->var_off, pointer_size,
-					 reg_pointer, 0);
-			}
 		}
 	}
 }
-
-#ifdef DEBUG
-DumpTree(nd)
-	struct node *nd;
-{
-	char *s;
-	extern char *symbol2str();
-	
-	if (!nd) {
-		print("()");
-		return;
-	}
-
-	print("(");
-	DumpTree(nd->nd_left);
-	switch(nd->nd_class) {
-	case Def:	s = "Def"; break;
-	case Oper:	s = "Oper"; break;
-	case Arrsel:	s = "Arrsel"; break;
-	case Arrow:	s = "Arrow"; break;
-	case Uoper:	s = "Uoper"; break;
-	case Name:	s = "Name"; break;
-	case Set:	s = "Set"; break;
-	case Value:	s = "Value"; break;
-	case Call:	s = "Call"; break;
-	case Xset:	s = "Xset"; break;
-	case Stat:	s = "Stat"; break;
-	case Link:	s = "Link"; break;
-	default:	s = "ERROR"; break;
-	}
-	print("%s %s", s, symbol2str(nd->nd_symb));
-	DumpTree(nd->nd_right);
-	print(")");
-}
-#endif