newer version

lang/m2/comp/Makefile

@@ -19,7 +19,7 @@ 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 options.o walk.o casestat.o desig.o \
-	code.o tmpvar.o
+	code.o tmpvar.o lookup.o
 OBJ =	$(COBJ) $(LOBJ) Lpars.o
 GENFILES=	tokenfile.c \
 	program.c declar.c expression.c statement.c \

lang/m2/comp/casestat.C

@@ -66,7 +66,7 @@ CaseCode(nd, exitlabel)
 	assert(pnode->nd_class == Stat && pnode->nd_symb == CASE);
 
 	clear((char *) sh, sizeof(*sh));
-	WalkExpr(pnode->nd_left, NO_LABEL, NO_LABEL);
+	WalkExpr(pnode->nd_left);
 	sh->sh_type = pnode->nd_left->nd_type;
 	sh->sh_break = text_label();
 
@@ -88,8 +88,9 @@ CaseCode(nd, exitlabel)
 		else {
 			/* Else part
 			*/
-			pnode = 0;
+
 			sh->sh_default = text_label();
+			pnode = 0;
 		}
 	}
 
@@ -98,7 +99,7 @@ CaseCode(nd, exitlabel)
 	tablabel = data_label();	/* the rom must have a label	*/
 	C_df_dlb(tablabel);
 	if (sh->sh_default) C_rom_ilb(sh->sh_default);
-	else C_rom_ucon("0", pointer_size);
+	else C_rom_ilb(sh->sh_break);
 	if (compact(sh->sh_nrofentries, sh->sh_lowerbd, sh->sh_upperbd)) {
 		/* CSA */
 
@@ -112,7 +113,7 @@ CaseCode(nd, exitlabel)
 				ce = ce->next;
 			}
 			else if (sh->sh_default) C_rom_ilb(sh->sh_default);
-			else C_rom_ucon("0", pointer_size);
+			else C_rom_ilb(sh->sh_break);
 		}
 		C_lae_dlb(tablabel, (arith)0); /* perform the switch	*/
 		C_csa(word_size);

lang/m2/comp/chk_expr.c

@@ -36,22 +36,17 @@ chk_expr(expp)
 	*/
 
 	switch(expp->nd_class) {
-	case Oper:
+	case Arrsel:
-		if (expp->nd_symb == '[') {
+		return chk_designator(expp, DESIGNATOR|VARIABLE, D_USED);
-			return chk_designator(expp, DESIGNATOR|VARIABLE, D_NOREG|D_USED);
-		}
 
-		return	chk_expr(expp->nd_left) &&
+	case Oper:
-			chk_expr(expp->nd_right) &&
+		return	chk_oper(expp);
-			chk_oper(expp);
+
+	case Arrow:
+		return chk_designator(expp, DESIGNATOR|VARIABLE, D_USED);
 
 	case Uoper:
-		if (expp->nd_symb == '^') {
+		return	chk_uoper(expp);
-			return chk_designator(expp, DESIGNATOR|VARIABLE, D_USED);
-		}
-
-		return	chk_expr(expp->nd_right) &&
-			chk_uoper(expp);
 
 	case Value:
 		switch(expp->nd_symb) {
@@ -547,7 +542,7 @@ df->df_idf->id_text);
 		return 0;
 	}
 
-	if (expp->nd_class == Oper) {
+	if (expp->nd_class == Arrsel) {
 		struct type *tpl, *tpr;
 
 		assert(expp->nd_symb == '[');
@@ -582,7 +577,7 @@ df->df_idf->id_text);
 		return 1;
 	}
 
-	if (expp->nd_class == Uoper) {
+	if (expp->nd_class == Arrow) {
 		assert(expp->nd_symb == '^');
 
 		if (! chk_designator(expp->nd_right, DESIGNATOR|VARIABLE, dflags)) {
@@ -665,12 +660,18 @@ chk_oper(expp)
 {
 	/*	Check a binary operation.
 	*/
-	register struct node *left = expp->nd_left;
+	register struct node *left, *right;
-	register struct node *right = expp->nd_right;
+	struct type *tpl, *tpr;
-	struct type *tpl = left->nd_type;
-	struct type *tpr = right->nd_type;
 	int allowed;
 
+	left = expp->nd_left;
+	right = expp->nd_right;
+
+	if (!chk_expr(left) || !chk_expr(right)) return 0;
+
+	tpl = left->nd_type;
+	tpr = right->nd_type;
+
 	if (tpl->tp_fund == T_SUBRANGE) tpl = tpl->next;
 	if (tpr->tp_fund == T_SUBRANGE) tpr = tpr->next;
 
@@ -763,8 +764,11 @@ chk_uoper(expp)
 	/*	Check an unary operation.
 	*/
 	register struct node *right = expp->nd_right;
-	register struct type *tpr = right->nd_type;
+	register struct type *tpr;
 
+	if (! chk_expr(right)) return 0;
+
+	tpr = right->nd_type;
 	if (tpr->tp_fund == T_SUBRANGE) tpr = tpr->next;
 	expp->nd_type = tpr;
 
@@ -839,7 +843,7 @@ getvariable(argp)
 	left = arg->nd_left;
 
 	if (! chk_designator(left, DESIGNATOR, D_REFERRED)) return 0;
-	if (left->nd_class == Oper || left->nd_class == Uoper) {
+	if (left->nd_class == Arrsel || left->nd_class == Arrow) {
 		*argp = arg;
 		return left;
 	}

lang/m2/comp/code.c

@@ -60,7 +60,7 @@ CodeString(nd)
 	}
 	else {
 		C_df_dlb(lab = data_label());
-		C_rom_scon(nd->nd_STR, align(nd->nd_SLE + 1, (int) word_size));
+		C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1));
 		C_lae_dlb(lab, (arith) 0);
 	}
 }
@@ -72,7 +72,7 @@ CodePadString(nd, sz)
 	/*	Generate code to push the string indicated by "nd".
 		Make it null-padded to "sz" bytes
 	*/
-	register arith sizearg = align(nd->nd_type->tp_size, word_align);
+	register arith sizearg = WA(nd->nd_type->tp_size);
 
 	assert(nd->nd_type->tp_fund == T_STRING);
 
@@ -114,25 +114,21 @@ CodeExpr(nd, ds, true_label, false_label)
 		/* Fall through */
 
 	case Link:
+	case Arrsel:
+	case Arrow:
 		CodeDesig(nd, ds);
 		break;
 
 	case Oper:
-		if (nd->nd_symb == '[') {
-			CodeDesig(nd, ds);
-			break;
-		}
 		CodeOper(nd, true_label, false_label);
 		if (true_label == 0) ds->dsg_kind = DSG_LOADED;
-		else ds->dsg_kind = DSG_INIT;
+		else {
-		true_label = 0;
+			ds->dsg_kind = DSG_INIT;
+			true_label = 0;
+		}
 		break;
 
 	case Uoper:
-		if (nd->nd_symb == '^') {
-			CodeDesig(nd, ds);
-			break;
-		}
 		CodePExpr(nd->nd_right);
 		CodeUoper(nd);
 		ds->dsg_kind = DSG_LOADED;
@@ -298,7 +294,6 @@ CodeCall(nd)
 	register struct node *arg = nd;
 	register struct paramlist *param;
 	struct type *tp;
-	arith pushed = 0;
 
 	if (left->nd_type == std_type) {
 		CodeStd(nd);
@@ -332,27 +327,28 @@ CodeCall(nd)
 			else if (tp->arr_elem == word_type) {
 				C_loc(left->nd_type->tp_size / word_size - 1);
 			}
-			else	C_loc(left->nd_type->tp_size /
+			else {
-				      tp->arr_elsize - 1);
+				tp = left->nd_type->next;
+				if (tp->tp_fund == T_SUBRANGE) {
+					C_loc(tp->sub_ub - tp->sub_lb);
+				}
+				else	C_loc((arith) (tp->enm_ncst - 1));
+			}
 			C_loc((arith) 0);
 			if (left->nd_symb == STRING) {
 				CodeString(left);
 			}
 			else	CodeDAddress(left);
-			pushed += pointer_size + 3 * word_size;
 		}
 		else if (IsVarParam(param)) {
 			CodeDAddress(left);
-			pushed += pointer_size;
 		}
 		else {
 			if (left->nd_type->tp_fund == T_STRING) {
-				CodePadString(left,
+				CodePadString(left, tp->tp_size);
-					      align(tp->tp_size, word_align));
 			}
 			else CodePExpr(left);
 			CheckAssign(left->nd_type, tp);
-			pushed += align(tp->tp_size, word_align);
 		}
 	}
 
