From: ceriel <none@none>
Date: Wed, 26 Mar 1986 22:46:48 +0000 (+0000)
Subject: safety commit, newer version
X-Git-Tag: release-5-5~5333
X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=f2ff7661e4b88463b4f22369e3a26b5f8fd3fcc4;p=ack.git

safety commit, newer version
---

diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c
index a67701088..d003cc708 100644
--- a/lang/m2/comp/LLlex.c
+++ b/lang/m2/comp/LLlex.c
@@ -196,7 +196,7 @@ again:
 			PushBack(ch);
 		*tg++ = '\0';
 
-		id = tk->TOK_IDF = str2idf(buf, 1);
+		tk->TOK_IDF = id = str2idf(buf, 1);
 		if (!id) fatal("Out of memory");
 		return tk->tk_symb = id->id_reserved ? id->id_reserved : IDENT;
 	}
diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index 2a2bd1f0a..653a2fa59 100644
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -75,12 +75,12 @@ tokenname.o: Lpars.h idf.h tokenname.h
 idf.o: idf.h
 input.o: f_info.h input.h
 type.o: Lpars.h def.h def_sizes.h idf.h type.h
-def.o: Lpars.h def.h idf.h main.h scope.h
+def.o: Lpars.h debug.h def.h idf.h main.h scope.h
 scope.o: debug.h scope.h
 misc.o: LLlex.h f_info.h idf.h misc.h
-enter.o: def.h idf.h scope.h type.h
+enter.o: def.h idf.h misc.h scope.h type.h
 tokenfile.o: Lpars.h
-program.o: LLlex.h Lpars.h idf.h main.h misc.h scope.h
+program.o: LLlex.h Lpars.h def.h idf.h main.h misc.h scope.h type.h
 declar.o: LLlex.h Lpars.h def.h idf.h misc.h scope.h type.h
 expression.o: Lpars.h
 statement.o: Lpars.h
diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index 721747673..e88573d9d 100644
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -5,6 +5,7 @@ static char *RcsId = "$Header$";
 
 #include	<em_arith.h>
 #include	<em_label.h>
+#include	<assert.h>
 #include	"idf.h"
 #include	"misc.h"
 #include	"LLlex.h"
@@ -15,29 +16,26 @@ static char *RcsId = "$Header$";
 
 ProcedureDeclaration
 {
-	register struct def *df;
+	struct def *df;
 } :
-	/* ProcedureHeading(&df) */
-	PROCEDURE IDENT
-			{ df = define(dot.TOK_IDF, CurrentScope, D_PROCEDURE);
-			  open_scope(OPENSCOPE, 0);
-			}
-	FormalParameters?
+	ProcedureHeading(&df, D_PROCEDURE)
 	';' block IDENT
 			{ match_id(dot.TOK_IDF, df->df_idf);
 			  close_scope();
 			}
 ;
 
-ProcedureHeading
+ProcedureHeading(struct def **pdf; int type;)
 {
-	register struct def *df;
 } :
-	/*	Only used for definition modules
-	*/
 	PROCEDURE IDENT
-			{ df = define(dot.TOK_IDF, CurrentScope, D_PROCHEAD); }
-	FormalParameters?
+			{ assert(type == D_PROCEDURE || type == D_PROCHEAD);
+			  *pdf = define(dot.TOK_IDF, CurrentScope, D_PROCHEAD);
+			  if (type == D_PROCEDURE) {
+				open_scope(OPENSCOPE, 0);
+			  }
+			}
+	FormalParameters(type, &((*pdf)->df_type))?
 ;
 
 block:
@@ -56,13 +54,13 @@ declaration:
 	ModuleDeclaration ';'
 ;
 
-FormalParameters:
-	'(' [ FPSection [ ';' FPSection ]* ]? ')'
+FormalParameters(int doparams; struct type **tp;) :
+	'(' [ FPSection(doparams) [ ';' FPSection(doparams)]* ]? ')'
 	[ ':' qualident
 	]?
 ;
 
-FPSection
+FPSection(int doparams;)
 {
 	struct id_list *FPList;
 	int VARflag = 0;
@@ -72,6 +70,13 @@ FPSection
 	]?
 	IdentList(&FPList) ':' FormalType
 			{
+			  if (doparams) {
+				EnterIdList(FPList,
+					    D_VARIABLE,
+					    VARflag,
+					    (struct type *) 0	/* ???? */
+				);
+			  }
 			  FreeIdList(FPList);
 			}
 ;
@@ -82,10 +87,13 @@ FormalType:
 
 TypeDeclaration
 {
-	register struct def *df;
+	struct def *df;
+	struct idf *id;
 }:
