From: ceriel <none@none>
Date: Fri, 16 May 1986 17:15:36 +0000 (+0000)
Subject: newer version
X-Git-Tag: release-5-5~5294
X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=a4887558b811f40a6460f41a95ddb8b72fbf8079;p=ack.git

newer version
---

diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index c0b90a479..3f233ffe1 100644
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -99,7 +99,7 @@ node.o: LLlex.h debug.h def.h node.h type.h
 cstoper.o: LLlex.h Lpars.h debug.h idf.h node.h standards.h target_sizes.h type.h
 chk_expr.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h standards.h type.h
 options.o: idfsize.h main.h ndir.h type.h
-walk.o: LLlex.h Lpars.h debug.h def.h main.h node.h scope.h type.h
+walk.o: LLlex.h Lpars.h debug.h def.h desig.h main.h node.h scope.h type.h
 casestat.o: LLlex.h Lpars.h debug.h density.h node.h type.h
 tokenfile.o: Lpars.h
 program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index a0bc2050a..a4f55fd00 100644
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -461,6 +461,8 @@ chk_designator(expp, flag)
 			return 0;
 		}
 		else {
+			expp->nd_right->nd_class = Def;
+			expp->nd_right->nd_def = df;
 			expp->nd_type = df->df_type;
 			if (!(df->df_flags & (D_EXPORTED|D_QEXPORTED))) {
 node_error(expp->nd_right,
diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index 1adbccd79..36c160b34 100644
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -33,7 +33,6 @@ ProcedureDeclaration
 } :
 	ProcedureHeading(&df, D_PROCEDURE)
 			{
-			  df->prc_level = proclevel++;
 			  currentdef = df;
 			}
 	';' block(&(df->prc_body)) IDENT
@@ -55,8 +54,9 @@ ProcedureHeading(struct def **pdf; int type;)
 } :
 	PROCEDURE IDENT
 		{
+		  if (type == D_PROCEDURE) proclevel++;
 		  df = DeclProc(type);
-		  if (proclevel) {
+		  if (proclevel > 1) {
 			/* Room for static link
 			*/
 			df->prc_nbpar = pointer_size;
@@ -242,7 +242,7 @@ enumeration(struct type **ptp;)
 		{
 		  *ptp = standard_type(T_ENUMERATION, 1, (arith) 1);
 		  EnterIdList(EnumList, D_ENUM, 0, *ptp,
-				CurrentScope, (arith *) 0);
+				 CurrentScope, (arith *) 0);
 		  FreeNode(EnumList);
 		  if ((*ptp)->enm_ncst > 256) {
 			if (word_size == 1) {
diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H
index 131f67f1a..82a5cda77 100644
--- a/lang/m2/comp/def.H
+++ b/lang/m2/comp/def.H
@@ -6,25 +6,18 @@ struct module {
 	arith mo_priority;	/* priority of a module */
 	struct scopelist *mo_vis;/* scope of this module */
 	struct node *mo_body;	/* body of this module */
-	int mo_number;		/* number of this module */
 #define mod_priority	df_value.df_module.mo_priority
 #define mod_vis		df_value.df_module.mo_vis
 #define mod_body	df_value.df_module.mo_body
-#define mod_number	df_value.df_module.mo_number
 };
 
 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 */
-	char va_noreg;		/* may not be in a register */
-	short va_number;	/* number of this variable in definition module
-				*/
 #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
-#define var_noreg	df_value.df_variable.va_noreg
-#define var_number	df_value.df_variable.va_number
 };
 
 struct constant {
@@ -52,11 +45,9 @@ struct field {
 
 struct dfproc {
 	struct scopelist *pr_vis; /* scope of procedure */
-	short pr_level;		/* depth level of this procedure */
 	arith pr_nbpar;		/* number of bytes parameters */
 	struct node *pr_body;	/* body of this procedure */
 #define prc_vis		df_value.df_proc.pr_vis
-#define prc_level	df_value.df_proc.pr_level
 #define prc_nbpar	df_value.df_proc.pr_nbpar
 #define prc_body	df_value.df_proc.pr_body
 };
diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c
new file mode 100644
index 000000000..e52b69f22
--- /dev/null
+++ b/lang/m2/comp/desig.c
@@ -0,0 +1,164 @@
+/* D E S I G N A T O R   E V A L U A T I O N */
+
+#ifndef NORCSID
+static char *RcsId = "$Header$";
+#endif
+
+/*	Code generation for designators.
+   	This file contains some routines that generate code common to address
+	as well as value computations, and leave a description in a "desig"
+	structure.  It also contains routines to load an address, load a value
+	or perform a store.
+*/
+
+#include	"debug.h"
+
+#include	<em_arith.h>
+#include	<em_label.h>
+#include	<assert.h>
+
+#include	"type.h"
+#include	"def.h"
+#include	"scope.h"
+#include	"desig.h"
+#include	"LLlex.h"
+#include	"node.h"
+
+CodeValue(ds, size)
+	register struct desig *ds;
+{
+	/*	Generate code to load the value of the designator described
+		in "ds"
+	*/
+
+	switch(ds->dsg_kind) {
+	case DSG_LOADED:
+		break;
+
+	case DSG_FIXED:
+		if (size == word_size) {
+			if (ds->dsg_name) {
+				C_loe_dnam(ds->dsg_name, ds->dsg_offset);
+			}
+			else	C_lol(ds->dsg_offset);
+			break;
+		}
+
+		if (size == dwird_size) {
+			if (ds->dsg_name) {
+				C_lde_dnam(ds->dsg_name, ds->dsg_offset);
+			}
+			else	C_ldl(ds->dsg_offset);
+			break;
+		}
+		/* Fall through */
+	case DSG_PLOADED:
+	case DSG_PFIXED:
+		CodeAddress(ds);
+		C_loi(size);
+		break;
+
+	case DSG_INDEXED:
+		C_lar(word_size);
+		break;
+
+	default:
+		assert(0);
+	}
+
+	ds->dsg_kind = DSG_LOADED;
+}
+
+CodeAddress(ds)
+	register struct desig *ds;
+{
+	/*	Generate code to load the address of the designator described
+	   	in "ds"
+	*/
+
+	switch(ds->dsg_kind) {
+	case DSG_PLOADED:
+		if (ds->dsg_offset) {
+			C_adp(ds->dsg_offset);
+		}
+		break;
+
+	case DSG_FIXED:
+		if (ds->dsg_name) {
+			C_lae_dnam(ds->dsg_name, ds->dsg_offset);
+			break;
+		}
+		C_lal(ds->dsg_offset);
+		break;
+		
+	case DSG_PFIXED:
+		ds->dsg_kind = DSG_FIXED;
+		CodeValue(ds, pointer_size);
+		break;
+
+	case DSG_INDEXED:
+		C_aar(word_size);
+		break;
+
+	default:
+		assert(0);
+		break;
+	}
+
+	ds->dsg_offset = 0;
+	ds->dsg_kind = DSG_PLOADED;
+}
+
+CodeFieldDesig(df, ds)
+	register struct def *df;
+	register struct desig *ds;
+{
+	/* Generate code for a field designator. Only the code common for
+	   address as well as value computation is generated, and the
+	   resulting information on where to find the designator is placed
+	   in "ds". "df" indicates the definition of the field.
+	*/
+
+	register struct withdesig *wds;
+
+	if (ds->dsg_kind == DSG_INIT) {
+		/* In a WITH statement. We must find the designator in the
+		   WITH statement, and act as if the field is a selection
+		   of this designator.
+		   So, first find the right WITH statement, which is the
+		   first one of the proper record type.
+		   Notice that the proper record type is recognized by its
+		   scope indication.
+		*/
+		wds = WithDesigs;
+		assert(wds != 0);
+
+		while (wds->w_scope != df->df_scope) {
+			wds = wds->w_next;
+			assert(wds != 0);
+		}
+
+		/* Found it. Now, act like it was a selection.
+		*/
+		*ds = wds->w_desig;
+	}
+
+	switch(ds->dsg_kind) {
+	case DSG_PLOADED:
+	case DSG_FIXED:
+		ds->dsg_offset += df->fld_off;
+		break;
+
+	case DSG_PFIXED:
+	case DSG_INDEXED:
+		CodeAddress(ds);
+		ds->dsg_kind = PLOADED;
+		ds->dsg_offset = df->fld_off;
+		break;
+
+	default:
+		assert(0);
+		break;
+	}
+}
+
diff --git a/lang/m2/comp/desig.h b/lang/m2/comp/desig.h
new file mode 100644
index 000000000..ffbbb65b3
--- /dev/null
+++ b/lang/m2/comp/desig.h
@@ -0,0 +1,53 @@
+/* D E S I G N A T O R   D E S C R I P T I O N S */
+
+/* $Header$ */
+
+/* Generating code for designators is not particularly easy, especially if
+   you don't know wether you want the address or the value.
+   The next structure is used to generate code for designators.
+   It contains information on how to find the designator, after generation
+   of the code that is common to both address and value computations.
+*/
+
+struct desig {
+	int	dsg_kind;
+#define DSG_INIT	0	/* don't know anything yet */
+#define DSG_LOADED	1	/* designator loaded  on top of the stack */
+#define DSG_PLOADED	2	/* designator accessible through pointer on
+				   stack, possibly with an offset
+				*/
+#define DSG_FIXED	3	/* designator directly accessible */
+#define DSG_PFIXED	4	/* designator accessible through directly
+				   accessible pointer
+				*/
+#define DSG_INDEXED	5	/* designator accessible through array
+				   operation. Address of array descriptor on
+				   top of the stack, index beneath that, and
+				   base address beneath that
+				*/
+	arith	dsg_offset;	/* contains an offset for PLOADED,
+				   or for FIXED or PFIXED it contains an
+				   offset from dsg_name, if it exists,
+				   or from the current Local Base
+				*/
+	char	*dsg_name;	/* name of global variable, used for
+				   FIXED and PFIXED
+				*/
+};
+
+/* The next structure describes the designator in a with-statement.
+   We have a linked list of them, as with-statements may be nested.
+*/
+
+struct withdesig {
+	struct withdesig *w_next;
+	struct scope *w_scope;	/* scope in which fields of this record
+				   reside
+				*/
+	struct desig *w_desig;	/* a desig structure for this particular
+				   designator
+				*/
+};
+
+extern struct withdesig	*WithDesigs;
+extern struct desig	Desig;
diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c
index 336a2e0a1..17fe39c5c 100644
--- a/lang/m2/comp/enter.c
+++ b/lang/m2/comp/enter.c
@@ -105,7 +105,7 @@ EnterVarList(IdList, type, local)
 	/*	Enter a list of identifiers representing variables into the
 		name list. "type" represents the type of the variables.
 		"local" is set if the variables are declared local to a
-		procedure
+		procedure.
 	*/
 	register struct def *df;
 	register struct scopelist *sc;
@@ -143,14 +143,15 @@ node_error(IdList->nd_left,"Illegal type for address");
 						type->tp_align);
 			df->var_off = sc->sc_scope->sc_off;
 		}
-		else if (!DefinitionModule &&
-			 CurrVis != Defined->mod_vis) {	
+		else if (!DefinitionModule && CurrVis != Defined->mod_vis) {	
 			/* variable list belongs to an internal global
-			   module. Align offset and add size
+			   module.
+			   Align offset and add size
 			*/
 			sc->sc_scope->sc_off =
 				align(sc->sc_scope->sc_off, type->tp_align);
 			df->var_off = sc->sc_scope->sc_off;
+			df->var_name = 0;
 			sc->sc_scope->sc_off += type->tp_size;
 		}
 		else {
@@ -160,6 +161,7 @@ node_error(IdList->nd_left,"Illegal type for address");
 					    df->df_idf->id_text);
 			df->var_name = Malloc((unsigned)(strlen(buf)+1));
 			strcpy(df->var_name, buf);
+
  			if (DefinitionModule) {
 				C_exa_dnam(df->var_name);
 			}
@@ -167,6 +169,7 @@ node_error(IdList->nd_left,"Illegal type for address");
 				C_ina_dnam(df->var_name);
 			}
 		}
+
 		IdList = IdList->nd_right;
 	}
 }
diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c
index c81078f3b..62b780def 100644
--- a/lang/m2/comp/main.c
+++ b/lang/m2/comp/main.c
@@ -84,7 +84,7 @@ Compile(src, dst)
 		return 1;
 	}
 #endif DEBUG
-	(void) open_scope(CLOSEDSCOPE);
+	open_scope(CLOSEDSCOPE);
 	GlobalScope = CurrentScope;
 	C_init(word_size, pointer_size);
 	if (! C_open(dst)) {
diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c
index 5206d4228..8e3214d07 100644
--- a/lang/m2/comp/options.c
+++ b/lang/m2/comp/options.c
@@ -64,7 +64,10 @@ DoOption(text)
 			switch (c)	{
 
 			case 'w':	/* word		*/
-				if (size != (arith)0) word_size = size;
+				if (size != (arith)0) {
+					word_size = size;
+					dword_size = 2 * size;
+				}
 				if (align != 0) word_align = align;
 				break;
 			case 'i':	/* int		*/
diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g
index 81444fc51..3fb43e3a1 100644
--- a/lang/m2/comp/program.g
+++ b/lang/m2/comp/program.g
@@ -67,16 +67,18 @@ ModuleDeclaration
 			  	open_scope(CLOSEDSCOPE);
 			  	df->mod_vis = CurrVis;
 			  }
-			  else	CurrVis = df->mod_vis;
+			  else {
+				CurrVis = df->mod_vis;
+				CurrentScope->sc_level = proclevel;
+			  }
 
 			  df->df_type = standard_type(T_RECORD, 0, (arith) 0);
 			  df->df_type->rec_scope = df->mod_vis->sc_scope;
-			  df->mod_number = ++modulecount;
-			  sprint(buf, "__%d%s", df->mod_number, id->id_text);
+			  sprint(buf, "__%d%s", ++modulecount, id->id_text);
 			  CurrentScope->sc_name =
 				Malloc((unsigned) (strlen(buf) + 1));
 			  strcpy(CurrentScope->sc_name, buf);
-			  C_ina_dnam(&buf[1]);
+			  if (! proclevel) C_ina_dnam(&buf[1]);
 			  C_inp(buf);
 			}
 	priority(&(df->mod_priority))?
@@ -161,7 +163,6 @@ DefinitionModule
 			  if (!SYSTEMModule) open_scope(CLOSEDSCOPE);
 			  if (!Defined) Defined = df;
 			  df->mod_vis = CurrVis;
-			  df->mod_number = 0;
 			  CurrentScope->sc_name = id->id_text;
 			  df->df_type = standard_type(T_RECORD, 0, (arith) 0);
 			  df->df_type->rec_scope = df->mod_vis->sc_scope;
@@ -253,7 +254,6 @@ ProgramModule(int state;)
 		  	Defined = df;
 			open_scope(CLOSEDSCOPE);
 			df->mod_vis = CurrVis;
-			df->mod_number = 0;
 			CurrentScope->sc_name = id->id_text;
 		  }
 		}
diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C
index f416ceb63..f98998724 100644
--- a/lang/m2/comp/scope.C
+++ b/lang/m2/comp/scope.C
@@ -20,7 +20,7 @@ static char *RcsId = "$Header$";
 
 struct scope *PervasiveScope, *GlobalScope;
 struct scopelist *CurrVis;
-static int scp_level;
+extern int proclevel;
 static struct scopelist *PervVis;
 
 /* STATICALLOCDEF "scope" */
@@ -36,7 +36,7 @@ open_scope(scopetype)
 
 	assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
 	sc->sc_scopeclosed = scopetype == CLOSEDSCOPE;
-	sc->sc_level = scp_level++;
+	sc->sc_level = proclevel;
 	sc->sc_forw = 0;
 	sc->sc_def = 0;
 	sc->sc_off = 0;
@@ -57,7 +57,7 @@ init_scope()
 	sc->sc_scopeclosed = 0;
 	sc->sc_forw = 0;
 	sc->sc_def = 0;
-	sc->sc_level = scp_level++;
+	sc->sc_level = proclevel;
 	PervasiveScope = sc;
 	ls->next = 0;
 	ls->sc_encl = 0;
@@ -228,7 +228,6 @@ close_scope(flag)
 		if (flag & SC_REVERSE) Reverse(&(sc->sc_def));
 	}
 	CurrVis = enclosing(CurrVis);
