From 7f9fd963fd67207054ee4cfe08df468eae4a0b97 Mon Sep 17 00:00:00 2001
From: ceriel <none@none>
Date: Wed, 23 Mar 1988 17:44:25 +0000
Subject: [PATCH] many minor mods

---
 lang/m2/comp/LLlex.c     |  5 ++++-
 lang/m2/comp/Makefile    |  1 +
 lang/m2/comp/Version.c   |  2 +-
 lang/m2/comp/chk_expr.c  |  2 --
 lang/m2/comp/code.c      | 19 ++++++++++-------
 lang/m2/comp/def.c       | 25 ++++++++++++----------
 lang/m2/comp/defmodule.c |  5 ++---
 lang/m2/comp/desig.c     | 46 ++++++++++++++++++++++++----------------
 lang/m2/comp/enter.c     |  2 +-
 lang/m2/comp/program.g   |  7 ++++--
 lang/m2/comp/tmpvar.C    |  2 +-
 lang/m2/comp/typequiv.c  |  2 +-
 lang/m2/comp/walk.c      | 43 ++++++++++++++++++++-----------------
 13 files changed, 92 insertions(+), 69 deletions(-)

diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c
index 530911433..3337102b3 100644
--- a/lang/m2/comp/LLlex.c
+++ b/lang/m2/comp/LLlex.c
@@ -354,7 +354,10 @@ again:
 
 		if (ch == EOI) eofseen = 1;
 		else PushBack();
-		*tag++ = '\0';
+		*tag = '\0';
+		if (*(tag - 1) == '_') {
+			lexerror("last character of an identifier may not be a '_'");
+		}
 
 		tk->TOK_IDF = id = str2idf(buf, 1);
 		return tk->tk_symb = id->id_reserved ? id->id_reserved : IDENT;
diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index 938708c6f..ee19ebdc7 100644
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -292,6 +292,7 @@ node.o: LLlex.h
 node.o: debug.h
 node.o: debugcst.h
 node.o: def.h
+node.o: main.h
 node.o: nocross.h
 node.o: node.h
 node.o: target_sizes.h
diff --git a/lang/m2/comp/Version.c b/lang/m2/comp/Version.c
index e1b1e8c3e..3c092b75c 100644
--- a/lang/m2/comp/Version.c
+++ b/lang/m2/comp/Version.c
@@ -1 +1 @@
-static char Version[] = "ACK Modula-2 compiler Version 0.36";
+static char Version[] = "ACK Modula-2 compiler Version 0.37";
diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index 58de781be..88c1a7f19 100644
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -1407,7 +1407,6 @@ int (*ExprChkTable[])() = {
 	done_before,
 	NodeCrash,
 	ChkExLinkOrName,
-	NodeCrash
 };
 
 int (*DesigChkTable[])() = {
@@ -1423,5 +1422,4 @@ int (*DesigChkTable[])() = {
 	done_before,
 	NodeCrash,
 	ChkLinkOrName,
-	NodeCrash
 };
diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index 484cdfa1b..15f521122 100644
--- a/lang/m2/comp/code.c
+++ b/lang/m2/comp/code.c
@@ -359,7 +359,8 @@ CodeCall(nd)
 		}
 		else	C_lfr(sz);
 	}
-	DoFilename(nd);
+	DoFilename();
+	DoLineno(nd);
 }
 
 CodeParameters(param, arg)
@@ -503,12 +504,12 @@ CodeStd(nd)
 	case S_ABS:
 		CodePExpr(left);
 		if (tp->tp_fund == T_INTEGER) {
-			if (tp->tp_size == int_size) C_cal("_absi");
-			else	C_cal("_absl");
+			if (tp->tp_size == int_size) C_cal("absi");
+			else	C_cal("absl");
 		}
 		else if (tp->tp_fund == T_REAL) {
-			if (tp->tp_size == float_size) C_cal("_absf");
-			else	C_cal("_absd");
+			if (tp->tp_size == float_size) C_cal("absf");
+			else	C_cal("absd");
 		}
 		C_asp(tp->tp_size);
 		C_lfr(tp->tp_size);
@@ -585,7 +586,7 @@ CodeStd(nd)
 		}
 
 	case S_HALT:
-		C_cal("_halt");
+		C_cal("halt");
 		break;
 
 	case S_INCL:
@@ -1026,7 +1027,7 @@ CodeEl(nd, tp)
 		}
 		else	C_loc((arith) (eltype->enm_ncst - 1));
 		Operands(nd);
-		C_cal("_LtoUset");	/* library routine to fill set */
+		C_cal("LtoUset");	/* library routine to fill set */
 		C_asp(5 * word_size);
 	}
 	else {
@@ -1060,7 +1061,9 @@ CodeDAddress(nd)
 
 	register t_desig *designator = new_desig();
 
-	ChkForFOR(nd);
+	/* ChkForFOR(nd); ??? not quite: wrong for value conformant arrays,
+			  where the parameter is the for-loop control variable
+	*/
 	CodeDesig(nd, designator);
 	CodeAddress(designator);
 	free_desig(designator);
diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c
index 9afcb53d3..544b09fa1 100644
--- a/lang/m2/comp/def.c
+++ b/lang/m2/comp/def.c
@@ -27,6 +27,16 @@
 #include	"Lpars.h"
 #include	"warning.h"
 
+STATIC
+internal(c)
+	register char *c;
+{
+	if (options['x']) {
+		C_exp(c);
+	}
+	else	C_inp(c);
+}
+
 STATIC
 DefInFront(df)
 	register t_def *df;
@@ -256,7 +266,7 @@ DeclProc(type, id)
 			df->for_name = id->id_text;
 		}
 		else {
-			sprint(buf,"_%s_%s",CurrentScope->sc_name,id->id_text);
+			sprint(buf,"%s_%s",CurrentScope->sc_name,id->id_text);
 			df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1));
 		}
 		if (CurrVis == Defined->mod_vis) {
@@ -281,10 +291,7 @@ DeclProc(type, id)
 			df = define(id, CurrentScope, type);
 			sprint(buf,"_%d_%s",++nmcount,id->id_text);
 			name = Salloc(buf, (unsigned)(strlen(buf)+1));
-			if (options['x']) {
-				C_exp(buf);
-			}
-			else	C_inp(buf);
+			internal(buf);
 			df->df_flags |= D_DEFINED;
 		}
 		open_scope(OPENSCOPE);
@@ -330,7 +337,7 @@ DefineLocalModule(id)
 	extern char *sprint();
 	extern int proclevel;
 
-	sprint(buf, "_%d%s", ++modulecount, id->id_text);
+	sprint(buf, "_%d%s_", ++modulecount, id->id_text);
 
 	if (!df->mod_vis) {	
 		/* We never saw the name of this module before. Create a
@@ -355,11 +362,7 @@ DefineLocalModule(id)
 	/* Generate code that indicates that the initialization procedure
 	   for this module is local.
 	*/
-	if (options['x']) {
-		C_exp(buf);
-	}
-	else	C_inp(buf);
-
+	internal(buf);
 	return df;
 }
 
diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c
index 2af9d4300..abfe9eb38 100644
--- a/lang/m2/comp/defmodule.c
+++ b/lang/m2/comp/defmodule.c
@@ -128,9 +128,8 @@ GetDefinitionModule(id, incr)
 					register t_node *n;
 					extern t_node *Modules;
 
-					n = dot2leaf(Name);
-					n->nd_IDF = id;
-					n->nd_symb = IDENT;
+					n = dot2leaf(Def);
+					n->nd_def = CurrentScope->sc_definedby;
 					if (nd_end) nd_end->nd_left = n;
 					else Modules = n;
 					nd_end = n;
diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c
index 958c14bf4..d55f4f292 100644
--- a/lang/m2/comp/desig.c
+++ b/lang/m2/comp/desig.c
@@ -214,7 +214,10 @@ CodeValue(ds, tp)
 			break;
 		case USE_LOAD_STORE:
 			sz = WA(tp->tp_size);
-			if (ds->dsg_kind != DSG_PFIXED) {
+#ifndef SQUEEZE
+			if (ds->dsg_kind != DSG_PFIXED)
+#endif
+			{
 				arith tmp = NewPtr();
 
 				CodeAddress(ds);
@@ -224,13 +227,15 @@ CodeValue(ds, tp)
 				LOL(tmp, pointer_size);
 				FreePtr(tmp);
 			}
+#ifndef SQUEEZE
 			else  {
 				CodeConst(-sz, (int) pointer_size);
 				C_ass(pointer_size);
 			}
+#endif
 			CodeAddress(ds);
 			CodeConst(tp->tp_size, (int) pointer_size);
-			C_cal("_load");
+			C_cal("load");
 			C_asp(pointer_size + pointer_size);
 			break;
 		}