-	IDENT		{ df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
-	'=' type
+	IDENT		{ id = dot.TOK_IDF; }
+	'=' type	{ df = define(id, CurrentScope, D_TYPE);
+			  /* ???? */
+			}
 ;
 
 type:
@@ -124,22 +132,29 @@ enumeration
 	struct id_list *EnumList;
 } :
 	'(' IdentList(&EnumList) ')'
+			{
+			  EnterIdList(EnumList,
+				      D_ENUM,
+				      0,
+				      (struct type *) 0 /* ???? */
+			  );
+			  FreeIdList(EnumList);
+			}
+
 ;
 
 IdentList(struct id_list **p;)
 {
 	register struct id_list *q = new_id_list();
 } :
-	IDENT			{ q->id_ptr = dot.TOK_IDF; }
+	IDENT			{ q->id_ptr = dot.TOK_IDF;  *p = q;}
 	[
 		',' IDENT	{ q->next = new_id_list();
 				  q = q->next;
 				  q->id_ptr = dot.TOK_IDF;
 				}
 	]*
-				{ q->next = 0;
-				  *p = q;
-				}
+				{ q->next = 0; }
 ;
 
 SubrangeType:
@@ -209,10 +224,13 @@ FormalTypeList:
 
 ConstantDeclaration
 {
-	register struct def *df;
+	struct def *df;
+	struct idf *id;
 }:
-	IDENT		{ df = define(dot.TOK_IDF, CurrentScope, D_CONST); }
-	'=' ConstExpression
+	IDENT			{ id = dot.TOK_IDF; }
+	'=' ConstExpression	{ df = define(id, CurrentScope, D_CONST);
+				  /* ???? */
+				}
 ;
 
 VariableDeclaration
@@ -224,4 +242,11 @@ VariableDeclaration
 		ConstExpression
 	]?
 	':' type
+			{ EnterIdList(VarList,
+				      D_VARIABLE,
+				      0,
+				      (struct type *) 0	/* ???? */
+				     );
+			  FreeIdList(VarList);
+			}
 ;
diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H
index ea7641377..ba3604df7 100644
--- a/lang/m2/comp/def.H
+++ b/lang/m2/comp/def.H
@@ -4,6 +4,7 @@
 
 struct module {
 	int mo_priority;	/* Priority of a module */
+	int mo_scope;		/* Scope of this module */
 };
 
 struct variable {
diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c
index 336bee3af..53e69b9d9 100644
--- a/lang/m2/comp/def.c
+++ b/lang/m2/comp/def.c
@@ -10,6 +10,7 @@ static char *RcsId = "$Header$";
 #include	"idf.h"
 #include	"main.h"
 #include	"scope.h"
+#include	"debug.h"
 
 struct def *h_def;		/* Pointer to free list of def structures */
 
@@ -23,6 +24,7 @@ define(id, scope, kind)
 	*/
 	register struct def *df = lookup(id, scope->sc_scope);
 
+	DO_DEBUG(debug(3,"Defining identifier %s in scope %d", id->id_text, scope->sc_scope));
 	if (	/* Already in this scope */
 		df
 	   ||	/* A closed scope, and id defined in the pervasive scope */
@@ -46,7 +48,7 @@ define(id, scope, kind)
 			return df;
 			break;
 		}
-		error("Identifier %s already declared", id->id_text);
+		error("Identifier \"%s\" already declared", id->id_text);
 		return df;
 	}
 	df = new_def();
@@ -71,6 +73,7 @@ lookup(id, scope)
 
 	df1 = 0;
 	df = id->id_def;
+	DO_DEBUG(debug(3,"Looking for identifier %s in scope %d", id->id_text, scope));
 	while (df) {
 		if (df->df_scope == scope) {
 			if (df1) {
@@ -80,6 +83,7 @@ lookup(id, scope)
 			}
 			return df;
 		}
+		df1 = df;
 		df = df->next;
 	}
 	return 0;
diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c
index dc1d31106..6dcc0480e 100644
--- a/lang/m2/comp/enter.c
+++ b/lang/m2/comp/enter.c
@@ -2,16 +2,19 @@
 
 static char *RcsId = "$Header$";
 
+#include	<alloc.h>
 #include	<em_arith.h>
 #include	<em_label.h>
 #include	"idf.h"
 #include	"def.h"
 #include	"type.h"
 #include	"scope.h"
+#include	"misc.h"
 
 extern struct idf *str2idf();
 extern struct def *define();
 
+struct def *
 Enter(name, kind, type, pnam)
 	char *name;
 	struct type *type;
@@ -26,4 +29,27 @@ Enter(name, kind, type, pnam)
 	if (kind == D_STDPROC || kind == D_STDFUNC) {
 		df->df_value.df_stdname = pnam;
 	}
