From 946006fb080ecc94e4837e455c59a202be97ca80 Mon Sep 17 00:00:00 2001
From: ceriel <none@none>
Date: Mon, 18 May 1987 15:57:33 +0000
Subject: [PATCH] many minor corrections

---
 lang/m2/comp/LLlex.c     |  9 +---
 lang/m2/comp/Makefile    | 70 +++++++++++++++++--------------
 lang/m2/comp/chk_expr.c  | 28 ++++++++++---
 lang/m2/comp/code.c      | 67 +++++++++++-------------------
 lang/m2/comp/declar.g    | 89 ++++++++++++++++++++--------------------
 lang/m2/comp/defmodule.c |  6 +--
 lang/m2/comp/desig.c     | 18 ++++----
 lang/m2/comp/main.c      |  3 +-
 lang/m2/comp/options.c   |  3 +-
 lang/m2/comp/program.g   |  5 +--
 lang/m2/comp/scope.C     |  5 ++-
 lang/m2/comp/tokenname.c |  4 ++
 lang/m2/comp/type.H      |  2 +-
 lang/m2/comp/type.c      | 51 ++++++++++++-----------
 lang/m2/comp/walk.c      | 19 ++++-----
 15 files changed, 193 insertions(+), 186 deletions(-)

diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c
index 03bf5bfad..3c6a047b7 100644
--- a/lang/m2/comp/LLlex.c
+++ b/lang/m2/comp/LLlex.c
@@ -156,13 +156,6 @@ getch()
 	return ch;
 }
 
-STATIC
-linedirective() {
-	/*	Read a line directive
-	*/
-	register int	ch;
-}
-
 CheckForLineDirective()
 {
 	register int ch = getch();
@@ -529,7 +522,7 @@ lexwarning(W_ORDINARY, "character constant out of range");
 			tk->TOK_REL = Salloc("0.0", 5);
 			lexerror("floating constant too long");
 		}
-		else	tk->TOK_REL = Salloc(buf, np - buf) + 1;
+		else	tk->TOK_REL = Salloc(buf, (unsigned) (np - buf)) + 1;
 		toktype = real_type;
 		return tk->tk_symb = REAL;
 
diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index bf27961a8..fb1d9ee1a 100644
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -20,7 +20,7 @@ PROFILE =
 CFLAGS = $(PROFILE) $(INCLUDES) -O -DSTATIC=
 LINTFLAGS = -DSTATIC= -DNORCSID
 MALLOC = $(LIBDIR)/malloc.o
-LFLAGS = $(PROFILE)
+LDFLAGS = -i $(PROFILE)
 LSRC =	tokenfile.c program.c declar.c expression.c statement.c
 LOBJ =	tokenfile.o program.o declar.o expression.o statement.o
 CSRC =	LLlex.c LLmessage.c error.c main.c \
@@ -34,7 +34,7 @@ COBJ =	LLlex.o LLmessage.o char.o error.o main.o \
 	cstoper.o chk_expr.o options.o walk.o casestat.o desig.o \
 	code.o tmpvar.o lookup.o Version.o next.o
 GENC=	$(LSRC) symbol2str.c char.c Lpars.c casestat.c tmpvar.c scope.c next.c
-SRC =	$(CSRC) $(GENC) Lpars.c
+SRC =	$(CSRC) $(GENC)
 OBJ =	$(COBJ) $(LOBJ) Lpars.o
 
 GENH=	errout.h\
@@ -137,10 +137,18 @@ depend:
 #INCLINCLINCLINCL
 
 Xlint:
-	lint $(INCLUDES) $(LINTFLAGS) $(SRC)
+	lint $(INCLUDES) $(LINTFLAGS) $(SRC) \
+		$(LIBDIR)/llib-lem_mes.ln \
+		$(LIBDIR)/llib-lemk.ln \
+		$(LIBDIR)/llib-linput.ln \
+		$(LIBDIR)/llib-lassert.ln \
+		$(LIBDIR)/llib-lalloc.ln \
+		$(LIBDIR)/llib-lprint.ln \
+		$(LIBDIR)/llib-lstring.ln \
+		$(LIBDIR)/llib-lsystem.ln
 
 $(CURRDIR)/main:	$(OBJ)