@@ -293,7 +298,7 @@ CodeStore(ds, tp)
 			break;
 		case USE_LOAD_STORE:
 			CodeConst(tp->tp_size, (int) pointer_size);
-			C_cal("_store");
+			C_cal("store");
 			CodeConst(pointer_size + pointer_size + WA(tp->tp_size),
 			  	(int) pointer_size);
 			C_ass(pointer_size);
@@ -362,7 +367,7 @@ CodeMove(rhs, left, rtp)
 			CodeAddress(lhs);
 			C_loc(rtp->tp_size);
 			C_loc(tp->tp_size);
-			C_cal("_StringAssign");
+			C_cal("StringAssign");
 			C_asp(pointer_size + pointer_size + dword_size);
 			break;
 		}
@@ -430,7 +435,7 @@ CodeMove(rhs, left, rtp)
 		case USE_LOAD_STORE:
 		case USE_LOI_STI:
 			CodeConst(tp->tp_size, (int) pointer_size);
-			C_cal("_blockmove");
+			C_cal("blockmove");
 			C_asp(3 * pointer_size);
 			break;
 		}
@@ -543,6 +548,7 @@ CodeVarDesig(df, ds)
 		those of an enclosing procedure, or it is global.
 	*/
 	register t_scope *sc = df->df_scope;
+	int difflevel;
 
 	/* Selections from a module are handled earlier, when identifying
 	   the variable, so ...
@@ -569,16 +575,16 @@ CodeVarDesig(df, ds)
 		return;
 	}
 
-	if (sc->sc_level != proclevel) {
+	if ((difflevel = proclevel - sc->sc_level) != 0) {
 		/* the variable is local to a statically enclosing procedure.
 		*/
