From: ceriel <none@none>
Date: Thu, 10 Apr 1986 01:08:49 +0000 (+0000)
Subject: newer version
X-Git-Tag: release-5-5~5311
X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=ba47f9fe7c7314c092adaeefad8aa85adb77dc5d;p=ack.git

newer version
---

diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index 3b0cd8ba6..21ba93bb4 100644
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -8,18 +8,18 @@ static char *RcsId = "$Header$";
 #include	<em_label.h>
 #include	<assert.h>
 #include	<alloc.h>
+#include	"Lpars.h"
 #include	"idf.h"
 #include	"type.h"
 #include	"def.h"
 #include	"LLlex.h"
 #include	"node.h"
-#include	"Lpars.h"
 #include	"scope.h"
 #include	"const.h"
 #include	"standards.h"
 
 int
-chk_expr(expp, const)
+chk_expr(expp)
 	register struct node *expp;
 {
 	/*	Check the expression indicated by expp for semantic errors,
@@ -29,12 +29,12 @@ chk_expr(expp, const)
 
 	switch(expp->nd_class) {
 	case Oper:
-		return	chk_expr(expp->nd_left, const) &&
-			chk_expr(expp->nd_right, const) &&
-			chk_oper(expp, const);
+		return	chk_expr(expp->nd_left) &&
+			chk_expr(expp->nd_right) &&
+			chk_oper(expp);
 	case Uoper:
-		return	chk_expr(expp->nd_right, const) &&
-			chk_uoper(expp, const);
+		return	chk_expr(expp->nd_right) &&
+			chk_uoper(expp);
 	case Value:
 		switch(expp->nd_symb) {
 		case REAL:
@@ -46,13 +46,13 @@ chk_expr(expp, const)
 		}
 		break;
 	case Xset:
-		return chk_set(expp, const);
+		return chk_set(expp);
 	case Name:
-		return chk_name(expp, const);
+		return chk_name(expp);
 	case Call:
-		return chk_call(expp, const);
+		return chk_call(expp);
 	case Link:
-		return chk_name(expp, const);
+		return chk_name(expp);
 	default:
 		assert(0);
 	}
@@ -60,7 +60,7 @@ chk_expr(expp, const)
 }
 
 int
-chk_set(expp, const)
+chk_set(expp)
 	register struct node *expp;
 {
 	/*	Check the legality of a SET aggregate, and try to evaluate it
@@ -82,7 +82,7 @@ chk_set(expp, const)
 		assert(expp->nd_left->nd_class == Def);
 		df = expp->nd_left->nd_def;
 		if ((df->df_kind != D_TYPE && df->df_kind != D_ERROR) ||
-		    (df->df_type->tp_fund != SET)) {
+		    (df->df_type->tp_fund != T_SET)) {
 			node_error(expp, "Illegal set type");
 			return 0;
 		}
@@ -96,11 +96,10 @@ chk_set(expp, const)
 	nd = expp->nd_right;
 	while (nd) {
 		assert(nd->nd_class == Link && nd->nd_symb == ',');
-		if (!chk_el(nd->nd_left, const, tp->next, &set)) return 0;
+		if (!chk_el(nd->nd_left, tp->next, &set)) return 0;
 		nd = nd->nd_right;
 	}
 	expp->nd_type = tp;
-	assert(!const || set);
 	if (set) {
 		/* Yes, in was a constant set, and we managed to compute it!
 		*/
@@ -114,7 +113,7 @@ chk_set(expp, const)
 }
 
 int
-chk_el(expp, const, tp, set)
+chk_el(expp, tp, set)
 	register struct node *expp;
 	struct type *tp;
 	arith **set;
@@ -127,8 +126,8 @@ chk_el(expp, const, tp, set)
 		/* { ... , expr1 .. expr2,  ... }
 		   First check expr1 and expr2, and try to compute them.
 		*/