@@ -361,7 +357,6 @@ CodeCall(nd)
 	if (left->nd_class == Def && left->nd_def->df_kind == D_PROCEDURE) {
 		if (left->nd_def->df_scope->sc_level > 0) {
 			C_lxl((arith) proclevel - left->nd_def->df_scope->sc_level);
-			pushed += pointer_size;
 		}
 		C_cal(NameOfProc(left->nd_def));
 	}
@@ -372,9 +367,9 @@ CodeCall(nd)
 		CodePExpr(left);
 		C_cai();
 	}
-	if (pushed) C_asp(pushed);
+	if (left->nd_type->prc_nbpar) C_asp(left->nd_type->prc_nbpar);
 	if (left->nd_type->next) {
-		C_lfr(align(left->nd_type->next->tp_size, word_align));
+		C_lfr(WA(left->nd_type->next->tp_size));
 	}
 }
 
@@ -526,7 +521,6 @@ CodeAssign(nd, dss, dst)
 		compatibility and the like is already done.
 	*/
 	register struct type *tp = nd->nd_right->nd_type;
-	extern arith align();
 
 	if (dss->dsg_kind == DSG_LOADED) {
 		if (tp->tp_fund == T_STRING) {
@@ -787,6 +781,10 @@ CodeOper(expr, true_label, false_label)
 		Operands(rightop, leftop);
 		CodeCoercion(leftop->nd_type, word_type);
 		C_inn(rightop->nd_type->tp_size);
+		if (true_label != 0) {
+			C_zne(true_label);
+			C_bra(false_label);
+		}
 		break;
 	case AND:
 	case '&':
@@ -1032,7 +1030,7 @@ DoHIGH(nd)
 
 	highoff = df->var_off + pointer_size + word_size;
 	if (df->df_scope->sc_level < proclevel) {
-		C_lxa(proclevel - df->df_scope->sc_level);
+		C_lxa((arith) (proclevel - df->df_scope->sc_level));
 		C_lof(highoff);
 	}
 	else	C_lol(highoff);

lang/m2/comp/cstoper.c

@@ -430,8 +430,7 @@ cstcall(expp, call)
 		CutSize(expp);
 		break;
 	case S_SIZE:
-		expp->nd_INT = align(expr->nd_type->tp_size, (int) word_size) /
+		expp->nd_INT = WA(expr->nd_type->tp_size) / word_size;
-				word_size;
 		break;
 	case S_VAL:
 		expp->nd_INT = expr->nd_INT;

lang/m2/comp/declar.g

@@ -139,10 +139,7 @@ FPSection(struct paramlist **ppr; arith *parmaddr;)
 		VAR	{ VARp = D_VARPAR; }
 	]?
 	IdentList(&FPList) ':' FormalType(&tp)
-		{
+			{ EnterParamList(ppr, FPList, tp, VARp, parmaddr); }
-		  ParamList(ppr, FPList, tp, VARp, parmaddr);
-		  FreeNode(FPList);
-		}
 ;
 
 FormalType(struct type **ptp;)
@@ -235,11 +232,8 @@ enumeration(struct type **ptp;)
 	'(' IdentList(&EnumList) ')'
 		{
 		  *ptp = tp = standard_type(T_ENUMERATION, 1, (arith) 1);
-		  EnterIdList(EnumList, D_ENUM, 0, tp,
+		  EnterEnumList(EnumList, tp);
-				 CurrentScope, (arith *) 0);
+		  if (tp->enm_ncst > 256) { /* ??? is this reasonable ??? */
-		  FreeNode(EnumList);
-		  if (tp->enm_ncst > 256) {
-			/* ??? is this reasonable ??? */
 			error("Too many enumeration literals");
 		  }
 		}
@@ -311,7 +305,7 @@ RecordType(struct type **ptp;)
 			}
 	FieldListSequence(scope, &count, &xalign)
 		{
-		  *ptp = standard_type(T_RECORD, xalign, count);
+		  *ptp = standard_type(T_RECORD, xalign, WA(count));
 		  (*ptp)->rec_scope = scope;
 		}
 	END
@@ -336,9 +330,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 [
 	IdentList(&FldList) ':' type(&tp)
 			{ *palign = lcm(*palign, tp->tp_align);
-			  EnterIdList(FldList, D_FIELD, D_QEXPORTED,
+			  EnterFieldList(FldList, tp, scope, cnt);
-					tp, scope, cnt);
-			  FreeNode(FldList);
 			}
 |
 	CASE
@@ -575,9 +567,7 @@ VariableDeclaration
 			{ nd = nd->nd_right; }
 	]*
 	':' type(&tp)
-			{ EnterVarList(VarList, tp, proclevel > 0);
+			{ EnterVarList(VarList, tp, proclevel > 0); }
-			  FreeNode(VarList);
-			}
 ;
 
 IdentAddr(struct node **pnd;) :

lang/m2/comp/def.c

@@ -141,276 +141,6 @@ error("identifier \"%s\" already declared", id->id_text);
 	return MkDef(id, scope, kind);
 }
 
