From 9291d87dabff30d13b78194645f244eacfbaf7ff Mon Sep 17 00:00:00 2001
From: ceriel <none@none>
Date: Wed, 5 Nov 1986 14:33:00 +0000
Subject: [PATCH] Several bug fixes

---
 lang/m2/comp/LLlex.c      | 93 ++++++++++++++++++++++++++++++++++++---
 lang/m2/comp/LLmessage.c  | 11 ++---
 lang/m2/comp/Makefile     | 58 ++++++++++++------------
 lang/m2/comp/Parameters   |  8 +---
 lang/m2/comp/Version.c    |  2 +-
 lang/m2/comp/casestat.C   | 15 ++++++-
 lang/m2/comp/chk_expr.c   |  3 +-
 lang/m2/comp/cstoper.c    | 10 +++--
 lang/m2/comp/debug.h      | 10 +++++
 lang/m2/comp/declar.g     | 43 +++++++++++++-----
 lang/m2/comp/defmodule.c  | 56 +++++++++++++----------
 lang/m2/comp/enter.c      | 33 +++++++++-----
 lang/m2/comp/error.c      | 35 +++++++++------
 lang/m2/comp/expression.g |  8 +++-
 lang/m2/comp/input.c      |  4 --
 lang/m2/comp/lookup.c     | 32 ++++++++++++++
 lang/m2/comp/main.c       |  6 ++-
 lang/m2/comp/misc.c       |  2 +-
 lang/m2/comp/options.c    | 39 +++++++++++++++-
 lang/m2/comp/program.g    | 40 ++++++-----------
 lang/m2/comp/scope.C      |  3 +-
 lang/m2/comp/tokenname.c  |  2 +-
 lang/m2/comp/type.c       | 26 ++++++-----
 lang/m2/comp/typequiv.c   |  3 +-
 lang/m2/comp/walk.c       |  5 ++-
 lang/m2/comp/warning.h    | 18 ++++++++
 26 files changed, 401 insertions(+), 164 deletions(-)
 create mode 100644 lang/m2/comp/debug.h
 create mode 100644 lang/m2/comp/warning.h

diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c
index 6489389cb..733ba3b37 100644
--- a/lang/m2/comp/LLlex.c
+++ b/lang/m2/comp/LLlex.c
@@ -18,6 +18,7 @@
 #include	"type.h"
 #include	"LLlex.h"
 #include	"const.h"
+#include	"warning.h"
 
 long str2long();
 
@@ -29,6 +30,8 @@ int		 idfsize = IDFSIZE;
 extern int	cntlines;
 #endif
 
+static int	eofseen;
+
 STATIC
 SkipComment()
 {
@@ -104,6 +107,81 @@ GetString(upto)
 	return str;
 }
 
+static char *s_error = "illegal line directive";
+
+STATIC int
+getch()
+{
+	register int ch;
+
+	for (;;) {
+		LoadChar(ch);
+		if ((ch & 0200) && ch != EOI) {
+			error("non-ascii '\\%03o' read", ch & 0377);
+			continue;
+		}
+		break;
+	}
+	if (ch == EOI) {
+		eofseen = 1;
+		return '\n';
+	}
+	return ch;
+}
+
+STATIC
+linedirective() {
+	/*	Read a line directive
+	*/
+	register int	ch;
+	register int	i = 0;
+	char		buf[IDFSIZE + 2];
+	register char	*c = buf;
+
+	do {	/*
+		 * Skip to next digit
+		 * Do not skip newlines
+		 */
+		ch = getch();
+		if (class(ch) == STNL) {
+			LineNumber++;
+			error(s_error);
+			return;
+		}
+	} while (class(ch) != STNUM);
+	do  {
+		i = i*10 + (ch - '0');
+		ch = getch();
+	} while (class(ch) == STNUM);
+	while (ch != '"' && class(ch) != STNL) ch = getch();
+	if (ch == '"') {
+		c = buf;
+		do {
+			*c++ = ch = getch();
+			if (class(ch) == STNL) {
+				LineNumber++;
+				error(s_error);
+				return;
+			}
+		} while (ch != '"');
+		*--c = '\0';
+		do {
+			ch = getch();
+		} while (class(ch) != STNL);
+		/*
+		 * Remember the file name
+		 */
+		if (!eofseen && strcmp(FileName,buf)) {
+			FileName = Salloc(buf,strlen(buf) + 1);
+		}
+	}
+	if (eofseen) {
+		error(s_error);
+		return;
+	}
+	LineNumber = i;
+}
+
 int
 LLlex()
 {
@@ -113,7 +191,6 @@ LLlex()
 	register struct token *tk = &dot;
 	char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 2];
 	register int ch, nch;
-	static int eofseen;
 
 	toktype = error_type;
 
@@ -125,6 +202,7 @@ LLlex()
 
 	tk->tk_lineno = LineNumber;
 
+again2:
 	if (eofseen) {
 		eofseen = 0;
 		ch = EOI;
@@ -132,8 +210,10 @@ LLlex()
 	else {
 again:
 		LoadChar(ch);
+again1:
 		if ((ch & 0200) && ch != EOI) {
-			fatal("non-ascii '\\%03o' read", ch & 0377);
+			error("non-ascii '\\%03o' read", ch & 0377);
+			goto again;
 		}
 	}
 
@@ -145,7 +225,10 @@ again:
 		cntlines++;
 #endif
 		tk->tk_lineno++;
-		/* Fall Through */
+		LoadChar(ch);
+		if (ch != '#') goto again1;
+		linedirective();
+		goto again2;
 
 	case STSKIP:
 		goto again;
@@ -192,7 +275,7 @@ again:
 				return tk->tk_symb = LESSEQUAL;
 			}
 			if (nch == '>') {
-				lexwarning("'<>' is old-fashioned; use '#'");
+				lexwarning(W_STRICT, "'<>' is old-fashioned; use '#'");
 				return tk->tk_symb = '#';
 			}
 			break;