-		assert(proclevel > sc->sc_level);
+		assert(difflevel > 0);
 
 		df->df_flags |= D_NOREG;
 		if (df->df_flags & (D_VARPAR|D_VALPAR)) {
 			/* value or var parameter
 			*/
-			C_lxa((arith) (proclevel - sc->sc_level));
+			C_lxa((arith) difflevel);
 			if ((df->df_flags & D_VARPAR) ||
 			    IsConformantArray(df->df_type)) {
 				/* var parameter or conformant array.
@@ -592,7 +598,7 @@ CodeVarDesig(df, ds)
 				return;
 			}
 		}
-		else	C_lxl((arith) (proclevel - sc->sc_level));
+		else	C_lxl((arith) difflevel);
 		ds->dsg_kind = DSG_PLOADED;
 		ds->dsg_offset = df->var_off;
 		return;
@@ -644,23 +650,26 @@ CodeDesig(nd, ds)
 		CodeDesig(nd->nd_left, ds);
 		CodeAddress(ds);
 		CodePExpr(nd->nd_right);
+		nd = nd->nd_left;
 
 		/* Now load address of descriptor
 		*/
-		if (IsConformantArray(nd->nd_left->nd_type)) {
-			assert(nd->nd_left->nd_class == Def);
+		if (IsConformantArray(nd->nd_type)) {
+			arith off;
+			assert(nd->nd_class == Def);
 
-			df = nd->nd_left->nd_def;
+			df = nd->nd_def;
+			off = df->var_off + pointer_size;
 			if (proclevel > df->df_scope->sc_level) {
 			    C_lxa((arith) (proclevel - df->df_scope->sc_level));
-			    C_adp(df->var_off + pointer_size);
+			    C_adp(off);
 			}
-			else	C_lal(df->var_off + pointer_size);
+			else	C_lal(off);
 		}
 		else	{
-			C_loc(nd->nd_left->nd_type->arr_low);
+			C_loc(nd->nd_type->arr_low);
 			C_sbu(int_size);
-			c_lae_dlb(nd->nd_left->nd_type->arr_descr);
+			c_lae_dlb(nd->nd_type->arr_descr);
 		}
 		if (options['A']) {
 			C_cal("rcka");
@@ -671,7 +680,8 @@ CodeDesig(nd, ds)
 	case Arrow:
 		assert(nd->nd_symb == '^');
 
-		CodeDesig(nd->nd_right, ds);
+		nd = nd->nd_right;
+		CodeDesig(nd, ds);
 		switch(ds->dsg_kind) {
 		case DSG_LOADED:
 			ds->dsg_kind = DSG_PLOADED;
@@ -680,7 +690,7 @@ CodeDesig(nd, ds)
 		case DSG_INDEXED:
 		case DSG_PLOADED:
 		case DSG_PFIXED:
-			CodeValue(ds, nd->nd_right->nd_type);
+			CodeValue(ds, nd->nd_type);
 			ds->dsg_kind = DSG_PLOADED;
 			ds->dsg_offset = 0;
 			break;
diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c
index 7b74733bd..d1c29d42d 100644
--- a/lang/m2/comp/enter.c
+++ b/lang/m2/comp/enter.c
@@ -160,7 +160,7 @@ EnterVarList(Idlist, type, local)
 				df->var_name = df->df_idf->id_text;
 			}
 			else {
-				sprint(buf,"_%s_%s", sc->sc_scope->sc_name,
+				sprint(buf,"%s_%s", sc->sc_scope->sc_name,
 					    df->df_idf->id_text);
 				df->var_name = Salloc(buf,
 						(unsigned)(strlen(buf)+1));
diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g
index 8ca562892..588bfa9c8 100644
--- a/lang/m2/comp/program.g
+++ b/lang/m2/comp/program.g
@@ -128,7 +128,9 @@ DefinitionModule
 	int		dummy;
 	extern t_idf	*DefId;
 	extern int	ForeignFlag;
+	extern char	*sprint();
 	register t_scope *currscope = CurrentScope;
+	char buf[512];
 } :
 	DEFINITION
 	MODULE IDENT	{ df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
@@ -139,7 +141,8 @@ DefinitionModule
 				error("DEFINITION MODULE name is \"%s\", not \"%s\"",
 					df->df_idf->id_text, DefId->id_text);
 			  }
-			  currscope->sc_name = df->df_idf->id_text;
+			  sprint(buf, "_%s_", df->df_idf->id_text);
+			  currscope->sc_name = Salloc(buf, (unsigned) strlen(buf) + 1);
 			  df->mod_vis = CurrVis;
 			  df->df_type = standard_type(T_RECORD, 1, (arith) 1);
 			  df->df_type->rec_scope = currscope;
@@ -214,7 +217,7 @@ ProgramModule
 			Defined = df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
 			open_scope(CLOSEDSCOPE);
 			df->mod_vis = CurrVis;
-			CurrentScope->sc_name = "_M2M";
+			CurrentScope->sc_name = "__M2M_";
 		  	CurrentScope->sc_definedby = df;
 		  }
 		}
diff --git a/lang/m2/comp/tmpvar.C b/lang/m2/comp/tmpvar.C
index d90104e17..0c2a5d8c4 100644
--- a/lang/m2/comp/tmpvar.C
+++ b/lang/m2/comp/tmpvar.C
@@ -63,7 +63,7 @@ TmpSpace(sz, al)
 
 STATIC arith
 NewTmp(plist, sz, al, regtype)
-	struct tmpvar **plist;
+	register struct tmpvar **plist;
 	arith sz;
 {
 	register arith offset;
diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c
index 4aae86cef..8e058ff14 100644
--- a/lang/m2/comp/typequiv.c
+++ b/lang/m2/comp/typequiv.c
@@ -263,7 +263,7 @@ TstParCompat(parno, formaltype, VARflag, nd, edf)
 }
 
 CompatCheck(nd, tp, message, fc)
-	t_node **nd;
+	register t_node **nd;
 	t_type *tp;
 	char *message;
 	int (*fc)();
diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index 7e9be7d86..a8b0b0982 100644
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -74,18 +74,21 @@ LblWalkNode(lbl, nd, exit)
 	WalkNode(nd, exit);
 }
 
+static arith tmpprio;
+
 STATIC
 DoPriority()
 {
 	/*	For the time being (???), handle priorities by calls to
 		the runtime system
 	*/
-	register t_node *pri = priority;
-
-	if (pri) {
-		C_loc(pri->nd_INT);
-		C_cal("_stackprio");
+	if (priority) {
+		tmpprio = NewInt();
+		C_loc(priority->nd_INT);
+		C_cal("stackprio");
 		C_asp(word_size);
+		C_lfr(word_size);
+		C_stl(tmpprio);
 	}
 }
 
@@ -93,7 +96,10 @@ STATIC
 EndPriority()
 {
 	if (priority) {
-		C_cal("_unstackprio");
+		C_lol(tmpprio);
+		C_cal("unstackprio");
+		C_asp(word_size);
+		FreeInt(tmpprio);
 	}
 }
 
@@ -113,8 +119,7 @@ DoLineno(nd)
 	}
 }
 
-DoFilename(nd)
-	t_node *nd;
+DoFilename()
 {
 	static label	filename_label = 0;
 
@@ -128,8 +133,6 @@ DoFilename(nd)
 		}
 
 		C_fil_dlb((label) 1, (arith) 0);
-
-		if (nd) DoLineno(nd);
 	}
 }
 