-struct def *
-lookup(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.
-		Return a pointer to its "def" structure if it exists,
-		otherwise return 0.
-	*/
-	register struct def *df, *df1;
-	struct def *retval;
-
-	df1 = 0;
-	df = id->id_def;
-	while (df) {
-		if (df->df_scope == scope) {
-			retval = df;
-			if (df->df_kind == D_IMPORT) {
-				retval = df->imp_def;
-				assert(retval != 0);
-			}
-			if (df1) {
-				/* Put the definition now found in front
-				*/
-				df1->next = df->next;
-				df->next = id->id_def;
-				id->id_def = df;
-			}
-			return retval;
-		}
-		df1 = df;
-		df = df->next;
-	}
-	return 0;
-}
-
-DoImport(df, scope)
-	register struct def *df;
-	struct scope *scope;
-{
-	/*	Definition "df" is imported to scope "scope".
-		Handle the case that it is an enumeration type or a module.
-	*/
-
-	define(df->df_idf, scope, D_IMPORT)->imp_def = df;
-
-	if (df->df_kind == D_TYPE && df->df_type->tp_fund == T_ENUMERATION) {
-		/* Also import all enumeration literals
-		*/
-		df = df->df_type->enm_enums;
-		while (df) {
-			define(df->df_idf, scope, D_IMPORT)->imp_def = df;
-			df = df->enm_next;
-		}
-	}
-	else if (df->df_kind == D_MODULE) {
-		/* Also import all definitions that are exported from this
-		   module
-		*/
-		df = df->mod_vis->sc_scope->sc_def;
-		while (df) {
-			if (df->df_flags & D_EXPORTED) {
-				define(df->df_idf,scope,D_IMPORT)->imp_def = df;
-			}
-			df = df->df_nextinscope;
-		}
-	}
-}
-
-Export(ids, qualified, moddef)
-	register struct node *ids;
-	struct def *moddef;
-{
-	/*	From the current scope, the list of identifiers "ids" is
-		exported. Note this fact. If the export is not qualified, make
-		all the "ids" visible in the enclosing scope by defining them
-		in this scope as "imported".
-	*/
-	register struct def *df, *df1;
-	register struct def *impmod;
-
-	for (;ids; ids = ids->next) {
-		df = lookup(ids->nd_IDF, CurrentScope);
-
-		if (!df) {
-			/* undefined item in export list
-			*/
-node_error(ids, "identifier \"%s\" not defined", ids->nd_IDF->id_text);
-			continue;
-		}
-
-		if (df->df_flags & (D_EXPORTED|D_QEXPORTED)) {
-node_error(ids, "identifier \"%s\" occurs more than once in export list",
-df->df_idf->id_text);
-		}
-
-		if (qualified) {
-			df->df_flags |= D_QEXPORTED;
-		}
-		else {
-			/* Export, but not qualified.
-			   Find all imports of the module in which this export
-			   occurs, and export the current definition to it
-			*/
-			df->df_flags |= D_EXPORTED;
-
-			impmod = moddef->df_idf->id_def;
-			while (impmod) {
-				if (impmod->df_kind == D_IMPORT &&
-				    impmod->imp_def == moddef) {
-					DoImport(df, impmod->df_scope);
-				}
-				impmod = impmod->next;
-			}
-
-			df1 = lookup(ids->nd_IDF, enclosing(CurrVis)->sc_scope);
-			if (df1 && df1->df_kind == D_PROCHEAD) {
-				if (df->df_kind == D_PROCEDURE) {
-					df1->df_kind = D_IMPORT;
-					df1->imp_def = df;
-					continue;
-				}
-			}
-			else if (df1 && df1->df_kind == D_HIDDEN) {
-				if (df->df_kind == D_TYPE) {
-					if (df->df_type->tp_fund != T_POINTER) {
-error("opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
-					}
-					df->df_kind = D_TYPE;
-					df1->df_kind = D_IMPORT;
-					df1->imp_def = df;
-					continue;
-				}
-			}
-
-			DoImport(df, enclosing(CurrVis)->sc_scope);
-		}
-	}
-}
-
-static struct scopelist *
-ForwModule(df, idn)
-	register struct def *df;
-	struct node *idn;
-{
-	/*	An import is done from a not yet defined module "idn".
-		Create a declaration and a scope for this module.
-	*/
-	struct scopelist *vis;
-
-	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
-				   enclosing scope, but this must be done AFTER
-				   closing this one
-				*/
-	df->for_vis = vis;
-	df->for_node = MkLeaf(Name, &(idn->nd_token));
-	close_scope(0);	
-	vis->sc_encl = enclosing(CurrVis);
-				/* Here ! */
-	return vis;
-}
-
-static struct def *
-ForwDef(ids, scope)
-	register struct node *ids;
-	struct scope *scope;
-{
-	/*	Enter a forward definition of "ids" in scope "scope",
-		if it is not already defined.
-	*/
-	register struct def *df;
-
-	if (!(df = lookup(ids->nd_IDF, scope))) {
-		df = define(ids->nd_IDF, scope, D_FORWARD);
-		df->for_node = MkLeaf(Name, &(ids->nd_token));
-	}
-	return df;
-}
-
-Import(ids, idn, local)
-	register struct node *ids;
-	struct node *idn;
-{
-	/*	"ids" is a list of imported identifiers.
-		If "idn" is a null-pointer, the identifiers are imported from
-		the enclosing scope. Otherwise they are imported from the module
-		indicated by "idn", which must be visible in the enclosing
-		scope.  An exception must be made for imports of the
-		Compilation Unit.
-		This case is indicated by  the value 0 of the flag "local".
-		In this case, if "idn" is a null pointer, the "ids" identifiers
-		are all module identifiers. Their Definition Modules must be
-		read.  Otherwise "idn" is a module identifier whose Definition
-		Module must be read. "ids" then represents a list of
-		identifiers defined in this module.
-	*/
-	register struct def *df;
-	struct scopelist *vis = enclosing(CurrVis);
-	int forwflag = 0;
-#define FROM_MODULE	0
-#define FROM_ENCLOSING	1
-	int imp_kind = FROM_ENCLOSING;
-	struct def *lookfor(), *GetDefinitionModule();
-
-	if (idn) {
-		imp_kind = FROM_MODULE;
-		if (local) {
-			df = lookfor(idn, vis, 0);
-			switch(df->df_kind) {
-			case D_ERROR:
-				/* 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.
-				   ???
-				*/
-				vis = ForwModule(df, idn);
-				forwflag = 1;
-				break;
-			case D_FORWMODULE:
-				vis = df->for_vis;
-				break;
-			case D_MODULE:
-				vis = df->mod_vis;
-				break;
-			default:
-node_error(idn, "identifier \"%s\" does not represent a module",
-idn->nd_IDF->id_text);
-				break;
-			}
-		}
-		else	vis = GetDefinitionModule(idn->nd_IDF)->mod_vis;
-
-		FreeNode(idn);
-	}
-
-	idn = ids;
-	while (ids) {
-		if (imp_kind == FROM_MODULE) {
-			if (forwflag) {
-				df = ForwDef(ids, vis->sc_scope);
-			}
-			else if (!(df = lookup(ids->nd_IDF, vis->sc_scope))) {
-node_error(ids, "identifier \"%s\" not declared in qualifying module",
-ids->nd_IDF->id_text);
-				df = define(ids->nd_IDF,vis->sc_scope,D_ERROR);
-			}
-			else if (!(df->df_flags&(D_EXPORTED|D_QEXPORTED))) {
-node_error(ids,"identifier \"%s\" not exported from qualifying module",
-ids->nd_IDF->id_text);
-				df->df_flags |= D_QEXPORTED;
-			}
-		}
-		else {
-			if (local) df = ForwDef(ids, vis->sc_scope);
-			else	df = GetDefinitionModule(ids->nd_IDF);
-		}
-
-		DoImport(df, CurrentScope);
-
-		ids = ids->next;
-	}
-
-	FreeNode(idn);
-}
-
 RemoveImports(pdf)
 	struct def **pdf;
 {

lang/m2/comp/desig.c

@@ -319,7 +319,7 @@ CodeDesig(nd, ds)
 		CodeFieldDesig(nd->nd_def, ds);
 		break;
 
-	case Oper:
+	case Arrsel:
 		assert(nd->nd_symb == '[');
 
 		CodeDesig(nd->nd_left, ds);
@@ -347,7 +347,7 @@ CodeDesig(nd, ds)
 		ds->dsg_kind = DSG_INDEXED;
 		break;
 
-	case Uoper:
+	case Arrow:
 		assert(nd->nd_symb == '^');
 
 		CodeDesig(nd->nd_right, ds);

lang/m2/comp/enter.c

@@ -1,4 +1,4 @@
-/* H I G H   L E V E L   S Y M B O L   E N T R Y   A N D   L O O K U P */
+/* H I G H   L E V E L   S Y M B O L   E N T R Y */
 
 #ifndef NORCSID
 static char *RcsId = "$Header$";
@@ -28,86 +28,65 @@ Enter(name, kind, type, pnam)
 		"type" in the Current Scope. If it is a standard name, also
 		put its number in the definition structure.
 	*/
-	struct idf *id;
+	register struct def *df;
-	struct def *df;
 
-	id = str2idf(name, 0);
+	df = define(str2idf(name, 0), CurrentScope, kind);
-	if (!id) fatal("Out of core");
-	df = define(id, CurrentScope, kind);
 	df->df_type = type;
-	if (type = std_type) {
+	if (pnam) df->df_value.df_stdname = pnam;
-		df->df_value.df_stdname = pnam;
-	}
 	return df;
 }
 
-EnterIdList(idlist, kind, flags, type, scope, addr)
+EnterEnumList(Idlist, type)
-	register struct node *idlist;
+	struct node *Idlist;
-	struct type *type;
+	register struct type *type;
+{
+	/*	Put a list of enumeration literals in the symbol table.
+		They all have type "type".
+		Also assign numbers to them, and link them together.
+		We must link them together because an enumeration type may
+		be exported, in which case its literals must also be exported.
+		Thus, we need an easy way to get to them.
+	*/
+	register struct def *df;
+	register struct node *idlist = Idlist;
+
+	type->enm_ncst = 0;
+	for (; idlist; idlist = idlist->next) {
+		df = define(idlist->nd_IDF, CurrentScope, D_ENUM);
+		df->df_type = type;
+		df->enm_val = (type->enm_ncst)++;
+		df->enm_next = type->enm_enums;
+		type->enm_enums = df;
+	}
+	FreeNode(Idlist);
+}
+
+EnterFieldList(Idlist, type, scope, addr)
+	struct node *Idlist;
+	register struct type *type;
 	struct scope *scope;
 	arith *addr;
 {
-	/*	Put a list of identifiers in the symbol table.
+	/*	Put a list of fields in the symbol table.
-		They all have kind "kind", and type "type", and are put
+		They all have type "type", and are put in scope "scope".
-		in scope "scope". "flags" initializes the "df_flags" field
+		Mark them as QUALIFIED EXPORT, because that's exactly what
-		of the definition structure.
+		fields are, you can get to them by qualifying them.
-		Also assign numbers to enumeration literals, and link
-		them together.
 	*/
 	register struct def *df;
-	struct def *first = 0, *last = 0;
+	register struct node *idlist = Idlist;
-	int assval = 0;
-	arith off;
 
-	while (idlist) {
+	for (; idlist; idlist = idlist->next) {
-		df = define(idlist->nd_IDF, scope, kind);
+		df = define(idlist->nd_IDF, scope, D_FIELD);
 		df->df_type = type;
-		df->df_flags |= flags;
+		df->df_flags |= D_QEXPORTED;
-		if (addr) {
+		df->fld_off = align(*addr, type->tp_align);
-			int xalign = type->tp_align;
+		*addr = df->fld_off + type->tp_size;
-
-			if (xalign < word_align && kind != D_FIELD) {
-				/* variables are at least word aligned
-				*/
-				xalign = word_align;
-			}
-
-			if (*addr >= 0) {
-				off = align(*addr, xalign);
-				*addr = off + type->tp_size;
-			}
-			else {
-				off = -align(-*addr-type->tp_size, xalign);
-				*addr = off;
-			}
-			if (kind == D_VARIABLE) {
-				df->var_off = off;
-			}
-			else {
-				assert(kind == D_FIELD);
-
-				df->fld_off = off;
-			}
-		}
-		if (kind == D_ENUM) {
-			if (!first) first = df;
-			df->enm_val = assval++;
-			if (last) last->enm_next = df;
-			last = df;
-		}
-		idlist = idlist->next;
-	}
-	if (last) {
-		/* Also meaning : kind == D_ENUM */
-		assert(kind == D_ENUM);
-		last->enm_next = 0;
-		type->enm_enums = first;
-		type->enm_ncst = assval;
 	}
+	FreeNode(Idlist);
 }
 
-EnterVarList(IdList, type, local)
+EnterVarList(Idlist, type, local)
-	register struct node *IdList;
+	struct node *Idlist;
 	struct type *type;
 {
 	/*	Enter a list of identifiers representing variables into the
@@ -116,6 +95,7 @@ EnterVarList(IdList, type, local)
 		procedure.
 	*/
 	register struct def *df;
+	register struct node *idlist = Idlist;
 	register struct scopelist *sc;
 	char buf[256];
 	extern char *sprint();
@@ -129,17 +109,17 @@ EnterVarList(IdList, type, local)
 		while (sc->sc_scope->sc_scopeclosed) sc = enclosing(sc);
 	}
 
-	while (IdList) {
+	for (; idlist; idlist = idlist->nd_right) {
-		df = define(IdList->nd_IDF, CurrentScope, D_VARIABLE);
+		df = define(idlist->nd_IDF, CurrentScope, D_VARIABLE);
 		df->df_type = type;
-		if (IdList->nd_left) {
+		if (idlist->nd_left) {
 			/* An address was supplied
 			*/
 			df->var_addrgiven = 1;
-			if (IdList->nd_left->nd_type != card_type) {
+			if (idlist->nd_left->nd_type != card_type) {
-node_error(IdList->nd_left,"Illegal type for address");
+node_error(idlist->nd_left,"Illegal type for address");
 			}
-			df->var_off = IdList->nd_left->nd_INT;
+			df->var_off = idlist->nd_left->nd_INT;
 		}
 		else if (local) {
 			/* subtract aligned size of variable to the offset,
@@ -147,8 +127,8 @@ node_error(IdList->nd_left,"Illegal type for address");
 			   procedure
 			*/
 			sc->sc_scope->sc_off =
-				-align(type->tp_size - sc->sc_scope->sc_off,
+				-WA(align(type->tp_size - sc->sc_scope->sc_off,
-						type->tp_align);
+						type->tp_align));
 			df->var_off = sc->sc_scope->sc_off;
 		}
 		else {
@@ -165,32 +145,279 @@ node_error(IdList->nd_left,"Illegal type for address");
 				C_ina_dnam(df->var_name);
 			}
 		}
-
-		IdList = IdList->nd_right;
 	}
+	FreeNode(Idlist);
 }
 
-struct def *
+EnterParamList(ppr, Idlist, type, VARp, off)
-lookfor(id, vis, give_error)
+	struct node *Idlist;
-	struct node *id;
+	struct paramlist **ppr;
-	struct scopelist *vis;
+	struct type *type;
+	int VARp;
+	arith *off;
 {
-	/*	Look for an identifier in the visibility range started by
+	/*	Create (part of) a parameterlist of a procedure.
-		"vis".
+		"ids" indicates the list of identifiers, "tp" their type, and
-		If it is not defined, maybe give an error message, and
+		"VARp" indicates D_VARPAR or D_VALPAR.
-		create a dummy definition.
 	*/
-	struct def *df;
+	register struct paramlist *pr;
-	register struct scopelist *sc = vis;
+	register struct def *df;
-	struct def *MkDef();
+	register struct node *idlist = Idlist;
 
-	while (sc) {
+	for ( ; idlist; idlist = idlist->next) {
-		df = lookup(id->nd_IDF, sc->sc_scope);
+		pr = new_paramlist();
-		if (df) return df;
+		pr->next = *ppr;
-		sc = nextvisible(sc);
+		*ppr = pr;
+		df = define(idlist->nd_IDF, CurrentScope, D_VARIABLE);
+		pr->par_def = df;
+		df->df_type = type;
+		df->var_off = *off;
+		df->df_flags = VARp;
+		if (IsConformantArray(type)) {
+			/* we need room for the base address and a descriptor
+			*/
+			*off += pointer_size + 3 * word_size;
+		}
+		else if (VARp == D_VARPAR) {
+			*off += pointer_size;
+		}
+		else {
+			*off += WA(type->tp_size);
+		}
+	}
+	FreeNode(Idlist);
+}
+
+static
+DoImport(df, scope)
+	register struct def *df;
+	struct scope *scope;
+{
+	/*	Definition "df" is imported to scope "scope".
+		Handle the case that it is an enumeration type or a module.
+	*/
+
+	define(df->df_idf, scope, D_IMPORT)->imp_def = df;
+
+	if (df->df_kind == D_TYPE && df->df_type->tp_fund == T_ENUMERATION) {
+		/* Also import all enumeration literals
+		*/
+		df = df->df_type->enm_enums;
+		while (df) {
+			define(df->df_idf, scope, D_IMPORT)->imp_def = df;
+			df = df->enm_next;
+		}
+	}
+	else if (df->df_kind == D_MODULE) {
+		/* Also import all definitions that are exported from this
+		   module
+		*/
+		df = df->mod_vis->sc_scope->sc_def;
+		while (df) {
+			if (df->df_flags & D_EXPORTED) {
+				define(df->df_idf,scope,D_IMPORT)->imp_def = df;
+			}
+			df = df->df_nextinscope;
+		}
+	}
+}
+
+static struct scopelist *
+ForwModule(df, idn)
+	register struct def *df;
+	struct node *idn;
+{
+	/*	An import is done from a not yet defined module "idn".
+		Create a declaration and a scope for this module.
+	*/
+	struct scopelist *vis;
+
+	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
+				   enclosing scope, but this must be done AFTER
+				   closing this one
+				*/
+	df->for_vis = vis;
+	df->for_node = MkLeaf(Name, &(idn->nd_token));
+	close_scope(0);	
+	vis->sc_encl = enclosing(CurrVis);
+				/* Here ! */
+	return vis;
+}
+
+static struct def *
+ForwDef(ids, scope)
+	register struct node *ids;
+	struct scope *scope;
+{
+	/*	Enter a forward definition of "ids" in scope "scope",
+		if it is not already defined.
+	*/
+	register struct def *df;
+
+	if (!(df = lookup(ids->nd_IDF, scope))) {
+		df = define(ids->nd_IDF, scope, D_FORWARD);
+		df->for_node = MkLeaf(Name, &(ids->nd_token));
+	}
+	return df;
+}
+
+EnterExportList(Idlist, qualified)
+	struct node *Idlist;
+{
+	/*	From the current scope, the list of identifiers "ids" is
+		exported. Note this fact. If the export is not qualified, make
+		all the "ids" visible in the enclosing scope by defining them
+		in this scope as "imported".
+	*/
+	register struct node *idlist = Idlist;
+	register struct def *df, *df1;
+	register struct def *impmod;
+
+	for (;idlist; idlist = idlist->next) {
+		df = lookup(idlist->nd_IDF, CurrentScope);
+
+		if (!df) {
+			/* undefined item in export list
+			*/
+node_error(idlist, "identifier \"%s\" not defined", idlist->nd_IDF->id_text);
+			continue;
+		}
+
+		if (df->df_flags & (D_EXPORTED|D_QEXPORTED)) {
+node_error(idlist, "identifier \"%s\" occurs more than once in export list",
+idlist->nd_IDF->id_text);
+		}
+
+		df->df_flags |= qualified;
+		if (qualified == D_EXPORTED) {
+			/* Export, but not qualified.
+			   Find all imports of the module in which this export
+			   occurs, and export the current definition to it
+			*/
+			impmod = CurrentScope->sc_definedby->df_idf->id_def;
+			while (impmod) {
+				if (impmod->df_kind == D_IMPORT &&
+				    impmod->imp_def == CurrentScope->sc_definedby) {
+					DoImport(df, impmod->df_scope);
+				}
+				impmod = impmod->next;
+			}
+
+			/* Also handle the definition as if the enclosing
+			   scope imports it.
+			*/
+			df1 = lookup(idlist->nd_IDF,
+				     enclosing(CurrVis)->sc_scope);
+			if (df1) {
+				/* It was already defined in the enclosing
+				   scope. There are two legal possibilities,
+				   which are examined below.
+				*/
+				if ((df1->df_kind == D_PROCHEAD &&
+				     df->df_kind == D_PROCEDURE) ||
+				    (df1->df_kind == D_HIDDEN &&
+				     df->df_kind == D_TYPE)) {
+					if (df->df_kind == D_TYPE &&
+					    df->df_type->tp_fund != T_POINTER) {
+node_error(idlist, "opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
+					}
+					df1->df_kind = D_IMPORT;
+					df1->imp_def = df;
+					continue;
+				}
+			}
+
+			DoImport(df, enclosing(CurrVis)->sc_scope);
+		}
+	}
+	FreeNode(Idlist);
+}
+
+EnterFromImportList(Idlist, Fromid, local)
+	struct node *Idlist;
+	register struct node *Fromid;
+{
+	/*	Import the list Idlist from the module indicated by Fromid.
+		An exception must be made for imports of the Compilation Unit,
+		because in this case the definition module for Fromid must
+		be read.
+		This case is indicated by  the value 0 of the flag "local".
+	*/
+	register struct node *idlist = Idlist;
+	register struct def *df;
+	struct scopelist *vis = enclosing(CurrVis);
+	int forwflag = 0;
+	extern struct def *lookfor(), *GetDefinitionModule();
+
+	if (local) {
+		df = lookfor(Fromid, vis, 0);
+		switch(df->df_kind) {
+		case D_ERROR:
+			/* 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.
+			   ???
+			*/
+			vis = ForwModule(df, Fromid);
+			forwflag = 1;
+			break;
+		case D_FORWMODULE:
+			vis = df->for_vis;
+			break;
+		case D_MODULE:
+			vis = df->mod_vis;
+			break;
+		default:
+node_error(Fromid, "identifier \"%s\" does not represent a module",
+Fromid->nd_IDF->id_text);
+			break;
+		}
+	}
+	else	vis = GetDefinitionModule(Fromid->nd_IDF)->mod_vis;
+
+	FreeNode(Fromid);
+
+	for (; idlist; idlist = idlist->next) {
+		if (forwflag) {
+			df = ForwDef(idlist, vis->sc_scope);
+		}
+		else if (!(df = lookup(idlist->nd_IDF, vis->sc_scope))) {
+node_error(idlist, "identifier \"%s\" not declared in qualifying module",
+idlist->nd_IDF->id_text);
+			df = define(idlist->nd_IDF,vis->sc_scope,D_ERROR);
+		}
+		else if (!(df->df_flags&(D_EXPORTED|D_QEXPORTED))) {
+node_error(idlist,"identifier \"%s\" not exported from qualifying module",
+idlist->nd_IDF->id_text);
+			df->df_flags |= D_QEXPORTED;
+		}
+		DoImport(df, CurrentScope);
 	}
 
-	if (give_error) id_not_declared(id);
+	FreeNode(Idlist);
-
+}
-	return MkDef(id->nd_IDF, vis->sc_scope, D_ERROR);
+
+EnterImportList(Idlist, local)
+	struct node *Idlist;
+{
+	/*	Import "Idlist" from the enclosing scope.
+		An exception must be made for imports of the compilation unit.
+		In this case, definition modules must be read for "Idlist".
+		This case is indicated by the value 0 of the "local" flag.
+	*/
+	register struct node *idlist = Idlist;
+	register struct def *df;
+	struct scopelist *vis = enclosing(CurrVis);
+	extern struct def *lookfor(), *GetDefinitionModule();
+
+	for (; idlist; idlist = idlist->next) {
+		if (local) df = ForwDef(idlist, vis->sc_scope);
+		else	df = GetDefinitionModule(idlist->nd_IDF);
+		DoImport(df, CurrentScope);
+	}
+	FreeNode(Idlist);
 }

lang/m2/comp/expression.g

@@ -258,16 +258,16 @@ designator_tail(struct node **pnd;):
 ;
 
 visible_designator_tail(struct node **pnd;):
-	'['		{ *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
+	'['		{ *pnd = MkNode(Arrsel, *pnd, NULLNODE, &dot); }
 		expression(&((*pnd)->nd_right))
 		[
 			','
-			{ *pnd = MkNode(Oper, *pnd, NULLNODE, &dot);
+			{ *pnd = MkNode(Arrsel, *pnd, NULLNODE, &dot);
 			  (*pnd)->nd_symb = '[';
 			}
 			expression(&((*pnd)->nd_right))
 		]*
 	']'
 |
-	'^'		{ *pnd = MkNode(Uoper, NULLNODE, *pnd, &dot); }
+	'^'		{ *pnd = MkNode(Arrow, NULLNODE, *pnd, &dot); }
 ;

lang/m2/comp/lookup.c

@@ -0,0 +1,74 @@
+/* L O O K U P   R O U T I N E S */
+
+#ifndef NORCSID
+static char *RcsId = "$Header$";
+#endif
+
+#include	"debug.h"
+
+#include	<em_arith.h>
+#include	<em_label.h>
+#include	<assert.h>
+
+#include	"def.h"
+#include	"idf.h"
+#include	"scope.h"
+#include	"LLlex.h"
+#include	"node.h"
+
+extern struct def	*MkDef();
+
+struct def *
+lookup(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.
+		Return a pointer to its "def" structure if it exists,
+		otherwise return 0.
+	*/
+	register struct def *df;
+	struct def *df1;
+
+	for (df = id->id_def, df1 = 0; df; df1 = df, df = df->next) {
+		if (df->df_scope == scope) {
+			if (df1) {
+				/* Put the definition in front
+				*/
+				df1->next = df->next;
+				df->next = id->id_def;
+				id->id_def = df;
+			}
+			if (df->df_kind == D_IMPORT) {
+				assert(df->imp_def != 0);
+				return df->imp_def;
+			}
+			return df;
+		}
+	}
+	return 0;
+}
+
+struct def *
+lookfor(id, vis, give_error)
+	register struct node *id;
+	struct scopelist *vis;
+{
+	/*	Look for an identifier in the visibility range started by "vis".
+		If it is not defined create a dummy definition and,
+		if "give_error" is set, give an error message.
+	*/
+	struct def *df;
+	register struct scopelist *sc = vis;
+
+	while (sc) {
+		df = lookup(id->nd_IDF, sc->sc_scope);
+		if (df) return df;
+		sc = nextvisible(sc);
+	}
+
+	if (give_error) id_not_declared(id);
+
+	return MkDef(id->nd_IDF, vis->sc_scope, D_ERROR);
+}

lang/m2/comp/main.c

@@ -146,7 +146,7 @@ LexScan()
 AddStandards()
 {
 	register struct def *df;
-	struct def *Enter();
+	extern struct def *Enter();
 	static struct node nilnode = { 0, 0, Value, 0, { INTEGER, 0}};
 
 	(void) Enter("ABS", D_PROCEDURE, std_type, S_ABS);
@@ -184,11 +184,11 @@ AddStandards()
 		     construct_type(T_PROCEDURE, NULLTYPE),
 		     0);
 	df = Enter("BITSET", D_TYPE, bitset_type, 0);
-	df = Enter("FALSE", D_ENUM, bool_type, 0);
+	df = Enter("TRUE", D_ENUM, bool_type, 0);
-	df->enm_val = 0;
-	df->enm_next = Enter("TRUE", D_ENUM, bool_type, 0);
-	df = df->enm_next;
 	df->enm_val = 1;
+	df->enm_next = Enter("FALSE", D_ENUM, bool_type, 0);
+	df = df->enm_next;
+	df->enm_val = 0;
 	df->enm_next = 0;
 }
 

lang/m2/comp/node.H

@@ -7,15 +7,17 @@ struct node {
 #define nd_left	next
 	struct node *nd_right;
 	int nd_class;		/* kind of node */
-#define Value	1		/* constant */
+#define Value	0		/* constant */
+#define Arrsel  1		/* array selection */
 #define Oper	2		/* binary operator */
 #define Uoper	3		/* unary operator */
-#define Call	4		/* cast or procedure - or function call */
+#define Arrow	4		/* ^ construction */
-#define Name	5		/* an identifier */
+#define Call	5		/* cast or procedure - or function call */
-#define Set	6		/* a set constant */
+#define Name	6		/* an identifier */
-#define Xset	7		/* a set */
+#define Set	7		/* a set constant */
-#define Def	8		/* an identified name */
+#define Xset	8		/* a set */
-#define Stat	9		/* a statement */
+#define Def	9		/* an identified name */
+#define Stat	10		/* a statement */
 #define Link	11
 	struct type *nd_type;	/* type of this node */
 	struct token nd_token;

lang/m2/comp/options.c

@@ -22,7 +22,7 @@ DoOption(text)
 	switch(*text++)	{
 
 	default:
-		options[text[-1]] = 1;	/* flags, debug options etc.	*/
+		options[text[-1]]++;	/* flags, debug options etc.	*/
 		break;
 
 	case 'L' :	/* don't generate fil/lin */

lang/m2/comp/program.g

@@ -76,12 +76,11 @@ ModuleDeclaration
 	priority(&(df->mod_priority))?
 	';'
 	import(1)*
-	export(&qualified, &exportlist, 0)?
+	export(&qualified, &exportlist)?
 	block(&nd)
 	IDENT		{ InitProc(nd, df);
 			  if (exportlist) {
-				Export(exportlist, qualified, df);
+				EnterExportList(exportlist, qualified);
-			  	FreeNode(exportlist);
 			  }
 			  close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
 			  match_id(id, dot.TOK_IDF);
@@ -101,23 +100,17 @@ priority(arith *pprio;)
 			}
 ;
 
-export(int *QUALflag; struct node **ExportList; int def;)
+export(int *QUALflag; struct node **ExportList;)
 {
 } :
 	EXPORT
 	[
 		QUALIFIED
-			{ *QUALflag = 1; }
+			{ *QUALflag = D_QEXPORTED; }
 	|
-			{ *QUALflag = 0; }
+			{ *QUALflag = D_EXPORTED; }
 	]
 	IdentList(ExportList) ';'
-			{
-			  if (def) {
-node_warning(*ExportList, "export list in definition module ignored");
-				FreeNode(*ExportList);
-			  }
-			}
 ;
 
 import(int local;)
@@ -135,8 +128,8 @@ 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 (id) EnterFromImportList(ImportList, id, local);
-			  Import(ImportList, id, local);
+			  else EnterImportList(ImportList, local);
 			}
 ;
 
@@ -144,7 +137,7 @@ DefinitionModule
 {
 	register struct def *df;
 	struct idf *id;
-	struct node *exportlist;
+	struct node *exportlist = 0;
 	int dummy;
 } :
 	DEFINITION
@@ -163,11 +156,16 @@ DefinitionModule
 			}
 	';'
 	import(0)* 
-	export(&dummy, &exportlist, 1)?
+	export(&dummy, &exportlist)?
 	/*	New Modula-2 does not have export lists in definition modules.
 		For the time being, we ignore export lists here, and a
 		warning is issued.
 	*/
+			{ if (exportlist) {
+node_warning(exportlist, "export list in definition module ignored");
+				FreeNode(exportlist);
+			  }
+			}
 	definition* END IDENT
 			{
 			  df = CurrentScope->sc_def;

lang/m2/comp/tmpvar.C

@@ -6,6 +6,9 @@ static char *RcsId = "$Header$";
 
 /*	Code for the allocation and de-allocation of temporary variables,
 	allowing re-use.
+	The routines use "ProcScope" instead of "CurrentScope", because
+	"CurrentScope" also reflects WITH statements, and these scopes do not
+	have local variabes.
 */
 
 #include	"debug.h"
@@ -29,8 +32,9 @@ struct tmpvar {
 
 static struct tmpvar	*TmpInts,	/* for integer temporaries */
 			*TmpPtrs;	/* for pointer temporaries */
-
+extern struct scope	*ProcScope;	/* scope of procedure in which the
-extern arith align();
+					   temporaries are allocated
+					*/
 
 arith
 NewInt()
@@ -39,8 +43,8 @@ NewInt()
 	register struct tmpvar *tmp;
 
 	if (!TmpInts) {
-		offset = - align(int_size - CurrentScope->sc_off, int_align);
+		offset = - WA(align(int_size - ProcScope->sc_off, int_align));
-		CurrentScope->sc_off = offset;
+		ProcScope->sc_off = offset;
 		C_ms_reg(offset, int_size, reg_any, 0);
 	}
 	else {
@@ -59,8 +63,8 @@ NewPtr()
 	register struct tmpvar *tmp;
 
 	if (!TmpPtrs) {
-		offset = - align(pointer_size - CurrentScope->sc_off, pointer_align);
+		offset = - WA(align(pointer_size - ProcScope->sc_off, pointer_align));
-		CurrentScope->sc_off = offset;
+		ProcScope->sc_off = offset;
 		C_ms_reg(offset, pointer_size, reg_pointer, 0);
 	}
 	else {

lang/m2/comp/type.H

@@ -138,3 +138,4 @@ struct type
 #define complex(tpx)	((tpx)->tp_fund & (T_RECORD|T_ARRAY))
 #define returntype(tpx)	(((tpx)->tp_fund & T_PRCRESULT) ||\
 		((tpx)->tp_fund == T_SET && (tpx)->tp_size <= dword_size))
+#define WA(sz)		(align(sz, (int) word_size))

lang/m2/comp/type.c

@@ -221,43 +221,6 @@ InitTypes()
 	error_type = standard_type(T_CHAR, 1, (arith) 1);
 }
 
-ParamList(ppr, ids, tp, VARp, off)
-	register struct node *ids;
-	struct paramlist **ppr;
-	struct type *tp;
-	int VARp;
-	arith *off;
-{
-	/*	Create (part of) a parameterlist of a procedure.
-		"ids" indicates the list of identifiers, "tp" their type, and
-		"VARp" indicates D_VARPAR or D_VALPAR.
-	*/
-	register struct paramlist *pr;
-	register struct def *df;
-
-	for ( ; ids; ids = ids->next) {
-		pr = new_paramlist();
-		pr->next = *ppr;
-		*ppr = pr;
-		df = define(ids->nd_IDF, CurrentScope, D_VARIABLE);
-		pr->par_def = df;
-		df->df_type = tp;
-		df->var_off = align(*off, word_align);
-		df->df_flags = VARp;
-		if (IsConformantArray(tp)) {
-			/* we need room for the base address and a descriptor
-			*/
-			*off = df->var_off + pointer_size + 3 * word_size;
-		}
-		else if (VARp == D_VARPAR) {
-			*off = df->var_off + pointer_size;
-		}
-		else {
-			*off = df->var_off + tp->tp_size;
-		}
-	}
-}
-
 chk_basesubrange(tp, base)
 	register struct type *tp, *base;
 {
@@ -417,7 +380,7 @@ set_type(tp)
 	}
 
 	tp = construct_type(T_SET, tp);
-	tp->tp_size = align(((ub - lb) + 7)/8, word_align);
+	tp->tp_size = WA(((ub - lb) + 7)/8);
 	return tp;
 }
 
@@ -433,8 +396,11 @@ ArrayElSize(tp)
 
 	if (tp->tp_fund == T_ARRAY) ArraySizes(tp);
 	algn = align(tp->tp_size, tp->tp_align);
-	if (!(algn % word_size == 0 || word_size % algn == 0)) {
+	if (word_size % algn != 0) {
-		algn = align(algn, (int) word_size);
+		/* algn is not a dividor of the word size, so make sure it
+		   is a multiple
+		*/
+		algn = WA(algn);
 	}
 	return algn;
 }
@@ -483,6 +449,7 @@ ArraySizes(tp)
 	}
 
 	C_rom_cst(tp->arr_elsize);
+	tp->tp_size = WA(tp->tp_size);
 
 	/* ??? overflow checking ???
 	*/

lang/m2/comp/walk.c

@@ -33,6 +33,7 @@ static char	return_expr_occurred;
 static struct type *func_type;
 struct withdesig *WithDesigs;
 struct node	*Modules;
+struct scope	*ProcScope;
 
 label
 text_label()
@@ -87,7 +88,7 @@ WalkModule(module)
 			if (df->df_kind == D_VARIABLE) {
 				C_df_dnam(df->var_name);
 				C_bss_cst(
-					align(df->df_type->tp_size, word_align),
+					WA(df->df_type->tp_size),
 					(arith) 0, 0);
 			}
 			df = df->df_nextinscope;
@@ -107,6 +108,7 @@ WalkModule(module)
 	sc->sc_off = 0;
 	instructionlabel = 2;
 	func_type = 0;
+	ProcScope = CurrentScope;	
 	C_pro_narg(state == PROGRAM ? "main" : sc->sc_name);
 	DoProfil();
 	if (CurrVis == Defined->mod_vis) {
@@ -161,7 +163,7 @@ WalkProcedure(procedure)
 
 	proclevel++;
 	CurrVis = procedure->prc_vis;
-	sc = CurrentScope;
+	ProcScope = sc = CurrentScope;
 	
 	WalkDef(sc->sc_def);
 
@@ -185,7 +187,7 @@ WalkProcedure(procedure)
 		if (! return_expr_occurred) {
 node_error(procedure->prc_body,"function procedure does not return a value");
 		}
-		C_ret(align(res_type->tp_size, word_align));
+		C_ret(WA(res_type->tp_size));
 	}
 	else	C_ret((arith) 0);
 	C_end(-sc->sc_off);
@@ -341,7 +343,7 @@ WalkStat(nd, lab)
 			l1 = instructionlabel++;
 			l2 = instructionlabel++;
 			C_df_ilb(l1);
-			WalkNode(left, l2);
+			WalkNode(right, l2);
 			C_bra(l1);
 			C_df_ilb(l2);
 			break;
@@ -425,7 +427,7 @@ WalkStat(nd, lab)
 
 	case RETURN:
 		if (right) {
-			WalkExpr(right, NO_LABEL, NO_LABEL);
+			WalkExpr(right);
 			/* Assignment compatibility? Yes, see Rep. 9.11
 			*/
 			if (!TstAssCompat(func_type, right->nd_type)) {
@@ -449,16 +451,18 @@ ExpectBool(nd, true_label, false_label)
 		generate code to evaluate the expression.
 	*/
 
-	WalkExpr(nd, true_label, false_label);
+	if (!chk_expr(nd)) return;
 
 	if (nd->nd_type != bool_type && nd->nd_type != error_type) {
 		node_error(nd, "boolean expression expected");
 	}
+
+	Desig = InitDesig;
+	CodeExpr(nd, &Desig,  true_label, false_label);
 }
 
-WalkExpr(nd, true_label, false_label)
+WalkExpr(nd)
 	struct node *nd;
-	label true_label, false_label;
 {
 	/*	Check an expression and generate code for it
 	*/
@@ -467,8 +471,7 @@ WalkExpr(nd, true_label, false_label)
 
 	if (! chk_expr(nd)) return;
 
-	Desig = InitDesig;
+	CodePExpr(nd);
-	CodeExpr(nd, &Desig, true_label, false_label);
 }
 
 WalkDesignator(nd)
@@ -568,6 +571,8 @@ DumpTree(nd)
 	switch(nd->nd_class) {
 	case Def:	s = "Def"; break;
 	case Oper:	s = "Oper"; break;
+	case Arrsel:	s = "Arrsel"; break;
+	case Arrow:	s = "Arrow"; break;
 	case Uoper:	s = "Uoper"; break;
 	case Name:	s = "Name"; break;
 	case Set:	s = "Set"; break;