@@ -331,7 +414,7 @@ again:
 				if (ch == 'C' && base == 8) {
 					toktype = char_type;
 					if (tk->TOK_INT<0 || tk->TOK_INT>255) {
-lexwarning("Character constant out of range");
+lexwarning(W_ORDINARY, "character constant out of range");
 					}
 				}
 				else if (tk->TOK_INT>=0 &&
diff --git a/lang/m2/comp/LLmessage.c b/lang/m2/comp/LLmessage.c
index ead8f103a..7de4385aa 100644
--- a/lang/m2/comp/LLmessage.c
+++ b/lang/m2/comp/LLmessage.c
@@ -21,15 +21,16 @@ extern int		err_occurred;
 LLmessage(tk)
 	int tk;
 {
-	if (tk)	{
-		/* if (tk != 0), it represents the token to be inserted.
-		   otherwize, the current token is deleted
+	if (tk > 0)	{
+		/* if (tk > 0), it represents the token to be inserted.
 		*/
 		error("%s missing", symbol2str(tk));
 		insert_token(tk);
 	}
-	else
-		error("%s deleted", symbol2str(dot.tk_symb));
+	else if (tk  < 0) {
+		error("garbage at end of program");
+	}
+	else	error("%s deleted", symbol2str(dot.tk_symb));
 }
 
 insert_token(tk)
diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index 3e4ad43f8..f9746fd19 100644
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -3,6 +3,7 @@ EMDIR =		../../..
 MHDIR =		$(EMDIR)/modules/h
 PKGDIR =	$(EMDIR)/modules/pkg
 LIBDIR =	$(EMDIR)/modules/lib
+OBJECTCODE =	$(LIBDIR)/libemk.a
 LLGEN =		$(EMDIR)/bin/LLgen
 
 INCLUDES = -I$(MHDIR) -I$(EMDIR)/h -I$(PKGDIR)
@@ -13,6 +14,7 @@ LLGENOPTIONS =
 PROFILE =
 CFLAGS = $(PROFILE) $(INCLUDES) -DSTATIC=
 LINTFLAGS = -DSTATIC= -DNORCSID
+MALLOC = $(LIBDIR)/dickmalloc.o
 LFLAGS = $(PROFILE)
 LSRC =	tokenfile.c program.c declar.c expression.c statement.c
 LOBJ =	tokenfile.o program.o declar.o expression.o statement.o
@@ -35,13 +37,13 @@ GENCFILES=	tokenfile.c \
 	symbol2str.c char.c Lpars.c casestat.c tmpvar.c scope.c
 GENGFILES=	tokenfile.g
 GENHFILES=	errout.h\
-	idfsize.h numsize.h strsize.h target_sizes.h debug.h\
+	idfsize.h numsize.h strsize.h target_sizes.h \
 	inputtype.h maxset.h ndir.h density.h\
-	def.h type.h Lpars.h node.h
+	def.h debugcst.h type.h Lpars.h node.h
 HFILES=		LLlex.h\
-	chk_expr.h class.h const.h desig.h f_info.h idf.h\
+	chk_expr.h class.h const.h debug.h desig.h f_info.h idf.h\
 	input.h main.h misc.h scope.h standards.h tokenname.h\
-	walk.h $(GENHFILES)
+	walk.h warning.h $(GENHFILES)
 #
 GENFILES = $(GENGFILES) $(GENCFILES) $(GENHFILES)
 
@@ -67,7 +69,7 @@ clashes:	$(SRC) $(HFILES)
 
 # entry points not to be used directly
 
-Cfiles:	hfiles LLfiles $(GENCFILES) $(GENHFILES)
+Cfiles:	hfiles LLfiles $(GENCFILES) $(GENHFILES) Makefile
 	echo $(SRC) $(HFILES) > Cfiles
 
 LLfiles:	$(GFILES)
@@ -122,39 +124,39 @@ Xlint:
 	lint $(INCLUDES) $(LINTFLAGS) $(SRC)
 
 ../comp/main:	$(OBJ) ../comp/Makefile
-	$(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libem_mes.a $(LIBDIR)/libemk.a $(LIBDIR)/input.a $(LIBDIR)/assert.a $(LIBDIR)/alloc.a $(LIBDIR)/malloc.o $(LIBDIR)/libprint.a $(LIBDIR)/libstr.a $(LIBDIR)/libsystem.a -o ../comp/main
+	$(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libem_mes.a $(OBJECTCODE) $(LIBDIR)/libinput.a $(LIBDIR)/libassert.a $(LIBDIR)/liballoc.a $(MALLOC) $(LIBDIR)/libprint.a $(LIBDIR)/libstring.a $(LIBDIR)/libsystem.a -o ../comp/main
 	size ../comp/main
 
 #AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
-LLlex.o: LLlex.h Lpars.h class.h const.h debug.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h
+LLlex.o: LLlex.h Lpars.h class.h const.h debug.h debugcst.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h warning.h
 LLmessage.o: LLlex.h Lpars.h idf.h
 char.o: class.h
-error.o: LLlex.h debug.h errout.h f_info.h input.h inputtype.h main.h node.h
-main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h inputtype.h ndir.h node.h scope.h standards.h tokenname.h type.h
+error.o: LLlex.h debug.h debugcst.h errout.h f_info.h input.h inputtype.h main.h node.h warning.h
+main.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h input.h inputtype.h ndir.h node.h scope.h standards.h tokenname.h type.h warning.h
 symbol2str.o: Lpars.h
 tokenname.o: Lpars.h idf.h tokenname.h
 idf.o: idf.h
 input.o: def.h f_info.h idf.h input.h inputtype.h scope.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
+type.o: LLlex.h const.h debug.h debugcst.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 debugcst.h def.h idf.h main.h node.h scope.h type.h
+scope.o: LLlex.h debug.h debugcst.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 Lpars.h debug.h def.h f_info.h idf.h input.h inputtype.h main.h node.h scope.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 misc.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 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 walk.h
-tmpvar.o: debug.h def.h main.h scope.h type.h
-lookup.o: LLlex.h debug.h def.h idf.h misc.h node.h scope.h type.h
+enter.o: LLlex.h debug.h debugcst.h def.h idf.h main.h node.h scope.h type.h
+defmodule.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h input.h inputtype.h main.h node.h scope.h type.h
+typequiv.o: LLlex.h debug.h debugcst.h def.h node.h type.h warning.h
+node.o: LLlex.h debug.h debugcst.h def.h node.h type.h
+cstoper.o: LLlex.h Lpars.h debug.h debugcst.h idf.h node.h standards.h target_sizes.h type.h warning.h
+chk_expr.o: LLlex.h Lpars.h chk_expr.h const.h debug.h debugcst.h def.h idf.h misc.h node.h scope.h standards.h type.h warning.h
+options.o: idfsize.h main.h ndir.h type.h warning.h
+walk.o: LLlex.h Lpars.h chk_expr.h debug.h debugcst.h def.h desig.h f_info.h idf.h main.h node.h scope.h type.h walk.h warning.h
+casestat.o: LLlex.h Lpars.h debug.h debugcst.h density.h desig.h node.h type.h walk.h
+desig.o: LLlex.h debug.h debugcst.h def.h desig.h node.h scope.h type.h
+code.o: LLlex.h Lpars.h debug.h debugcst.h def.h desig.h node.h scope.h standards.h type.h walk.h
+tmpvar.o: debug.h debugcst.h def.h main.h scope.h type.h
+lookup.o: LLlex.h debug.h debugcst.h def.h idf.h misc.h node.h scope.h type.h
 tokenfile.o: Lpars.h
-program.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h main.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
+program.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h main.h node.h scope.h type.h warning.h
+declar.o: LLlex.h Lpars.h chk_expr.h debug.h debugcst.h def.h idf.h main.h misc.h node.h scope.h type.h warning.h
+expression.o: LLlex.h Lpars.h chk_expr.h const.h debug.h debugcst.h def.h idf.h node.h type.h warning.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 0fe8880a4..9aa80fbe2 100644
--- a/lang/m2/comp/Parameters
+++ b/lang/m2/comp/Parameters
@@ -45,14 +45,8 @@
 #define AL_UNION	1
 
 
-!File: debug.h
+!File: debugcst.h
 #define DEBUG		1	/* perform various self-tests		*/
-extern char options[];
-#ifdef DEBUG
-#define DO_DEBUG(y, x)	((y) && (x))
-#else
-#define DO_DEBUG(y, x)
-#endif DEBUG
 
 !File: inputtype.h
 #define INP_READ_IN_ONE	1	/* read input file in one	*/
diff --git a/lang/m2/comp/Version.c b/lang/m2/comp/Version.c
index 0be24d41f..44e57907d 100644
--- a/lang/m2/comp/Version.c
+++ b/lang/m2/comp/Version.c
@@ -1 +1 @@
-char Version[] = "Version 0.6";
+char Version[] = "Version 0.7";
diff --git a/lang/m2/comp/casestat.C b/lang/m2/comp/casestat.C
index 8216036fb..63913e73e 100644
--- a/lang/m2/comp/casestat.C
+++ b/lang/m2/comp/casestat.C
@@ -69,6 +69,7 @@ CaseCode(nd, exitlabel)
 	register struct case_entry *ce;
 	register arith val;
 	label CaseDescrLab;
+	int casecnt = 0;
 
 	assert(pnode->nd_class == Stat && pnode->nd_symb == CASE);
 
@@ -85,6 +86,7 @@ CaseCode(nd, exitlabel)
 				/* non-empty case
 				*/
 				pnode->nd_lab = ++text_label;
+				casecnt++;
 				if (! AddCases(sh, /* to descriptor */
 					       pnode->nd_left->nd_left,
 						   /* of case labels */
@@ -105,6 +107,17 @@ CaseCode(nd, exitlabel)
 		}
 	}
 
+	if (!casecnt) {
+		/* There were no cases, so we have to check the case-expression
+		   here
+		*/
+		if (! (sh->sh_type->tp_fund & T_DISCRETE)) {
+			node_error(nd, "illegal type in CASE-expression");
+			FreeSh(sh);
+			return;
+		}
+	}
+
 	/* Now generate code for the switch itself
 	   First the part that CSA and CSB descriptions have in common.
 	*/
@@ -232,7 +245,7 @@ AddOneCase(sh, node, lbl)
 	ce->ce_label = lbl;
 	ce->ce_value = node->nd_INT;
 	if (! TstCompat(sh->sh_type, node->nd_type)) {
-		node_error(node, "Type incompatibility in case");
+		node_error(node, "type incompatibility in case");
 		free_case_entry(ce);
 		return 0;
 	}
diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index 40a2064a3..c01ae1a5d 100644
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -21,6 +21,7 @@
 #include	"standards.h"
 #include	"chk_expr.h"
 #include	"misc.h"
+#include	"warning.h"
 
 extern char *symbol2str();
 
@@ -936,7 +937,7 @@ node_error(left, "illegal type in %s", std == S_MAX ? "MAX" : "MIN");
 
 			if (!warning_given) {
 				warning_given = 1;
-				node_warning(expp, "NEW and DISPOSE are old-fashioned");
+	node_warning(expp, W_OLDFASHIONED, "NEW and DISPOSE are old-fashioned");
 			}
 		}
 		if (! (left = getvariable(&arg))) return 0;
diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c
index 9e5135c7e..aeb9bb8d1 100644
--- a/lang/m2/comp/cstoper.c
+++ b/lang/m2/comp/cstoper.c
@@ -13,6 +13,7 @@
 #include	"node.h"
 #include	"Lpars.h"
 #include	"standards.h"
+#include	"warning.h"
 
 long mach_long_sign;	/* sign bit of the machine long */
 int mach_long_size;	/* size of long on this machine == sizeof(long) */
@@ -22,6 +23,8 @@ arith max_unsigned;	/* maximum unsigned on target machine	*/
 arith max_longint;	/* maximum longint on target machine	*/
 arith wrd_bits;		/* number of bits in a word */
 
+static char ovflow[] = "overflow in constant expression";
+
 cstunary(expp)
 	register struct node *expp;
 {
@@ -485,7 +488,7 @@ cstcall(expp, call)
 		      || expp->nd_INT >= expp->nd_type->enm_ncst
 		      )
 		    )
-		   )	node_warning(expp,"overflow in constant expression");
+		   )	node_warning(expp, W_ORDINARY, ovflow);
 		else CutSize(expp);
 		break;
 
