From: ceriel <none@none>
Date: Mon, 17 Nov 1986 11:41:28 +0000 (+0000)
Subject: Trying to check more of an expression, giving some more sophisticated error messages... 
X-Git-Tag: release-5-5~5148
X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=9d0ee46068e05696740aeb9dbf27e15c44de7038;p=ack.git

Trying to check more of an expression, giving some more sophisticated error messages,and be less wasteful with space for subranges
---

diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c
index 733ba3b37..c9372ecb7 100644
--- a/lang/m2/comp/LLlex.c
+++ b/lang/m2/comp/LLlex.c
@@ -76,10 +76,12 @@ GetString(upto)
 	/*	Read a Modula-2 string, delimited by the character "upto".
 	*/
 	register int ch;
-	register struct string *str = (struct string *) Malloc(sizeof(struct string));
+	register struct string *str = (struct string *)
+			Malloc((unsigned) sizeof(struct string));
 	register char *p;
+	register int len;
 	
-	str->s_length = ISTRSIZE;
+	len = ISTRSIZE;
 	str->s_str = p = Malloc((unsigned int) ISTRSIZE);
 	while (LoadChar(ch), ch != upto)	{
 		if (class(ch) == STNL)	{
@@ -95,15 +97,18 @@ GetString(upto)
 			break;
 		}
 		*p++ = ch;
-		if (p - str->s_str == str->s_length)	{
+		if (p - str->s_str == len)	{
 			str->s_str = Srealloc(str->s_str,
-				(unsigned int) str->s_length + RSTRSIZE);
-			p = str->s_str + str->s_length;
-			str->s_length += RSTRSIZE;
+				(unsigned int) len + RSTRSIZE);
+			p = str->s_str + len;
+			len += RSTRSIZE;
 		}
 	}
-	*p = '\0';
 	str->s_length = p - str->s_str;
+	while (p - str->s_str < len) *p++ = '\0';
+	if (str->s_length == 0) str->s_length = 1;	/* ??? string length
+							   at least 1 ???
+						   	*/
 	return str;
 }
 
@@ -172,7 +177,7 @@ linedirective() {
 		 * Remember the file name
 		 */
 		if (!eofseen && strcmp(FileName,buf)) {
-			FileName = Salloc(buf,strlen(buf) + 1);
+			FileName = Salloc(buf,(unsigned) strlen(buf) + 1);
 		}
 	}
 	if (eofseen) {
diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index f9746fd19..aff09b741 100644
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -64,8 +64,8 @@ lint:	Cfiles
 	sh -c 'if $(CC) nmclash.c > /dev/null 2>&1 ; then make Xlint ; else sh Resolve Xlint ; fi'
 	@rm -f nmclash.o a.out
 
-clashes:	$(SRC) $(HFILES)
-	sh -c 'if test -f clashes ; then cclash -l7 clashes $? > Xclashes ; mv Xclashes clashes ; else cclash -l7 $? > clashes ; fi'
+longnames:	$(SRC) $(HFILES)
+	sh -c 'if test -f longnames ; then prid -l7 longnames $? > Xlongnames ; mv Xlongnames longnames ; else prid -l7 $? > longnames ; fi'
 
 # entry points not to be used directly
 
diff --git a/lang/m2/comp/Parameters b/lang/m2/comp/Parameters
index 9aa80fbe2..fecdc8a73 100644
--- a/lang/m2/comp/Parameters
+++ b/lang/m2/comp/Parameters
@@ -1,6 +1,6 @@
 !File: errout.h
 #define	ERROUT		STDERR	/* file pointer for writing messages	*/
-#define	MAXERR_LINE	5	/* maximum number of error messages given
+#define	MAXERR_LINE	100	/* maximum number of error messages given
 					on the same input line.		*/
 
 
diff --git a/lang/m2/comp/Resolve b/lang/m2/comp/Resolve
index b8712499d..eeb0a7b86 100755
--- a/lang/m2/comp/Resolve
+++ b/lang/m2/comp/Resolve
@@ -20,10 +20,10 @@ then
 	:
 else	mkdir ../Xsrc
 fi
-make clashes
+make longnames
 : remove code generating routines from the clashes list as they are defines.
 : code generating routine names start with C_
-sed '/^C_/d' < clashes > tmp$$
+sed '/^C_/d' < longnames > tmp$$
 cclash -c -l7 tmp$$ > ../Xsrc/Xclashes
 rm -f tmp$$
 PW=`pwd`
diff --git a/lang/m2/comp/Version.c b/lang/m2/comp/Version.c
index 44e57907d..521e211af 100644
--- a/lang/m2/comp/Version.c
+++ b/lang/m2/comp/Version.c
@@ -1 +1 @@
-char Version[] = "Version 0.7";
+char Version[] = "ACK Modula-2 compiler Version 0.8";
diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index c01ae1a5d..fb1dd1904 100644
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -25,6 +25,20 @@
 
 extern char *symbol2str();
 
+STATIC
+Xerror(nd, mess, edf)
+	struct node *nd;
+	char *mess;
+	struct def *edf;
+{
+	if (edf) {
+		if (edf->df_kind != D_ERROR)  {
+			node_error(nd, "\"%s\": %s", edf->df_idf->id_text, mess);
+		}
+	}
+	else	node_error(nd, "%s", mess);
+}
+
 int
 ChkVariable(expp)
 	register struct node *expp;
@@ -37,7 +51,7 @@ ChkVariable(expp)
 
 	if (expp->nd_class == Def &&
 	    !(expp->nd_def->df_kind & (D_FIELD|D_VARIABLE))) {
-		node_error(expp, "variable expected");
+		Xerror(expp, "variable expected", expp->nd_def);
 		return 0;
 	}
 
@@ -63,7 +77,7 @@ ChkArrow(expp)
 	tp = expp->nd_right->nd_type;
 
 	if (tp->tp_fund != T_POINTER) {
-		node_error(expp, "illegal operand for unary operator \"^\"");
+		node_error(expp, "\"^\": illegal operand");
 		return 0;
 	}
 
@@ -82,22 +96,18 @@ ChkArr(expp)
 	*/
 
 	register struct type *tpl, *tpr;
+	int retval;
 
 	assert(expp->nd_class == Arrsel);
 	assert(expp->nd_symb == '[');
 
 	expp->nd_type = error_type;
 
-	if ( 
-	     !ChkVariable(expp->nd_left)
-	   ||
-	     !ChkExpression(expp->nd_right)
-	   ||
-	     expp->nd_left->nd_type == error_type
-	   )	return 0;
+	retval = ChkVariable(expp->nd_left) & ChkExpression(expp->nd_right);
 
 	tpl = expp->nd_left->nd_type;
 	tpr = expp->nd_right->nd_type;
+	if (tpl == error_type || tpr == error_type) return 0;
 
 	if (tpl->tp_fund != T_ARRAY) {
 		node_error(expp, "not indexing an ARRAY type");
@@ -116,7 +126,7 @@ ChkArr(expp)
 	}
 
 	expp->nd_type = RemoveEqual(tpl->arr_elem);
-	return 1;
+	return retval;
 }
 
 #ifdef DEBUG
