newer version

lang/m2/comp/Makefile

@@ -18,7 +18,7 @@ LOBJ =	tokenfile.o program.o declar.o expression.o statement.o
 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
+	cstoper.o chk_expr.o options.o walk.o
 OBJ =	$(COBJ) $(LOBJ) Lpars.o
 GENFILES=	tokenfile.c \
 	program.c declar.c expression.c statement.c \
@@ -81,7 +81,7 @@ depend:
 LLlex.o: LLlex.h Lpars.h class.h const.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h
 LLmessage.o: LLlex.h Lpars.h idf.h
 char.o: class.h
-error.o: LLlex.h errout.h f_info.h input.h inputtype.h main.h node.h
+error.o: LLlex.h debug.h errout.h f_info.h input.h inputtype.h main.h node.h
 main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h inputtype.h scope.h standards.h tokenname.h type.h
 symbol2str.o: Lpars.h
 tokenname.o: Lpars.h idf.h tokenname.h
@@ -92,15 +92,16 @@ def.o: LLlex.h debug.h def.h idf.h main.h node.h scope.h type.h
 scope.o: LLlex.h debug.h def.h idf.h node.h scope.h type.h
 misc.o: LLlex.h f_info.h idf.h misc.h node.h
 enter.o: LLlex.h def.h idf.h main.h node.h scope.h type.h
-defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h inputtype.h scope.h
+defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h inputtype.h main.h scope.h
 typequiv.o: def.h type.h
 node.o: LLlex.h debug.h def.h node.h type.h
 cstoper.o: LLlex.h Lpars.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 type.h
+walk.o: debug.h def.h main.h scope.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
-declar.o: LLlex.h Lpars.h def.h idf.h misc.h node.h scope.h type.h
+declar.o: LLlex.h Lpars.h def.h idf.h main.h misc.h node.h scope.h type.h
 expression.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h type.h
 statement.o: LLlex.h Lpars.h node.h type.h
 Lpars.o: Lpars.h

lang/m2/comp/declar.g

@@ -16,25 +16,22 @@ static char *RcsId = "$Header$";
 #include	"misc.h"
 #include	"main.h"
 
-static int	proclevel = 0;	/* nesting level of procedures */
+int		proclevel = 0;	/* nesting level of procedures */
-char *		sprint();
+extern char	*sprint();
 }
 
 ProcedureDeclaration
 {
 	struct def *df;
-	char buf[256];
 } :
 	ProcedureHeading(&df, D_PROCEDURE)