@@ -512,8 +515,7 @@ CutSize(expr)
 	uns = (tp->tp_fund & (T_CARDINAL|T_CHAR));
 	if (uns) {
 		if (o1 & ~full_mask[size]) {
-			node_warning(expr,
-				"overflow in constant expression");
+			node_warning(expr, W_ORDINARY, ovflow);
 			o1 &= full_mask[size];
 		}
 	}
@@ -522,7 +524,7 @@ CutSize(expr)
 		long remainder = o1 & ~full_mask[size];
 
 		if (remainder != 0 && remainder != ~full_mask[size]) {
-			node_warning(expr, "overflow in constant expression");
+			node_warning(expr, W_ORDINARY, ovflow);
 			o1 <<= nbits;
 			o1 >>= nbits;
 		}
diff --git a/lang/m2/comp/debug.h b/lang/m2/comp/debug.h
new file mode 100644
index 000000000..670c29d18
--- /dev/null
+++ b/lang/m2/comp/debug.h
@@ -0,0 +1,10 @@
+/* A debugging macro
+*/
+
+#include "debugcst.h"
+
+#ifdef DEBUG
+#define DO_DEBUG(x, y)	((x) && (y))
+#else
+#define DO_DEBUG(x, y)
+#endif
diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index 7bca82d62..8a277ed8c 100644
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -17,6 +17,7 @@
 #include	"misc.h"
 #include	"main.h"
 #include	"chk_expr.h"
