From d3d6e637d634272d1772973f344a36e7864d98f9 Mon Sep 17 00:00:00 2001
From: ceriel <none@none>
Date: Thu, 17 Apr 1986 09:28:09 +0000
Subject: [PATCH] newer version

---
 lang/m2/comp/LLlex.c     |  21 +++++---
 lang/m2/comp/LLlex.h     |   2 +-
 lang/m2/comp/Makefile    |  25 +++++----
 lang/m2/comp/Parameters  |  60 +++++++++++++++++++++
 lang/m2/comp/chk_expr.c  |  24 ++++-----
 lang/m2/comp/cstoper.c   |  15 +++---
 lang/m2/comp/declar.g    |  57 +++++++++++++-------
 lang/m2/comp/def.H       |   6 ++-
 lang/m2/comp/error.c     |   6 +--
 lang/m2/comp/input.h     |   2 +
 lang/m2/comp/main.c      |  18 ++-----
 lang/m2/comp/make.hfiles |  35 ++++++++++++
 lang/m2/comp/options.c   | 114 +++++++++++++++++++++++++++++++++++++++
 lang/m2/comp/program.g   |  71 ++++++++++++++----------
 lang/m2/comp/scope.C     |  20 ++++++-
 lang/m2/comp/statement.g |  24 +++++----
 lang/m2/comp/type.H      |  22 ++++----
 lang/m2/comp/type.c      |  56 ++++++++++---------
 18 files changed, 427 insertions(+), 151 deletions(-)
 create mode 100644 lang/m2/comp/Parameters
 create mode 100755 lang/m2/comp/make.hfiles
 create mode 100644 lang/m2/comp/options.c

diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c
index db080a5f2..c53e31594 100644
--- a/lang/m2/comp/LLlex.c
+++ b/lang/m2/comp/LLlex.c
@@ -6,6 +6,11 @@ static char *RcsId = "$Header$";
 #include	<em_arith.h>
 #include	<em_label.h>
 #include	<assert.h>
+
+#include	"idfsize.h"
+#include	"numsize.h"
+#include	"strsize.h"
+
 #include	"input.h"
 #include	"f_info.h"
 #include	"Lpars.h"
@@ -15,14 +20,12 @@ static char *RcsId = "$Header$";
 #include	"LLlex.h"
 #include	"const.h"
 
-#define IDFSIZE	256	/* Number of significant characters in an identifier */
-#define NUMSIZE	256	/* maximum number of characters in a number */
-
 long str2long();
 
 struct token dot, aside;
 struct type *numtype;
 struct string string;
+int idfsize = IDFSIZE;
 
 static
 SkipComment()
@@ -73,7 +76,7 @@ GetString(upto)
 	register struct string *str = &string;
 	register char *p;
 	
-	str->s_str = p = Malloc(str->s_length = 32);
+	str->s_str = p = Malloc((unsigned) (str->s_length = ISTRSIZE));
 	LoadChar(ch);
 	while (ch != upto)	{
 		if (class(ch) == STNL)	{
@@ -87,8 +90,10 @@ GetString(upto)
 		}
 		*p++ = ch;
 		if (p - str->s_str == str->s_length)	{
-			str->s_str = Srealloc(str->s_str, str->s_length += 8);
-			p = str->s_str + (str->s_length - 8);
+			str->s_str = Srealloc(str->s_str,
+					      str->s_length + RSTRSIZE);
+			p = str->s_str + str->s_length;
+			str->s_length += RSTRSIZE;
 		}
 		LoadChar(ch);
 	}