@@ -168,11 +178,11 @@ ChkLinkOrName(expp)
 		     !(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD))
 		    )
 		   ) {
-			node_error(left, "illegal selection");
+			Xerror(left, "illegal selection", left->nd_def);
 			return 0;
 		}
 
-		if (!(df = lookup(expp->nd_IDF, left->nd_type->rec_scope))) {
+		if (!(df = lookup(expp->nd_IDF, left->nd_type->rec_scope, 1))) {
 			id_not_declared(expp);
 			return 0;
 		}
@@ -184,9 +194,7 @@ ChkLinkOrName(expp)
 				/* 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;
+Xerror(expp, "not exported from qualifying module", df);
 			}
 		}
 
@@ -202,7 +210,6 @@ df->df_idf->id_text);
 	assert(expp->nd_class == Def);
 
 	df = expp->nd_def;
-	if (df->df_kind == D_ERROR) return 0;
 
 	if (df->df_kind & (D_ENUM | D_CONST)) {
 		/* Replace an enum-literal or a CONST identifier by its value.
@@ -220,8 +227,7 @@ df->df_idf->id_text);
 			expp->nd_lineno = ln;
 		}
 	}
-
-	return 1;
+	return df->df_kind != D_ERROR;
 }
 
 STATIC int
@@ -238,7 +244,7 @@ ChkExLinkOrName(expp)
 	df = expp->nd_def;
 
 	if (!(df->df_kind & D_VALUE)) {
-		node_error(expp, "value expected");
+		Xerror(expp, "value expected", df);
 	}
 
 	if (df->df_kind == D_PROCEDURE) {
@@ -352,19 +358,18 @@ ChkSet(expp)
 		/* A type was given. Check it out
 		*/
 		if (! ChkDesignator(nd)) return 0;
-
 		assert(nd->nd_class == Def);
 		df = nd->nd_def;
 
 		if (!is_type(df) ||
-		    (df->df_type->tp_fund != T_SET)) {
+	   	    (df->df_type->tp_fund != T_SET)) {
 			if (df->df_kind != D_ERROR) {
-node_error(expp, "type specifier does not represent a set type");
+				Xerror(expp, "not a set type", df);
 			}
 			return 0;
 		}
 		tp = df->df_type;
-		FreeNode(expp->nd_left);
+		FreeNode(nd);
 		expp->nd_left = 0;
 	}
 	else	tp = bitset_type;
@@ -412,8 +417,9 @@ node_error(expp, "type specifier does not represent a set type");
 }
 
 STATIC struct node *
-getarg(argp, bases, designator)
+getarg(argp, bases, designator, edf)
 	struct node **argp;
+	struct def *edf;
 {
 	/*	This routine is used to fetch the next argument from an
 		argument list. The argument list is indicated by "argp".
@@ -427,7 +433,7 @@ getarg(argp, bases, designator)
 	register struct node *left;
 
 	if (! arg) {
-		node_error(*argp, "too few arguments supplied");
+		Xerror(*argp, "too few arguments supplied", edf);
 		return 0;
 	}
 
@@ -443,7 +449,7 @@ getarg(argp, bases, designator)
 
 	if (bases) {
 		if (!(BaseType(left->nd_type)->tp_fund & bases)) {
-			node_error(arg, "unexpected type");
+			Xerror(arg, "unexpected parameter type", edf);
 			return 0;
 		}
 	}
@@ -453,8 +459,9 @@ getarg(argp, bases, designator)
 }
 
 STATIC struct node *
-getname(argp, kinds)
+getname(argp, kinds, bases, edf)
 	struct node **argp;
+	struct def *edf;
 {
 	/*	Get the next argument from argument list "argp".
 		The argument must indicate a definition, and the
@@ -464,7 +471,7 @@ getname(argp, kinds)
 	register struct node *left;
 
 	if (!arg->nd_right) {
-		node_error(arg, "too few arguments supplied");
+		Xerror(arg, "too few arguments supplied", edf);
 		return 0;
 	}
 
@@ -473,15 +480,22 @@ getname(argp, kinds)
 	if (! ChkDesignator(left)) return 0;
 
 	if (left->nd_class != Def && left->nd_class != LinkDef) {
-		node_error(arg, "identifier expected");
+		Xerror(arg, "identifier expected", edf);
 		return 0;
 	}
 
 	if (!(left->nd_def->df_kind & kinds)) {
-		node_error(arg, "unexpected type");
+		Xerror(arg, "unexpected parameter type", edf);
 		return 0;
 	}
 
+	if (bases) {
+		if (!(left->nd_type->tp_fund & bases)) {
+			Xerror(arg, "unexpected parameter type", edf);
+			return 0;
+		}
+	}
+
 	*argp = arg;
 	return left;
 }
@@ -493,16 +507,25 @@ ChkProcCall(expp)
 	/*	Check a procedure call
 	*/
 	register struct node *left;
-	struct node *arg;
+	struct def *edf = 0;
 	register struct paramlist *param;
+	char ebuf[256];
+	int retval = 1;
+	int cnt = 0;
 
 	left = expp->nd_left;
+	if (left->nd_class == Def || left->nd_class == LinkDef) {
+		edf = left->nd_def;
+	}
 	expp->nd_type = RemoveEqual(ResultType(left->nd_type));
 
 	/* Check parameter list
 	*/
 	for (param = ParamList(left->nd_type); param; param = param->next) {
-		if (!(left = getarg(&expp, 0, IsVarParam(param)))) return 0;
+		if (!(left = getarg(&expp, 0, IsVarParam(param), edf))) {
+			return 0;
+		}
+		cnt++;
 		if (left->nd_symb == STRING) {
 			TryToString(left, TypeOfParam(param));
 		}
@@ -510,17 +533,19 @@ ChkProcCall(expp)
 				   left->nd_type,
 				   IsVarParam(param),
 				   left)) {
-node_error(left, "type incompatibility in parameter");
-			return 0;
+			sprint(ebuf, "type incompatibility in parameter %d",
+					cnt);
+			Xerror(left, ebuf, edf);
+			retval = 0;
 		}
 	}
 
 	if (expp->nd_right) {
-		node_error(expp->nd_right, "too many parameters supplied");
+		Xerror(expp->nd_right, "too many parameters supplied", edf);
 		return 0;
 	}
 