-		if (!chk_el(expp->nd_left, const, tp, set) ||
-		    !chk_el(expp->nd_right, const, tp, set)) {
+		if (!chk_el(expp->nd_left, tp, set) ||
+		    !chk_el(expp->nd_right, tp, set)) {
 			return 0;
 		}
 		if (expp->nd_left->nd_class == Value &&
@@ -157,7 +156,7 @@ node_error(expp, "Lower bound exceeds upper bound in range");
 
 	/* Here, a single element is checked
 	*/
-	if (!chk_expr(expp, const)) {
+	if (!chk_expr(expp)) {
 		return rem_set(set);
 	}
 	if (!TstCompat(tp, expp->nd_type)) {
@@ -165,10 +164,10 @@ node_error(expp, "Lower bound exceeds upper bound in range");
 		return rem_set(set);
 	}
 	if (expp->nd_class == Value) {
-	    	if ((tp->tp_fund != ENUMERATION &&
+	    	if ((tp->tp_fund != T_ENUMERATION &&
 		     (expp->nd_INT < tp->sub_lb || expp->nd_INT > tp->sub_ub))
 		   ||
-		    (tp->tp_fund == ENUMERATION &&
+		    (tp->tp_fund == T_ENUMERATION &&
 		     (expp->nd_INT < 0 || expp->nd_INT > tp->enm_ncst))
 		   ) {
 			node_error(expp, "Set element out of range");
@@ -193,12 +192,52 @@ rem_set(set)
 	return 0;
 }
 
+struct node *
+getarg(argp, bases)
+	struct node *argp;
+{
+	struct type *tp;
+
+	if (!argp->nd_right) {
+		node_error(argp, "Too few arguments supplied");
+		return 0;
+	}
+	argp = argp->nd_right;
+	if (!chk_expr(argp->nd_left)) return 0;
+	tp = argp->nd_left->nd_type;
+	if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
+	if (!(tp->tp_fund & bases)) {
+		node_error(argp, "Unexpected type");
+		return 0;
+	}
+	return argp;
+}
+
+struct node *
+getname(argp, kinds)
+	struct node *argp;
+{
+	if (!argp->nd_right) {
+		node_error(argp, "Too few arguments supplied");
+		return 0;
+	}
+	argp = argp->nd_right;
+	if (!findname(argp->nd_left)) return 0;
+	assert(argp->nd_left->nd_class == Def);
+	if (!(argp->nd_left->nd_def->df_kind & kinds)) {
+		node_error(argp, "Unexpected type");
+		return 0;
+	}
+	return argp;
+}
+
 int
-chk_call(expp, const)
+chk_call(expp)
 	register struct node *expp;
 {
 	register struct type *tp;
 	register struct node *left;
+	register struct node *arg;
 
 	expp->nd_type = error_type;
 	(void) findname(expp->nd_left);
@@ -211,57 +250,148 @@ chk_call(expp, const)
 		/* A type cast. This is of course not portable.
 		   No runtime action. Remove it.
 		*/
-		if (!expp->nd_right ||
-		    (expp->nd_right->nd_symb == ',')) {
+		arg = expp->nd_right;
+		if (!arg || arg->nd_right) {
 node_error(expp, "Only one parameter expected in type cast");
 			return 0;
 		}
-		if (! chk_expr(expp->nd_right, const)) return 0;
-		if (expp->nd_right->nd_type->tp_size !=
+		if (! chk_expr(arg->nd_left)) return 0;
+		if (arg->nd_left->nd_type->tp_size !=
 		    	left->nd_type->tp_size) {
 node_error(expp, "Size of type in type cast does not match size of operand");
 			return 0;
 		}
-		expp->nd_right->nd_type = left->nd_type;
-		left = expp->nd_right;
+		arg->nd_left->nd_type = left->nd_type;
 		FreeNode(expp->nd_left);
-		*expp = *(expp->nd_right);
-		left->nd_left = left->nd_right = 0;
-		FreeNode(left);
+		*expp = *(arg->nd_left);
+		arg->nd_left->nd_left = 0;
+		arg->nd_left->nd_right = 0;
+		FreeNode(arg);
 		return 1;
 	}
 
 	if ((left->nd_class == Def && left->nd_def->df_kind == D_PROCEDURE) ||
-	    tp->tp_fund == PROCVAR) {
+	    tp->tp_fund == T_PROCEDURE) {
 		/* A procedure call. it may also be a call to a
 		   standard procedure
 		*/
+		arg = expp;
 		if (tp == std_type) {
 			assert(left->nd_class == Def);
 			switch(left->nd_def->df_value.df_stdname) {
 			case S_ABS:
+				arg = getarg(arg, T_INTEGER|T_CARDINAL|T_REAL);
+				if (! arg) return 0;
+				expp->nd_type = arg->nd_left->nd_type;
+				break;
 			case S_CAP:
+				arg = getarg(arg, T_CHAR);
+				expp->nd_type = char_type;
+				if (!arg) return 0;
+				break;
 			case S_CHR:
+				arg = getarg(arg, T_INTEGER|T_CARDINAL);
+				expp->nd_type = char_type;
+				if (!arg) return 0;
+				break;
 			case S_FLOAT:
+				arg = getarg(arg, T_CARDINAL|T_INTEGER);
+				expp->nd_type = real_type;
+				if (!arg) return 0;
+				break;
 			case S_HIGH:
+				arg = getarg(arg, T_ARRAY);
+				if (!arg) return 0;
+				expp->nd_type = arg->nd_left->nd_type->next;
+				if (!expp->nd_type) expp->nd_type = int_type;
+				break;
 			case S_MAX:
 			case S_MIN:
+				arg = getarg(arg, T_ENUMERATION|T_CHAR|T_INTEGER|T_CARDINAL);
+				if (!arg) return 0;
+				expp->nd_type = arg->nd_left->nd_type;
+				break;
 			case S_ODD:
+				arg = getarg(arg, T_INTEGER|T_CARDINAL);
+				if (!arg) return 0;
+				expp->nd_type = bool_type;
+				break;
 			case S_ORD:
+				arg = getarg(arg, T_ENUMERATION|T_CHAR|T_INTEGER|T_CARDINAL);
+				if (!arg) return 0;
+				expp->nd_type = card_type;
+				break;
+			case S_TSIZE:	/* ??? */
 			case S_SIZE:
+				arg = getname(arg, D_FIELD|D_VARIABLE|D_TYPE|D_HIDDEN|D_HTYPE);
+				expp->nd_type = intorcard_type;
+				if (!arg) return 0;
+				break;
 			case S_TRUNC:
+				arg = getarg(arg, T_REAL);
+				if (!arg) return 0;
+				expp->nd_type = card_type;
+				break;
 			case S_VAL:
+				arg = getname(arg, D_HIDDEN|D_HTYPE|D_TYPE);
+				if (!arg) return 0;
+				tp = arg->nd_left->nd_def->df_type;
+				if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
+				if (!(tp->tp_fund & (T_ENUMERATION|T_CHAR|T_INTEGER|T_CARDINAL))) {
+					node_error(arg, "unexpected type");
+					return 0;
+				}
+				expp->nd_type = arg->nd_left->nd_def->df_type;
+				FreeNode(arg->nd_left);
+				arg->nd_left = 0;
+				arg = getarg(arg, T_INTEGER|T_CARDINAL);
+				if (!arg) return 0;
+				break;
+			case S_ADR:
+				arg = getname(arg, D_VARIABLE|D_FIELD|D_PROCEDURE);
+				expp->nd_type = address_type;
+				if (!arg) return 0;
 				break;
 			case S_DEC:
 			case S_INC:
+				expp->nd_type = 0;
+				arg = getname(arg, D_VARIABLE|D_FIELD);
+				if (!arg) return 0;
+				if (arg->nd_right) {
+					arg = getarg(arg, T_INTEGER|T_CARDINAL);
+					if (!arg) return 0;
+				}
+				break;
 			case S_HALT:
+				expp->nd_type = 0;
+				break;
 			case S_EXCL:
 			case S_INCL:
 				expp->nd_type = 0;
+				arg = getname(arg, D_VARIABLE|D_FIELD);
+				if (!arg) return 0;
+				tp = arg->nd_left->nd_type;
+				if (tp->tp_fund != T_SET) {
+node_error(arg, "EXCL and INCL expect a SET parameter");
+					return 0;
+				}
+				arg = getarg(arg, T_INTEGER|T_CARDINAL|T_CHAR|T_ENUMERATION);
+				if (!arg) return 0;
+				if (!TstCompat(tp->next, arg->nd_left->nd_type)) {
+					node_error(arg, "Unexpected type");
+					return 0;
+				}
 				break;
 			default:
 				assert(0);
 			}
+			if (arg->nd_right) {
+				node_error(arg->nd_right,
+					"Too many parameters supplied");
+				return 0;
+			}
+			FreeNode(expp->nd_left);
+			expp->nd_left = 0;
 			return 1;
 		}
 		return 1;
@@ -297,7 +427,7 @@ findname(expp)
 		if (tp == error_type) {
 			df = ill_df;
 		}
-		else if (tp->tp_fund != RECORD) {
+		else if (tp->tp_fund != T_RECORD) {
 			/* This is also true for modules */
 			node_error(expp,"Illegal selection");
 			df = ill_df;
@@ -341,18 +471,15 @@ df->df_idf->id_text);
 }
 
 int
-chk_name(expp, const)
+chk_name(expp)
 	register struct node *expp;
 {
 	register struct def *df;
-	int retval = 1;
 
 	(void) findname(expp);
 	assert(expp->nd_class == Def);
 	df = expp->nd_def;
-	if (df->df_kind == D_ERROR) {
-		retval = 0;
-	}
+	if (df->df_kind == D_ERROR) return 0;
 	if (df->df_kind & (D_ENUM | D_CONST)) {
 		if (df->df_kind == D_ENUM) {
 			expp->nd_class = Value;
@@ -363,20 +490,14 @@ chk_name(expp, const)
 			*expp = *(df->con_const);
 		}
 	}
-	else if (const) {
-		node_error(expp, "constant expected");
-		retval = 0;
-	}
-	return retval;
+	return 1;
 }
 
 int
-chk_oper(expp, const)
+chk_oper(expp)
 	register struct node *expp;
 {
-	/*	Check a binary operation. If "const" is set, also check
-		that it is constant.
-		The code is ugly !
+	/*	Check a binary operation.
 	*/
 	register struct type *tpl = expp->nd_left->nd_type;
 	register struct type *tpr = expp->nd_right->nd_type;
@@ -398,7 +519,7 @@ chk_oper(expp, const)
 	if (expp->nd_symb == IN) {
 		/* Handle this one specially */
 		expp->nd_type = bool_type;
-		if (tpr->tp_fund != SET) {
+		if (tpr->tp_fund != T_SET) {
 node_error(expp, "RHS of IN operator not a SET type");
 			return 0;
 		}
@@ -411,7 +532,7 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
 
 	if (expp->nd_symb == '[') {
 		/* Handle ARRAY selection specially too! */
-		if (tpl->tp_fund != ARRAY) {
+		if (tpl->tp_fund != T_ARRAY) {
 node_error(expp, "array index not belonging to an ARRAY");
 			return 0;
 		}
@@ -420,11 +541,10 @@ node_error(expp, "incompatible index type");
 			return 0;
 		}
 		expp->nd_type = tpl->arr_elem;
-		if (const) return 0;
 		return 1;
 	}
 
-	if (tpl->tp_fund == SUBRANGE) tpl = tpl->next;
+	if (tpl->tp_fund == T_SUBRANGE) tpl = tpl->next;
 	expp->nd_type = tpl;
 
 	if (!TstCompat(tpl, tpr)) {
@@ -437,49 +557,35 @@ node_error(expp, "Incompatible types for operator \"%s\"", symbol2str(expp->nd_s
 	case '-':
 	case '*':
 		switch(tpl->tp_fund) {
-		case INTEGER:
-		case INTORCARD:
-		case CARDINAL:
-		case LONGINT:
-		case SET:
+		case T_INTEGER:
+		case T_CARDINAL:
+		case T_SET:
 			if (expp->nd_left->nd_class == Value &&
 			    expp->nd_right->nd_class == Value) {
 				cstbin(expp);
 			}
 			return 1;
-		case REAL:
-		case LONGREAL:
-			if (const) {
-				errval = 2;
-				break;
-			}
+		case T_REAL:
 			return 1;
 		}
 		break;
 	case '/':
 		switch(tpl->tp_fund) {
-		case SET:
+		case T_SET:
 			if (expp->nd_left->nd_class == Value &&
 			    expp->nd_right->nd_class == Value) {
 				cstbin(expp);
 			}
 			return 1;
-		case REAL:
-		case LONGREAL:
-			if (const) {
-				errval = 2;
-				break;
-			}
+		case T_REAL:
 			return 1;
 		}
 		break;
 	case DIV:
 	case MOD:
 		switch(tpl->tp_fund) {
-		case INTEGER:
-		case INTORCARD:
-		case CARDINAL:
-		case LONGINT:
+		case T_INTEGER:
+		case T_CARDINAL:
 			if (expp->nd_left->nd_class == Value &&
 			    expp->nd_right->nd_class == Value) {
 				cstbin(expp);
@@ -505,32 +611,30 @@ node_error(expp, "Incompatible types for operator \"%s\"", symbol2str(expp->nd_s
 	case '<':
 	case '>':
 		switch(tpl->tp_fund) {
-		case SET:
+		case T_SET:
 			if (expp->nd_symb == '<' || expp->nd_symb == '>') {
 				break;
 			}
-		case INTEGER:
-		case INTORCARD:
-		case LONGINT:
-		case CARDINAL:
-		case ENUMERATION:	/* includes boolean */
-		case CHAR:
+			if (expp->nd_left->nd_class == Set &&
+			    expp->nd_right->nd_class == Set) {
+				cstbin(expp);
+			}
+			return 1;
+		case T_INTEGER:
+		case T_CARDINAL:
+		case T_ENUMERATION:	/* includes boolean */
+		case T_CHAR:
 			if (expp->nd_left->nd_class == Value &&
 			    expp->nd_right->nd_class == Value) {
 				cstbin(expp);
 			}
 			return 1;
-		case POINTER:
+		case T_POINTER:
 			if (!(expp->nd_symb == '=' || expp->nd_symb == '#')) {
 				break;
 			}
 			/* Fall through */
-		case REAL:
-		case LONGREAL:
-			if (const) {
-				errval = 2;
-				break;
-			}
+		case T_REAL:
 			return 1;
 		}
 	default:
@@ -540,37 +644,32 @@ node_error(expp, "Incompatible types for operator \"%s\"", symbol2str(expp->nd_s
 	case 1:
 		node_error(expp,"Operator \"%s\": illegal operand type(s)", symbol2str(expp->nd_symb));
 		break;
-	case 2:
-		node_error(expp, "Expression not constant");
-		break;
 	case 3:
 		node_error(expp, "BOOLEAN type(s) expected");
 		break;
+	default:
+		assert(0);
 	}
 	return 0;
 }
 
 int
-chk_uoper(expp, const)
+chk_uoper(expp)
 	register struct node *expp;
 {
-	/*	Check an unary operation. If "const" is set, also check that
-		it can be evaluated compile-time.
+	/*	Check an unary operation.
 	*/
 	register struct type *tpr = expp->nd_right->nd_type;
 
-	if (tpr->tp_fund == SUBRANGE) tpr = tpr->next;
+	if (tpr->tp_fund == T_SUBRANGE) tpr = tpr->next;
 	expp->nd_type = tpr;
 
 	switch(expp->nd_symb) {
 	case '+':
 		switch(tpr->tp_fund) {
-		case INTEGER:
-		case LONGINT:
-		case REAL:
-		case LONGREAL:
-		case CARDINAL:
-		case INTORCARD:
+		case T_INTEGER:
+		case T_REAL:
+		case T_CARDINAL:
 			expp->nd_token = expp->nd_right->nd_token;
 			FreeNode(expp->nd_right);
 			expp->nd_right = 0;
@@ -579,15 +678,12 @@ chk_uoper(expp, const)
 		break;
 	case '-':
 		switch(tpr->tp_fund) {
-		case INTEGER:
-		case LONGINT:
-		case INTORCARD:
+		case T_INTEGER:
 			if (expp->nd_right->nd_class == Value) {
 				cstunary(expp);
 			}
 			return 1;
-		case REAL:
-		case LONGREAL:
+		case T_REAL:
 			if (expp->nd_right->nd_class == Value) {
 				expp->nd_token = expp->nd_right->nd_token;
 				if (*(expp->nd_REL) == '-') {
@@ -609,9 +705,8 @@ chk_uoper(expp, const)
 		}
 		break;
 	case '^':
-		if (tpr->tp_fund != POINTER) break;
+		if (tpr->tp_fund != T_POINTER) break;
 		expp->nd_type = tpr->next;
-		if (const) return 0;
 		return 1;
 	default:
 		assert(0);
diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c
index cb9e14319..a6182bd83 100644
--- a/lang/m2/comp/cstoper.c
+++ b/lang/m2/comp/cstoper.c
@@ -60,7 +60,7 @@ cstbin(expp)
 	int uns = expp->nd_type != int_type;
 
 	assert(expp->nd_class == Oper);
-	if (expp->nd_right->nd_type->tp_fund == SET) {
+	if (expp->nd_right->nd_type->tp_fund == T_SET) {
 		cstset(expp);
 		return;
 	}
diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index 65dcc05c9..79bc4dc02 100644
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -56,7 +56,7 @@ ProcedureHeading(struct def **pdf; int type;)
 			}
 	FormalParameters(type == D_PROCEDURE, &params, &tp)?
 			{
-			  df->df_type = tp = construct_type(PROCEDURE, tp);
+			  df->df_type = tp = construct_type(T_PROCEDURE, tp);
 			  tp->prc_params = params;
 			  if (tp1 && !TstTypeEquiv(tp, tp1)) {
 error("inconsistent procedure declaration for \"%s\"", df->df_idf->id_text); 
@@ -137,7 +137,7 @@ FormalType(struct type **tp;)
 	]?
 	qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0)
 			{ if (ARRAYflag) {
-				*tp = construct_type(ARRAY, NULLTYPE);
+				*tp = construct_type(T_ARRAY, NULLTYPE);
 				(*tp)->arr_elem = df->df_type;
 			  }
 			  else	*tp = df->df_type;
@@ -153,12 +153,12 @@ TypeDeclaration
 	'=' type(&tp)
 			{ df->df_type = tp;
 			  if ((df->df_flags&D_EXPORTED) &&
-			      tp->tp_fund == ENUMERATION) {
+			      tp->tp_fund == T_ENUMERATION) {
 				exprt_literals(tp->enm_enums,
 						enclosing(CurrentScope));
 			  }
 			  if (df->df_kind == D_HTYPE &&
-			      tp->tp_fund != POINTER) {
+			      tp->tp_fund != T_POINTER) {
 error("Opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
 			  }
 
@@ -207,11 +207,11 @@ enumeration(struct type **ptp;)
 	struct node *EnumList;
 } :
 	'(' IdentList(&EnumList) ')'
-			{
-			  *ptp = standard_type(ENUMERATION,int_align,int_size);
-			  EnterIdList(EnumList, D_ENUM, 0, *ptp, CurrentScope);
-			  FreeNode(EnumList);
-			}
+		{
+		  *ptp = standard_type(T_ENUMERATION,int_align,int_size);
+		  EnterIdList(EnumList, D_ENUM, 0, *ptp, CurrentScope);
+		  FreeNode(EnumList);
+		}
 
 ;
 
@@ -252,12 +252,12 @@ ArrayType(struct type **ptp;)
 } :
 	ARRAY SimpleType(&tp)
 			{
-			  *ptp = tp2 = construct_type(ARRAY, tp);
+			  *ptp = tp2 = construct_type(T_ARRAY, tp);
 			}
 	[
 		',' SimpleType(&tp)
 			{ tp2 = tp2->arr_elem = 
-				construct_type(ARRAY, tp);
+				construct_type(T_ARRAY, tp);
 			}
 	]* OF type(&tp)
 			{ tp2->arr_elem = tp; }
@@ -273,10 +273,10 @@ RecordType(struct type **ptp;)
 			  scope.next = CurrentScope;
 			}
 	FieldListSequence(&scope)
-			{
-			  *ptp = standard_type(RECORD, record_align, (arith) 0 /* ???? */);
-			  (*ptp)->rec_scope = scope.sc_scope;
-			}
+		{
+		  *ptp = standard_type(T_RECORD, record_align, (arith) 0 /* ???? */);
+		  (*ptp)->rec_scope = scope.sc_scope;
+		}
 	END
 ;
 
@@ -380,7 +380,7 @@ PointerType(struct type **ptp;)
 				{ tp = NULLTYPE; }
 	]
 				{
-				  *ptp = construct_type(POINTER, tp);
+				  *ptp = construct_type(T_POINTER, tp);
 				  if (!tp) Forward(&dot, &((*ptp)->next));
 				}
 ;
@@ -391,7 +391,7 @@ ProcedureType(struct type **ptp;)
 	struct type *tp = 0;
 } :
 	PROCEDURE FormalTypeList(&pr, &tp)?
-			{ *ptp = construct_type(PROCVAR, tp);
+			{ *ptp = construct_type(T_PROCEDURE, tp);
 			  (*ptp)->prc_params = pr;
 			}
 ;
diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c
index 55df98c84..b0f444806 100644
--- a/lang/m2/comp/def.c
+++ b/lang/m2/comp/def.c
@@ -204,7 +204,7 @@ ids->nd_IDF->id_text);
 		DO_DEBUG(2, debug("importing \"%s\", kind %d", ids->nd_IDF->id_text, df->df_kind));
 		define(ids->nd_IDF, CurrentScope, kind)->imp_def = df;
 		if (df->df_kind == D_TYPE &&
-		    df->df_type->tp_fund == ENUMERATION) {
+		    df->df_type->tp_fund == T_ENUMERATION) {
 			/* Also import all enumeration literals */
 			exprt_literals(df->df_type->enm_enums,
 					CurrentScope);
diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g
index 2abfb97fe..6a9e1556f 100644
--- a/lang/m2/comp/expression.g
+++ b/lang/m2/comp/expression.g
@@ -68,12 +68,15 @@ ExpList(struct node **pnd;)
 {
 	struct node **nd;
 } :
-	expression(pnd)		{ nd = pnd; }
+	expression(pnd)		{ *pnd = MkNode(Link, *pnd, NULLNODE, &dot);
+				  (*pnd)->nd_symb = ',';
+				  nd = &((*pnd)->nd_right);
+				}
 	[
-		','		{ *nd = MkNode(Link, *nd, NULLNODE, &dot);
-				  nd = &(*nd)->nd_right;
+		','		{ *nd = MkNode(Link, NULLNODE, NULLNODE, &dot);
 				}
-		expression(nd)
+		expression(&(*nd)->nd_left)
+				{ nd = &((*pnd)->nd_right); }
 	]*
 ;
 
@@ -86,7 +89,10 @@ ConstExpression(struct node **pnd;):
 		{ DO_DEBUG(3,
 		     ( debug("Constant expression:"),
 		       PrNode(*pnd)));
-		  (void) chk_expr(*pnd, 1);
+		  if (chk_expr(*pnd) &&
+		      ((*pnd)->nd_class != Set && (*pnd)->nd_class != Value)) {
+			error("Constant expression expected");
+		  }
 		  DO_DEBUG(3, PrNode(*pnd));
 		}
 ;
diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c
index 5019dce96..08632c06b 100644
--- a/lang/m2/comp/main.c
+++ b/lang/m2/comp/main.c
@@ -156,7 +156,7 @@ add_standards()
 	(void) Enter("NIL", D_CONST, address_type, 0);
 	(void) Enter("PROC",
 		     D_TYPE,
-		     construct_type(PROCEDURE, NULLTYPE),
+		     construct_type(T_PROCEDURE, NULLTYPE),
 		     0);
 	df = Enter("BITSET", D_TYPE, bitset_type, 0);
 	df = Enter("FALSE", D_ENUM, bool_type, 0);
diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g
index f76742465..0cca0902d 100644
--- a/lang/m2/comp/program.g
+++ b/lang/m2/comp/program.g
@@ -48,7 +48,7 @@ ModuleDeclaration
 				  open_scope(CLOSEDSCOPE, 0);
 				  df->mod_scope = CurrentScope->sc_scope;
 				  df->df_type = 
-					standard_type(RECORD, 0, (arith) 0);
+					standard_type(T_RECORD, 0, (arith) 0);
 				  df->df_type->rec_scope = df->mod_scope;
 				}
 	priority? ';'
@@ -116,7 +116,7 @@ DefinitionModule
 			  df = define(id, GlobalScope, D_MODULE);
 			  if (!SYSTEMModule) open_scope(CLOSEDSCOPE, 0);
 			  df->mod_scope = CurrentScope->sc_scope;
-			  df->df_type = standard_type(RECORD, 0, (arith) 0);
+			  df->df_type = standard_type(T_RECORD, 0, (arith) 0);
 			  df->df_type->rec_scope = df->mod_scope;
 			  DefinitionModule = 1;
 			  DO_DEBUG(1, debug("Definition module \"%s\"", id->id_text));
diff --git a/lang/m2/comp/tokenname.c b/lang/m2/comp/tokenname.c
index 9e0ca1cb5..a9b9920c2 100644
--- a/lang/m2/comp/tokenname.c
+++ b/lang/m2/comp/tokenname.c
@@ -76,22 +76,10 @@ struct tokenname tkidf[] =	{	/* names of the identifier tokens */
 
 struct tokenname tkinternal[] = {	/* internal keywords	*/
 	{PROGRAM, ""},
-	{SUBRANGE, ""},
-	{ENUMERATION, ""},
-	{ERRONEOUS, ""},
-	{PROCVAR, ""},
-	{INTORCARD, ""},
 	{0, "0"}
 };
 
 struct tokenname tkstandard[] =	{	/* standard identifiers */
-	{CHAR, ""},
-	{BOOLEAN, ""},
-	{LONGINT, ""},
-	{CARDINAL, ""},
-	{LONGREAL, ""},
-	{WORD, ""},
-	{ADDRESS, ""},
 	{0, ""}
 };
 
diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H
index bba1f4afe..d144e4458 100644
--- a/lang/m2/comp/type.H
+++ b/lang/m2/comp/type.H
@@ -53,9 +53,23 @@ struct type	{
 				   SUBRANGE
 				*/
 	int tp_fund;		/* fundamental type  or constructor */
+#define T_RECORD	0x0001
+#define	T_ENUMERATION	0x0002
+#define	T_INTEGER	0x0004
+#define T_CARDINAL	0x0008
+/* #define T_LONGINT	0x0010 */
+#define T_REAL		0x0020
+/* #define T_LONGREAL	0x0040 */
+#define T_POINTER	0x0080
+#define T_CHAR		0x0100
+#define T_WORD		0x0200
+#define T_SET		0x0400
+#define T_SUBRANGE	0x0800
+#define T_PROCEDURE	0x1000
+#define T_ARRAY		0x2000
+#define T_STRING	0x4000
 	int tp_align;		/* alignment requirement of this type */
 	arith tp_size;		/* size of this type */
-/*	struct idf *tp_idf;	/* name of this type */
 	union {
 	    struct enume tp_enum;
 	    struct subrange tp_subrange;
diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index 36083a1d9..f509f0d06 100644
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -82,21 +82,21 @@ construct_type(fund, tp)
 	struct type *dtp = create_type(fund);
 
 	switch (fund)	{
-	case PROCEDURE:
-	case POINTER:
+	case T_PROCEDURE:
+	case T_POINTER:
 		dtp->tp_align = ptr_align;
 		dtp->tp_size = ptr_size;
 		dtp->next = tp;
 		break;
-	case SET:
+	case T_SET:
 		dtp->tp_align = wrd_align;
 		dtp->next = tp;
 		break;
-	case ARRAY:
+	case T_ARRAY:
 		dtp->tp_align = tp->tp_align;
 		dtp->next = tp;
 		break;
-	case SUBRANGE:
+	case T_SUBRANGE:
 		dtp->tp_align = tp->tp_align;
 		dtp->tp_size = tp->tp_size;
 		dtp->next = tp;
@@ -131,25 +131,25 @@ init_types()
 {
 	register struct type *tp;
 
-	char_type = standard_type(CHAR, 1, (arith) 1);
+	char_type = standard_type(T_CHAR, 1, (arith) 1);
 	char_type->enm_ncst = 256;
-	bool_type = standard_type(ENUMERATION, 1, (arith) 1);
+	bool_type = standard_type(T_ENUMERATION, 1, (arith) 1);
 	bool_type->enm_ncst = 2;
-	int_type = standard_type(INTEGER, int_align, int_size);
-	longint_type = standard_type(LONGINT, lint_align, lint_size);
-	card_type = standard_type(CARDINAL, int_align, int_size);
-	real_type = standard_type(REAL, real_align, real_size);
-	longreal_type = standard_type(LONGREAL, lreal_align, lreal_size);
-	word_type = standard_type(WORD, wrd_align, wrd_size);
-	intorcard_type = standard_type(INTORCARD, int_align, int_size);
-	string_type = standard_type(STRING, 1, (arith) -1);
-	address_type = construct_type(POINTER, word_type);
-	tp = construct_type(SUBRANGE, int_type);
+	int_type = standard_type(T_INTEGER, int_align, int_size);
+	longint_type = standard_type(T_INTEGER, lint_align, lint_size);
+	card_type = standard_type(T_CARDINAL, int_align, int_size);
+	real_type = standard_type(T_REAL, real_align, real_size);
+	longreal_type = standard_type(T_REAL, lreal_align, lreal_size);
+	word_type = standard_type(T_WORD, wrd_align, wrd_size);
+	intorcard_type = standard_type(T_INTEGER, int_align, int_size);
+	string_type = standard_type(T_STRING, 1, (arith) -1);
+	address_type = construct_type(T_POINTER, word_type);
+	tp = construct_type(T_SUBRANGE, int_type);
 	tp->sub_lb = 0;
 	tp->sub_ub = wrd_size * 8 - 1;
 	bitset_type = set_type(tp);
-	std_type = construct_type(PROCEDURE, NULLTYPE);
-	error_type = standard_type(ERRONEOUS, 1, (arith) 1);
+	std_type = construct_type(T_PROCEDURE, NULLTYPE);
+	error_type = standard_type(T_CHAR, 1, (arith) 1);
 }
 
 int
@@ -160,14 +160,11 @@ has_selectors(df)
 	switch(df->df_kind) {
 	case D_MODULE:
 		return df->df_value.df_module.mo_scope;
-	case D_VARIABLE: {	
-		register struct type *tp = df->df_type;
-
-		if (tp->tp_fund == RECORD) {
-			return tp->rec_scope;
+	case D_VARIABLE:
+		if (df->df_type->tp_fund == T_RECORD) {
+			return df->df_type->rec_scope;
 		}
 		break;
-		}
 	}
 	error("no selectors for \"%s\"", df->df_idf->id_text);
 	return 0;
@@ -205,7 +202,7 @@ ParamList(ids, tp, VARp)
 chk_basesubrange(tp, base)
 	register struct type *tp, *base;
 {
-	if (base->tp_fund == SUBRANGE) {
+	if (base->tp_fund == T_SUBRANGE) {
 		/* Check that the bounds of "tp" fall within the range
 		   of "base"
 		*/
@@ -214,7 +211,7 @@ chk_basesubrange(tp, base)
 		}
 		base = base->next;
 	}
-	if (base->tp_fund == ENUMERATION || base->tp_fund == CHAR) {
+	if (base->tp_fund == T_ENUMERATION || base->tp_fund == T_CHAR) {
 		if (tp->next != base) {
 			error("Specified base does not conform");
 		}
@@ -247,13 +244,13 @@ subr_type(lb, ub)
 		return error_type;
 	}
 
-	if (tp->tp_fund == SUBRANGE) tp = tp->next;
+	if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
 	if (tp == intorcard_type) tp = card_type;	/* lower bound > 0 */
 
 	/* Check base type
 	*/
 	if (tp != int_type && tp != card_type && tp != char_type &&
-	    tp->tp_fund != ENUMERATION) {
+	    tp->tp_fund != T_ENUMERATION) {
 		/* BOOLEAN is also an ENUMERATION type
 		*/
 		node_error(ub, "Illegal base type for subrange");
@@ -268,7 +265,7 @@ subr_type(lb, ub)
 
 	/* Now construct resulting type
 	*/
-	tp = construct_type(SUBRANGE, tp);
+	tp = construct_type(T_SUBRANGE, tp);
 	tp->sub_lb = lb->nd_INT;
 	tp->sub_ub = ub->nd_INT;
 	DO_DEBUG(2,debug("Creating subrange type %ld-%ld", (long)lb->nd_INT,(long)ub->nd_INT));
@@ -285,13 +282,13 @@ set_type(tp)
 	*/
 	int lb, ub;
 
-	if (tp->tp_fund == SUBRANGE) {
+	if (tp->tp_fund == T_SUBRANGE) {
 		if ((lb = tp->sub_lb) < 0 || (ub = tp->sub_ub) > MAX_SET - 1) {
 			error("Set type limits exceeded");
 			return error_type;
 		}
 	}
-	else if (tp->tp_fund == ENUMERATION || tp == char_type) {
+	else if (tp->tp_fund == T_ENUMERATION || tp == char_type) {
 		lb = 0;
 		if ((ub = tp->enm_ncst - 1) > MAX_SET - 1) {
 			error("Set type limits exceeded");
@@ -302,7 +299,7 @@ set_type(tp)
 		error("illegal base type for set");
 		return error_type;
 	}
-	tp = construct_type(SET, tp);
+	tp = construct_type(T_SET, tp);
 	tp->tp_size = align(((ub - lb) + 7)/8, wrd_align);
 	return tp;
 }
diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c
index 02f184cd8..9cf8621ff 100644
--- a/lang/m2/comp/typequiv.c
+++ b/lang/m2/comp/typequiv.c
@@ -25,9 +25,9 @@ TstTypeEquiv(tp1, tp2)
 		   tp2 == error_type
 		||
 		   ( 
-		     tp1 && tp1->tp_fund == PROCEDURE
+		     tp1 && tp1->tp_fund == T_PROCEDURE
 		   &&
-		     tp2 && tp2->tp_fund == PROCEDURE
+		     tp2 && tp2->tp_fund == T_PROCEDURE
 		   &&
 		     TstProcEquiv(tp1, tp2)
 		   );
@@ -65,8 +65,8 @@ TstCompat(tp1, tp2)
 		Modula-2 Report for a definition of "compatible".
 	*/
 	if (TstTypeEquiv(tp1, tp2)) return 1;
-	if (tp1->tp_fund == SUBRANGE) tp1 = tp1->next;
-	if (tp2->tp_fund == SUBRANGE) tp2 = tp2->next;
+	if (tp1->tp_fund == T_SUBRANGE) tp1 = tp1->next;
+	if (tp2->tp_fund == T_SUBRANGE) tp2 = tp2->next;
 	return	tp1 == tp2
 	    ||
 		(  tp1 == intorcard_type
@@ -83,7 +83,7 @@ TstCompat(tp1, tp2)
 		&& 
 	          (  tp2 == card_type
 		  || tp2 == intorcard_type
-		  || tp2->tp_fund == POINTER
+		  || tp2->tp_fund == T_POINTER
 		  )
 		)
 	    ||
@@ -91,7 +91,7 @@ TstCompat(tp1, tp2)
 		&& 
 	          (  tp1 == card_type
 		  || tp1 == intorcard_type
-		  || tp1->tp_fund == POINTER
+		  || tp1->tp_fund == T_POINTER
 		  )
 		)
 	;