+	return df;
+}
+
+EnterIdList(idlist, kind, flags, type)
+	register struct id_list *idlist;
+	struct type *type;
+{
+	register struct def *df;
+	struct def *last = 0;
+	int assval = 0;
+
+	while (idlist) {
+		df = define(idlist->id_ptr, CurrentScope, kind);
+		df->df_type = type;
+		df->df_flags = flags;
+		if (kind == D_ENUM) {
+			df->df_value.df_enum.en_val = assval++;
+			if (last) last->df_value.df_enum.en_next = df;
+			last = df;
+		}
+		idlist = idlist->next;
+	}
+	if (last) last->df_value.df_enum.en_next = 0;
 }
diff --git a/lang/m2/comp/misc.H b/lang/m2/comp/misc.H
index 5ca8a003d..82deee35f 100644
--- a/lang/m2/comp/misc.H
+++ b/lang/m2/comp/misc.H
@@ -10,3 +10,5 @@ struct id_list {
 };
 
 /* ALLOCDEF "id_list" */
+
+#define is_anon_idf(x)	((x)->id_text[0] == '#')
diff --git a/lang/m2/comp/misc.c b/lang/m2/comp/misc.c
index 7afd72023..7199fc11c 100644
--- a/lang/m2/comp/misc.c
+++ b/lang/m2/comp/misc.c
@@ -17,7 +17,7 @@ match_id(id1, id2)
 		first place, and if not, give an error message
 	*/
 	if (id1 != id2 && !is_anon_idf(id1) && !is_anon_idf(id2)) {
-		error("Identifier \"%s\" does not match identifier \"%s\"",
+		error("Name \"%s\" does not match block name \"%s\"",
 		      id1->id_text,
 		      id2->id_text
 		);
@@ -54,10 +54,3 @@ gen_anon_idf()
 			++name_cnt, FileName, LineNumber);
 	return str2idf(buff, 1);
 }
-
-int
-is_anon_idf(idf)
-	struct idf *idf;
-{
-	return idf->id_text[0] == '#';
-}
diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g
index 662ba71c7..32e888f80 100644
--- a/lang/m2/comp/program.g
+++ b/lang/m2/comp/program.g
@@ -5,11 +5,14 @@ static  char *RcsId = "$Header$";
 
 #include	<alloc.h>
 #include	<em_arith.h>
+#include	<em_label.h>
 #include	"idf.h"
 #include	"misc.h"
 #include	"main.h"
 #include	"LLlex.h"
 #include	"scope.h"
+#include	"def.h"
+#include	"type.h"
 }
 /*
 	The grammar as given by Wirth is already almost LL(1); the
@@ -40,8 +43,13 @@ priority:
 export
 {
 	struct id_list *ExportList;
+	int QUALflag = 0;
 } :
-	EXPORT QUALIFIED? IdentList(&ExportList) ';'
+	EXPORT
+	[
+		QUALIFIED	{ QUALflag = 1; }
+	]?
+	IdentList(&ExportList) ';'
 			{
 			  FreeIdList(ExportList);
 			}
@@ -67,9 +75,16 @@ import(int local;)
 			}
 ;
 
-DefinitionModule:
+DefinitionModule
+{
+	struct def *df;
+} :
 	DEFINITION	{ state = DEFINITION; }
-	MODULE IDENT	{ open_scope(CLOSEDSCOPE, 0); }
+	MODULE IDENT	{ 
+			  df = define(dot.TOK_IDF, CurrentScope, D_MODULE);
+			  open_scope(CLOSEDSCOPE, 0);
+			  df->df_value.df_module.mo_scope = CurrentScope->sc_scope;
+			}
 	';'
 	import(0)* 
 	/*	export?
@@ -80,7 +95,10 @@ DefinitionModule:
 			{ close_scope(); }
 ;
 
-definition:
+definition
+{
+	struct def *df;
+} :
 	CONST [ ConstantDeclaration ';' ]*
 |
 	TYPE
@@ -98,13 +116,17 @@ definition:
 |
 	VAR [ VariableDeclaration ';' ]*
 |
-	ProcedureHeading ';'
+	ProcedureHeading(&df, D_PROCHEAD) ';'
 ;
 
 ProgramModule:
 	MODULE		{ if (state != IMPLEMENTATION) state = PROGRAM; }
 	IDENT		{ if (state == IMPLEMENTATION) {
-				/* Re-open scope ??? */
+				/* ????
+				   Read definition module,
+				   Look for current identifier,
+				   and find out its scope number
+				*/
 				open_scope(CLOSEDSCOPE, 0);
 			  }
 			  else	open_scope(CLOSEDSCOPE, 0);