+#include	"warning.h"
 
 int		proclevel = 0;		/* nesting level of procedures */
 int		return_occurred;	/* set if a return occurs in a block */
@@ -162,7 +163,7 @@ enumeration(struct type **ptp;)
 		  *ptp = standard_type(T_ENUMERATION, 1, (arith) 1);
 		  EnterEnumList(EnumList, *ptp);
 		  if ((*ptp)->enm_ncst > 256) { /* ??? is this reasonable ??? */
-			error("Too many enumeration literals");
+			error("too many enumeration literals");
 		  }
 		}
 ;
@@ -277,7 +278,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 	  |		/* Old fashioned! the first qualident now represents
 			   the type
 			*/
-			{ warning("Old fashioned Modula-2 syntax; ':' missing");
+			{ warning(W_OLDFASHIONED, "old fashioned Modula-2 syntax; ':' missing");
 			  if (ChkDesignator(nd) &&
 			      (nd->nd_class != Def ||
 			       !(nd->nd_def->df_kind&(D_ERROR|D_ISTYPE)) ||
@@ -297,7 +298,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 								 scope,
 								 D_FIELD);
 			  	if (!(tp->tp_fund & T_DISCRETE)) {
-					error("Illegal type in variant");
+					error("illegal type in variant");
 			  	}
 			  	df->df_type = tp;
 			  	df->fld_off = align(*cnt, tp->tp_align);
@@ -386,18 +387,36 @@ PointerType(struct type **ptp;)
 } :
 	POINTER TO
 			{ *ptp = construct_type(T_POINTER, NULLTYPE); }
-	[ %if ( lookup(dot.TOK_IDF, CurrentScope))
-		/* Either a Module or a Type, but in both cases defined
-		   in this scope, so this is the correct identification
-		*/
-	  qualtype(&((*ptp)->next))
-	| %if ( nd = new_node(),
-		nd->nd_token = dot,
-		lookfor(nd, CurrVis, 0)->df_kind == D_MODULE)
+	[ %if	( lookup(dot.TOK_IDF, CurrentScope)
+			/* Either a Module or a Type, but in both cases defined
+		   	   in this scope, so this is the correct identification
+			*/
+		||
+		  ( nd = new_node(),
+		    nd->nd_token = dot,
+		    lookfor(nd, CurrVis, 0)->df_kind == D_MODULE
+		  )
+			/* A Modulename in one of the enclosing scopes.
+			   It is not clear from the language definition that
+			   it is correct to handle these like this, but
+			   existing compilers do it like this, and the
+			   alternative is difficult with a lookahead of only
+			   one token.
+			   ???
+			*/
+		)
 	  type(&((*ptp)->next)) 
 			{ if (nd) free_node(nd); }
 	|
-	  IDENT		{ Forward(nd, (*ptp)); }
+	  IDENT		{ if (nd) {
+				/* nd could be a null pointer, if we had a
+				   syntax error exactly at this alternation.
+				   MORAL: Be careful with %if resolvers with
+				   side effects!
+				*/
+				Forward(nd, (*ptp));
+			  }
+			}
 	]
 ;
 
diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c
index 3ba1f6d8f..aaf49e9df 100644
--- a/lang/m2/comp/defmodule.c
+++ b/lang/m2/comp/defmodule.c
@@ -15,13 +15,13 @@
 #include	"f_info.h"
 #include	"main.h"
 #include	"node.h"
+#include	"type.h"
 
 #ifdef DEBUG
 long	sys_filesize();
 #endif
 
-struct idf *	CurrentId;
-
+STATIC
 GetFile(name)
 	char *name;
 {
@@ -35,10 +35,12 @@ GetFile(name)
 	buf[10] = '\0';			/* maximum length */
 	strcat(buf, ".def");
 	if (! InsertFile(buf, DEFPATH, &(FileName))) {
-		fatal("Could'nt find a DEFINITION MODULE for \"%s\"", name);
+		error("could'nt find a DEFINITION MODULE for \"%s\"", name);
+		return 0;
 	}
 	LineNumber = 1;
 	DO_DEBUG(options['F'], debug("File %s : %ld characters", FileName, sys_filesize(FileName)));
+	return 1;
 }
 
 struct def *
@@ -52,6 +54,7 @@ GetDefinitionModule(id, incr)
 	*/
 	struct def *df;
 	static int level;
+	struct scopelist *vis;
 
 	level += incr;
 	df = lookup(id, GlobalScope);
@@ -62,33 +65,40 @@ GetDefinitionModule(id, incr)
 			do_SYSTEM();
 		}
 		else {
-			GetFile(id->id_text);
-			CurrentId = id;
 			open_scope(CLOSEDSCOPE);
-			DefModule();
-			if (level == 1) {
-				/* The module is directly imported by the
-				   currently defined module, so we have to
-				   remember its name because we have to call
-				   its initialization routine
-				*/
-				static struct node *nd_end; /* end of list */
-				register struct node *n;
-				extern struct node *Modules;
+			if (GetFile(id->id_text)) {
+				DefModule();
+				if (level == 1) {
+					/* The module is directly imported by
+					   the currently defined module, so we
+					   have to remember its name because
+					   we have to call its initialization
+					   routine
+					*/
+					static struct node *nd_end;
+					register struct node *n;
+					extern struct node *Modules;
 
-				n = MkLeaf(Name, &dot);
-				n->nd_IDF = id;
-				n->nd_symb = IDENT;
-				if (nd_end) nd_end->next = n;
-				else Modules = n;
-				nd_end = n;
+					n = MkLeaf(Name, &dot);
+					n->nd_IDF = id;
+					n->nd_symb = IDENT;
+					if (nd_end) nd_end->next = n;
+					else Modules = n;
+					nd_end = n;
+				}
 			}
+			vis = CurrVis;
 			close_scope(SC_CHKFORW);
 		}
 		df = lookup(id, GlobalScope);
+		if (! df) {
+			df = MkDef(id, GlobalScope, D_ERROR);
+			df->df_type = error_type;
+			df->mod_vis = CurrVis;
+			return df;
+		}
 	}
-	CurrentId = 0;
-	assert(df && df->df_kind == D_MODULE);
+	assert(df);
 	level -= incr;
 	return df;
 }
diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c
index fb87c58ce..b5c0aa027 100644
--- a/lang/m2/comp/enter.c
+++ b/lang/m2/comp/enter.c
@@ -116,7 +116,7 @@ EnterVarList(Idlist, type, local)
 			df->df_flags |= D_NOREG;
 			if (idlist->nd_left->nd_type != card_type) {
 				node_error(idlist->nd_left,
-					   "Illegal type for address");
+					   "illegal type for address");
 			}
 			df->var_off = idlist->nd_left->nd_INT;
 		}