-			{ df->prc_level = proclevel++;
+			{
-			  if (DefinitionModule) {
+			  df->prc_level = proclevel++;
-				C_exp(sprint(buf, "%s_%s",
+
-						df->df_scope->sc_name,
-						df->df_idf->id_text));
-			  }
 			}
 	';' block(&(df->prc_body)) IDENT
-			{ match_id(dot.TOK_IDF, df->df_idf);
+			{
+			  match_id(dot.TOK_IDF, df->df_idf);
 			  df->prc_scope = CurrentScope;
 			  close_scope(SC_CHKFORW);
 			  proclevel--;
@@ -44,34 +41,22 @@ ProcedureDeclaration
 ProcedureHeading(struct def **pdf; int type;)
 {
 	struct type *tp = 0;
-	struct type *tp1 = 0;
 	struct paramlist *params = 0;
 	register struct def *df;
+	struct def *DeclProc();
 } :
 	PROCEDURE IDENT
-		{ assert(type & (D_PROCEDURE | D_PROCHEAD));
+		{
-		  if (type == D_PROCHEAD) {
+		  df = DeclProc(type);
-			df = define(dot.TOK_IDF, CurrentScope, type);
-			df->for_node = MkNode(Name, NULLNODE, NULLNODE, &dot);
-		  }
-		  else {
-			df = lookup(dot.TOK_IDF, CurrentScope);
-			if (df && df->df_kind == D_PROCHEAD) {
-				df->df_kind = type;
-				tp1 = df->df_type;
-			}
-			else	df = define(dot.TOK_IDF, CurrentScope, type);
-			df->prc_nbpar = 0;
-			open_scope(OPENSCOPE);
-		  }
 		}
 	FormalParameters(type == D_PROCEDURE, &params, &tp, &(df->prc_nbpar))?
 		{
-		  df->df_type = tp = construct_type(T_PROCEDURE, tp);
+		  tp = construct_type(T_PROCEDURE, tp);
 		  tp->prc_params = params;
-		  if (tp1 && !TstTypeEquiv(tp, tp1)) {
+		  if (df->df_type && !TstTypeEquiv(tp, df->df_type)) {
 error("inconsistent procedure declaration for \"%s\"", df->df_idf->id_text); 
 		  }
+		  df->df_type = tp;
 		  *pdf = df;
 		}
 ;
@@ -120,7 +105,8 @@ FormalParameters(int doparams;
 	]?
 	')'
 			{ *tp = 0; }
-	[	':' qualident(D_TYPE|D_HTYPE|D_HIDDEN, &df, "type", (struct node **) 0)
+	[	':' qualident(D_TYPE|D_HTYPE|D_HIDDEN, &df, "type",
+							(struct node **) 0)
 			{ *tp = df->df_type; }
 	]?
 ;
@@ -160,15 +146,15 @@ FormalType(struct type **tp;)
 	[ ARRAY OF	{ ARRAYflag = 1; }
 	]?
 	qualident(D_TYPE|D_HTYPE|D_HIDDEN, &df, "type", (struct node **) 0)
-			{ if (ARRAYflag) {
+		{ if (ARRAYflag) {
-				*tp = construct_type(T_ARRAY, NULLTYPE);
+			*tp = construct_type(T_ARRAY, NULLTYPE);
-				(*tp)->arr_elem = df->df_type;
+			(*tp)->arr_elem = df->df_type;
-				(*tp)->tp_align = lcm(word_align, pointer_align);
+			(*tp)->tp_align = lcm(word_align, pointer_align);
-				(*tp)->tp_size = align(pointer_size + 3*word_size,
+			(*tp)->tp_size = align(pointer_size + word_size,
-							(*tp)->tp_align);
+						(*tp)->tp_align);
-			  }
+		  }
-			  else	*tp = df->df_type;
+		  else	*tp = df->df_type;
-			}
+		}
 ;
 
 TypeDeclaration
@@ -188,7 +174,6 @@ TypeDeclaration
 			      tp->tp_fund != T_POINTER) {
 error("Opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
 			  }
-
 			}
 ;
 
@@ -244,6 +229,7 @@ enumeration(struct type **ptp;)
 				error("Too many enumeration literals");
 			}
 			else {
+				/* ??? This is crummy */
 				(*ptp)->tp_size = word_size;
 				(*ptp)->tp_align = word_align;
 			}
@@ -392,7 +378,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 				{ max = tcnt; tcnt = *cnt; }
 	[
 		'|' variant(scope, &tcnt, tp, palign)
-				{ if (tcnt > max) max = tcnt; }
+				{ if (tcnt > max) max = tcnt; tcnt = *cnt; }
 	]*
 	[ ELSE FieldListSequence(scope, &tcnt, palign)
 				{ if (tcnt > max) max = tcnt; }

lang/m2/comp/def.H

@@ -6,18 +6,22 @@ struct module {
 	arith mo_priority;	/* priority of a module */
 	struct scope *mo_scope;	/* 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_scope	df_value.df_module.mo_scope
 #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
@@ -49,15 +53,14 @@ struct field {
 struct dfproc {
 	struct scope *pr_scope;	/* scope of procedure */
 	short pr_level;		/* depth level of this procedure */
-	short pr_number;	/* number of this procedure in definition module
+	char *pr_name;		/* name of this procedure */
-				*/
 	arith pr_nbpar;		/* number of bytes parameters */
 	struct node *pr_body;	/* body of this procedure */
 #define prc_scope	df_value.df_proc.pr_scope
 #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
-#define prc_number	df_value.df_proc.pr_number
+#define prc_name	df_value.df_proc.pr_name
 };
 
 struct import {
@@ -68,8 +71,10 @@ struct import {
 struct dforward {
 	struct scope *fo_scope;
 	struct node *fo_node;
+	char *fo_name;
 #define for_node	df_value.df_forward.fo_node
 #define for_scope	df_value.df_forward.fo_scope
+#define for_name	df_value.df_forward.fo_name
 };
 
 struct def	{		/* list of definitions for a name */

lang/m2/comp/def.c

@@ -6,6 +6,7 @@ static char *RcsId = "$Header$";
 #include	<em_arith.h>
 #include	<em_label.h>
 #include	<assert.h>
+
 #include	"main.h"
 #include	"def.h"
 #include	"type.h"
@@ -13,6 +14,7 @@ static char *RcsId = "$Header$";
 #include	"scope.h"
 #include	"LLlex.h"
 #include	"node.h"
+
 #include	"debug.h"
 
 struct def *h_def;		/* Pointer to free list of def structures */
@@ -77,6 +79,7 @@ define(id, scope, kind)
 				   already seen in a definition module
 				*/
 				df->df_kind = kind;
+				df->prc_name = df->for_name;
 				return df;
 			}
 			break;	
@@ -391,6 +394,56 @@ RemFromId(df)
 	}
 }
 
+struct def *
+DeclProc(type)
+{
+	/*	A procedure is declared, either in a definition or a program
+		module. Create a def structure for it (if neccessary)
+	*/
+	register struct def *df;
+	extern char *sprint(), *Malloc(), *strcpy();
+	static int nmcount = 0;
+	char buf[256];
+
+	assert(type & (D_PROCEDURE | D_PROCHEAD));
+
+	if (type == D_PROCHEAD) {
+		/* In a definition module
+		*/
+		df = define(dot.TOK_IDF, CurrentScope, type);
+		df->for_node = MkNode(Name, NULLNODE, NULLNODE, &dot);
+		sprint(buf,"%s_%s",CurrentScope->sc_name,df->df_idf->id_text);
+		df->for_name = Malloc((unsigned) (strlen(buf)+1));
+		strcpy(df->for_name, buf);
+		C_exp(df->for_name);
+	}
+	else {
+		df = lookup(dot.TOK_IDF, CurrentScope);
+		if (df && df->df_kind == D_PROCHEAD) {
+			/* C_exp already generated when we saw the definition
+			   in the definition module
+			*/
+			df->df_kind = type;
+		}
+		else {
+			df = define(dot.TOK_IDF, CurrentScope, type);
+			if (CurrentScope != Defined->mod_scope) {
+				sprint(buf, "_%d_%s", ++nmcount,
+					df->df_idf->id_text);
+			}
+			else	(sprint(buf, "%s_%s",df->df_scope->sc_name,
+						df->df_idf->id_text));
+			df->prc_name = Malloc((unsigned)(strlen(buf)+1));
+			strcpy(df->prc_name, buf);
+			C_inp(buf);
+		}
+		df->prc_nbpar = 0;
+		open_scope(OPENSCOPE);
+	}
+
+	return df;
+}
+
 #ifdef DEBUG
 PrDef(df)
 	register struct def *df;

lang/m2/comp/defmodule.c

@@ -5,12 +5,15 @@ static char *RcsId = "$Header$";
 #include	<assert.h>
 #include	<em_arith.h>
 #include	<em_label.h>
+
 #include	"idf.h"
 #include	"input.h"
 #include	"scope.h"
 #include	"def.h"
 #include	"LLlex.h"
 #include	"f_info.h"
+#include	"main.h"
+
 #include	"debug.h"
 
 #ifdef DEBUG

lang/m2/comp/enter.c

@@ -96,14 +96,21 @@ EnterVarList(IdList, type, local)
 	register struct node *IdList;
 	struct type *type;
 {
+	/*	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
+	*/
 	register struct def *df;
-	struct scope *scope;
+	register struct scope *scope;
+	char buf[256];
+	extern char *sprint(), *Malloc(), *strcpy();
 
+	scope = CurrentScope;
 	if (local) {
 		/* Find the closest enclosing open scope. This
 		   is the procedure that we are dealing with
 		*/
-		scope = CurrentScope;
 		while (scope->sc_scopeclosed) scope = scope->next;
 	}
 
@@ -111,6 +118,8 @@ EnterVarList(IdList, type, local)
 		df = define(IdList->nd_IDF, CurrentScope, D_VARIABLE);
 		df->df_type = type;
 		if (IdList->nd_left) {
+			/* An address was supplied
+			*/
 			df->var_addrgiven = 1;
 			if (IdList->nd_left->nd_type != card_type) {
 node_error(IdList->nd_left,"Illegal type for address");
@@ -127,12 +136,23 @@ node_error(IdList->nd_left,"Illegal type for address");
 			df->var_off = off;
 			scope->sc_off = off;
 		}
-		else if (DefinitionModule) {
+		else if (!DefinitionModule &&
-			char buf[256];
+			 CurrentScope != Defined->mod_scope) {	
-			char *sprint();
+			scope->sc_off = align(scope->sc_off, type->tp_align);
-
+			df->var_off = scope->sc_off;
-			C_exa_dnam(sprint(buf,"%s_%s",df->df_scope->sc_name,
+			scope->sc_off += type->tp_size;
-						df->df_idf->id_text));
+		}
+		else {
+			sprint(buf,"%s_%s", df->df_scope->sc_name,
+					    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);
+			}
+			else {
+				C_ina_dnam(df->var_name);
+			}
 		}
 		IdList = IdList->nd_right;
 	}

lang/m2/comp/main.c

@@ -5,18 +5,20 @@ static char *RcsId = "$Header$";
 #include	<system.h>
 #include	<em_arith.h>
 #include	<em_label.h>
+
 #include	"input.h"
 #include	"f_info.h"
 #include	"idf.h"
 #include	"LLlex.h"
 #include	"Lpars.h"
-#include	"debug.h"
 #include	"type.h"
 #include	"def.h"
 #include	"scope.h"
 #include	"standards.h"
 #include	"tokenname.h"
 
+#include	"debug.h"
+
 char	options[128];
 int	DefinitionModule; 
 int	SYSTEMModule = 0;
@@ -24,6 +26,7 @@ char	*ProgName;
 extern int err_occurred;
 char	*DEFPATH[128];
 char	*getenv();
+struct def *Defined;
 
 main(argc, argv)
 	char *argv[];
@@ -45,7 +48,6 @@ main(argc, argv)
 		return 1;
 	}
 #ifdef DEBUG
-	print("MODULA-2 compiler -- Debug version\n");
 	DO_DEBUG(1, debug("Debugging level: %d", options['D']));
 #endif DEBUG
 	return !Compile(Nargv[1], Nargv[2]);
@@ -72,20 +74,25 @@ Compile(src, dst)
 	init_types();
 	add_standards();
 #ifdef DEBUG
-	if (options['l']) LexScan();
+	if (options['l']) {
-	else
+		LexScan();
-#endif DEBUG
+		return 1;
-	{
-		(void) open_scope(CLOSEDSCOPE);
-		GlobalScope = CurrentScope;
-		C_init(word_size, pointer_size);
-		if (! C_open(dst)) {
-			fatal("Could not open output file");
-		}
-		C_magic();
-		C_ms_emx(word_size, pointer_size);
-		CompUnit();
 	}
+#endif DEBUG
+	(void) open_scope(CLOSEDSCOPE);
+	GlobalScope = CurrentScope;
+	C_init(word_size, pointer_size);
+	if (! C_open(dst)) {
+		fatal("Could not open output file");
+	}
+	C_magic();
+	C_ms_emx(word_size, pointer_size);
+	CompUnit();
+	if (err_occurred) {
+		C_close();
+		return 0;
+	}
+	WalkModule(Defined);
 	C_close();
 	if (err_occurred) return 0;
 	return 1;

lang/m2/comp/main.h

@@ -12,3 +12,7 @@ extern int DefinitionModule;
 extern int SYSTEMModule;/* Flag indicating that we are handling the SYSTEM
 			   module
 			*/
+extern struct def *Defined;
+			/* Definition structure of module defined in this
+			   compilation
+			*/

lang/m2/comp/program.g

@@ -6,6 +6,7 @@ static  char *RcsId = "$Header$";
 #include	<alloc.h>
 #include	<em_arith.h>
 #include	<em_label.h>
+
 #include	"main.h"
 #include	"idf.h"
 #include	"LLlex.h"
@@ -13,6 +14,7 @@ static  char *RcsId = "$Header$";
 #include	"def.h"
 #include	"type.h"
 #include	"node.h"
+
 #include	"debug.h"
 
 static int DEFofIMPL = 0;	/* Flag indicating that we are currently
@@ -20,9 +22,6 @@ static int DEFofIMPL = 0;	/* Flag indicating that we are currently
 				   implementation module currently being
 				   compiled
 				*/
-short nmcount = 0;		/* count names in definition modules in order
-				   to create suitable names in the object code
-				*/
 }
 /*
 	The grammar as given by Wirth is already almost LL(1); the
@@ -47,27 +46,37 @@ ModuleDeclaration
 {
 	struct idf *id;
 	register struct def *df;
+	extern int proclevel;
+	static int modulecount = 0;
+	char buf[256];
+	extern char *sprint(), *Malloc(), *strcpy();
 } :
-	MODULE IDENT		{
+	MODULE IDENT	{
-				  id = dot.TOK_IDF;
+			  id = dot.TOK_IDF;
-				  df = define(id, CurrentScope, D_MODULE);
+			  df = define(id, CurrentScope, D_MODULE);
-				  if (!df->mod_scope) {	
+			  if (!df->mod_scope) {	
-				  	open_scope(CLOSEDSCOPE);
+			  	open_scope(CLOSEDSCOPE);
-				  	df->mod_scope = CurrentScope;
+			  	df->mod_scope = CurrentScope;
-				  }
+			  }
-				  else	CurrentScope = df->mod_scope;
+			  else	CurrentScope = df->mod_scope;
-				  df->df_type = 
+			  df->df_type = standard_type(T_RECORD, 0, (arith) 0);
-					standard_type(T_RECORD, 0, (arith) 0);
+			  df->df_type->rec_scope = df->mod_scope;
-				  df->df_type->rec_scope = df->mod_scope;
+			  df->mod_number = ++modulecount;
-				}
+			  sprint(buf, "__%d%s", df->mod_number, id->id_text);
+			  CurrentScope->sc_name =
+				Malloc((unsigned) (strlen(buf) + 1));
+			  strcpy(CurrentScope->sc_name, buf);
+			  C_ina_dnam(&buf[1]);
+			  C_inp(buf);
+			}
 	priority(&(df->mod_priority))?
 	';'
 	import(1)*
 	export(0)?
 	block(&(df->mod_body))
-	IDENT			{ close_scope(SC_CHKFORW|SC_CHKPROC);
+	IDENT		{ close_scope(SC_CHKFORW|SC_CHKPROC);
-				  match_id(id, dot.TOK_IDF);
+			  match_id(id, dot.TOK_IDF);
-				}
+			}
 ;
 
 priority(arith *pprio;)
@@ -75,12 +84,12 @@ priority(arith *pprio;)
 	struct node *nd;
 } :
 	'[' ConstExpression(&nd) ']'
-				{ if (!(nd->nd_type->tp_fund & T_INTORCARD)) {
+			{ if (!(nd->nd_type->tp_fund & T_INTORCARD)) {
-					node_error(nd, "Illegal priority");
+				node_error(nd, "Illegal priority");
-				  }
+			  }
-				  *pprio = nd->nd_INT;
+			  *pprio = nd->nd_INT;
-				  FreeNode(nd);
+			  FreeNode(nd);
-				}
+			}
 ;
 
 export(int def;)
@@ -90,7 +99,8 @@ export(int def;)
 } :
 	EXPORT
 	[
-		QUALIFIED	{ QUALflag = 1; }
+		QUALIFIED
+			{ QUALflag = 1; }
 	]?
 	IdentList(&ExportList) ';'
 			{
@@ -128,18 +138,19 @@ DefinitionModule
 {
 	register struct def *df;
 	struct idf *id;
-	int savnmcount = nmcount;
 } :
 	DEFINITION
-	MODULE IDENT	{ id = dot.TOK_IDF;
+	MODULE IDENT	{ 
+			  id = dot.TOK_IDF;
 			  df = define(id, GlobalScope, D_MODULE);
 			  if (!SYSTEMModule) open_scope(CLOSEDSCOPE);
+			  if (!Defined) Defined = df;
 			  df->mod_scope = CurrentScope;
+			  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_scope;
 			  DefinitionModule++;
-			  nmcount = 0;
 			  DO_DEBUG(1, debug("Definition module \"%s\" %d",
 					id->id_text, DefinitionModule));
 			}
@@ -167,7 +178,6 @@ DefinitionModule
 			  if (!SYSTEMModule) close_scope(SC_CHKFORW);
 			  DefinitionModule--;
 			  match_id(id, dot.TOK_IDF);
-			  nmcount = savnmcount;
 			}
 	'.'
 ;
@@ -221,8 +231,10 @@ ProgramModule(int state;)
 		  }
 		  else {
 			df = define(id, CurrentScope, D_MODULE);
+		  	Defined = df;
 			open_scope(CLOSEDSCOPE);
 			df->mod_scope = CurrentScope;
+			df->mod_number = 0;
 		  }
 		}
 	priority(&(df->mod_priority))?

lang/m2/comp/scope.C

@@ -168,16 +168,31 @@ Reverse(pdf)
 {
 	/*	Reverse the order in the list of definitions in a scope.
 		This is neccesary because this list is built in reverse.
+		Also, while we're at it, remove uninteresting definitions
+		from this list. The only interesting definitions are:
+		D_MODULE, D_PROCEDURE, and D_PROCHEAD.
 	*/
 	register struct def *df, *df1;
+#define INTERESTING D_MODULE|D_PROCEDURE|D_PROCHEAD
 
 	df = 0;
 	df1 = *pdf;
 	while (df1) {
+		if (df1->df_kind & INTERESTING) break;
 		df1 = df1->df_nextinscope;
+	}
+
+	if (!(*pdf = df1)) return;
+
+	while (df1) {
+		*pdf = df1;
+		df1 = df1->df_nextinscope;
+		while (df1) {
+			if (df1->df_kind & INTERESTING) break;
+			df1 = df1->df_nextinscope;
+		}
 		(*pdf)->df_nextinscope = df;
 		df = *pdf;
-		*pdf = df1;
 	}
 }
 

lang/m2/comp/walk.c

@@ -0,0 +1,142 @@
+/* P A R S E   T R E E   W A L K E R */
+
+static char *RcsId = "$Header$";
+
+/*	Routines to walk through parts of the parse tree, and generate
+	code for these parts.
+*/
+
+#include	<em_arith.h>
+#include	<em_label.h>
+#include	<assert.h>
+
+#include	"def.h"
+#include	"type.h"
+#include	"scope.h"
+#include	"main.h"
+#include	"LLlex.h"
+#include	"node.h"
+
+#include	"debug.h"
+
+extern arith	align();
+static int	prclev = 0;
+
+WalkModule(module)
+	register struct def *module;
+{
+	/*	Walk through a module, and all its local definitions.
+		Also generate code for its body.
+	*/
+	register struct def *df = module->mod_scope->sc_def;
+	struct scope *scope;
+
+	scope = CurrentScope;
+	CurrentScope = module->mod_scope;
+	if (!prclev && module->mod_number) {
+		/* This module is a local module, but not within a
+		   procedure. Generate code to allocate storage for its
+		   variables
+		*/
+		arith size = align(CurrentScope->sc_off, word_size);
+
+		if (size == 0) size = word_size;
+		C_df_dnam(&(CurrentScope->sc_name[1]));
+		C_bss_cst(size, (arith) 0, 0);
+	}
+	else if (CurrentScope == Defined->mod_scope) {
+		/* This module is the module currently being compiled.
+		   Again, generate code to allocate storage for its
+		   variables, which all have an explicit name.
+		*/
+		while (df) {
+			if (df->df_kind == D_VARIABLE) {
+				C_df_dnam(df->var_name);
+				C_bss_cst(df->df_type->tp_size, (arith) 0, 0);
+			}
+			df = df->df_nextinscope;
+		}
+	}
+
+	/* Now, walk through it's local definitions
+	*/
+	WalkDef(CurrentScope->sc_def);
+
+	/* Now, generate initialization code for this module.
+	   First call initialization routines for modules defined within
+	   this module.
+	*/
+	CurrentScope->sc_off = 0;
+	C_pro_narg(CurrentScope->sc_name);
+	MkCalls(CurrentScope->sc_def);
+	WalkNode(module->mod_body);
+	C_end(align(-CurrentScope->sc_off, word_size));
+
+	CurrentScope = scope;
+}
+
+WalkProcedure(procedure)
+	struct def *procedure;
+{
+	/*	Walk through the definition of a procedure and all its
+		local definitions
+	*/
+	struct scope *scope = CurrentScope;
+	register struct def *df;
+
+	prclev++;
+	CurrentScope = procedure->prc_scope;
+	
+	WalkDef(CurrentScope->sc_def);
+
+	/* Generate code for this procedure
+	*/
+	C_pro_narg(procedure->prc_name);
+	/* generate calls to initialization routines of modules defined within
+	   this procedure
+	*/
+	MkCalls(CurrentScope->sc_def);
+	WalkNode(procedure->prc_body);
+	C_end(align(-CurrentScope->sc_off, word_size));
+	CurrentScope = scope;
+	prclev--;
+}
+
+WalkDef(df)
+	register struct def *df;
+{
+	/*	Walk through a list of definitions
+	*/
+	while (df) {
+		if (df->df_kind == D_MODULE) {
+			WalkModule(df);
+		}
+		else if (df->df_kind == D_PROCEDURE) {
+			WalkProcedure(df);
+		}
+		df = df->df_nextinscope;
+	}
+}
+
+MkCalls(df)
+	register struct def *df;
+{
+	/*	Generate calls to initialization routines of modules
+	*/
+	while (df) {
+		if (df->df_kind == D_MODULE) {
+			C_lxl((arith) 0);
+			C_cal(df->df_scope->sc_name);
+		}
+		df = df->df_nextinscope;
+	}
+}
+
+WalkNode(nd)
+	struct node *nd;
+{
+	/*	Node "nd" represents either a statement or a statement list.
+		Generate code for it.
+	*/
+	/* ??? */
+}