@@ -160,7 +163,6 @@ WalkModule(module)
 	TmpOpen(sc);		/* Initialize for temporaries */
 	C_pro_narg(sc->sc_name);
 	DoPriority();
-	DoFilename(module->mod_body);
 	if (module == Defined) {
 		/* Body of implementation or program module.
 		   Call initialization routines of imported modules.
@@ -183,8 +185,9 @@ WalkModule(module)
 		}
 
 		for (; nd; nd = nd->nd_left) {
-			C_cal(nd->nd_IDF->id_text);
+			C_cal(nd->nd_def->mod_vis->sc_scope->sc_name);
 		}
+		DoFilename();
 	}
 	WalkDefList(sc->sc_def, MkCalls);
 	proclevel++;
@@ -227,7 +230,7 @@ WalkProcedure(procedure)
 	*/
 	C_pro_narg(procscope->sc_name);
 	DoPriority();
-	DoFilename(procedure->prc_body);
+	DoFilename();		/* ??? only when this procedure is exported? */
 	TmpOpen(procscope);
 
 	func_type = tp = RemoveEqual(ResultType(procedure->df_type));
@@ -300,14 +303,14 @@ WalkProcedure(procedure)
 				}
 				/* First compute new stackpointer */
 				C_lal(param->par_def->var_off);
-				C_cal("_new_stackptr");
+				C_cal("new_stackptr");
 				C_asp(pointer_size);
 				C_lfr(pointer_size);
 				C_str((arith) 1);
 						/* adjusted stack pointer */
 				LOL(param->par_def->var_off, pointer_size);
 						/* push source address */
-				C_cal("_copy_array");
+				C_cal("copy_array");
 						/* copy */
 				C_asp(pointer_size);
 			}
@@ -445,13 +448,13 @@ WalkStat(nd, exit_label)
 	assert(nd->nd_class == Stat);
 
 	DoLineno(nd);
-	if (nd->nd_flags & ROPTION) options['R'] = 1;
-	if (nd->nd_flags & AOPTION) options['A'] = 1;
+	options['R'] = (nd->nd_flags & ROPTION);
+	options['A'] = (nd->nd_flags & AOPTION);
 	switch(nd->nd_symb) {
 	case '(':
 		if (ChkCall(nd)) {
 			if (nd->nd_type != 0) {
-				node_error(nd, "illegal function call");
+				node_error(nd, "procedure call expected instead of function call");
 				break;
 			}
 			CodeCall(nd);
@@ -521,7 +524,7 @@ WalkStat(nd, exit_label)
 	case FOR:
 		{
 			arith tmp = NewInt();
-			arith tmp2;
+			arith tmp2 = 0;
 			register t_node *fnd;
 			int good_forvar;
 			label l1 = ++text_label;
@@ -575,7 +578,7 @@ WalkStat(nd, exit_label)
 			WalkNode(right, exit_label);
 			nd->nd_def->df_flags &= ~D_FORLOOP;
 			if (good_forvar) {
-				if (! options['R']) {
+				if (tmp2 != 0) {
 					label x = ++text_label;
 					C_lol(tmp2);
 					ForLoopVarExpr(nd);
-- 
2.34.1