@@ -235,17 +235,20 @@ DoImport(df, scope)
 }
 
 STATIC struct scopelist *
-ForwModule(df, idn)
+ForwModule(df, nd)
 	register struct def *df;
-	struct node *idn;
+	struct node *nd;
 {
-	/*	An import is done from a not yet defined module "idn".
+	/*	An import is done from a not yet defined module "df".
+		We could also end up here for not found DEFINITION MODULES.
 		Create a declaration and a scope for this module.
 	*/
 	struct scopelist *vis;
 
-	df->df_scope = enclosing(CurrVis)->sc_scope;
-	df->df_kind = D_FORWMODULE;
+	if (df->df_scope != GlobalScope) {
+		df->df_scope = enclosing(CurrVis)->sc_scope;
+		df->df_kind = D_FORWMODULE;
+	}
 	open_scope(CLOSEDSCOPE);
 	vis = CurrVis;		/* The new scope, but watch out, it's "sc_encl"
 				   field is not set right. It must indicate the
@@ -256,7 +259,7 @@ ForwModule(df, idn)
 	vis->sc_encl = enclosing(CurrVis);
 				/* Here ! */
 	df->for_vis = vis;
-	df->for_node = MkLeaf(Name, &(idn->nd_token));
+	df->for_node = nd;
 	return vis;
 }
 
@@ -289,7 +292,9 @@ EnterExportList(Idlist, qualified)
 	register struct def *df, *df1;
 
 	for (;idlist; idlist = idlist->next) {
-		df = lookup(idlist->nd_IDF, CurrentScope);
+		extern struct def *NoImportlookup();
+
+		df = NoImportlookup(idlist->nd_IDF, CurrentScope);
 
 		if (!df) {
 			/* undefined item in export list
@@ -306,6 +311,8 @@ EnterExportList(Idlist, qualified)
 				idlist->nd_IDF->id_text);
 		}
 
+		if (df->df_kind == D_IMPORT) df = df->imp_def;
+
 		df->df_flags |= qualified;
 		if (qualified == D_EXPORTED) {
 			/* Export, but not qualified.
@@ -357,9 +364,10 @@ EnterExportList(Idlist, qualified)
 	FreeNode(Idlist);
 }
 
-EnterFromImportList(Idlist, FromDef)
+EnterFromImportList(Idlist, FromDef, FromId)
 	struct node *Idlist;
 	register struct def *FromDef;
+	struct node *FromId;
 {
 	/*	Import the list Idlist from the module indicated by Fromdef.
 	*/
@@ -373,9 +381,11 @@ EnterFromImportList(Idlist, FromDef)
 		/* The module from which the import was done
 		   is not yet declared. I'm not sure if I must
 		   accept this, but for the time being I will.
+		   We also end up here if some definition module could not
+		   be found.
 		   ???
 		*/
-		vis = ForwModule(FromDef, FromDef->df_idf);
+		vis = ForwModule(FromDef, FromId);
 		forwflag = 1;
 		break;
 	case D_FORWMODULE:
@@ -385,7 +395,7 @@ EnterFromImportList(Idlist, FromDef)
 		vis = FromDef->mod_vis;
 		break;
 	default:
-		error("identifier \"%s\" does not represent a module",
+		node_error(FromId, "identifier \"%s\" does not represent a module",
 		       FromDef->df_idf->id_text);
 		break;
 	}
@@ -405,6 +415,7 @@ EnterFromImportList(Idlist, FromDef)
 		DoImport(df, CurrentScope);
 	}
 
+	if (!forwflag) FreeNode(FromId);
 	FreeNode(Idlist);
 }
 
diff --git a/lang/m2/comp/error.c b/lang/m2/comp/error.c
index cde6d7c39..468abbe04 100644
--- a/lang/m2/comp/error.c
+++ b/lang/m2/comp/error.c
@@ -17,6 +17,7 @@
 #include	"LLlex.h"
 #include	"main.h"
 #include	"node.h"