-	$(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 $(CURRDIR)/main
+	$(CC) $(LDFLAGS) $(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 $(CURRDIR)/main
 	size $(CURRDIR)/main
 
 #AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
@@ -162,7 +170,6 @@ LLlex.o: warning.h
 LLmessage.o: LLlex.h
 LLmessage.o: Lpars.h
 LLmessage.o: idf.h
-char.o: class.h
 error.o: LLlex.h
 error.o: debug.h
 error.o: debugcst.h
@@ -189,7 +196,6 @@ main.o: standards.h
 main.o: tokenname.h
 main.o: type.h
 main.o: warning.h
-symbol2str.o: Lpars.h
 tokenname.o: Lpars.h
 tokenname.o: idf.h
 tokenname.o: tokenname.h
@@ -223,14 +229,6 @@ def.o: main.h
 def.o: node.h
 def.o: scope.h
 def.o: type.h
-scope.o: LLlex.h
-scope.o: debug.h
-scope.o: debugcst.h
-scope.o: def.h
-scope.o: idf.h
-scope.o: node.h
-scope.o: scope.h
-scope.o: type.h
 misc.o: LLlex.h
 misc.o: f_info.h
 misc.o: idf.h
@@ -316,15 +314,6 @@ walk.o: scope.h
 walk.o: type.h
 walk.o: walk.h
 walk.o: warning.h
-casestat.o: LLlex.h
-casestat.o: Lpars.h
-casestat.o: debug.h
-casestat.o: debugcst.h
-casestat.o: density.h
-casestat.o: desig.h
-casestat.o: node.h
-casestat.o: type.h
-casestat.o: walk.h
 desig.o: LLlex.h
 desig.o: debug.h
 desig.o: debugcst.h
@@ -344,12 +333,6 @@ code.o: scope.h
 code.o: standards.h
 code.o: type.h
 code.o: walk.h
-tmpvar.o: debug.h
-tmpvar.o: debugcst.h
-tmpvar.o: def.h
-tmpvar.o: main.h
-tmpvar.o: scope.h
-tmpvar.o: type.h
 lookup.o: LLlex.h
 lookup.o: debug.h
 lookup.o: debugcst.h
@@ -359,8 +342,6 @@ lookup.o: misc.h
 lookup.o: node.h
 lookup.o: scope.h
 lookup.o: type.h
-next.o: debug.h
-next.o: debugcst.h
 tokenfile.o: Lpars.h
 program.o: LLlex.h
 program.o: Lpars.h
@@ -405,4 +386,31 @@ statement.o: idf.h
 statement.o: node.h
 statement.o: scope.h
 statement.o: type.h
+symbol2str.o: Lpars.h
+char.o: class.h
 Lpars.o: Lpars.h
+casestat.o: LLlex.h
+casestat.o: Lpars.h
+casestat.o: debug.h
+casestat.o: debugcst.h
+casestat.o: density.h
+casestat.o: desig.h
+casestat.o: node.h
+casestat.o: type.h
+casestat.o: walk.h
+tmpvar.o: debug.h
+tmpvar.o: debugcst.h
+tmpvar.o: def.h
+tmpvar.o: main.h
+tmpvar.o: scope.h
+tmpvar.o: type.h
+scope.o: LLlex.h
+scope.o: debug.h
+scope.o: debugcst.h
+scope.o: def.h
+scope.o: idf.h
+scope.o: node.h
+scope.o: scope.h
+scope.o: type.h
+next.o: debug.h
+next.o: debugcst.h
diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index 500b98774..75e20d6a2 100644
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -33,6 +33,7 @@
 #include	"warning.h"
 
 extern char *symbol2str();
+extern char *sprint();
 
 STATIC
 Xerror(nd, mess, edf)
@@ -293,7 +294,7 @@ ChkElement(expp, tp, set, level)
 	register struct node *expr = *expp;
 	register struct node *left = expr->nd_left;
 	register struct node *right = expr->nd_right;
-	register int i;
+	register arith i;
 
 	if (expr->nd_class == Link && expr->nd_symb == UPTO) {
 		/* { ... , expr1 .. expr2,  ... }
@@ -310,7 +311,7 @@ ChkElement(expp, tp, set, level)
 			*/
 
 		    	if (left->nd_INT > right->nd_INT) {
-node_error(expp, "lower bound exceeds upper bound in range");
+node_error(expr, "lower bound exceeds upper bound in range");
 				return 0;
 			}
 
@@ -385,7 +386,7 @@ ChkSet(expp)
 		if (!is_type(df) ||
 	   	    (df->df_type->tp_fund != T_SET)) {
 			if (df->df_kind != D_ERROR) {
-				Xerror(expp, "not a set type", df);
+				Xerror(nd, "not a set type", df);
 			}
 			return 0;
 		}
@@ -571,6 +572,23 @@ ChkProcCall(expp)
 	return retval;
 }
 
+int
+ChkFunCall(expp)
+	register struct node *expp;
+{
+	/*	Check a call that must have a result
+	*/
+	int retval = 1;
+
+	if (!ChkCall(expp)) retval = 0;
+	if (expp->nd_type == 0) {
+		node_error(expp, "function call expected");
+		expp->nd_type = error_type;
+		retval = 0;
+	}
+	return retval;
+}
+
 int
 ChkCall(expp)
 	register struct node *expp;
@@ -1007,7 +1025,7 @@ ChkStandard(expp, left)
 			tk->TOK_INT = PointedtoType(left->nd_type)->tp_size;
 			tk->tk_symb = INTEGER;
 			tk->tk_lineno = left->nd_lineno;
-			nd = MkLeaf(Value, &dt);
+			nd = MkLeaf(Value, tk);
 			nd->nd_type = card_type;
 			tk->tk_symb = ',';
 			arg->nd_right = MkNode(Link, nd, NULLNODE, tk);
@@ -1199,7 +1217,7 @@ int (*ExprChkTable[])() = {
 	ChkBinOper,
 	ChkUnOper,
 	ChkArrow,
-	ChkCall,
+	ChkFunCall,
 	ChkExLinkOrName,
 	NodeCrash,
 	ChkSet,
diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index f7afbae21..305d2c4fc 100644
--- a/lang/m2/comp/code.c
+++ b/lang/m2/comp/code.c
@@ -49,11 +49,9 @@ CodeConst(cst, size)
 	else {
 		crash("(CodeConst)");
 /*
-		label dlab = ++data_label;
-
-		C_df_dlb(dlab);
+		C_df_dlb(++data_label);
 		C_rom_icon(long2str((long) cst), size);
-		C_lae_dlb(dlab, (arith) 0);
+		C_lae_dlb(data_label, (arith) 0);
 		C_loi(size);
 */
 	}
@@ -63,14 +61,13 @@ CodeString(nd)
 	register struct node *nd;
 {
 	if (nd->nd_type->tp_fund != T_STRING) {
+		/* Character constant */
 		C_loc(nd->nd_INT);
 	}
 	else {
-		label lab = ++data_label;
-
-		C_df_dlb(lab);
+		C_df_dlb(++data_label);
 		C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1));
-		C_lae_dlb(lab, (arith) 0);
+		C_lae_dlb(data_label, (arith) 0);
 	}
 }
 
@@ -100,11 +97,8 @@ CodeExpr(nd, ds, true_label, false_label)
 
 	case Oper:
 		CodeOper(nd, true_label, false_label);
-		if (true_label == 0) ds->dsg_kind = DSG_LOADED;
-		else {
-			ds->dsg_kind = DSG_INIT;
-			true_label = 0;
-		}
+		ds->dsg_kind = DSG_LOADED;
+		true_label = NO_LABEL;
 		break;
 
 	case Uoper:
@@ -114,14 +108,11 @@ CodeExpr(nd, ds, true_label, false_label)
 
 	case Value:
 		switch(nd->nd_symb) {
-		case REAL: {
-			label lab = ++data_label;
-
-			C_df_dlb(lab);
+		case REAL:
+			C_df_dlb(++data_label);
 			C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size);
-			C_lae_dlb(lab, (arith) 0);
+			C_lae_dlb(data_label, (arith) 0);
 			C_loi(nd->nd_type->tp_size);
-			}
 			break;
 		case STRING:
 			CodeString(nd);
@@ -142,16 +133,11 @@ CodeExpr(nd, ds, true_label, false_label)
 
 	case Xset:
 	case Set: {
-		register arith *st = nd->nd_set;
-		register int i;
+		register int i = tp->tp_size / word_size;
+		register arith *st = nd->nd_set + i;
 
-		st = nd->nd_set;
 		ds->dsg_kind = DSG_LOADED;
-		if (!st) {
-			C_zer(tp->tp_size);
-			break;
-		}
-		for (i = tp->tp_size / word_size, st += i; i > 0; i--) { 
+		for (; i > 0; i--) { 
 			C_loc(*--st);
 		}
 		CodeSet(nd);
@@ -162,11 +148,10 @@ CodeExpr(nd, ds, true_label, false_label)
 		crash("(CodeExpr) bad node type");
 	}
 
-	if (true_label != 0) {
+	if (true_label != NO_LABEL) {
 		/* Only for boolean expressions
 		*/
 		CodeValue(ds, tp->tp_size, tp->tp_align);
-		*ds = InitDesig;
 		C_zne(true_label);
 		C_bra(false_label);
 	}
@@ -304,10 +289,10 @@ CodeCall(nd)
 		register struct def *df = left->nd_def;
 
 		if (df->df_kind == D_PROCEDURE) {
-			arith level = df->df_scope->sc_level;
+			int level = df->df_scope->sc_level;
 
 			if (level > 0) {
-				C_lxl((arith) proclevel - level);
+				C_lxl((arith) (proclevel - level));
 			}
 			C_cal(NameOfProc(df));
 			break;
@@ -321,7 +306,7 @@ CodeCall(nd)
 		CodePExpr(left);
 		C_cai();
 	}
-	if (left->nd_type->prc_nbpar) C_asp(left->nd_type->prc_nbpar);
+	C_asp(left->nd_type->prc_nbpar);
 	if (result_tp = ResultType(left->nd_type)) {
 		if (IsConstructed(result_tp)) {
 			C_lfr(pointer_size);
@@ -353,7 +338,7 @@ CodeParameters(param, arg)
 
 		C_loc(tp->arr_elsize);
 		if (IsConformantArray(left_type)) {
-			DoHIGH(left);
+			DoHIGH(left->nd_def);
 			if (elem->tp_size != left_type->arr_elem->tp_size) {
 				/* This can only happen if the formal type is
 				   ARRAY OF (WORD|BYTE)
@@ -478,13 +463,13 @@ CodeStd(nd)
 
 	case S_HIGH:
 		assert(IsConformantArray(tp));
-		DoHIGH(left);
+		DoHIGH(left->nd_def);
 		break;
 
 	case S_SIZE:
 	case S_TSIZE:
 		assert(IsConformantArray(tp));
-		DoHIGH(left);
+		DoHIGH(left->nd_def);
 		C_inc();
 		C_loc(tp->arr_elem->tp_size);
 		C_mlu(word_size);
@@ -777,7 +762,7 @@ CodeOper(expr, true_label, false_label)
 		default:
 			crash("bad type COMPARE");
 		}
-		if (true_label != 0)	{
+		if (true_label != NO_LABEL)	{
 			compare(expr->nd_symb, true_label);
 			C_bra(false_label);
 		}
@@ -794,7 +779,7 @@ CodeOper(expr, true_label, false_label)
 		CodePExpr(leftop);
 		CodeCoercion(leftop->nd_type, word_type);
 		C_inn(rightop->nd_type->tp_size);
-		if (true_label != 0) {
+		if (true_label != NO_LABEL) {
 			C_zne(true_label);
 			C_bra(false_label);
 		}
@@ -806,7 +791,7 @@ CodeOper(expr, true_label, false_label)
 		struct desig Des;
 		int genlabels = 0;
 
-		if (true_label == 0)	{
+		if (true_label == NO_LABEL)	{
 			genlabels = 1;
 			true_label = ++text_label;
 			false_label = ++text_label;
@@ -1000,17 +985,15 @@ CodeDStore(nd)
 	CodeStore(&designator, nd->nd_type->tp_size, nd->nd_type->tp_align);
 }
 
-DoHIGH(nd)
-	struct node *nd;
+DoHIGH(df)
+	register struct def *df;
 {
 	/*	Get the high index of a conformant array, indicated by "nd".
 		The high index is the second field in the descriptor of
 		the array, so it is easily found.
 	*/
-	register struct def *df = nd->nd_def;
 	register arith highoff;
 
-	assert(nd->nd_class == Def);
 	assert(df->df_kind == D_VARIABLE);
 	assert(IsConformantArray(df->df_type));
 
diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index 229fcbf41..3a67f1a62 100644
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -132,7 +132,7 @@ TypeDeclaration
 {
 	struct def *df;
 	struct type *tp;
-	struct node *nd;
+	register struct node *nd;
 }:
 	IDENT		{ df = define(dot.TOK_IDF, CurrentScope, D_TYPE);
 			  nd = MkLeaf(Name, &dot);
@@ -143,7 +143,7 @@ TypeDeclaration
 			}
 ;
 
-type(struct type **ptp;):
+type(register struct type **ptp;):
 	%default SimpleType(ptp)
 |
 	ArrayType(ptp)
@@ -157,7 +157,7 @@ type(struct type **ptp;):
 	ProcedureType(ptp)
 ;
 
-SimpleType(struct type **ptp;)
+SimpleType(register struct type **ptp;)
 {
 	struct type *tp;
 } :
@@ -264,9 +264,9 @@ FieldListSequence(struct scope *scope; arith *cnt; int *palign;):
 FieldList(struct scope *scope; arith *cnt; int *palign;)
 {
 	struct node *FldList;
-	register struct idf *id = 0;
 	struct type *tp;
 	struct node *nd;
+	register struct def *df;
 	arith tcnt, max;
 } :
 [
@@ -288,7 +288,17 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 			{ if (nd->nd_class != Name) {
 				error("illegal variant tag");
 		  	  }
-		  	  else	id = nd->nd_IDF;
+			  else {
+			  	df = define(nd->nd_IDF, scope, D_FIELD);
+			  	*palign = lcm(*palign, tp->tp_align);
+			  	if (!(tp->tp_fund & T_DISCRETE)) {
+					error("illegal type in variant");
+			  	}
+			  	df->df_type = tp;
+			  	df->fld_off = align(*cnt, tp->tp_align);
+			  	*cnt = df->fld_off + tp->tp_size;
+			  	df->df_flags |= D_QEXPORTED;
+			  }
 			  FreeNode(nd);
 			}
 	  |		/* Old fashioned! the first qualident now represents
@@ -302,22 +312,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 	| ':' qualtype(&tp)
 	  /* Aha, third edition. Well done! */
 	]
-			{
-			  *palign = lcm(*palign, tp->tp_align);
-			  if (id) {
-			  	register struct def *df = 
-					define(id, scope, D_FIELD);
-
-			  	if (!(tp->tp_fund & T_DISCRETE)) {
-					error("illegal type in variant");
-			  	}
-			  	df->df_type = tp;
-			  	df->fld_off = align(*cnt, tp->tp_align);
-			  	*cnt = df->fld_off + tp->tp_size;
-			  	df->df_flags |= D_QEXPORTED;
-			  }
-			  tcnt = *cnt;
-			}
+			{ tcnt = *cnt; }
 	OF variant(scope, &tcnt, tp, palign)
 			{ max = tcnt; tcnt = *cnt; }
 	[
@@ -360,26 +355,26 @@ CaseLabelList(struct type **ptp; struct node **pnd;):
 
 CaseLabels(struct type **ptp; register struct node **pnd;)
 {
-	register struct node *nd1;
+	register struct node *nd;
 }:
 	ConstExpression(pnd)
-			{ nd1 = *pnd; }
+			{ nd = *pnd; }
 	[
-		UPTO	{ *pnd = MkNode(Link,nd1,NULLNODE,&dot); }
+		UPTO	{ *pnd = MkNode(Link,nd,NULLNODE,&dot); }
 		ConstExpression(&(*pnd)->nd_right)
-			{ if (!TstCompat(nd1->nd_type,
+			{ if (!TstCompat(nd->nd_type,
 					 (*pnd)->nd_right->nd_type)) {
 				node_error((*pnd)->nd_right,
 					  "type incompatibility in case label");
-			  	nd1->nd_type = error_type;
+			  	nd->nd_type = error_type;
 			  }
 			}
 	]?
-			{ if (*ptp != 0 && !TstCompat(*ptp, nd1->nd_type)) {
-				node_error(nd1,
+			{ if (*ptp != 0 && !TstCompat(*ptp, nd->nd_type)) {
+				node_error(nd,
 					  "type incompatibility in case label");
 			  }
-			  *ptp = nd1->nd_type;
+			  *ptp = nd->nd_type;
 			}
 ;
 
@@ -392,7 +387,7 @@ SetType(struct type **ptp;) :
 	have to be declared yet, so be careful about identifying
 	type-identifiers
 */
-PointerType(struct type **ptp;) :
+PointerType(register struct type **ptp;) :
 	POINTER TO
 	[ %if	(type_or_forward(ptp))
 	  type(&((*ptp)->next)) 
@@ -409,7 +404,7 @@ qualtype(struct type **ptp;)
 		{ *ptp = qualified_type(nd); }
 ;
 
-ProcedureType(struct type **ptp;)
+ProcedureType(register struct type **ptp;)
 {
 	struct paramlist *pr = 0;
 	arith parmaddr = 0;
@@ -423,18 +418,12 @@ ProcedureType(struct type **ptp;)
 			{ *ptp = proc_type(*ptp, pr, parmaddr); }
 ;
 
-FormalTypeList(struct paramlist **ppr; arith *parmaddr; struct type **ptp;)
-{
-	struct type *tp;
-	int VARp;
-} :
+FormalTypeList(struct paramlist **ppr; arith *parmaddr; struct type **ptp;):
 	'('
 	[
-		var(&VARp) FormalType(&tp)
-			{ EnterParamList(ppr,NULLNODE,tp,VARp,parmaddr); }
+		VarFormalType(ppr, parmaddr)
 		[
-			',' var(&VARp) FormalType(&tp)
-			{ EnterParamList(ppr,NULLNODE,tp,VARp,parmaddr); }
+			',' VarFormalType(ppr, parmaddr)
 		]*
 	]?
 	')'
@@ -442,10 +431,22 @@ FormalTypeList(struct paramlist **ppr; arith *parmaddr; struct type **ptp;)
 	]?
 ;
 
-var(int *VARp;):
-	VAR		{ *VARp = D_VARPAR; }
-|
-	/* empty */	{ *VARp = D_VALPAR; }
+VarFormalType(struct paramlist **ppr; arith *parmaddr;)
+{
+	struct type *tp;
+	int isvar;
+} :
+	var(&isvar)
+	FormalType(&tp)
+			{ EnterParamList(ppr,NULLNODE,tp,isvar,parmaddr); }
+;
+
+var(int *VARp;) :
+	[
+		VAR		{ *VARp = D_VARPAR; }
+	|
+		/* empty */	{ *VARp = D_VALPAR; }
+	]
 ;
 
 ConstantDeclaration
diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c
index d402a7805..6b913327a 100644
--- a/lang/m2/comp/defmodule.c
+++ b/lang/m2/comp/defmodule.c
@@ -36,7 +36,7 @@ struct idf *DefId;
 
 STATIC char *
 getwdir(fn)
-	char *fn;
+	register char *fn;
 {
 	register char *p;
 	char *strrindex();
@@ -49,7 +49,7 @@ getwdir(fn)
 
 	if (p) {
 		*p = '\0';
-		fn = Salloc(fn, p - &fn[0] + 1);
+		fn = Salloc(fn, (unsigned) (p - &fn[0] + 1));
 		*p = '/';
 		return fn;
 	}
@@ -64,7 +64,7 @@ GetFile(name)
 		in the directories mentioned in "DEFPATH".
 	*/
 	char buf[15];
-	char *strcpy(), *strcat();
+	char *strncpy(), *strcat();
 	static char *WorkingDir = ".";
 
 	strncpy(buf, name, 10);
diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c
index d04ccf19f..63da0249c 100644
--- a/lang/m2/comp/desig.c
+++ b/lang/m2/comp/desig.c
@@ -67,7 +67,6 @@ CodeValue(ds, size, al)
 	/*	Generate code to load the value of the designator described
 		in "ds"
 	*/
-	arith tmp = 0;
 
 	switch(ds->dsg_kind) {
 	case DSG_LOADED:
@@ -100,14 +99,16 @@ CodeValue(ds, size, al)
 			break;
 		}
 		if (ds->dsg_kind == DSG_PLOADED) {
-			tmp = NewPtr();
-			C_stl(tmp);
+			arith sz = WA(size) - pointer_size;
+
+			C_asp(-sz);
+			C_lor((arith) 1);
+			C_adp(sz);
+			C_loi(pointer_size);
 		}
-		C_asp(-WA(size));
-		if (!tmp) CodeAddress(ds);
-		else {
-			C_lol(tmp);
-			FreePtr(tmp);
+		else  {
+			C_asp(-WA(size));
+			CodeAddress(ds);
 		}
 		C_loc(size);
 		C_cal("_load");
@@ -300,6 +301,7 @@ CodeMove(rhs, left, rtp)
 		}
 		{
 			arith tmp;
+			extern arith NewPtr();
 
 			if (loadedflag) {	
 				tmp = NewPtr();
diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c
index 427fb241d..9019d634d 100644
--- a/lang/m2/comp/main.c
+++ b/lang/m2/comp/main.c
@@ -14,6 +14,7 @@
 #include	<system.h>
 #include	<em_arith.h>
 #include	<em_label.h>
+#include	<alloc.h>
 
 #include	"input.h"
 #include	"f_info.h"
@@ -101,7 +102,7 @@ Compile(src, dst)
 	C_ms_emx(word_size, pointer_size);
 	CheckForLineDirective();
 	CompUnit();
-	C_ms_src((arith) (LineNumber - 1), FileName);
+	C_ms_src((int)LineNumber - 1, FileName);
 	if (!err_occurred) {
 		C_exp(Defined->mod_vis->sc_scope->sc_name);
 		WalkModule(Defined);
diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c
index 6bcf3d164..174206112 100644
--- a/lang/m2/comp/options.c
+++ b/lang/m2/comp/options.c
@@ -13,6 +13,7 @@
 
 #include	<em_arith.h>
 #include	<em_label.h>
+#include	<alloc.h>
 
 #include	"type.h"
 #include	"main.h"
@@ -117,7 +118,7 @@ DoOption(text)
 
 			if (++nDEF > mDEF) {
 				char **n = (char **)
-					Malloc((10+mDEF)*sizeof(char *));
+				   Malloc((unsigned)((10+mDEF)*sizeof(char *)));
 
 				for (i = 0; i < mDEF; i++) {
 					n[i] = DEFPATH[i];
diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g
index 034ff445d..e6852401a 100644
--- a/lang/m2/comp/program.g
+++ b/lang/m2/comp/program.g
@@ -66,10 +66,7 @@ ModuleDeclaration
 			}
 ;
 
-priority(register struct def *df;)
-{
-	register struct node *nd;
-} :
+priority(register struct def *df;):
 	[
 		'[' ConstExpression(&(df->mod_priority)) ']'
 			{ if (!(df->mod_priority->nd_type->tp_fund &
diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C
index 337feefa8..8f0b6534c 100644
--- a/lang/m2/comp/scope.C
+++ b/lang/m2/comp/scope.C
@@ -60,7 +60,7 @@ open_and_close_scope(scopetype)
 
 	open_scope(scopetype);
 	sc = CurrentScope;
-	close_scope();
+	close_scope(0);
 	return sc;
 }
 
@@ -106,7 +106,7 @@ chk_proc(df)
 
 STATIC
 chk_forw(pdf)
-	register struct def **pdf;
+	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
@@ -197,6 +197,7 @@ Reverse(pdf)
 }
 
 close_scope(flag)
+	register int flag;
 {
 	/*	Close a scope. If "flag" is set, check for forward declarations,
 		either POINTER declarations, or EXPORTs, or forward references
diff --git a/lang/m2/comp/tokenname.c b/lang/m2/comp/tokenname.c
index c78f50bd9..cbf7c8413 100644
--- a/lang/m2/comp/tokenname.c
+++ b/lang/m2/comp/tokenname.c
@@ -20,6 +20,7 @@
 	Also, the "token2str.c" file is produced from this file.
 */
 
+#ifdef ___XXX___
 struct tokenname tkspec[] =	{	/* the names of the special tokens */
 	{IDENT, "identifier"},
 	{STRING, "string"},
@@ -35,6 +36,7 @@ struct tokenname tkcomp[] =	{	/* names of the composite tokens */
 	{BECOMES, ":="},
 	{0, ""}
 };
+#endif
 
 struct tokenname tkidf[] =	{	/* names of the identifier tokens */
 	{AND, "AND"},
@@ -80,6 +82,7 @@ struct tokenname tkidf[] =	{	/* names of the identifier tokens */
 	{0, ""}
 };
 
+#ifdef ___XXX___
 struct tokenname tkinternal[] = {	/* internal keywords	*/
 	{PROGRAM, ""},
 	{0, "0"}
@@ -88,6 +91,7 @@ struct tokenname tkinternal[] = {	/* internal keywords	*/
 struct tokenname tkstandard[] =	{	/* standard identifiers */
 	{0, ""}
 };
+#endif
 
 /* Some routines to handle tokennames */
 
diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H
index 9bca0e904..06cc533c5 100644
--- a/lang/m2/comp/type.H
+++ b/lang/m2/comp/type.H
@@ -12,7 +12,7 @@
 struct paramlist {		/* structure for parameterlist of a PROCEDURE */
 	struct paramlist *next;
 	struct def *par_def;	/* "df" of parameter */
-#define	IsVarParam(xpar)	((xpar)->par_def->df_flags & D_VARPAR)
+#define	IsVarParam(xpar)	((int) ((xpar)->par_def->df_flags & D_VARPAR))
 #define TypeOfParam(xpar)	((xpar)->par_def->df_type)
 };
 
diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index b9eb03ced..9afdc889a 100644
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -217,7 +217,7 @@ u_small(tp, n)
 		tp->tp_size = 1;
 		tp->tp_align = 1;
 	}
-	else if (ufit(n, short_size)) {
+	else if (ufit(n, (int)short_size)) {
 		tp->tp_size = short_size;
 		tp->tp_align = short_align;
 	}
@@ -302,16 +302,18 @@ chk_basesubrange(tp, base)
 
 struct type *
 subr_type(lb, ub)
-	struct node *lb, *ub;
+	register struct node *lb;
+	struct node *ub;
 {
 	/*	Construct a subrange type from the constant expressions
 		indicated by "lb" and "ub", but first perform some
 		checks
 	*/
-	register struct type *tp = BaseType(lb->nd_type), *res;
+	register struct type *tp = BaseType(lb->nd_type);
+	register struct type *res;
 
 	if (!TstCompat(lb->nd_type, ub->nd_type)) {
-		node_error(ub, "types of subrange bounds not equal");
+		node_error(lb, "types of subrange bounds not equal");
 		return error_type;
 	}
 
@@ -326,14 +328,14 @@ subr_type(lb, ub)
 	/* Check base type
 	*/
 	if (! (tp->tp_fund & T_DISCRETE)) {
-		node_error(ub, "illegal base type for subrange");
+		node_error(lb, "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(lb, "lower bound exceeds upper bound");
 	}
 
 	/* Now construct resulting type
@@ -351,8 +353,8 @@ subr_type(lb, ub)
 			res->tp_size = 1;
 			res->tp_align = 1;
 		}
-		else if (fit(res->sub_lb, short_size) &&
-			 fit(res->sub_ub, short_size)) {
+		else if (fit(res->sub_lb, (int)short_size) &&
+			 fit(res->sub_ub, (int)short_size)) {
 			res->tp_size = short_size;
 			res->tp_align = short_align;
 		}
@@ -381,22 +383,19 @@ genrck(tp)
 	*/
 	arith lb, ub;
 	register label ol;
-	int newlabel = 0;
 
 	getbounds(tp, &lb, &ub);
 
 	if (tp->tp_fund == T_SUBRANGE) {
 		if (!(ol = tp->sub_rck)) {
-			tp->sub_rck = ol = ++data_label;
-			newlabel = 1;
+			tp->sub_rck = ++data_label;
 		}
 	}
 	else if (!(ol = tp->enm_rck)) {
-		tp->enm_rck = ol = ++data_label;
-		newlabel = 1;
+		tp->enm_rck = ++data_label;
 	}
-	if (newlabel) {
-		C_df_dlb(ol);
+	if (!ol) {
+		C_df_dlb(ol = data_label);
 		C_rom_cst(lb);
 		C_rom_cst(ub);
 	}
@@ -571,18 +570,21 @@ int
 type_or_forward(ptp)
 	struct type **ptp;
 {
-	struct node *nd = 0;
+	/*	POINTER TO IDENTIFIER construction. The IDENTIFIER resides
+		in "dot". This routine handles the different cases.
+	*/
+	register struct node *nd;
 
 	*ptp = construct_type(T_POINTER, NULLTYPE);
-	if (lookup(dot.TOK_IDF, CurrentScope, 1)
+	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
 		*/
-	    ||
-	    ( nd = new_node(),
-	      nd->nd_token = dot,
-	      lookfor(nd, CurrVis, 0)->df_kind == D_MODULE
-	    )
+		return 1;
+	}
+	nd = new_node();
+	nd->nd_token = dot;
+	if (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
@@ -591,8 +593,7 @@ type_or_forward(ptp)
 		   one token.
 		   ???
 		*/
-	   ) {
-		if (nd) free_node(nd);
+		free_node(nd);
 		return 1;
 	}
 	/*	Enter a forward reference into a list belonging to the
@@ -652,7 +653,7 @@ DumpType(tp)
 	switch(tp->tp_fund) {
 	case T_RECORD:
 		print("RECORD\n");
-		DumpScope(tp->rec_scope);
+		DumpScope(tp->rec_scope->sc_def);
 		break;
 	case T_ENUMERATION:
 		print("ENUMERATION; ncst:%d", tp->enm_ncst); break;
diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index f8328455e..f64ac4070 100644
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -75,15 +75,14 @@ DoProfil()
 	static label	filename_label = 0;
 
 	if (! options['L']) {
-		register label fn_label = filename_label;
 
-		if (!fn_label) {
-			filename_label = fn_label = ++data_label;
-			C_df_dlb(fn_label);
+		if (!filename_label) {
+			filename_label = ++data_label;
+			C_df_dlb(filename_label);
 			C_rom_scon(FileName, (arith) (strlen(FileName) + 1));
 		}
 
-		C_fil_dlb(fn_label, (arith) 0);
+		C_fil_dlb(filename_label, (arith) 0);
 	}
 }
 
@@ -126,16 +125,14 @@ WalkModule(module)
 			/* We don't actually prevent recursive calls,
 			   but do nothing if called recursively
 			*/
-			label l1 = ++data_label;
-
-			C_df_dlb(l1);
-			C_bss_cst(word_size, (arith) 0, 1);
+			C_df_dlb(++data_label);
+			C_con_cst((arith) 0);
 			/* if this one is set to non-zero, the initialization
 			   was already done.
 			*/
-			C_loe_dlb(l1, (arith) 0);
+			C_loe_dlb(data_label, (arith) 0);
 			C_zne(RETURN_LABEL);
-			C_ine_dlb(l1, (arith) 0);
+			C_ine_dlb(data_label, (arith) 0);
 		}
 
 		for (; nd; nd = nd->next) {
-- 
2.34.1