many minor mods

lang/m2/comp/LLlex.c

@@ -354,7 +354,10 @@ LLlex()
 
 		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;

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

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";

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
 };

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);

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;
 }
 

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;

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;

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));

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;
 		  }
 		}

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;

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)();