-	return 1;
+	return retval;
 }
 
 int
@@ -659,11 +684,12 @@ ChkBinOper(expp)
 	register struct node *left, *right;
 	struct type *tpl, *tpr;
 	int allowed;
+	int retval;
 
 	left = expp->nd_left;
 	right = expp->nd_right;
 
-	if (!ChkExpression(left) || !ChkExpression(right)) return 0;
+	retval = ChkExpression(left) & ChkExpression(right);
 
 	tpl = BaseType(left->nd_type);
 	tpr = BaseType(right->nd_type);
@@ -695,24 +721,27 @@ ChkBinOper(expp)
 		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???
+			   if a INTEGER is a member of a BITSET???
 			*/
 
-node_error(expp, "incompatible types for operator \"IN\"");
+			node_error(expp, "\"IN\": incompatible types");
 			return 0;
 		}
 		if (left->nd_class == Value && right->nd_class == Set) {
 			cstset(expp);
 		}
-		return 1;
+		return retval;
 	}
 
+	if (!retval) return 0;
+
 	allowed = AllowedTypes(expp->nd_symb);
 
 	if (!(tpr->tp_fund & allowed) || !(tpl->tp_fund & allowed)) {
 	    	if (!((T_CARDINAL & allowed) &&
 	             ChkAddress(tpl, tpr))) {
-node_error(expp,"operator \"%s\": illegal operand type(s)", symbol2str(expp->nd_symb));
+			node_error(expp, "\"%s\": illegal operand type(s)", 
+				     symbol2str(expp->nd_symb));
 			return 0;
 		}
 		if (expp->nd_type->tp_fund & T_CARDINAL) {
@@ -721,16 +750,15 @@ node_error(expp,"operator \"%s\": illegal operand type(s)", symbol2str(expp->nd_
 	}
 
 	if (Boolean(expp->nd_symb) && tpl != bool_type) {
-node_error(expp,"operator \"%s\": illegal operand type(s)", symbol2str(expp->nd_symb));
-	    
+		node_error(expp, "\"%s\": illegal operand type(s)",
+			     symbol2str(expp->nd_symb));
 		return 0;
 	}
 
 	/* Operands must be compatible (distilled from Def 8.2)
 	*/
 	if (!TstCompat(tpl, tpr)) {
-		node_error(expp, "incompatible types for operator \"%s\"",
-					symbol2str(expp->nd_symb));
+		node_error(expp, "\"%s\": incompatible types", symbol2str(expp->nd_symb));
 		return 0;
 	}
 
@@ -810,14 +838,14 @@ ChkUnOper(expp)
 	default:
 		crash("ChkUnOper");
 	}
-	node_error(expp, "illegal operand for unary operator \"%s\"",
-			symbol2str(expp->nd_symb));
+	node_error(expp, "\"%s\": illegal operand", symbol2str(expp->nd_symb));
 	return 0;
 }
 
 STATIC struct node *
-getvariable(argp)
+getvariable(argp, edf)
 	struct node **argp;
+	struct def *edf;
 {
 	/*	Get the next argument from argument list "argp".
 		It must obey the rules of "ChkVariable".
@@ -826,7 +854,7 @@ getvariable(argp)
 
 	arg = arg->nd_right;
 	if (!arg) {
-		node_error(arg, "too few parameters supplied");
+		Xerror(arg, "too few parameters supplied", edf);
 		return 0;
 	}
 
@@ -844,14 +872,16 @@ ChkStandard(expp, left)
 	/*	Check a call of a standard procedure or function
 	*/
 	struct node *arg = expp;
+	register struct def *edf;
 	int std;
 
 	assert(left->nd_class == Def);
 	std = left->nd_def->df_value.df_stdname;
+	edf = left->nd_def;
 
 	switch(std) {
 	case S_ABS:
-		if (!(left = getarg(&arg, T_NUMERIC, 0))) return 0;
+		if (!(left = getarg(&arg, T_NUMERIC, 0, edf))) return 0;
 		expp->nd_type = left->nd_type;
 		if (left->nd_class == Value &&
 		    expp->nd_type->tp_fund != T_REAL) {
@@ -861,28 +891,31 @@ ChkStandard(expp, left)
 
 	case S_CAP:
 		expp->nd_type = char_type;
-		if (!(left = getarg(&arg, T_CHAR, 0))) return 0;
+		if (!(left = getarg(&arg, T_CHAR, 0, edf))) return 0;
 		if (left->nd_class == Value) cstcall(expp, S_CAP);
 		break;
 
 	case S_CHR:
 		expp->nd_type = char_type;
-		if (!(left = getarg(&arg, T_INTORCARD, 0))) return 0;
+		if (!(left = getarg(&arg, T_INTORCARD, 0, edf))) return 0;
 		if (left->nd_class == Value) cstcall(expp, S_CHR);
 		break;
 
 	case S_FLOAT:
 		expp->nd_type = real_type;
-		if (!(left = getarg(&arg, T_INTORCARD, 0))) return 0;
+		if (!(left = getarg(&arg, T_INTORCARD, 0, edf))) return 0;
 		break;
 
 	case S_HIGH:
-		if (!(left = getarg(&arg, T_ARRAY|T_STRING|T_CHAR, 0))) return 0;
+		if (!(left = getarg(&arg, T_ARRAY|T_STRING|T_CHAR, 0, edf))) {
+			return 0;
+		}
 		if (IsConformantArray(left->nd_type)) {
-			/* A conformant array has no explicit index type
-			   ??? So, what can we use as index-type ???
+			/* A conformant array has no explicit index type,
+			   but it is a subrange with lower bound 0, so
+			   it is of type CARDINAL !!!
 			*/
-			expp->nd_type = intorcard_type;
+			expp->nd_type = card_type;
 			break;
 		}
 		if (left->nd_type->tp_fund == T_ARRAY) {
@@ -890,14 +923,17 @@ ChkStandard(expp, left)
 			cstcall(expp, S_MAX);
 			break;
 		}
-		if (left->nd_type->tp_fund == T_CHAR) {
-			if (left->nd_symb != STRING) {
-				node_error(left,"HIGH: array parameter expected");
-				return 0;
-			}
+		if (left->nd_symb != STRING) {
+			Xerror(left,"array parameter expected", edf);
+			return 0;
 		}
-		expp->nd_type = intorcard_type;
+		expp->nd_type = card_type;
 		expp->nd_class = Value;
+		/* Notice that we could disallow HIGH("") here by checking
+		   that left->nd_type->tp_fund != T_CHAR || left->nd_INT != 0.
+		   ??? For the time being, we don't. !!!
+		   Maybe the empty string should not be allowed at all.
+		*/
 		expp->nd_INT = left->nd_type->tp_fund == T_CHAR ? 0 :
 					left->nd_SLE - 1;
 		expp->nd_symb = INTEGER;
@@ -905,9 +941,7 @@ ChkStandard(expp, left)
 
 	case S_MAX:
 	case S_MIN:
-		if (!(left = getname(&arg, D_ISTYPE))) return 0;
-		if (!(left->nd_type->tp_fund & (T_DISCRETE))) {
-node_error(left, "illegal type in %s", std == S_MAX ? "MAX" : "MIN");
+		if (!(left = getname(&arg, D_ISTYPE, T_DISCRETE, edf))) {
 			return 0;
 		}
 		expp->nd_type = left->nd_type;
@@ -915,17 +949,13 @@ node_error(left, "illegal type in %s", std == S_MAX ? "MAX" : "MIN");
 		break;
 
 	case S_ODD:
-		if (!(left = getarg(&arg, T_INTORCARD, 0))) return 0;
+		if (!(left = getarg(&arg, T_INTORCARD, 0, edf))) return 0;
 		expp->nd_type = bool_type;
 		if (left->nd_class == Value) cstcall(expp, S_ODD);
 		break;
 
 	case S_ORD:
-		if (!(left = getarg(&arg, T_DISCRETE, 0))) return 0;
-		if (left->nd_type->tp_size > word_size) {
-			node_error(left, "illegal type in argument of ORD");
-			return 0;
-		}
+		if (!(left = getarg(&arg, T_DISCRETE, 0, edf))) return 0;
 		expp->nd_type = card_type;
 		if (left->nd_class == Value) cstcall(expp, S_ORD);
 		break;
@@ -937,12 +967,12 @@ node_error(left, "illegal type in %s", std == S_MAX ? "MAX" : "MIN");
 
 			if (!warning_given) {
 				warning_given = 1;
-	node_warning(expp, W_OLDFASHIONED, "NEW and DISPOSE are old-fashioned");
+	node_warning(expp, W_OLDFASHIONED, "NEW and DISPOSE are obsolete");
 			}
 		}
-		if (! (left = getvariable(&arg))) return 0;
+		if (! (left = getvariable(&arg, edf))) return 0;
 		if (! (left->nd_type->tp_fund == T_POINTER)) {
-			node_error(left, "pointer variable expected");
+			Xerror(left, "pointer variable expected", edf);
 			return 0;
 		}
 		if (left->nd_class == Def) {
@@ -974,23 +1004,19 @@ node_error(left, "illegal type in %s", std == S_MAX ? "MAX" : "MIN");
 	case S_TSIZE:	/* ??? */
 	case S_SIZE:
 		expp->nd_type = intorcard_type;
-		if (! getname(&arg, D_FIELD|D_VARIABLE|D_ISTYPE)) return 0;
+		if (! getname(&arg, D_FIELD|D_VARIABLE|D_ISTYPE, 0, edf)) {
+			return 0;
+		}
 		cstcall(expp, S_SIZE);
 		break;
 
 	case S_TRUNC:
 		expp->nd_type = card_type;
-		if (!(left = getarg(&arg, T_REAL, 0))) return 0;
+		if (!(left = getarg(&arg, T_REAL, 0, edf))) return 0;
 		break;
 
 	case S_VAL:
-		{
-		struct type *tp;
-
-		if (!(left = getname(&arg, D_ISTYPE))) return 0;
-		tp = left->nd_def->df_type;
-		if (!(tp->tp_fund & T_DISCRETE)) {
-			node_error(arg, "unexpected type");
+		if (!(left = getname(&arg, D_ISTYPE, T_DISCRETE, edf))) {
 			return 0;
 		}
 		expp->nd_type = left->nd_def->df_type;
@@ -998,26 +1024,25 @@ node_error(left, "illegal type in %s", std == S_MAX ? "MAX" : "MIN");
 		arg->nd_right = 0;
 		FreeNode(arg);
 		arg = expp;
-		if (!(left = getarg(&arg, T_INTORCARD, 0))) return 0;
+		if (!(left = getarg(&arg, T_INTORCARD, 0, edf))) return 0;
 		if (left->nd_class == Value) cstcall(expp, S_VAL);
 		break;
-		}
 
 	case S_ADR:
 		expp->nd_type = address_type;
-		if (!(left = getarg(&arg, 0, 1))) return 0;
+		if (!(left = getarg(&arg, 0, 1, edf))) return 0;
 		break;
 
 	case S_DEC:
 	case S_INC:
 		expp->nd_type = 0;
-		if (! (left = getvariable(&arg))) return 0;
+		if (! (left = getvariable(&arg, edf))) return 0;
 		if (! (left->nd_type->tp_fund & T_DISCRETE)) {
-node_error(left,"illegal type in argument of %s",std == S_INC ? "INC" : "DEC");
+			Xerror(left,"illegal parameter type", edf);
 			return 0;
 		}
 		if (arg->nd_right) {
-			if (! getarg(&arg, T_INTORCARD, 0)) return 0;
+			if (! getarg(&arg, T_INTORCARD, 0, edf)) return 0;
 		}
 		break;
 
@@ -1031,18 +1056,18 @@ node_error(left,"illegal type in argument of %s",std == S_INC ? "INC" : "DEC");
 		struct type *tp;
 
 		expp->nd_type = 0;
-		if (!(left = getvariable(&arg))) return 0;
+		if (!(left = getvariable(&arg, edf))) return 0;
 		tp = left->nd_type;
 		if (tp->tp_fund != T_SET) {
-node_error(arg, "%s expects a SET parameter", std == S_EXCL ? "EXCL" : "INCL");
+			Xerror(arg, "SET parameter expected", edf);
 			return 0;
 		}
-		if (!(left = getarg(&arg, T_DISCRETE, 0))) return 0;
+		if (!(left = getarg(&arg, T_DISCRETE, 0, edf))) return 0;
 		if (!TstAssCompat(ElementType(tp), left->nd_type)) {
 			/* What type of compatibility do we want here?
 			   apparently assignment compatibility! ??? ???
 			*/
-			node_error(arg, "unexpected type");
+			Xerror(arg, "unexpected parameter type", edf);
 			return 0;
 		}
 		break;
@@ -1053,7 +1078,7 @@ node_error(arg, "%s expects a SET parameter", std == S_EXCL ? "EXCL" : "INCL");
 	}
 
 	if (arg->nd_right) {
-		node_error(arg->nd_right, "too many parameters supplied");
+		Xerror(arg->nd_right, "too many parameters supplied", edf);
 		return 0;
 	}
 
@@ -1074,7 +1099,7 @@ ChkCast(expp, left)
 	register struct node *arg = expp->nd_right;
 
 	if ((! arg) || arg->nd_right) {
-node_error(expp, "only one parameter expected in type cast");
+		Xerror(expp, "too many parameters in type cast", left->nd_def);
 		return 0;
 	}
 
@@ -1084,7 +1109,7 @@ node_error(expp, "only one parameter expected in type cast");
 	if (arg->nd_type->tp_size != left->nd_type->tp_size &&
 	    (arg->nd_type->tp_size > word_size ||
 	     left->nd_type->tp_size > word_size)) {
-		node_error(expp, "unequal sizes in type cast");
+		Xerror(expp, "unequal sizes in type cast", left->nd_def);
 	}
 
 	if (arg->nd_class == Value) {
@@ -1132,8 +1157,7 @@ no_desig(expp)
 }
 
 STATIC int
-done_before(expp)
-	struct node *expp;
+done_before()
 {
 	return 1;
 }
diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index d5d419ee3..1fbea8be3 100644
--- a/lang/m2/comp/code.c
+++ b/lang/m2/comp/code.c
@@ -65,6 +65,7 @@ CodeString(nd)
 	}
 }
 
+STATIC
 CodePadString(nd, sz)
 	register struct node *nd;
 	arith sz;
@@ -96,7 +97,7 @@ CodeExpr(nd, ds, true_label, false_label)
 	if (tp->tp_fund == T_REAL) fp_used = 1;
 	switch(nd->nd_class) {
 	case Def:
-		if (nd->nd_def->df_kind == D_PROCEDURE) {
+		if (nd->nd_def->df_kind & (D_PROCEDURE|D_PROCHEAD)) {
 			C_lpi(NameOfProc(nd->nd_def));
 			ds->dsg_kind = DSG_LOADED;
 			break;
@@ -380,7 +381,7 @@ CodeParameters(param, arg)
 			}
 		}
 		else if (left->nd_symb == STRING) {
-			C_loc(left->nd_SLE - 1);
+			C_loc(left->nd_SLE);
 		}
 		else if (tp->arr_elem == word_type) {
 			C_loc((left_type->tp_size+word_size-1) / word_size - 1);
@@ -403,8 +404,10 @@ CodeParameters(param, arg)
 		if (left_type->tp_fund == T_STRING) {
 			CodePadString(left, tp->tp_size);
 		}
-		else CodePExpr(left);
-		RangeCheck(left_type, tp);
+		else {
+			CodePExpr(left);
+			RangeCheck(left_type, tp);
+		}
 	}
 }
 
@@ -413,7 +416,7 @@ CodeStd(nd)
 {
 	register struct node *arg = nd->nd_right;
 	register struct node *left = 0;
-	register struct type *tp = 0;
+	register struct type *tp;
 	int std = nd->nd_left->nd_def->df_value.df_stdname;
 
 	if (arg) {
@@ -426,15 +429,11 @@ CodeStd(nd)
 	case S_ABS:
 		CodePExpr(left);
 		if (tp->tp_fund == T_INTEGER) {
-			if (tp->tp_size == int_size) {
-				C_cal("_absi");
-			}
+			if (tp->tp_size == int_size) C_cal("_absi");
 			else	C_cal("_absl");
 		}
 		else if (tp->tp_fund == T_REAL) {
-			if (tp->tp_size == float_size) {
-				C_cal("_absf");
-			}
+			if (tp->tp_size == float_size) C_cal("_absf");
 			else	C_cal("_absd");
 		}
 		C_asp(tp->tp_size);
diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c
index aeb9bb8d1..5f743b42d 100644
--- a/lang/m2/comp/cstoper.c
+++ b/lang/m2/comp/cstoper.c
@@ -72,7 +72,7 @@ cstbin(expp)
 	*/
 	register arith o1 = expp->nd_left->nd_INT;
 	register arith o2 = expp->nd_right->nd_INT;
-	register int uns = expp->nd_type != int_type;
+	register int uns = expp->nd_left->nd_type != int_type;
 
 	assert(expp->nd_class == Oper);
 	assert(expp->nd_left->nd_class == Value);
diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index 8a277ed8c..00624af52 100644
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -50,13 +50,14 @@ ProcedureHeading(struct def **pdf; int type;)
 ;
 
 block(struct node **pnd;) :
-	declaration*
-	[		{ return_occurred = 0; }
+	[	%persistent
+		declaration
+	]*
+			{ return_occurred = 0; *pnd = 0; }
+	[	%persistent
 		BEGIN
 		StatementSequence(pnd)
-	|
-			{ *pnd = 0; }
-	]
+	]?
 	END
 ;
 
@@ -72,7 +73,7 @@ declaration:
 	ModuleDeclaration ';'
 ;
 
-FormalParameters(struct paramlist *ppr; arith *parmaddr; struct type **ptp;):
+FormalParameters(struct paramlist **ppr; arith *parmaddr; struct type **ptp;):
 	'('
 	[
 		FPSection(ppr, parmaddr)
@@ -160,10 +161,15 @@ enumeration(struct type **ptp;)
 } :
 	'(' IdentList(&EnumList) ')'
 		{
-		  *ptp = standard_type(T_ENUMERATION, 1, (arith) 1);
+		  *ptp = standard_type(T_ENUMERATION, int_align, int_size);
 		  EnterEnumList(EnumList, *ptp);
-		  if ((*ptp)->enm_ncst > 256) { /* ??? is this reasonable ??? */
-			error("too many enumeration literals");
+		  if (ufit((*ptp)->enm_ncst-1, 1)) {
+			(*ptp)->tp_size = 1;
+			(*ptp)->tp_align = 1;
+		  }
+		  else if (ufit((*ptp)->enm_ncst-1, short_size)) {
+			(*ptp)->tp_size = short_size;
+			(*ptp)->tp_align = short_align;
 		  }
 		}
 ;
@@ -263,7 +269,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 	/* Also accept old fashioned Modula-2 syntax, but give a warning.
 	   Sorry for the complicated code.
 	*/
-	[ qualident(0, (struct def **) 0, (char *) 0, &nd1)
+	[ qualident(&nd1)
 			{ nd = nd1; }
 	  [ ':' qualtype(&tp)
 			/* This is correct, in both kinds of Modula-2, if
@@ -387,7 +393,7 @@ PointerType(struct type **ptp;)
 } :
 	POINTER TO
 			{ *ptp = construct_type(T_POINTER, NULLTYPE); }
-	[ %if	( lookup(dot.TOK_IDF, CurrentScope)
+	[ %if	( lookup(dot.TOK_IDF, CurrentScope, 1)
 			/* Either a Module or a Type, but in both cases defined
 		   	   in this scope, so this is the correct identification
 			*/
@@ -422,18 +428,34 @@ PointerType(struct type **ptp;)
 
 qualtype(struct type **ptp;)
 {
-	struct def *df = 0;
+	register struct node *nd;
+	struct node *nd1;		/* because &nd is illegal */
 } :
-	qualident(D_ISTYPE, &df, "type", (struct node **) 0)
-			{ if (df && !(*ptp = df->df_type)) {
-				error("type \"%s\" not declared",
-				       df->df_idf->id_text);
-				*ptp = error_type;
-		  	  }
+	qualident(&nd1)
+		{ nd = nd1;
+		  *ptp = error_type;
+		  if (ChkDesignator(nd)) {
+			if (nd->nd_class != Def) {
+				node_error(nd, "type expected");
+			}
+			else {
+				register struct def *df = nd->nd_def;
+
+				if (df->df_kind&(D_ISTYPE|D_FORWARD|D_ERROR)) {
+				    if (! df->df_type) {
+node_error(nd,"type \"%s\" not (yet) declared", df->df_idf->id_text);
+				    }
+				    else *ptp = df->df_type;
+				}
+				else {
+node_error(nd,"identifier \"%s\" is not a type", df->df_idf->id_text);
+				}
 			}
+		  }
+		  FreeNode(nd);
+		}
 ;
 
-
 ProcedureType(struct type **ptp;)
 {
 	struct paramlist *pr = 0;
diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H
index 226395c3a..dee4b94b1 100644
--- a/lang/m2/comp/def.H
+++ b/lang/m2/comp/def.H
@@ -90,9 +90,8 @@ struct def	{		/* list of definitions for a name */
 #define is_type(dfx)	((dfx)->df_kind & D_ISTYPE)
 	char df_flags;
 #define D_NOREG		0x01	/* set if it may not reside in a register */
-#define D_USED		0x02	/* set if used */
-#define D_DEFINED	0x04	/* set if it is assigned a value */
-#define D_REFERRED	0x08	/* set if it is referred to */
+#define D_USED		0x02	/* set if used (future use ???) */
+#define D_DEFINED	0x04	/* set if it is assigned a value (future use ???) */
 #define D_VARPAR	0x10	/* set if it is a VAR parameter */
 #define D_VALPAR	0x20	/* set if it is a value parameter */
 #define D_EXPORTED	0x40	/* set if exported */
diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c
index c57f91548..36c8906a0 100644
--- a/lang/m2/comp/def.c
+++ b/lang/m2/comp/def.c
@@ -91,14 +91,14 @@ define(id, scope, kind)
 	*/
 	register struct def *df;
 
-	df = lookup(id, scope);
+	df = lookup(id, scope, 1);
 	if (	/* Already in this scope */
 		df
 	   ||	/* A closed scope, and id defined in the pervasive scope */
 		( 
 		  scopeclosed(scope)
 		&&
-		  (df = lookup(id, PervasiveScope)))
+		  (df = lookup(id, PervasiveScope, 1)))
 	   ) {
 		switch(df->df_kind) {
 		case D_HIDDEN:
@@ -234,7 +234,7 @@ DeclProc(type, id)
 	else {
 		char *name;
 
-		df = lookup(id, CurrentScope);
+		df = lookup(id, CurrentScope, 1);
 		if (df && df->df_kind == D_PROCHEAD) {
 			/* C_exp already generated when we saw the definition
 			   in the definition module
diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c
index aaf49e9df..b381d68b6 100644
--- a/lang/m2/comp/defmodule.c
+++ b/lang/m2/comp/defmodule.c
@@ -16,6 +16,7 @@
 #include	"main.h"
 #include	"node.h"
 #include	"type.h"
+#include	"misc.h"
 
 #ifdef DEBUG
 long	sys_filesize();
@@ -57,7 +58,7 @@ GetDefinitionModule(id, incr)
 	struct scopelist *vis;
 
 	level += incr;
-	df = lookup(id, GlobalScope);
+	df = lookup(id, GlobalScope, 1);
 	if (!df) {
 		/* Read definition module. Make an exception for SYSTEM.
 		*/
@@ -66,7 +67,7 @@ GetDefinitionModule(id, incr)
 		}
 		else {
 			open_scope(CLOSEDSCOPE);
-			if (GetFile(id->id_text)) {
+			if (!is_anon_idf(id) && GetFile(id->id_text)) {
 				DefModule();
 				if (level == 1) {
 					/* The module is directly imported by
@@ -90,14 +91,17 @@ GetDefinitionModule(id, incr)
 			vis = CurrVis;
 			close_scope(SC_CHKFORW);
 		}
-		df = lookup(id, GlobalScope);
+		df = lookup(id, GlobalScope, 1);
 		if (! df) {
 			df = MkDef(id, GlobalScope, D_ERROR);
 			df->df_type = error_type;
-			df->mod_vis = CurrVis;
-			return df;
+			df->mod_vis = vis;
 		}
 	}
+	else if (df == Defined) {
+		error("cannot import from currently defined module");
+		df->df_kind = D_ERROR;
+	}
 	assert(df);
 	level -= incr;
 	return df;
diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c
index b8736335c..66d7ab4ec 100644
--- a/lang/m2/comp/desig.c
+++ b/lang/m2/comp/desig.c
@@ -219,7 +219,6 @@ CodeVarDesig(df, ds)
 	*/
 	assert(ds->dsg_kind == DSG_INIT);
 
-	SetUsed(df);
 	if (df->var_addrgiven) {
 		/* the programmer specified an address in the declaration of
 		   the variable. Generate code to push the address.
@@ -293,7 +292,6 @@ CodeDesig(nd, ds)
 	case Def:
 		df = nd->nd_def;
 
-		SetUsed(df);
 		switch(df->df_kind) {
 		case D_FIELD:
 			CodeFieldDesig(df, ds);
diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c
index b5c0aa027..04a948e14 100644
--- a/lang/m2/comp/enter.c
+++ b/lang/m2/comp/enter.c
@@ -273,7 +273,7 @@ ForwDef(ids, scope)
 	*/
 	register struct def *df;
 
-	if (!(df = lookup(ids->nd_IDF, scope))) {
+	if (!(df = lookup(ids->nd_IDF, scope, 1))) {
 		df = define(ids->nd_IDF, scope, D_FORWARD);
 		df->for_node = MkLeaf(Name, &(ids->nd_token));
 	}
@@ -292,9 +292,7 @@ EnterExportList(Idlist, qualified)
 	register struct def *df, *df1;
 
 	for (;idlist; idlist = idlist->next) {
-		extern struct def *NoImportlookup();
-
-		df = NoImportlookup(idlist->nd_IDF, CurrentScope);
+		df = lookup(idlist->nd_IDF, CurrentScope, 0);
 
 		if (!df) {
 			/* undefined item in export list
@@ -332,7 +330,7 @@ EnterExportList(Idlist, qualified)
 			   scope imports it.
 			*/
 			df1 = lookup(idlist->nd_IDF,
-				     enclosing(CurrVis)->sc_scope);
+				     enclosing(CurrVis)->sc_scope, 1);
 			if (df1) {
 				/* It was already defined in the enclosing
 				   scope. There are two legal possibilities,
@@ -402,7 +400,7 @@ EnterFromImportList(Idlist, FromDef, FromId)
 
 	for (; idlist; idlist = idlist->next) {
 		if (forwflag) df = ForwDef(idlist, vis->sc_scope);
-		else if (! (df = lookup(idlist->nd_IDF, vis->sc_scope))) {
+		else if (! (df = lookup(idlist->nd_IDF, vis->sc_scope, 1))) {
 		    not_declared("identifier", idlist, " in qualifying module");
 		    df = define(idlist->nd_IDF,vis->sc_scope,D_ERROR);
 		}
@@ -434,7 +432,7 @@ EnterImportList(Idlist, local)
 	for (; idlist; idlist = idlist->next) {
 		DoImport(local ?
 				ForwDef(idlist, sc) :
-				GetDefinitionModule(idlist->nd_IDF) ,
+				GetDefinitionModule(idlist->nd_IDF, 1) ,
 			 CurrentScope);
 	}
 	FreeNode(Idlist);
diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g
index 0baa3356e..787669bda 100644
--- a/lang/m2/comp/expression.g
+++ b/lang/m2/comp/expression.g
@@ -31,39 +31,13 @@ number(struct node **p;) :
 			}
 ;
 
-qualident(int types;
-	  struct def **pdf;
-	  char *str;
-	  struct node **p;
-	 )
+qualident(struct node **p;)
 {
-	struct node *nd;
 } :
-	IDENT	{ nd = MkLeaf(Name, &dot); }
+	IDENT	{ *p = MkLeaf(Name, &dot); }
 	[
-		selector(&nd)
+		selector(p)
 	]*
-		{ if (types && ChkDesignator(nd)) {
-			if (nd->nd_class != Def) {
-				node_error(nd, "%s expected", str);
-			}
-			else {
-				register struct def *df = nd->nd_def;
-
-		  		if ( !((types|D_ERROR) & df->df_kind)) {
-				    if (df->df_kind == D_FORWARD) {
-					not_declared(str, nd, "");
-				    }
-				    else {
-node_error(nd,"identifier \"%s\" is not a %s", df->df_idf->id_text, str);
-				    }
-				}
-				if (pdf) *pdf = df;
-			}
-		  }
-		  if (!p) FreeNode(nd);
-		  else *p = nd;
-		}
 ;
 
 selector(struct node **pnd;):
@@ -167,7 +141,7 @@ factor(register struct node **p;)
 {
 	struct node *nd;
 } :
-	qualident(0, (struct def **) 0, (char *) 0, p)
+	qualident(p)
 	[
 		designator_tail(p)?
 		[
@@ -231,7 +205,7 @@ element(struct node *nd;)
 
 designator(struct node **pnd;)
 :
-	qualident(0, (struct def **) 0, (char *) 0, pnd)
+	qualident(pnd)
 	designator_tail(pnd)?
 ;
 
diff --git a/lang/m2/comp/lookup.c b/lang/m2/comp/lookup.c
index 599cf77fc..c4c297a09 100644
--- a/lang/m2/comp/lookup.c
+++ b/lang/m2/comp/lookup.c
@@ -15,7 +15,7 @@
 #include	"misc.h"
 
 struct def *
-lookup(id, scope)
+lookup(id, scope, import)
 	register struct idf *id;
 	struct scope *scope;
 {
@@ -43,7 +43,7 @@ lookup(id, scope)
 			df->next = id->id_def;
 			id->id_def = df;
 		}
-		if (df->df_kind == D_IMPORT) {
+		if (import && df->df_kind == D_IMPORT) {
 			assert(df->imp_def != 0);
 			return df->imp_def;
 		}
@@ -51,38 +51,6 @@ lookup(id, scope)
 	return df;
 }
 
-struct def *
-NoImportlookup(id, scope)
-	register struct idf *id;
-	struct scope *scope;
-{
-	/*	Look up a definition of an identifier in scope "scope".
-		Make the "def" list self-organizing.
-		Don't check if the definition is imported!
-	*/
-	register struct def *df, *df1;
-
-	/* Look in the chain of definitions of this "id" for one with scope
-	   "scope".
-	*/
-	for (df = id->id_def, df1 = 0;
-	     df && df->df_scope != scope;
-	     df1 = df, df = df->next) { /* nothing */ }
-
-	if (df) {
-		/* Found it
-		*/
-		if (df1) {
-			/* Put the definition in front
-			*/
-			df1->next = df->next;
-			df->next = id->id_def;
-			id->id_def = df;
-		}
-	}
-	return df;
-}
-
 struct def *
 lookfor(id, vis, give_error)
 	register struct node *id;
@@ -96,7 +64,7 @@ lookfor(id, vis, give_error)
 	register struct scopelist *sc = vis;
 
 	while (sc) {
-		df = lookup(id->nd_IDF, sc->sc_scope);
+		df = lookup(id->nd_IDF, sc->sc_scope, 1);
 		if (df) return df;
 		sc = nextvisible(sc);
 	}
diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c
index 782c67a53..8bdea33c4 100644
--- a/lang/m2/comp/options.c
+++ b/lang/m2/comp/options.c
@@ -10,6 +10,13 @@
 #include	"main.h"
 #include	"warning.h"
 
+#define	MINIDFSIZE	14
+
+#if MINIDFSIZE < 14
+You fouled up! MINIDFSIZE has to be at least 14 or the compiler will not
+recognize some keywords!
+#endif
+
 extern int	idfsize;
 static int	ndirs;
 int		warning_classes;
@@ -72,8 +79,14 @@ DoOption(text)
 		idfsize = txt2int(&t);
 		if (*t || idfsize <= 0)
 			fatal("malformed -M option");
-		if (idfsize > IDFSIZE)
-			fatal("maximum identifier length is %d", IDFSIZE);
+		if (idfsize > IDFSIZE) {
+			idfsize = IDFSIZE;
+			warning(W_ORDINARY,"maximum identifier length is %d", IDFSIZE);
+		}
+		if (idfsize < MINIDFSIZE) {
+			warning(W_ORDINARY, "minimum identifier length is %d", MINIDFSIZE);
+			idfsize = MINIDFSIZE;
+		}
 		}
 		break;
 
@@ -113,6 +126,10 @@ DoOption(text)
 				if (size != (arith)0) int_size = size;
 				if (align != 0) int_align = align;
 				break;
+			case 's':	/* short (subranges) */
+				if (size != 0) short_size = size;
+				if (align != 0) short_align = align;
+				break;
 			case 'l':	/* longint	*/
 				if (size != (arith)0) long_size = size;
 				if (align != 0) long_align = align;
diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g
index afaeb7220..100c55dfb 100644
--- a/lang/m2/comp/program.g
+++ b/lang/m2/comp/program.g
@@ -133,7 +133,7 @@ DefinitionModule
 			modules. Issue a warning.
 		*/
 			{ 
-node_warning(exportlist, W_ORDINARY, "export list in definition module ignored");
+node_warning(exportlist, W_OLDFASHIONED, "export list in definition module ignored");
 				FreeNode(exportlist);
 			}
 	|
@@ -183,7 +183,7 @@ definition
 
 ProgramModule
 {
-	struct def *GetDefinitionModule();
+	extern struct def *GetDefinitionModule();
 	register struct def *df;
 } :
 	MODULE
@@ -210,7 +210,9 @@ ProgramModule
 ;
 
 Module:
-				{ open_scope(CLOSEDSCOPE); }
+				{ open_scope(CLOSEDSCOPE);
+				  warning(W_ORDINARY, "Compiling a definition module");
+				}
 	DefinitionModule
 				{ close_scope(SC_CHKFORW); }
 |
diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H
index 0e612f20e..d8a345a7c 100644
--- a/lang/m2/comp/type.H
+++ b/lang/m2/comp/type.H
@@ -103,6 +103,7 @@ extern struct type
 
 extern int
 	word_align,
+	short_align,
 	int_align,
 	long_align,
 	float_align,
@@ -113,6 +114,7 @@ extern int
 extern arith
 	word_size,
 	dword_size,
+	short_size,
 	int_size,
 	long_size,
 	float_size,
@@ -149,3 +151,8 @@ struct type
 #define BaseType(tpx)		((tpx)->tp_fund == T_SUBRANGE ? (tpx)->next : \
 					(tpx))
 #define	IsConstructed(tpx)	((tpx)->tp_fund & T_CONSTRUCTED)
+
+extern long full_mask[];
+
+#define fit(n, i)	(((n) + (0x80<<(((i)-1)*8)) & ~full_mask[(i)]) == 0)
+#define ufit(n, i)	(((n) & ~full_mask[(i)]) == 0)
diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index 13fac5323..e76565805 100644
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -21,6 +21,7 @@
 
 int
 	word_align = AL_WORD,
+	short_align = AL_SHORT,
 	int_align = AL_INT,
 	long_align = AL_LONG,
 	float_align = AL_FLOAT,
@@ -32,6 +33,7 @@ arith
 	word_size = SZ_WORD,
 	dword_size = 2 * SZ_WORD,
 	int_size = SZ_INT,
+	short_size = SZ_SHORT,
 	long_size = SZ_LONG,
 	float_size = SZ_FLOAT,
 	double_size = SZ_DOUBLE,
@@ -280,6 +282,27 @@ subr_type(lb, ub)
 	res->sub_ub = ub->nd_INT;
 	res->tp_size = tp->tp_size;
 	res->tp_align = tp->tp_align;
+	if (tp == card_type) {
+		if (ufit(res->sub_ub, 1)) {
+			res->tp_size = 1;
+			res->tp_align = 1;
+		}
+		else if (ufit(res->sub_ub, 2)) {
+			res->tp_size = short_size;
+			res->tp_align = short_align;
+		}
+	}
+	else if (tp == int_type) {
+		if (fit(res->sub_lb, 1) && fit(res->sub_ub, 1)) {
+			res->tp_size = 1;
+			res->tp_align = 1;
+		}
+		else if (fit(res->sub_lb, short_size) &&
+			 fit(res->sub_ub, short_size)) {
+			res->tp_size = short_size;
+			res->tp_align = short_align;
+		}
+	}
 	return res;
 }
 
diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index 1672cf58b..5eb55204a 100644
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -636,9 +636,9 @@ DoForInit(nd, left)
 	nd->nd_class = Name;
 	nd->nd_symb = IDENT;
 
-	if (! ChkVariable(nd) ||
-	    ! WalkExpr(left->nd_left) ||
-	    ! ChkExpression(left->nd_right)) return 0;
+	if (!( ChkVariable(nd) &
+	       WalkExpr(left->nd_left) &
+	       ChkExpression(left->nd_right))) return 0;
 
 	df = nd->nd_def;
 	if (df->df_kind == D_FIELD) {
@@ -696,17 +696,17 @@ DoAssign(nd, left, right)
 	*/
 	struct desig dsl, dsr;
 
-	if (! ChkExpression(right) || ! ChkVariable(left)) return;
+	if (! (ChkExpression(right) & ChkVariable(left))) return;
 
 	if (right->nd_symb == STRING) TryToString(right, left->nd_type);
 	dsr = InitDesig;
-	CodeExpr(right, &dsr, NO_LABEL, NO_LABEL);
 
 	if (! TstAssCompat(left->nd_type, right->nd_type)) {
 		node_error(nd, "type incompatibility in assignment");
 		return;
 	}
 
+	CodeExpr(right, &dsr, NO_LABEL, NO_LABEL);
 	if (complex(right->nd_type)) {
 		CodeAddress(&dsr);
 	}