From: ceriel <none@none>
Date: Mon, 29 Jun 1987 12:46:00 +0000 (+0000)
Subject: - fixes: improved POINTER TO IDENT mechanism, prevent core dump when
X-Git-Tag: release-5-5~4062
X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=efafb68f00aea1e3d56a1047fc2aee4431177d6e;p=ack.git

- fixes: improved POINTER TO IDENT mechanism, prevent core dump when
        definition module not found, corrected typo.
- changed mechanism for variables that have their address given.
- added option for symmetric integer ranges
---

diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index ca90aa87b..3318db043 100644
--- a/lang/m2/comp/code.c
+++ b/lang/m2/comp/code.c
@@ -177,7 +177,7 @@ CodeCoercion(t1, t2)
 		fund1 = T_CARDINAL;
 		break;
 	}
-	switch(fund2 = t1->tp_fund) {
+	switch(fund2 = t2->tp_fund) {
 	case T_WORD:
 		fund2 = T_INTEGER;
 		break;
@@ -556,7 +556,10 @@ CodeStd(nd)
 			if (tp->tp_fund == T_INTEGER) C_adi(size);
 			else	C_adu(size);
 		}
-		if (size == word_size) RangeCheck(tp, int_type);
+		if (size == word_size) {
+			RangeCheck(tp, tp->tp_fund == T_INTEGER ?
+						int_type : card_type);
+		}
 		CodeDStore(left);
 		break;
 		}
diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H
index 15111f434..b51188402 100644
--- a/lang/m2/comp/def.H
+++ b/lang/m2/comp/def.H
@@ -21,10 +21,8 @@ struct module {
 struct variable {
 	arith va_off;		/* address or offset of variable */
 	char *va_name;		/* name of variable if given */
-	char va_addrgiven;	/* an address was given in the program */
 #define var_off		df_value.df_variable.va_off
 #define var_name	df_value.df_variable.va_name
-#define var_addrgiven	df_value.df_variable.va_addrgiven
 };
 
 struct constant {
@@ -74,8 +72,6 @@ struct dforward {
 
 struct forwtype {
 	struct node *f_node;
-	struct type *f_type;
-#define df_forw_type	df_value.df_fortype.f_type
 #define df_forw_node	df_value.df_fortype.f_node
 };
 
@@ -116,6 +112,7 @@ struct def	{		/* list of definitions for a name */
 #define D_QEXPORTED	0x40	/* set if qualified exported */
 #define D_BUSY		0x80	/* set if busy reading this definition module */
 #define D_FOREIGN	0x100	/* set for foreign language modules */
+#define D_ADDRGIVEN	0x200	/* set if address given for variable */
 	struct type *df_type;
 	union {
 		struct module df_module;
diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c
index f8dfcf783..0f15dfdb1 100644
--- a/lang/m2/comp/def.c
+++ b/lang/m2/comp/def.c
@@ -142,7 +142,6 @@ define(id, scope, kind)
 			if (kind == D_FORWTYPE) return df;
 			if (kind == D_TYPE) {
 				df->df_kind = D_FTYPE;
-				FreeNode(df->df_forw_node);
 			}
 			else {
 				error("identifier \"%s\" must be a type",
diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c
index 35815a122..cde9c363d 100644
--- a/lang/m2/comp/defmodule.c
+++ b/lang/m2/comp/defmodule.c
@@ -94,6 +94,7 @@ GetDefinitionModule(id, incr)
 	struct scopelist *vis;
 	char *fn = FileName;
 	int ln = LineNumber;
+	struct scope *newsc = CurrentScope;
 
 	level += incr;
 	df = lookup(id, GlobalScope, 1);
@@ -110,6 +111,7 @@ GetDefinitionModule(id, incr)
 
 			ForeignFlag = 0;
 			open_scope(CLOSEDSCOPE);
+			newsc = CurrentScope;
 			if (!is_anon_idf(id) && GetFile(id->id_text)) {
 
 				DefModule();
@@ -136,7 +138,7 @@ GetDefinitionModule(id, incr)
 			}
 			else {
 				df = lookup(id, GlobalScope, 1);
-				CurrentScope->sc_name = id->id_text;
+				newsc->sc_name = id->id_text;
 			}
 			vis = CurrVis;
 			close_scope(SC_CHKFORW);
@@ -145,6 +147,7 @@ GetDefinitionModule(id, incr)
 			df = MkDef(id, GlobalScope, D_ERROR);
 			df->df_type = error_type;
 			df->mod_vis = vis;
+			newsc->sc_definedby = df;
 		}
 	}
 	else if (df->df_flags & D_BUSY) {
diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c
index fb0a9ba8b..800b231da 100644
--- a/lang/m2/comp/desig.c
+++ b/lang/m2/comp/desig.c
@@ -438,7 +438,7 @@ CodeVarDesig(df, ds)
 	*/
 	assert(ds->dsg_kind == DSG_INIT);
 
-	if (df->var_addrgiven) {
+	if (df->df_flags & D_ADDRGIVEN) {
 		/* the programmer specified an address in the declaration of
 		   the variable. Generate code to push the address.
 		*/
diff --git a/lang/m2/comp/em_m2.6 b/lang/m2/comp/em_m2.6
index 531cb3689..5732581ee 100644
--- a/lang/m2/comp/em_m2.6
+++ b/lang/m2/comp/em_m2.6
@@ -65,6 +65,10 @@ make all procedure names global, so that \fIadb\fR(1) understands them.
 .IP \fB\-i\fR\fInum\fR
 maximum number of bits in a set. When not used, a default value is
 retained.
+.IP \fB\-s\fR
+make INTEGER ranges symmetric, t.i., MIN(INTEGER) = - MAX(INTEGER).
+This is useful for interpreters that use the "real" MIN(INTEGER) to
+indicate "undefined".
 .LP
 .SH FILES
 .IR ~em/lib/em_m2 :
diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c
index 1e3326a11..c6c4b22c3 100644
--- a/lang/m2/comp/enter.c
+++ b/lang/m2/comp/enter.c
@@ -133,8 +133,7 @@ EnterVarList(Idlist, type, local)
 			*/
 			register struct type *tp = idlist->nd_left->nd_type;
 
-			df->var_addrgiven = 1;
-			df->df_flags |= D_NOREG;
+			df->df_flags |= D_ADDRGIVEN | D_NOREG;
 			if (tp != error_type && !(tp->tp_fund & T_CARDINAL)){
 				node_error(idlist->nd_left,
 					   "illegal type for address");
diff --git a/lang/m2/comp/modula-2.1 b/lang/m2/comp/modula-2.1
index 93aac3ca5..d3fd8400c 100644
--- a/lang/m2/comp/modula-2.1
+++ b/lang/m2/comp/modula-2.1
@@ -80,6 +80,10 @@ By default, warnings in class \fBO\fR and \fBW\fR are given.
 allow for warning messages whose class is a member of \fIclasses\fR.
 .IP \fB\-x\fR
 make all procedure names global, so that \fIadb\fR(1) understands them.
+.IP \fB\-Xs\fR
+make INTEGER ranges symmetric, t.i., MIN(INTEGER) = - MAX(INTEGER).
+This is useful for interpreters that use the "real" MIN(INTEGER) to
+indicate "undefined".
 .LP
 .SH SEE ALSO
 \fIack\fR(1), \fIem_m2\fR(6)
diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C
index 8f0b6534c..38d6dc1a9 100644
--- a/lang/m2/comp/scope.C
+++ b/lang/m2/comp/scope.C
@@ -117,21 +117,31 @@ chk_forw(pdf)
 	while (df = *pdf) {
 		if (df->df_kind == D_FORWTYPE) {
 			register struct def *df1 = df;
+			register struct node *nd = df->df_forw_node;
 
 			*pdf = df->df_nextinscope;
 			RemoveFromIdList(df);
-			df = lookfor(df->df_forw_node, CurrVis, 1);
+			df = lookfor(nd, CurrVis, 1);
 			if (! df->df_kind & (D_ERROR|D_FTYPE|D_TYPE)) {
-node_error(df1->df_forw_node, "\"%s\" is not a type", df1->df_idf->id_text);
+node_error(nd, "\"%s\" is not a type", df1->df_idf->id_text);
+			}
+			while (nd) {
+				nd->nd_type->next = df->df_type;
+				nd = nd->nd_right;
 			}
-			df1->df_forw_type->next = df->df_type;
 			FreeNode(df1->df_forw_node);
 			free_def(df1);
 			continue;
 		}
 		else if (df->df_kind == D_FTYPE) {
+			register struct node *nd = df->df_forw_node;
+
 			df->df_kind = D_TYPE;
-			df->df_forw_type->next = df->df_type;
+			while (nd) {
+				nd->nd_type->next = df->df_type;
+				nd = nd->nd_right;
+			}
+			FreeNode(df->df_forw_node);
 		}
 		else if (df->df_kind & (D_FORWARD|D_FORWMODULE)) {
 			/* These definitions must be found in
diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index 3f6bd0ea0..4ecaf2714 100644
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -249,11 +249,16 @@ qualified_type(nd)
 		else {
 			register struct def *df = nd->nd_def;
 
-			if (df->df_kind&(D_ISTYPE|D_FORWARD|D_ERROR)) {
+			if (df->df_kind&(D_ISTYPE|D_FORWARD|D_FORWTYPE|D_ERROR)) {
 			    if (! df->df_type) {
 node_error(nd,"type \"%s\" not (yet) declared", df->df_idf->id_text);
 			    }
-			    else tp = df->df_type;
+			    else {
+				if (df->df_kind == D_FORWTYPE) {
+					df->df_kind = D_FTYPE;
+				}
+			   	tp = df->df_type;
+			    }
 			}
 			else {
 node_error(nd,"identifier \"%s\" is not a type", df->df_idf->id_text);
@@ -577,17 +582,25 @@ type_or_forward(ptp)
 		in "dot". This routine handles the different cases.
 	*/
 	register struct node *nd;
+	register struct def *df1;
 
 	*ptp = construct_type(T_POINTER, NULLTYPE);
-	if (lookup(dot.TOK_IDF, CurrentScope, 1)) {
+	if ((df1 = 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
 		*/
+		if (df1->df_kind == D_FORWTYPE) {
+			nd = new_node();
+			nd->nd_token = dot;
+			nd->nd_right = df1->df_forw_node;
+			df1->df_forw_node = nd;
+			nd->nd_type = *ptp;
+		}
 		return 1;
 	}
 	nd = new_node();
 	nd->nd_token = dot;
-	if (lookfor(nd, CurrVis, 0)->df_kind == D_MODULE) {
+	if ((df1 = 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
@@ -610,10 +623,14 @@ type_or_forward(ptp)
 
 		if (df->df_kind == D_TYPE) {
 			(*ptp)->next = df->df_type;
+			free_node(nd);
 		}
 		else {
-			df->df_forw_type = *ptp;
+			nd->nd_type = *ptp;
 			df->df_forw_node = nd;
+			if (df1->df_kind == D_TYPE) {
+				df->df_type = df1->df_type;
+			}
 		}
 	}
 	return 0;
diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index db1dd2147..ac94d47ed 100644
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -325,7 +325,7 @@ WalkDef(df)
 			WalkProcedure(df);
 			break;
 		case D_VARIABLE:
-			if (!proclevel  && !df->var_addrgiven) {
+			if (!proclevel  && !(df->df_flags & D_ADDRGIVEN)) {
 				C_df_dnam(df->var_name);
 				C_bss_cst(
 					WA(df->df_type->tp_size),