-	scp_level = CurrentScope->sc_level;
 }
 
 #ifdef DEBUG
diff --git a/lang/m2/comp/scope.h b/lang/m2/comp/scope.h
index 4bee7e82b..a80a1dbc7 100644
--- a/lang/m2/comp/scope.h
+++ b/lang/m2/comp/scope.h
@@ -27,8 +27,8 @@ struct scope {
 
 struct scopelist {
 	struct scopelist *next;
-	struct scopelist *sc_encl;
 	struct scope *sc_scope;
+	struct scopelist *sc_encl;
 };
 
 extern struct scope
diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H
index e1595d4f5..ef74b9932 100644
--- a/lang/m2/comp/type.H
+++ b/lang/m2/comp/type.H
@@ -112,6 +112,7 @@ extern int
 
 extern arith
 	word_size,
+	dword_size,
 	int_size,
 	long_size,
 	float_size,
diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index e9f19f97c..a15405cfa 100644
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -34,6 +34,7 @@ int
 
 arith
 	word_size = SZ_WORD,
+	dword_size = 2 * SZ_WORD,
 	int_size = SZ_INT,
 	long_size = SZ_LONG,
 	float_size = SZ_FLOAT,
diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index 6e56b658d..9c4ba1cfd 100644
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -21,12 +21,14 @@ static char *RcsId = "$Header$";
 #include	"LLlex.h"
 #include	"node.h"
 #include	"Lpars.h"
+#include	"desig.h"
 
 extern arith	align();
-static int	prclev = 0;
+extern int	proclevel;
 static label	instructionlabel;
 static char	return_expr_occurred;
 static struct type *func_type;
+struct withdesig *WithDesigs;
 
 label
 text_label()
@@ -54,7 +56,7 @@ WalkModule(module)
 	vis = CurrVis;
 	CurrVis = module->mod_vis;
 
-	if (!prclev && module->mod_number) {
+	if (!proclevel && module != Defined) {
 		/* This module is a local module, but not within a
 		   procedure. Generate code to allocate storage for its
 		   variables. This is done by generating a "bss",
@@ -63,6 +65,8 @@ WalkModule(module)
 		arith size = align(CurrentScope->sc_off, word_align);
 
 		if (size == 0) size = word_size;
+		/* WHY ??? because we generated an INA for it ??? */
+
 		C_df_dnam(&(CurrentScope->sc_name[1]));
 		C_bss_cst(size, (arith) 0, 0);
 	}
@@ -109,7 +113,7 @@ WalkProcedure(procedure)
 	*/
 	struct scopelist *vis = CurrVis;
 
-	prclev++;
+	proclevel++;
 	CurrVis = procedure->prc_vis;
 	
 	WalkDef(CurrentScope->sc_def);
@@ -133,9 +137,9 @@ node_error(procedure->prc_body,"function procedure does not return a value");
 		C_ret((int) align(func_type->tp_size, word_align));
 	}
 	else	C_ret(0);
-	C_end((int) align(-CurrentScope->sc_off, word_align));
+	C_end(align(-CurrentScope->sc_off, word_align));
 	CurrVis = vis;
-	prclev--;
+	proclevel--;
 }
 
 WalkDef(df)
@@ -295,6 +299,7 @@ WalkStat(nd, lab)
 	case WITH:
 		{
 			struct scopelist link;
+			struct withdesig wds;
 
 			WalkDesignator(left);
 			if (left->nd_type->tp_fund != T_RECORD) {
@@ -302,12 +307,23 @@ WalkStat(nd, lab)
 				break;
 			}
 
-			link.sc_scope = left->nd_type->rec_scope;
+			wds.w_next = WithDesigs;
+			WithDesigs = &wds;
+			wds.w_scope = left->nd_type->rec_scope;
+			/* 
+			   Decide here wether to use a temporary variable or
+			   not, depending on the value of Desig.
+			   Suggestion: temporary if Desig != DSG_FIXED
+
+			   And then:
+			   wds.w_desig = Desig; ???
+			*/
+			link.sc_scope = wds.w_scope;
 			link.next = CurrVis;
 			CurrVis = &link;
 			WalkNode(right, lab);
 			CurrVis = link.next;
-			/* ??? */
+			WithDesigs = wds.w_next;
 			break;
 		}