+#include	"warning.h"
 
 /* error classes */
 #define	ERROR		1
@@ -30,6 +31,7 @@
 #endif
 
 int err_occurred;
+static int warn_class;
 
 extern char *symbol2str();
 
@@ -69,18 +71,20 @@ node_error(node, fmt, args)
 }
 
 /*VARARGS1*/
-warning(fmt, args)
+warning(class, fmt, args)
 	char *fmt;
 {
-	_error(WARNING, NULLNODE, fmt, &args);
+	warn_class = class;
+	if (class & warning_classes) _error(WARNING, NULLNODE, fmt, &args);
 }
 
 /*VARARGS2*/
-node_warning(node, fmt, args)
+node_warning(node, class, fmt, args)
 	struct node *node;
 	char *fmt;
 {
-	_error(WARNING, node, fmt, &args);
+	warn_class = class;
+	if (class & warning_classes) _error(WARNING, node, fmt, &args);
 }
 
 /*VARARGS1*/
@@ -91,10 +95,11 @@ lexerror(fmt, args)
 }
 
 /*VARARGS1*/
-lexwarning(fmt, args) 
+lexwarning(class, fmt, args) 
 	char *fmt;
 {
-	_error(LEXWARNING, NULLNODE, fmt, &args);
+	warn_class = class;
+	if (class & warning_classes) _error(LEXWARNING, NULLNODE, fmt, &args);
 }
 
 /*VARARGS1*/
@@ -149,19 +154,23 @@ _error(class, node, fmt, argv)
 		if (C_busy()) C_ms_err();
 		err_occurred = 1;
 		break;
-	
-	case WARNING:
-	case LEXWARNING:
-		if (options['w'])
-			return;
-		break;
 	}
 
 	/* the remark */
 	switch (class)	{	
 	case WARNING:
 	case LEXWARNING:
-		remark = "(warning)";
+		switch(warn_class) {
+		case W_OLDFASHIONED:
+			remark = "(old-fashioned use)";
+			break;
+		case W_STRICT:
+			remark = "(strict)";
+			break;
+		default:
+			remark = "(warning)";
+			break;
+		}
 		break;
 	case CRASH:
 		remark = "CRASH\007";
diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g
index 5edf0c854..0baa3356e 100644
--- a/lang/m2/comp/expression.g
+++ b/lang/m2/comp/expression.g
@@ -15,6 +15,9 @@
 #include	"const.h"
 #include	"type.h"
 #include	"chk_expr.h"
+#include	"warning.h"
+
+extern char	options[];
 }
 
 number(struct node **p;) :
@@ -93,7 +96,7 @@ ConstExpression(struct node **pnd;):
 		  DO_DEBUG(options['X'], PrNode(*pnd, 0));
 		  if (ChkExpression(*pnd) &&
 		      ((*pnd)->nd_class != Set && (*pnd)->nd_class != Value)) {
-			error("Constant expression expected");
+			error("constant expression expected");
 		  }
 		  DO_DEBUG(options['X'], print("RESULTS IN\n"));
 		  DO_DEBUG(options['X'], PrNode(*pnd, 0));
@@ -234,7 +237,8 @@ designator(struct node **pnd;)
 
 designator_tail(struct node **pnd;):
 	visible_designator_tail(pnd)