@@ -99,7 +104,7 @@ GetString(upto)
 int
 LLlex()
 {
-	/*	LLlex() plays the role of Lexical Analyzer for the parser.
+	/*	LLlex() is the Lexical Analyzer.
 		The putting aside of tokens is taken into account.
 	*/
 	register struct token *tk = &dot;
@@ -199,7 +204,7 @@ again:
 		register struct idf *id;
 
 		do	{
-			if (tg - buf < IDFSIZE) *tg++ = ch;
+			if (tg - buf < idfsize) *tg++ = ch;
 			LoadChar(ch);
 		} while(in_idf(ch));
 
diff --git a/lang/m2/comp/LLlex.h b/lang/m2/comp/LLlex.h
index 31ddcd465..16ea9e010 100644
--- a/lang/m2/comp/LLlex.h
+++ b/lang/m2/comp/LLlex.h
@@ -3,7 +3,7 @@
 /* $Header$ */
 
 struct string {
-	int s_length;		/* length of a string */
+	unsigned int s_length;	/* length of a string */
 	char *s_str;		/* the string itself */
 };
 
diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index 7cb39541f..8ce1097fc 100644
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -12,19 +12,20 @@ CC =	cc
 GEN =	LLgen
 GENOPTIONS =
 PROFILE =
-CFLAGS = -DDEBUG $(PROFILE) $(INCLUDES)
+CFLAGS = $(PROFILE) $(INCLUDES)
 LFLAGS = $(PROFILE)
 LOBJ =	tokenfile.o program.o declar.o expression.o statement.o
 COBJ =	LLlex.o LLmessage.o char.o error.o main.o \
 	symbol2str.o tokenname.o idf.o input.o type.o def.o \
 	scope.o misc.o enter.o defmodule.o typequiv.o node.o \
-	cstoper.o chk_expr.o
+	cstoper.o chk_expr.o options.o
 OBJ =	$(COBJ) $(LOBJ) Lpars.o
 GENFILES=	tokenfile.c \
 	program.c declar.c expression.c statement.c \
 	tokenfile.g symbol2str.c char.c Lpars.c Lpars.h
 
 all:
+	make hfiles
 	make LLfiles
 	make main
 
@@ -32,6 +33,10 @@ LLfiles:	$(LSRC)
 	$(GEN) $(GENOPTIONS) $(LSRC)
 	@touch LLfiles
 
+hfiles:	Parameters make.hfiles
+	make.hfiles Parameters
+	touch hfiles
+
 main:	$(OBJ) Makefile
 	$(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libcomp.a $(LIBDIR)/malloc.o /user1/erikb/em/lib/libprint.a /user1/erikb/em/lib/libstr.a /user1/erikb/em/lib/libsystem.a -o main
 	size main
@@ -73,28 +78,28 @@ depend:
 	make.allocd < $< > $@
 
 #AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
-LLlex.o: LLlex.h Lpars.h class.h f_info.h idf.h input.h
+LLlex.o: LLlex.h Lpars.h class.h const.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h
 LLmessage.o: LLlex.h Lpars.h idf.h
 char.o: class.h
-error.o: LLlex.h f_info.h input.h main.h node.h
-main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h scope.h standards.h tokenname.h type.h
+error.o: LLlex.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 scope.h standards.h tokenname.h type.h
 symbol2str.o: Lpars.h
 tokenname.o: Lpars.h idf.h tokenname.h
 idf.o: idf.h
-input.o: f_info.h input.h
-type.o: LLlex.h const.h debug.h def.h def_sizes.h idf.h node.h type.h
+input.o: f_info.h input.h inputtype.h
+type.o: LLlex.h const.h debug.h def.h idf.h node.h target_sizes.h type.h
 def.o: LLlex.h debug.h def.h idf.h main.h node.h scope.h type.h
 scope.o: LLlex.h debug.h def.h idf.h node.h scope.h type.h
 misc.o: LLlex.h f_info.h idf.h misc.h node.h
 enter.o: LLlex.h def.h idf.h node.h scope.h type.h
-defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h scope.h
+defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h inputtype.h scope.h
 typequiv.o: def.h type.h
 node.o: LLlex.h debug.h def.h node.h type.h
-cstoper.o: LLlex.h Lpars.h def_sizes.h idf.h node.h standards.h type.h
+cstoper.o: LLlex.h Lpars.h idf.h node.h standards.h target_sizes.h type.h
 chk_expr.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h standards.h type.h
 tokenfile.o: Lpars.h
 program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
 declar.o: LLlex.h Lpars.h def.h idf.h misc.h node.h scope.h type.h
 expression.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h type.h
-statement.o: LLlex.h Lpars.h node.h
+statement.o: LLlex.h Lpars.h node.h type.h
 Lpars.o: Lpars.h
diff --git a/lang/m2/comp/Parameters b/lang/m2/comp/Parameters
new file mode 100644
index 000000000..f49d2aad8
--- /dev/null
+++ b/lang/m2/comp/Parameters
@@ -0,0 +1,60 @@
+!File: errout.h
+#define	ERROUT		STDERR	/* file pointer for writing messages	*/
+#define	MAXERR_LINE	5	/* maximum number of error messages given
+					on the same input line.		*/
+
+
+!File: idfsize.h
+#define	IDFSIZE	30	/* maximum significant length of an identifier	*/
+
+
+!File: numsize.h
+#define	NUMSIZE	256	/* maximum length of a numeric constant		*/
+
+
+!File: strsize.h
+#define ISTRSIZE	32	/* minimum number of bytes allocated for
+					storing a string		*/
+#define RSTRSIZE	8	/* step size in enlarging the memory for
+					the storage of a string		*/
+
+
+!File: target_sizes.h
+#define MAXSIZE		8	/* the maximum of the SZ_* constants	*/
+
+/* target machine sizes	*/
+#define	SZ_CHAR		(arith)1
+#define	SZ_SHORT	(arith)2
+#define SZ_WORD		(arith)4
+#define	SZ_INT		(arith)4
+#define	SZ_LONG		(arith)4
+#define	SZ_FLOAT	(arith)4
+#define	SZ_DOUBLE	(arith)8
+#define	SZ_POINTER	(arith)4
+
+/* target machine alignment requirements	*/
+#define	AL_CHAR		1
+#define	AL_SHORT	SZ_SHORT
+#define AL_WORD		SZ_WORD
+#define	AL_INT		SZ_WORD
+#define	AL_LONG		SZ_WORD
+#define	AL_FLOAT	SZ_WORD
+#define	AL_DOUBLE	SZ_WORD
+#define	AL_POINTER	SZ_WORD
+#define AL_STRUCT	1
+#define AL_UNION	1
+
+
+!File: debug.h
+#define DEBUG		1	/* perform various self-tests		*/
+extern char options[];
+#ifdef DEBUG
+#define DO_DEBUG(n, x)	((n) <= options['D'] && (x))
+#else
+#define DO_DEBUG(n, x)
+#endif DEBUG
+
+!File: inputtype.h
+#undef INP_READ_IN_ONE	1	/* read input file in one	*/
+
+
diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index fdd55cb49..95ecf20b1 100644
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -79,7 +79,7 @@ chk_set(expp)
 	if (expp->nd_left) {
 		/* A type was given. Check it out
 		*/
-		(void) findname(expp->nd_left);
+		findname(expp->nd_left);
 		assert(expp->nd_left->nd_class == Def);
 		df = expp->nd_left->nd_def;
 		if ((df->df_kind != D_TYPE && df->df_kind != D_ERROR) ||
@@ -93,7 +93,7 @@ chk_set(expp)
 
 	/* Now check the elements given, and try to compute a constant set.
 	*/
-	set = (arith *) Malloc(tp->tp_size * sizeof(arith) / wrd_size);
+	set = (arith *) Malloc(tp->tp_size * sizeof(arith) / word_size);
 	nd = expp->nd_right;
 	while (nd) {
 		assert(nd->nd_class == Link && nd->nd_symb == ',');
@@ -149,7 +149,7 @@ node_error(expp, "Lower bound exceeds upper bound in range");
 			}
 		}
 		else if (*set) {
-			free(*set);
+			free((char *) *set);
 			*set = 0;
 		}
 		return 1;
@@ -223,7 +223,7 @@ getname(argp, kinds)
 		return 0;
 	}
 	argp = argp->nd_right;
-	if (!findname(argp->nd_left)) return 0;
+	findname(argp->nd_left);
 	assert(argp->nd_left->nd_class == Def);
 	if (!(argp->nd_left->nd_def->df_kind & kinds)) {
 		node_error(argp, "Unexpected type");
@@ -244,8 +244,8 @@ chk_call(expp)
 	register struct node *arg;
 
 	expp->nd_type = error_type;
-	(void) findname(expp->nd_left);	/* parser made sure it is a name */
 	left = expp->nd_left;
+	findname(left);
 
 	if (left->nd_type == error_type) return 0;
 	if (left->nd_class == Def &&
@@ -451,8 +451,8 @@ findname(expp)
 		scope.
 	*/
 	register struct def *df;
-	struct def *lookfor();
 	register struct type *tp;
+	struct def *lookfor();
 
 	expp->nd_type = error_type;
 	if (expp->nd_class == Name) {
@@ -498,18 +498,18 @@ df->df_idf->id_text);
 	}
 	if (expp->nd_class == Oper) {
 		assert(expp->nd_symb == '[');
-		(void) findname(expp->nd_left);
-		if (chk_expr(expp->nd_right, 0) &&
+		findname(expp->nd_left);
+		if (chk_expr(expp->nd_right) &&
 		    expp->nd_left->nd_type != error_type &&
 		    chk_oper(expp)) /* ??? */ ;
-		return 1;
+		return;
 	}
 	if (expp->nd_class == Uoper && expp->nd_symb == '^') {
-		(void) findname(expp->nd_right);
+		findname(expp->nd_right);
 		if (expp->nd_right->nd_type != error_type &&
 	    		chk_uoper(expp)) /* ??? */ ;
 	}
-	return 0;
+	return;
 }
 
 int
@@ -518,7 +518,7 @@ chk_name(expp)
 {
 	register struct def *df;
 
-	(void) findname(expp);
+	findname(expp);
 	assert(expp->nd_class == Def);
 	df = expp->nd_def;
 	if (df->df_kind == D_ERROR) return 0;
diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c
index 81411b290..be2ba576b 100644
--- a/lang/m2/comp/cstoper.c
+++ b/lang/m2/comp/cstoper.c
@@ -5,7 +5,9 @@ static char *RcsId = "$Header$";
 #include	<em_arith.h>
 #include	<em_label.h>
 #include	<assert.h>
-#include	"def_sizes.h"
+
+#include	"target_sizes.h"
+
 #include	"idf.h"
 #include	"type.h"
 #include	"LLlex.h"
@@ -211,7 +213,7 @@ cstset(expp)
 	assert(expp->nd_right->nd_class == Set);
 	assert(expp->nd_symb == IN || expp->nd_left->nd_class == Set);
 	set2 = expp->nd_right->nd_set;
-	setsize = expp->nd_right->nd_type->tp_size / wrd_size;
+	setsize = expp->nd_right->nd_type->tp_size / word_size;
 
 	if (expp->nd_symb == IN) {
 		arith i;
@@ -359,7 +361,8 @@ cstcall(expp, call)
 		cut_size(expp);
 		break;
 	case S_SIZE:
-		expp->nd_INT = align(expr->nd_type->tp_size, wrd_size)/wrd_size;
+		expp->nd_INT = align(expr->nd_type->tp_size, (int) word_size) /
+				word_size;
 		break;
 	case S_VAL:
 		expp->nd_INT = expr->nd_INT;
@@ -435,12 +438,12 @@ init_cst()
 	}
 	mach_long_size = i;
 	mach_long_sign = 1 << (mach_long_size * 8 - 1);
-	if (lint_size > mach_long_size) {
+	if (long_size > mach_long_size) {
 		fatal("sizeof (long) insufficient on this machine");
 	}
 
 	max_int = full_mask[int_size] & ~(1 << (int_size * 8 - 1));
 	max_unsigned = full_mask[int_size];
-	max_longint = full_mask[lint_size] & ~(1 << (lint_size * 8 - 1));
-	wrd_bits = 8 * wrd_size;
+	max_longint = full_mask[long_size] & ~(1 << (long_size * 8 - 1));
+	wrd_bits = 8 * word_size;
 }
diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index afedfbbe1..8e5dbcd5d 100644
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -25,7 +25,7 @@ ProcedureDeclaration
 	ProcedureHeading(&df, D_PROCEDURE)
 			{ df->prc_level = proclevel++;
 			}
-	';' block IDENT
+	';' block(&(df->prc_body)) IDENT
 			{ match_id(dot.TOK_IDF, df->df_idf);
 			  df->prc_scope = CurrentScope;
 			  close_scope(SC_CHKFORW);
@@ -68,11 +68,17 @@ error("inconsistent procedure declaration for \"%s\"", df->df_idf->id_text);
 		}
 ;
 
-block
+block(struct node **pnd;)
 {
-	struct node *nd;
 }:
-	declaration* [ BEGIN StatementSequence(&nd) ]? END
+	declaration*
+	[
+		BEGIN
+		StatementSequence(pnd)
+	|
+			{ *pnd = 0; }
+	]
+	END
 ;
 
 declaration:
@@ -101,7 +107,7 @@ FormalParameters(int doparams;
 			{ pr1 = *pr; }
 		[
 			{ for (; pr1->next; pr1 = pr1->next) ; }
-			';' FPSection(doparams, &(pr1->next), &parmaddr)
+			';' FPSection(doparams, &(pr1->next), parmaddr)
 		]*
 	]?
 	')'
@@ -149,8 +155,8 @@ FormalType(struct type **tp;)
 			{ if (ARRAYflag) {
 				*tp = construct_type(T_ARRAY, NULLTYPE);
 				(*tp)->arr_elem = df->df_type;
-				(*tp)->tp_align = lcm(wrd_align, ptr_align);
-				(*tp)->tp_size = align(ptr_size + 3*wrd_size,
+				(*tp)->tp_align = lcm(word_align, pointer_align);
+				(*tp)->tp_size = align(pointer_size + 3*word_size,
 							(*tp)->tp_align);
 			  }
 			  else	*tp = df->df_type;
@@ -221,17 +227,17 @@ enumeration(struct type **ptp;)
 } :
 	'(' IdentList(&EnumList) ')'
 		{
-		  *ptp = standard_type(T_ENUMERATION,1,1);
+		  *ptp = standard_type(T_ENUMERATION, 1, (arith) 1);
 		  EnterIdList(EnumList, D_ENUM, 0, *ptp,
 				CurrentScope, (arith *) 0);
 		  FreeNode(EnumList);
 		  if ((*ptp)->enm_ncst > 256) {
-			if (wrd_size == 1) {
+			if (word_size == 1) {
 				error("Too many enumeration literals");
 			}
 			else {
-				(*ptp)->tp_size = wrd_size;
-				(*ptp)->tp_align = wrd_align;
+				(*ptp)->tp_size = word_size;
+				(*ptp)->tp_align = word_align;
 			}
 		  }
 		}
@@ -291,7 +297,7 @@ RecordType(struct type **ptp;)
 {
 	struct scope *scope;
 	arith count;
-	int xalign = record_align;
+	int xalign = struct_align;
 }
 :
 	RECORD
@@ -391,28 +397,43 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 variant(struct scope *scope; arith *cnt; struct type *tp; int *palign;)
 {
 	struct type *tp1 = tp;
+	struct node *nd;
 } :
 	[
-		CaseLabelList(&tp1) ':' FieldListSequence(scope, cnt, palign)
+		CaseLabelList(&tp1, &nd)
+				{ /* Ignore the cases for the time being.
+				     Maybe a checking version will be supplied
+				     later ???
+				  */
+				  FreeNode(nd);
+				}
+		':' FieldListSequence(scope, cnt, palign)
 	]?
 					/* Changed rule in new modula-2 */
 ;
 
-CaseLabelList(struct type **ptp;):
-	CaseLabels(ptp) [ ',' CaseLabels(ptp) ]*
+CaseLabelList(struct type **ptp; struct node **pnd;):
+	CaseLabels(ptp, pnd)
+	[	
+			{ *pnd = MkNode(Link, *pnd, NULLNODE, &dot); }
+		',' CaseLabels(ptp, &((*pnd)->nd_right))
+			{ pnd = &((*pnd)->nd_right); }
+	]*
 ;
 
-CaseLabels(struct type **ptp;)
+CaseLabels(struct type **ptp; struct node **pnd;)
 {
 	struct node *nd1, *nd2 = 0;
 }:
-	ConstExpression(&nd1)
+	ConstExpression(&nd1)	{ *pnd = nd1; }
 	[
-		UPTO ConstExpression(&nd2)
+		UPTO		{ *pnd = MkNode(Link,nd1,NULLNODE,&dot); }
+		ConstExpression(&nd2)
 				{ if (!TstCompat(nd1->nd_type, nd2->nd_type)) {
 node_error(nd2,"type incompatibility in case label");
 				  }
 				  nd1->nd_type = error_type;
+				  (*pnd)->nd_right = nd2;
 				}
 	]?
 				{ if (*ptp != 0 &&
diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H
index 6a7629379..f2705a946 100644
--- a/lang/m2/comp/def.H
+++ b/lang/m2/comp/def.H
@@ -3,10 +3,12 @@
 /* $Header$ */
 
 struct module {
-	int mo_priority;	/* priority of a module */
+	arith mo_priority;	/* priority of a module */
 	struct scope *mo_scope;	/* scope of this module */
+	struct node *mo_body;	/* body of this module */
 #define mod_priority	df_value.df_module.mo_priority
 #define mod_scope	df_value.df_module.mo_scope
+#define mod_body	df_value.df_module.mo_body
 };
 
 struct variable {
@@ -43,9 +45,11 @@ struct dfproc {
 	struct scope *pr_scope;	/* scope of procedure */
 	int pr_level;		/* depth level of this procedure */
 	arith pr_nbpar;		/* Number of bytes parameters */
+	struct node *pr_body;	/* body of this procedure */
 #define prc_scope	df_value.df_proc.pr_scope
 #define prc_level	df_value.df_proc.pr_level
 #define prc_nbpar	df_value.df_proc.pr_nbpar
+#define prc_body	df_value.df_proc.pr_body
 };
 
 struct import {
diff --git a/lang/m2/comp/error.c b/lang/m2/comp/error.c
index e72269c42..13eae686d 100644
--- a/lang/m2/comp/error.c
+++ b/lang/m2/comp/error.c
@@ -9,15 +9,15 @@ static char *RcsId = "$Header$";
 
 #include	<system.h>
 #include	<em_arith.h>
+
+#include	"errout.h"
+
 #include	"input.h"
 #include	"f_info.h"
 #include	"LLlex.h"
 #include	"main.h"
 #include	"node.h"
 
-#define MAXERR_LINE	5	/* Number of error messages on one line ... */
-#define	ERROUT		STDERR
-
 /* error classes */
 #define	ERROR		1
 #define	WARNING		2
diff --git a/lang/m2/comp/input.h b/lang/m2/comp/input.h
index 550cdc501..abb111c60 100644
--- a/lang/m2/comp/input.h
+++ b/lang/m2/comp/input.h
@@ -2,6 +2,8 @@
 
 /* $Header$ */
 
+#include	"inputtype.h"
+
 #define INP_NPUSHBACK 2
 #define INP_TYPE	struct f_info
 #define INP_VAR		file_info
diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c
index a66d0aa85..a135e6682 100644
--- a/lang/m2/comp/main.c
+++ b/lang/m2/comp/main.c
@@ -28,14 +28,14 @@ char	*getenv();
 main(argc, argv)
 	char *argv[];
 {
-	register Nargc = 1;
+	register int Nargc = 1;
 	register char **Nargv = &argv[0];
 
 	ProgName = *argv++;
 
 	while (--argc > 0) {
 		if (**argv == '-')
-			Option(*argv++);
+			do_option((*argv++) + 1);
 		else
 			Nargv[Nargc++] = *argv++;
 	}
@@ -71,16 +71,14 @@ Compile(src)
 	init_types();
 	add_standards();
 #ifdef DEBUG
-	if (options['L']) LexScan();
-	else {
+	if (options['l']) LexScan();
+	else
 #endif DEBUG
+	{
 		(void) open_scope(CLOSEDSCOPE);
 		GlobalScope = CurrentScope;
 		CompUnit();
-#ifdef DEBUG
 	}
-	if (options['h']) hash_stat();
-#endif DEBUG
 	if (err_occurred) return 0;
 	return 1;
 }
@@ -117,12 +115,6 @@ LexScan()
 }
 #endif
 
-Option(str)
-	char *str;
-{
-	options[str[1]]++;	/* switch option on	*/
-}
-
 add_standards()
 {
 	register struct def *df;
diff --git a/lang/m2/comp/make.hfiles b/lang/m2/comp/make.hfiles
new file mode 100755
index 000000000..2132dd618
--- /dev/null
+++ b/lang/m2/comp/make.hfiles
@@ -0,0 +1,35 @@
+: Update Files from database
+
+PATH=/bin:/usr/bin
+
+case $# in
+1) ;;
+*)	echo use: $0 file >&2
+	exit 1
+esac
+
+(
+IFCOMMAND="if (<\$FN) 2>/dev/null;\
+	then	if cmp -s \$FN \$TMP;\
+		then	rm \$TMP;\
+		else	mv \$TMP \$FN;\
+			echo update \$FN;\
+		fi;\
+	else	mv \$TMP \$FN;\
+		echo create \$FN;\
+	fi"
+echo 'TMP=.uf$$'
+echo 'FN=$TMP'
+echo 'cat >$TMP <<\!EOF!'
+sed -n '/^!File:/,${
+/^$/d
+/^!File:[	 ]*\(.*\)$/s@@!EOF!\
+'"$IFCOMMAND"'\
+FN=\1\
+cat >$TMP <<\\!EOF!@
+p
+}' $1
+echo '!EOF!'
+echo $IFCOMMAND
+) |
+sh
diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c
new file mode 100644
index 000000000..f8bc48818
--- /dev/null
+++ b/lang/m2/comp/options.c
@@ -0,0 +1,114 @@
+/* U S E R   O P T I O N - H A N D L I N G */
+
+static char *RcsId = "$Header$";
+
+#include	<em_arith.h>
+#include	<em_label.h>
+
+#include	"idfsize.h"
+
+#include	"type.h"
+
+extern char options[];
+extern int	idfsize;
+
+do_option(text)
+	char *text;
+{
+	switch(*text++)	{
+
+	default:
+		options[text[-1]] = 1;	/* flags, debug options etc.	*/
+		break;
+
+	case 'L' :
+		warning("-L: default no EM profiling; use -p for EM profiling");
+		break;
+
+	case 'M':	/* maximum identifier length */
+		idfsize = txt2int(&text);
+		if (*text || idfsize <= 0)
+			fatal("malformed -M option");
+		if (idfsize > IDFSIZE)
+			fatal("maximum identifier length is %d", IDFSIZE);
+		break;
+
+	case 'p' :	/* generate profiling code (fil/lin) */
+		options['p'] = 1;
+		break;
+
+	case 'V' :	/* set object sizes and alignment requirements	*/
+	{
+		arith size;
+		int align;
+		char c;
+
+		while (c = *text++)	{
+			size = txt2int(&text);
+			align = 0;
+			if (*text == '.')	{
+				text++;
+				align = txt2int(&text);
+			}
+			switch (c)	{
+
+			case 'w':	/* word		*/
+				if (size != (arith)0) word_size = size;
+				if (align != 0) word_align = align;
+				break;
+			case 'i':	/* int		*/
+				if (size != (arith)0) int_size = size;
+				if (align != 0) int_align = align;
+				break;
+			case 'l':	/* longint	*/
+				if (size != (arith)0) long_size = size;
+				if (align != 0) long_align = align;
+				break;
+			case 'f':	/* real		*/
+				if (size != (arith)0) float_size = size;
+				if (align != 0) float_align = align;
+				break;
+			case 'd':	/* longreal	*/
+				if (size != (arith)0) double_size = size;
+				if (align != 0) double_align = align;
+				break;
+			case 'p':	/* pointer	*/
+				if (size != (arith)0) pointer_size = size;
+				if (align != 0) pointer_align = align;
+				break;
+			case 'S':	/* initial record alignment	*/
+				if (align != (arith)0) struct_align = align;
+				break;
+			default:
+				error("-V: bad type indicator %c\n", c);
+			}
+		}
+		break;
+	}
+
+	case 'n':
+		options['n'] = 1;	/* use no registers	*/
+		break;
+
+	case 'w':
+		options['w'] = 1;	/* no warnings will be given	*/
+		break;
+	}
+}
+
+int
+txt2int(tp)
+	char **tp;
+{
+	/*	the integer pointed to by *tp is read, while increasing
+		*tp; the resulting value is yielded.
+	*/
+	register int val = 0;
+	register int ch;
+	
+	while (ch = **tp, ch >= '0' && ch <= '9')	{
+		val = val * 10 + ch - '0';
+		(*tp)++;
+	}
+	return val;
+}
diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g
index e3c6bb787..07930f4a7 100644
--- a/lang/m2/comp/program.g
+++ b/lang/m2/comp/program.g
@@ -43,7 +43,7 @@ static int DEFofIMPL = 0;	/* Flag indicating that we are currently
 ModuleDeclaration
 {
 	struct idf *id;
-	struct def *df;
+	register struct def *df;
 } :
 	MODULE IDENT		{
 				  id = dot.TOK_IDF;
@@ -57,20 +57,27 @@ ModuleDeclaration
 					standard_type(T_RECORD, 0, (arith) 0);
 				  df->df_type->rec_scope = df->mod_scope;
 				}
-	priority? ';'
+	priority(&(df->mod_priority))?
+	';'
 	import(1)*
 	export(0)?
-	block
+	block(&(df->mod_body))
 	IDENT			{ close_scope(SC_CHKFORW|SC_CHKPROC);
 				  match_id(id, dot.TOK_IDF);
 				}
 ;
 
-priority
+priority(arith *pprio;)
 {
 	struct node *nd;
-}:
+} :
 	'[' ConstExpression(&nd) ']'
+				{ if (!(nd->nd_type->tp_fund & T_INTORCARD)) {
+					node_error(nd, "Illegal priority");
+				  }
+				  *pprio = nd->nd_INT;
+				  FreeNode(nd);
+				}
 ;
 
 export(int def;)
@@ -161,7 +168,7 @@ definition
 {
 	struct def *df;
 } :
-	CONST [ ConstantDeclaration ';' ]*
+	CONST [ ConstantDeclaration Semicolon ]*
 |
 	TYPE
 	[ IDENT 	{ df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
@@ -175,38 +182,48 @@ definition
 	    		{ df->df_kind = D_HIDDEN;
 			}
 	  ]
-	  ';'
+	  Semicolon
 	]*
 |
-	VAR [ VariableDeclaration ';' ]*
+	VAR [ VariableDeclaration Semicolon ]*
 |
-	ProcedureHeading(&df, D_PROCHEAD) ';'
+	ProcedureHeading(&df, D_PROCHEAD) Semicolon
+;
+
+Semicolon:
+	';'
+|
+			{ warning("; expected"); }
 ;
 
 ProgramModule(int state;)
 {
 	struct idf *id;
-	struct def *df, *GetDefinitionModule();
-	struct scope *scope = 0;
+	struct def *GetDefinitionModule();
+	register struct def *df;
 } :
 	MODULE
-	IDENT		{ 
-			  id = dot.TOK_IDF;
-			  if (state == IMPLEMENTATION) {
-				DEFofIMPL = 1;
-				df = GetDefinitionModule(id);
-				CurrentScope = df->mod_scope;
-				DEFofIMPL = 0;
-			  	DefinitionModule = 0;
-			  }
-			  else	open_scope(CLOSEDSCOPE);
-			}
-	priority?
+	IDENT	{ 
+		  id = dot.TOK_IDF;
+		  if (state == IMPLEMENTATION) {
+			DEFofIMPL = 1;
+			df = GetDefinitionModule(id);
+			CurrentScope = df->mod_scope;
+			DEFofIMPL = 0;
+		  	DefinitionModule = 0;
+		  }
+		  else {
+			df = define(id, CurrentScope, D_MODULE);
+			open_scope(CLOSEDSCOPE);
+			df->mod_scope = CurrentScope;
+		  }
+		}
+	priority(&(df->mod_priority))?
 	';' import(0)*
-	block IDENT
-			{ close_scope(SC_CHKFORW|SC_CHKPROC);
-			  match_id(id, dot.TOK_IDF);
-			}
+	block(&(df->mod_body)) IDENT
+		{ close_scope(SC_CHKFORW|SC_CHKPROC);
+		  match_id(id, dot.TOK_IDF);
+		}
 	'.'
 ;
 
diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C
index ca6086823..79ebb5f84 100644
--- a/lang/m2/comp/scope.C
+++ b/lang/m2/comp/scope.C
@@ -23,7 +23,6 @@ open_scope(scopetype)
 	/*	Open a scope that is either open (automatic imports) or closed.
 	*/
 	register struct scope *sc = new_scope();
-	register struct scope *sc1;
 
 	assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
 	sc->sc_scopeclosed = scopetype == CLOSEDSCOPE;
@@ -161,6 +160,24 @@ rem_forwards(fo)
 	}
 }
 
+Reverse(pdf)
+	register struct def **pdf;
+{
+	/*	Reverse the order in the list of definitions in a scope.
+		This is neccesary because this list is built in reverse.
+	*/
+	register struct def *df, *df1;
+
+	df = 0;
+	df1 = *pdf;
+	while (df1) {
+		df1 = df1->df_nextinscope;
+		(*pdf)->df_nextinscope = df;
+		df = *pdf;
+		*pdf = df1;
+	}
+}
+
 close_scope(flag)
 {
 	/*	Close a scope. If "flag" is set, check for forward declarations,
@@ -177,6 +194,7 @@ close_scope(flag)
 		DO_DEBUG(2, PrScopeDef(sc->sc_def));
 		if (flag & SC_CHKPROC) chk_proc(sc->sc_def);
 		if (flag & SC_CHKFORW) chk_forw(&(sc->sc_def));
+		Reverse(&(sc->sc_def));
 	}
 	CurrentScope = sc->next;
 }
diff --git a/lang/m2/comp/statement.g b/lang/m2/comp/statement.g
index 36596be0d..c30e66b31 100644
--- a/lang/m2/comp/statement.g
+++ b/lang/m2/comp/statement.g
@@ -4,7 +4,9 @@
 static char *RcsId = "$Header$";
 
 #include	<em_arith.h>
+#include	<em_label.h>
 #include	"LLlex.h"
+#include	"type.h"
 #include	"node.h"
 
 static int	loopcount = 0;	/* Count nested loops */
@@ -12,7 +14,7 @@ static int	loopcount = 0;	/* Count nested loops */
 
 statement(struct node **pnd;)
 {
-	struct node *nd1;
+	register struct node *nd;
 } :
 				{ *pnd = 0; }
 [
@@ -21,16 +23,16 @@ statement(struct node **pnd;)
 	 * states : assignment | ProcedureCall | ...
 	 * but this gives LL(1) conflicts
 	 */
-	designator(&nd1)
-	[			{ nd1 = MkNode(Call, nd1, NULLNODE, &dot);
-				  nd1->nd_symb = '(';
+	designator(pnd)
+	[			{ nd = MkNode(Call, *pnd, NULLNODE, &dot);
+				  nd->nd_symb = '(';
 				}
-		ActualParameters(&(nd1->nd_right))?
+		ActualParameters(&(nd->nd_right))?
 	|
-		BECOMES		{ nd1 = MkNode(Stat, nd1, NULLNODE, &dot); }
-		expression(&(nd1->nd_right))
+		BECOMES		{ nd = MkNode(Stat, *pnd, NULLNODE, &dot); }
+		expression(&(nd->nd_right))
 	]
-				{ *pnd = nd1; }
+				{ *pnd = nd; }
 	/*
 	 * end of changed part
 	 */
@@ -58,9 +60,9 @@ statement(struct node **pnd;)
 			  *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot);
 			}
 |
-	RETURN		{ *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+	RETURN		{ *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
 	[
-		expression(&((*pnd)->nd_right))
+		expression(&(nd->nd_right))
 	]?
 ]?
 ;
@@ -138,7 +140,7 @@ CaseStatement(struct node **pnd;)
 
 case(struct node **pnd; struct type **ptp;) :
 			{ *pnd = 0; }
-	[ CaseLabelList(ptp/*,pnd*/)
+	[ CaseLabelList(ptp, pnd)
 	  ':'		{ *pnd = MkNode(Link, *pnd, NULLNODE, &dot); }
 	  StatementSequence(&((*pnd)->nd_right))
 	]?
diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H
index 38c8a96c9..c2824a847 100644
--- a/lang/m2/comp/type.H
+++ b/lang/m2/comp/type.H
@@ -102,21 +102,21 @@ extern struct type
 	*error_type;		/* All from type.c */
 
 extern int
-	wrd_align,
+	word_align,
 	int_align,
-	lint_align,
-	real_align,
-	lreal_align,
-	ptr_align,
-	record_align;		/* All from type.c */
+	long_align,
+	float_align,
+	double_align,
+	pointer_align,
+	struct_align;		/* All from type.c */
 
 extern arith
-	wrd_size,
+	word_size,
 	int_size,
-	lint_size,
-	real_size,
-	lreal_size,
-	ptr_size;		/* All from type.c */
+	long_size,
+	float_size,
+	double_size,
+	pointer_size;		/* All from type.c */
 
 extern arith
 	align();		/* type.c */
diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index 5792379ea..581399992 100644
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -6,34 +6,36 @@ static char *RcsId = "$Header$";
 #include	<alloc.h>
 #include	<em_arith.h>
 #include	<em_label.h>
-#include	"def_sizes.h"
+
+#include	"target_sizes.h"
+#include	"debug.h"
+
 #include	"def.h"
 #include	"type.h"
 #include	"idf.h"
 #include	"LLlex.h"
 #include	"node.h"
 #include	"const.h"
-#include	"debug.h"
 
 /*	To be created dynamically in main() from defaults or from command
 	line parameters.
 */
 int
-	wrd_align = AL_WORD,
+	word_align = AL_WORD,
 	int_align = AL_INT,
-	lint_align = AL_LONG,
-	real_align = AL_FLOAT,
-	lreal_align = AL_DOUBLE,
-	ptr_align = AL_POINTER,
-	record_align = AL_STRUCT;
+	long_align = AL_LONG,
+	float_align = AL_FLOAT,
+	double_align = AL_DOUBLE,
+	pointer_align = AL_POINTER,
+	struct_align = AL_STRUCT;
 
 arith
-	wrd_size = SZ_WORD,
+	word_size = SZ_WORD,
 	int_size = SZ_INT,
-	lint_size = SZ_LONG,
-	real_size = SZ_FLOAT,
-	lreal_size = SZ_DOUBLE,
-	ptr_size = SZ_POINTER;
+	long_size = SZ_LONG,
+	float_size = SZ_FLOAT,
+	double_size = SZ_DOUBLE,
+	pointer_size = SZ_POINTER;
 
 struct type
 	*bool_type,
@@ -83,12 +85,12 @@ construct_type(fund, tp)
 	switch (fund)	{
 	case T_PROCEDURE:
 	case T_POINTER:
-		dtp->tp_align = ptr_align;
-		dtp->tp_size = ptr_size;
+		dtp->tp_align = pointer_align;
+		dtp->tp_size = pointer_size;
 		dtp->next = tp;
 		break;
 	case T_SET:
-		dtp->tp_align = wrd_align;
+		dtp->tp_align = word_align;
 		dtp->next = tp;
 		break;
 	case T_ARRAY:
@@ -135,17 +137,17 @@ init_types()
 	bool_type = standard_type(T_ENUMERATION, 1, (arith) 1);
 	bool_type->enm_ncst = 2;
 	int_type = standard_type(T_INTEGER, int_align, int_size);
-	longint_type = standard_type(T_INTEGER, lint_align, lint_size);
+	longint_type = standard_type(T_INTEGER, long_align, long_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);
+	real_type = standard_type(T_REAL, float_align, float_size);
+	longreal_type = standard_type(T_REAL, double_align, double_size);
+	word_type = standard_type(T_WORD, word_align, word_size);
 	intorcard_type = standard_type(T_INTORCARD, 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;
+	tp->sub_ub = word_size * 8 - 1;
 	bitset_type = set_type(tp);
 	std_type = construct_type(T_PROCEDURE, NULLTYPE);
 	error_type = standard_type(T_CHAR, 1, (arith) 1);
@@ -265,7 +267,7 @@ set_type(tp)
 	/*	Construct a set type with base type "tp", but first
 		perform some checks
 	*/
-	int lb, ub;
+	arith lb, ub;
 
 	if (tp->tp_fund == T_SUBRANGE) {
 		if ((lb = tp->sub_lb) < 0 || (ub = tp->sub_ub) > MAX_SET - 1) {
@@ -285,7 +287,7 @@ set_type(tp)
 		return error_type;
 	}
 	tp = construct_type(T_SET, tp);
-	tp->tp_size = align(((ub - lb) + 7)/8, wrd_align);
+	tp->tp_size = align(((ub - lb) + 7)/8, word_align);
 	return tp;
 }
 
@@ -346,13 +348,9 @@ gcd(m, n)
 
 int
 lcm(m, n)
-	register int m, n;
+	int m, n;
 {
 	/*	Least Common Multiple
  	*/
-	while (m != n) {
-		if (m < n) m = m + m;
-		else n = n + n;
-	}
-	return n;		/* or m */
+	return m * (n / gcd(m, n));
 }
-- 
2.34.1