-	[
+	[ %persistent
+		%default
 		selector(pnd)
 	|
 		visible_designator_tail(pnd)
diff --git a/lang/m2/comp/input.c b/lang/m2/comp/input.c
index acf29915a..48f0525a1 100644
--- a/lang/m2/comp/input.c
+++ b/lang/m2/comp/input.c
@@ -10,16 +10,12 @@ struct f_info	file_info;
 #include	"scope.h"
 #include	<inp_pkg.body>
 
-extern struct idf *CurrentId;
 
 AtEoIF()
 {
 	/*	Make the unstacking of input streams noticable to the
 	   	lexical analyzer
 	*/
-	if (CurrentId && ! lookup(CurrentId, GlobalScope)) {
-fatal("No definition module read for \"%s\"", CurrentId->id_text);
-	}
 	return 1;
 }
 
diff --git a/lang/m2/comp/lookup.c b/lang/m2/comp/lookup.c
index 6143502c0..599cf77fc 100644
--- a/lang/m2/comp/lookup.c
+++ b/lang/m2/comp/lookup.c
@@ -51,6 +51,38 @@ 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;
diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c
index 2ac8c2e58..9468c4665 100644
--- a/lang/m2/comp/main.c
+++ b/lang/m2/comp/main.c
@@ -18,6 +18,7 @@
 #include	"standards.h"
 #include	"tokenname.h"
 #include	"node.h"
+#include	"warning.h"
 
 int		state;			/* either IMPLEMENTATION or PROGRAM */
 char		options[128];
@@ -35,6 +36,7 @@ main(argc, argv)
 	register char **Nargv = &argv[0];
 
 	ProgName = *argv++;
+	warning_classes = W_INITIAL;
 
 	while (--argc > 0) {
 		if (**argv == '-')
@@ -78,7 +80,7 @@ Compile(src, dst)
 	open_scope(CLOSEDSCOPE);
 	GlobalScope = CurrentScope;
 	C_init(word_size, pointer_size);
-	if (! C_open(dst)) fatal("Could not open output file");
+	if (! C_open(dst)) fatal("could not open output file");
 	C_magic();
 	C_ms_emx(word_size, pointer_size);
 	CompUnit();
@@ -199,7 +201,7 @@ do_SYSTEM()
 	(void) Enter("ADR", D_PROCEDURE, std_type, S_ADR);
 	(void) Enter("TSIZE", D_PROCEDURE, std_type, S_TSIZE);
 	if (!InsertText(SYSTEM, sizeof(SYSTEM) - 1)) {
-		fatal("Could not insert text");
+		fatal("could not insert text");
 	}
 	DefModule();
 	close_scope(SC_CHKFORW);
diff --git a/lang/m2/comp/misc.c b/lang/m2/comp/misc.c
index d945e553b..dc589d6f7 100644
--- a/lang/m2/comp/misc.c
+++ b/lang/m2/comp/misc.c
@@ -18,7 +18,7 @@ match_id(id1, id2)
 		first place, and if not, give an error message
 	*/
 	if (id1 != id2 && !is_anon_idf(id1) && !is_anon_idf(id2)) {
-		error("Name \"%s\" does not match block name \"%s\"",
+		error("name \"%s\" does not match block name \"%s\"",
 		      id1->id_text,
 		      id2->id_text
 		);
diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c
index c66341bda..782c67a53 100644
--- a/lang/m2/comp/options.c
+++ b/lang/m2/comp/options.c
@@ -8,9 +8,11 @@
 
 #include	"type.h"
 #include	"main.h"
+#include	"warning.h"
 
 extern int	idfsize;
 static int	ndirs;
+int		warning_classes;
 
 DoOption(text)
 	register char *text;
@@ -29,6 +31,41 @@ DoOption(text)
 					*/
 
 
+	case 'w':
+		if (*text) {
+			while (*text) {
+				switch(*text++) {
+				case 'O':
+					warning_classes &= ~W_OLDFASHIONED;
+					break;
+				case 'R':
+					warning_classes &= ~W_STRICT;
+					break;
+				case 'W':
+					warning_classes &= ~W_ORDINARY;
+					break;
+				}
+			}
+		}
+		else warning_classes = 0;
+		break;
+
+	case 'W':
+		while (*text) {
+			switch(*text++) {
+			case 'O':
+				warning_classes |= W_OLDFASHIONED;
+				break;
+			case 'R':
+				warning_classes |= W_STRICT;
+				break;
+			case 'W':
+				warning_classes |= W_ORDINARY;
+				break;
+			}
+		}
+		break;
+
 	case 'M': {	/* maximum identifier length */
 		char *t = text;		/* because &text is illegal */
 
@@ -42,7 +79,7 @@ DoOption(text)
 
 	case 'I' :
 		if (++ndirs >= NDIRS) {
-			fatal("Too many -I options");
+			fatal("too many -I options");
 		}
 		DEFPATH[ndirs] = text;
 		break;
diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g
index b6a1d27ee..afaeb7220 100644
--- a/lang/m2/comp/program.g
+++ b/lang/m2/comp/program.g
@@ -15,6 +15,7 @@
 #include	"type.h"
 #include	"node.h"
 #include	"f_info.h"
+#include	"warning.h"
 
 }
 /*
@@ -62,7 +63,7 @@ priority(arith *pprio;)
 } :
 	'[' ConstExpression(&nd) ']'
 			{ if (!(nd->nd_type->tp_fund & T_CARDINAL)) {
-				node_error(nd, "Illegal priority");
+				node_error(nd, "illegal priority");
 			  }
 			  *pprio = nd->nd_INT;
 			  FreeNode(nd);
@@ -85,23 +86,16 @@ export(int *QUALflag; struct node **ExportList;)
 import(int local;)
 {
 	struct node *ImportList;
+	struct node *FromId = 0;
 	register struct def *df;
-	int fromid;
 	extern struct def *GetDefinitionModule();
 } :
 	[ FROM
-	  IDENT		{ fromid = 1;
-			  if (local) {
-				struct node *nd = MkLeaf(Name, &dot);
-
-				df = lookfor(nd,enclosing(CurrVis),0);
-				FreeNode(nd);
-			  }
-			  else	df = GetDefinitionModule(dot.TOK_IDF, 1);
+	  IDENT		{ FromId = MkLeaf(Name, &dot);
+			  if (local) df = lookfor(FromId,enclosing(CurrVis),0);
+			  else df = GetDefinitionModule(dot.TOK_IDF, 1);
 			}
-	|
-			{ fromid = 0; }
-	]
+	]?
 	IMPORT IdentList(&ImportList) ';'
 	/*
 	   When parsing a global module, this is the place where we must
@@ -109,7 +103,9 @@ import(int local;)
 	   If the FROM clause is present, the identifier in it is a module
 	   name, otherwise the names in the import list are module names.
 	*/
-			{ if (fromid) EnterFromImportList(ImportList, df);
+			{ if (FromId) {
+				EnterFromImportList(ImportList, df, FromId);
+			  }
 			  else EnterImportList(ImportList, local);
 			}
 ;
@@ -137,7 +133,7 @@ DefinitionModule
 			modules. Issue a warning.
 		*/
 			{ 
-node_warning(exportlist, "export list in definition module ignored");
+node_warning(exportlist, W_ORDINARY, "export list in definition module ignored");
 				FreeNode(exportlist);
 			}
 	|
@@ -161,7 +157,7 @@ definition
 	register struct def *df;
 	struct def *dummy;
 } :
-	CONST [ ConstantDeclaration Semicolon ]*
+	CONST [ ConstantDeclaration ';' ]*
 |
 	TYPE
 	[ IDENT 	{ df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
@@ -176,21 +172,13 @@ definition
 			  df->df_type = construct_type(T_HIDDEN, NULLTYPE);
 			}
 	  ]
-	  Semicolon
+	  ';'
 	]*
 |
-	VAR [ VariableDeclaration Semicolon ]*
+	VAR [ VariableDeclaration ';' ]*
 |
 	ProcedureHeading(&dummy, D_PROCHEAD)
-	Semicolon
-;
-
-/*	The next nonterminal is used to relax the grammar a little.
-*/
-Semicolon:
 	';'
-|
-	/* empty */	{ warning("; expected"); }
 ;
 
 ProgramModule
diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C
index fda13e58d..d2a26c55e 100644
--- a/lang/m2/comp/scope.C
+++ b/lang/m2/comp/scope.C
@@ -18,6 +18,7 @@ struct scope *PervasiveScope, *GlobalScope;
 struct scopelist *CurrVis;
 extern int proclevel;
 static struct scopelist *PervVis;
+extern char options[];
 
 /* STATICALLOCDEF "scope" 10 */
 
@@ -107,7 +108,7 @@ chk_proc(df)
 
 STATIC
 chk_forw(pdf)
-	struct def **pdf;
+	register struct def **pdf;
 {
 	/*	Called at scope close. Look for all forward definitions and
 		if the scope was a closed scope, give an error message for
diff --git a/lang/m2/comp/tokenname.c b/lang/m2/comp/tokenname.c
index 1e8dd3e33..1de739fdf 100644
--- a/lang/m2/comp/tokenname.c
+++ b/lang/m2/comp/tokenname.c
@@ -92,7 +92,7 @@ reserve(resv)
 
 	while (resv->tn_symbol)	{
 		p = str2idf(resv->tn_name, 0);
-		if (!p) fatal("Out of Memory");
+		if (!p) fatal("out of Memory");
 		p->id_reserved = resv->tn_symbol;
 		resv++;
 	}
diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index 9fc4435cf..13fac5323 100644
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -107,7 +107,9 @@ align(pos, al)
 	arith pos;
 	int al;
 {
-	return ((pos + al - 1) / al) * al;
+	arith i;
+
+	return pos + ((i = pos % al) ? al - i : 0);
 }
 
 struct type *
@@ -209,25 +211,25 @@ chk_basesubrange(tp, base)
 		   of "base".
 		*/
 		if (base->sub_lb > tp->sub_lb || base->sub_ub < tp->sub_ub) {
-			error("Base type has insufficient range");
+			error("base type has insufficient range");
 		}
 		base = base->next;
 	}
 
 	if (base->tp_fund & (T_ENUMERATION|T_CHAR)) {
 		if (tp->next != base) {
-			error("Specified base does not conform");
+			error("specified base does not conform");
 		}
 	}
 	else if (base != card_type && base != int_type) {
-		error("Illegal base for a subrange");
+		error("illegal base for a subrange");
 	}
 	else if (base == int_type && tp->next == card_type &&
 		 (tp->sub_ub > max_int || tp->sub_ub < 0)) {
-		error("Upperbound to large for type INTEGER");
+		error("upperbound to large for type INTEGER");
 	}
 	else if (base != tp->next && base != int_type) {
-		error("Specified base does not conform");
+		error("specified base does not conform");
 	}
 
 	tp->next = base;
@@ -246,7 +248,7 @@ subr_type(lb, ub)
 	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");
+		node_error(ub, "types of subrange bounds not equal");
 		return error_type;
 	}
 
@@ -261,14 +263,14 @@ subr_type(lb, ub)
 	/* Check base type
 	*/
 	if (! (tp->tp_fund & T_DISCRETE)) {
-		node_error(ub, "Illegal base type for subrange");
+		node_error(ub, "illegal base type for subrange");
 		return error_type;
 	}
 
 	/* Check bounds
 	*/
 	if (lb->nd_INT > ub->nd_INT) {
-		node_error(ub, "Lower bound exceeds upper bound");
+		node_error(ub, "lower bound exceeds upper bound");
 	}
 
 	/* Now construct resulting type
@@ -361,12 +363,12 @@ set_type(tp)
 	getbounds(tp, &lb, &ub);
 
 	if (lb < 0 || ub > MAXSET-1) {
-		error("Set type limits exceeded");
+		error("set type limits exceeded");
 		return error_type;
 	}
 
 	tp = construct_type(T_SET, tp);
-	tp->tp_size = WA(((ub - lb) + 8)/8);
+	tp->tp_size = WA(((ub - lb) + 8) >> 3);
 	return tp;
 }
 
@@ -406,7 +408,7 @@ ArraySizes(tp)
 	/* check index type
 	*/
 	if (! bounded(index_type)) {
-		error("Illegal index type");
+		error("illegal index type");
 		tp->tp_size = 0;
 		return;
 	}
diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c
index 0f4e8c3c4..9735e0cb8 100644
--- a/lang/m2/comp/typequiv.c
+++ b/lang/m2/comp/typequiv.c
@@ -13,6 +13,7 @@
 #include	"def.h"
 #include	"LLlex.h"
 #include	"node.h"
+#include	"warning.h"
 
 int
 TstTypeEquiv(tp1, tp2)
@@ -218,7 +219,7 @@ TstParCompat(formaltype, actualtype, VARflag, nd)
 		(  VARflag
 		&& (  TstCompat(formaltype, actualtype)
 		   &&
-(node_warning(nd, "oldfashioned! types of formal and actual must be identical"),
+(node_warning(nd, W_OLDFASHIONED, "types of formal and actual must be identical"),
 		      1)
 		   )
 		)
diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index 2679b5370..1672cf58b 100644
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -24,6 +24,7 @@
 #include	"idf.h"
 #include	"chk_expr.h"
 #include	"walk.h"
+#include	"warning.h"
 
 extern arith	NewPtr();
 extern arith	NewInt();
@@ -147,7 +148,7 @@ WalkProcedure(procedure)
 	DoProfil();
 	TmpOpen(sc);
 
-	func_type = tp = ResultType(procedure->df_type);
+	func_type = tp = RemoveEqual(ResultType(procedure->df_type));
 
 	if (tp && IsConstructed(tp)) {
 		/* The result type of this procedure is constructed.
@@ -678,7 +679,7 @@ DoForInit(nd, left)
 			node_error(nd, "type incompatibility in FOR statement");
 			return 0;
 		}
-node_warning(nd, "old-fashioned! compatibility required in FOR statement");
+node_warning(nd, W_OLDFASHIONED, "compatibility required in FOR statement");
 	}
 
 	return 1;
diff --git a/lang/m2/comp/warning.h b/lang/m2/comp/warning.h
new file mode 100644
index 000000000..ee7cc60c6
--- /dev/null
+++ b/lang/m2/comp/warning.h
@@ -0,0 +1,18 @@
+/* Warning classes, at the moment three of them:
+   Strict (R)
+   Ordinary (W)
+   Old-fashioned(O)
+*/
+
+/* Bits for a bit mask: */
+
+#define	W_ORDINARY	1
+#define W_STRICT	2
+#define W_OLDFASHIONED	4
+
+#define W_ALL		(W_ORDINARY|W_STRICT|W_OLDFASHIONED)
+
+#define W_INITIAL	(W_ORDINARY | W_OLDFASHIONED)
+
+/* The bit mask itself: */
+extern int	warning_classes;
-- 
2.34.1