Browse Source

safety commit, newer version

ceriel 38 years ago
parent
commit
0968b74220

+ 2 - 2
lang/m2/comp/Makefile

@@ -76,12 +76,12 @@ 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 debug.h def.h idf.h main.h scope.h
-scope.o: debug.h scope.h
+scope.o: LLlex.h debug.h def.h idf.h scope.h type.h
 misc.o: LLlex.h f_info.h idf.h misc.h
 enter.o: def.h idf.h misc.h scope.h type.h
 tokenfile.o: Lpars.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
+expression.o: LLlex.h Lpars.h def.h idf.h scope.h
 statement.o: Lpars.h
 Lpars.o: Lpars.h

+ 190 - 60
lang/m2/comp/declar.g

@@ -27,15 +27,17 @@ ProcedureDeclaration
 
 ProcedureHeading(struct def **pdf; int type;)
 {
+	struct type *tp;
+	struct paramlist *params = 0;
 } :
 	PROCEDURE IDENT
 			{ assert(type == D_PROCEDURE || type == D_PROCHEAD);
-			  *pdf = define(dot.TOK_IDF, CurrentScope, D_PROCHEAD);
+			  *pdf = define(dot.TOK_IDF, CurrentScope, type);
 			  if (type == D_PROCEDURE) {
 				open_scope(OPENSCOPE, 0);
 			  }
 			}
-	FormalParameters(type, &((*pdf)->df_type))?
+	FormalParameters(type, &params, &tp)?
 ;
 
 block:
@@ -54,15 +56,31 @@ declaration:
 	ModuleDeclaration ';'
 ;
 
-FormalParameters(int doparams; struct type **tp;) :
-	'(' [ FPSection(doparams) [ ';' FPSection(doparams)]* ]? ')'
-	[ ':' qualident
+FormalParameters(int doparams; struct paramlist **pr; struct type **tp;)
+{
+	struct def *df;
+	register struct paramlist *pr1;
+} :
+	'('
+	[
+		FPSection(doparams, pr)
+		[
+			{ for (pr1 = *pr; pr1->next; pr1 = pr1->next) ; }
+			';' FPSection(doparams, &(pr1->next))
+		]*
+	]?
+	')'
+			{ *tp = 0; }
+	[ ':' qualident(D_TYPE | D_HTYPE, &df, "type")
+			{ /* ???? *tp = df->df_type; */ }
 	]?
 ;
 
-FPSection(int doparams;)
+FPSection(int doparams; struct paramlist **ppr;)
 {
 	struct id_list *FPList;
+	register struct id_list *pid;
+	register struct paramlist *pr = 0;
 	int VARflag = 0;
 } :
 	[
@@ -74,70 +92,88 @@ FPSection(int doparams;)
 				EnterIdList(FPList,
 					    D_VARIABLE,
 					    VARflag,
-					    (struct type *) 0	/* ???? */
+					    (struct type *) 0	/* ???? */,
+					    CurrentScope
 				);
 			  }
+			  *ppr = pr = new_paramlist();
+			  pr->par_type = 0;	/* ??? */
+			  pr->par_var = VARflag;
+			  for (pid = FPList->next; pid; pid = pid->next) {
+				pr->next = new_paramlist();
+				pr = pr->next;
+				pr->par_type = 0;	/* ??? */
+				pr->par_var = VARflag;
+			  }
+			  pr->next = 0;
 			  FreeIdList(FPList);
 			}
 ;
 
-FormalType:
-	[ ARRAY OF ]? qualident
+FormalType
+{
+	struct def *df;
+	int ARRAYflag = 0;
+} :
+	[ ARRAY OF	{ ARRAYflag = 1; }
+	]?
+	qualident(D_TYPE | D_HTYPE, &df, "type")
 ;
 
 TypeDeclaration
 {
 	struct def *df;
-	struct idf *id;
+	struct type *tp;
 }:
-	IDENT		{ id = dot.TOK_IDF; }
-	'=' type	{ df = define(id, CurrentScope, D_TYPE);
-			  /* ???? */
+	IDENT		{ df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
+	'=' type(&tp)
+			{ df->df_type = tp;
 			}
 ;
 
-type:
-	SimpleType
+type(struct type **ptp;):
+	SimpleType(ptp)
 |
-	ArrayType
+	ArrayType(ptp)
 |
-	RecordType
+	RecordType(ptp)
 |
-	SetType
+	SetType(ptp)
 |
-	PointerType
+	PointerType(ptp)
 |
-	ProcedureType
+	ProcedureType(ptp)
 ;
 
-SimpleType:
-	qualident
+SimpleType(struct type **ptp;)
+{
+	struct def *df;
+} :
+	qualident(D_TYPE | D_HTYPE, &df, "type")
 	[
 
 	|
-		SubrangeType
+		SubrangeType(ptp)
 		/*
 		 * The subrange type is given a base type by the
 		 * qualident (this is new modula-2).
 		 */
+			{ /* ???? (*ptp)->next = df->df_type; */ }
 	]
 |
-	enumeration
+	enumeration(ptp)
 |
-	SubrangeType
+	SubrangeType(ptp)
 ;
 
-enumeration
+enumeration(struct type **ptp;)
 {
 	struct id_list *EnumList;
 } :
 	'(' IdentList(&EnumList) ')'
 			{
-			  EnterIdList(EnumList,
-				      D_ENUM,
-				      0,
-				      (struct type *) 0 /* ???? */
-			  );
+			  *ptp = standard_type(ENUMERATION,int_align,int_size);
+			  EnterIdList(EnumList, D_ENUM, 0, *ptp, CurrentScope);
 			  FreeIdList(EnumList);
 			}
 
@@ -157,43 +193,102 @@ IdentList(struct id_list **p;)
 				{ q->next = 0; }
 ;
 
-SubrangeType:
+SubrangeType(struct type **ptp;)
+{
+	struct type *tp;
+}:
 	/*
 	   This is not exactly the rule in the new report, but see
 	   the rule for "SimpleType".
 	*/
-	'[' ConstExpression UPTO ConstExpression ']'
+	'[' ConstExpression
+	UPTO ConstExpression
+	']'
+	/*
+	   Evaluate the expressions. Check that they are indeed constant.
+	   ???
+	   Leave the basetype of the subrange in tp;
+	*/
+			{
+			  /* For the time being: */
+			  tp = int_type;
+			  tp = construct_type(SUBRANGE, tp, (arith) 0);
+			  *ptp = tp;
+			}
 ;
 
-ArrayType:
-	ARRAY SimpleType [ ',' SimpleType ]* OF type
+ArrayType(struct type **ptp;)
+{
+	struct type *tp;
+	register struct type *tp2;
+} :
+	ARRAY SimpleType(&tp)
+			{
+			  *ptp = tp2 = construct_type(ARRAY, tp);
+			}
+	[
+		',' SimpleType(&tp)
+			{ tp2 = tp2->tp_value.tp_arr.ar_elem = 
+				construct_type(ARRAY, tp);
+			}
+	]* OF type(&tp)
+			{ tp2->tp_value.tp_arr.ar_elem = tp; }
 ;
 
-RecordType:
-	RECORD FieldListSequence END
+RecordType(struct type **ptp;)
+{
+	int scopenr;
+}
+:
+	RECORD
+			{ scopenr = uniq_scope(); }
+	FieldListSequence(scopenr)
+			{
+			  *ptp = standard_type(RECORD, record_align, (arith) 0 /* ???? */);
+			  (*ptp)->tp_value.tp_record.rc_scopenr = scopenr;
+			}
+	END
 ;
 
-FieldListSequence:
-	FieldList [ ';' FieldList ]*
+FieldListSequence(int scopenr;):
+	FieldList(scopenr)
+	[
+		';' FieldList(scopenr)
+	]*
 ;
 
-FieldList
+FieldList(int scopenr;)
 {
 	struct id_list *FldList;
+	struct idf *id;
+	struct def *df, *df1;
+	struct type *tp;
 } :
 [
-	IdentList(&FldList) ':' type
+	IdentList(&FldList) ':' type(&tp)
 |
-	CASE IDENT?			/* Changed rule in new modula-2 */
-	':' qualident
-	OF variant [ '|' variant ]*
-	[ ELSE FieldListSequence ]?
+	CASE
+	[
+		IDENT		{ id = dot.TOK_IDF; }
+	|
+				{ id = gen_anon_idf(); }
+	]			/* Changed rule in new modula-2 */
+	':' qualident(D_TYPE|D_HTYPE, &df, "type")
+				{ df1 = define(id, scopenr, D_FIELD);
+				  df1->df_type = df->df_type;
+				}
+	OF variant(scopenr)
+	[
+		'|' variant(scopenr)
+	]*
+	[ ELSE FieldListSequence(scopenr)
+	]?
 	END
 ]?
 ;
 
-variant:
-	[ CaseLabelList ':' FieldListSequence ]?
+variant(int scopenr;):
+	[ CaseLabelList ':' FieldListSequence(scopenr) ]?
 					/* Changed rule in new modula-2 */
 ;
 
@@ -205,21 +300,59 @@ CaseLabels:
 	ConstExpression [ UPTO ConstExpression ]?
 ;
 
-SetType:
-	SET OF SimpleType
+SetType(struct type **ptp;)
+{
+	struct type *tp;
+} :
+	SET OF SimpleType(&tp)
+			{
+			  *ptp = construct_type(SET, tp, (arith) 0 /* ???? */);
+			}
 ;
 
-PointerType:
-	POINTER TO type
+PointerType(struct type **ptp;)
+{
+	struct type *tp;
+	register struct def *df;
+	struct def *lookfor();
+} :
+	POINTER TO
+	[ %if ( (df = lookup(dot.TOK_IDF, CurrentScope)))
+		IDENT
+				{
+				  if (!(df->df_kind & (D_TYPE | D_HTYPE))) {
+					error("\"%s\" is not a type identifier",
+						df->df_idf->id_text);
+				  }
+				  if (!df->df_type) {
+					error("type \"%s\" not declared",
+						df->df_idf->id_text);
+				  }
+				  *ptp = df->df_type;
+				}
+	| %if (df = lookfor(dot.TOK_IDF, 0), df->df_kind == D_MODULE)
+		type(&tp)
+				{ *ptp = construct_type(POINTER, tp); }
+	|
+		IDENT
+				{ *ptp = construct_type(POINTER, NULLTYPE);
+				  Forward(&dot, &((*ptp)->next));
+				}
+	]
 ;
 
-ProcedureType:
+ProcedureType(struct type **ptp;):
 	PROCEDURE FormalTypeList?
+			{ *ptp = 0; }
 ;
 
-FormalTypeList:
+FormalTypeList
+{
+	struct def *df;
+} :
 	'(' [ VAR? FormalType [ ',' VAR? FormalType ]* ]? ')'
-	[ ':' qualident ]?
+	[ ':' qualident(1, &df, "type")
+	]?
 ;
 
 ConstantDeclaration
@@ -236,17 +369,14 @@ ConstantDeclaration
 VariableDeclaration
 {
 	struct id_list *VarList;
+	struct type *tp;
 } :
 	IdentList(&VarList)
 	[
 		ConstExpression
 	]?
-	':' type
-			{ EnterIdList(VarList,
-				      D_VARIABLE,
-				      0,
-				      (struct type *) 0	/* ???? */
-				     );
+	':' type(&tp)
+			{ EnterIdList(VarList, D_VARIABLE, 0, tp, CurrentScope);
 			  FreeIdList(VarList);
 			}
 ;

+ 23 - 17
lang/m2/comp/def.H

@@ -38,21 +38,24 @@ struct def	{		/* list of definitions for a name */
 	struct def *next;
 	struct idf *df_idf;	/* link back to the name */
 	int df_scope;		/* Scope in which this definition resides */
-	char df_kind;		/* The kind of this definition: */
-#define D_MODULE	0x00
-#define D_PROCEDURE	0x01
-#define D_VARIABLE	0x02
-#define D_FIELD		0x03
-#define D_TYPE		0x04
-#define D_ENUM		0x05
-#define D_CONST		0x06
-#define D_IMPORT	0x07
-#define D_PROCHEAD	0x08	/* A procedure heading in a definition module */
-#define D_HIDDEN	0x09	/* A hidden type */
-#define D_HTYPE		0x0A	/* Definition of a hidden type seen */
-#define D_STDPROC	0x0B	/* A standard procedure */
-#define D_STDFUNC	0x0C	/* A standard function */
-#define D_ISEXPORTED	0xFF	/* Not yet defined */
+	short df_kind;		/* The kind of this definition: */
+#define D_MODULE	0x0001
+#define D_PROCEDURE	0x0002
+#define D_VARIABLE	0x0004
+#define D_FIELD		0x0008
+#define D_TYPE		0x0010
+#define D_ENUM		0x0020
+#define D_CONST		0x0040
+#define D_IMPORT	0x0080
+#define D_PROCHEAD	0x0100	/* A procedure heading in a definition module */
+#define D_HIDDEN	0x0200	/* A hidden type */
+#define D_HTYPE		0x0400	/* Definition of a hidden type seen */
+#define D_STDPROC	0x0800	/* A standard procedure */
+#define D_STDFUNC	0x1000	/* A standard function */
+#define D_ERROR		0x2000	/* A compiler generated definition for an
+				   undefined variable
+				*/
+#define D_ISEXPORTED	0x4000	/* Not yet defined */
 	char df_flags;
 #define D_ADDRESS	0x01	/* Set if address was taken */
 #define D_USED		0x02	/* Set if used */
@@ -74,6 +77,9 @@ struct def	{		/* list of definitions for a name */
 
 /* ALLOCDEF "def" */
 
-struct def
+extern struct def
 	*define(),
-	*lookup();
+	*lookup(),
+	*ill_df;
+
+#define NULLDEF ((struct def *) 0)

+ 17 - 8
lang/m2/comp/def.c

@@ -14,21 +14,30 @@ static char *RcsId = "$Header$";
 
 struct def *h_def;		/* Pointer to free list of def structures */
 
+static struct def illegal_def =
+	{0, 0, -20 /* Illegal scope */, D_ERROR};
+
+struct def *ill_df = &illegal_def;
+
 struct def *
 define(id, scope, kind)
 	register struct idf *id;
-	register struct scope *scope;
 {
 	/*	Declare an identifier in a scope, but first check if it
 		already has been defined. If so, error message.
 	*/
-	register struct def *df = lookup(id, scope->sc_scope);
+	register struct def *df;
 
-	DO_DEBUG(debug(3,"Defining identifier %s in scope %d", id->id_text, scope->sc_scope));
+	DO_DEBUG(debug(4,"Defining identifier %s in scope %d", id->id_text, scope));
+	df = lookup(id, scope);
 	if (	/* Already in this scope */
 		df
 	   ||	/* A closed scope, and id defined in the pervasive scope */
-		(scopeclosed(scope) && (df = lookup(id, 0)))
+		( CurrentScope == scope 
+		&&
+		  scopeclosed(currscope)
+		&&
+		  (df = lookup(id, 0)))
 	   ) {
 		switch(df->df_kind) {
 		case D_PROCHEAD:
@@ -43,17 +52,17 @@ define(id, scope, kind)
 				return df;
 			}
 			break;
+		case D_ERROR:
 		case D_ISEXPORTED:
 			df->df_kind = 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();
 	df->df_idf = id;
-	df->df_scope = scope->sc_scope;
+	df->df_scope = scope;
 	df->df_kind = kind;
 	df->next = id->id_def;
 	id->id_def = df;
@@ -73,7 +82,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));
+	DO_DEBUG(debug(4,"Looking for identifier %s in scope %d", id->id_text, scope));
 	while (df) {
 		if (df->df_scope == scope) {
 			if (df1) {

+ 30 - 4
lang/m2/comp/enter.c

@@ -32,24 +32,50 @@ Enter(name, kind, type, pnam)
 	return df;
 }
 
-EnterIdList(idlist, kind, flags, type)
+EnterIdList(idlist, kind, flags, type, scope)
 	register struct id_list *idlist;
 	struct type *type;
 {
 	register struct def *df;
-	struct def *last = 0;
+	struct def *first = 0, *last = 0;
 	int assval = 0;
 
 	while (idlist) {
-		df = define(idlist->id_ptr, CurrentScope, kind);
+		df = define(idlist->id_ptr, scope, kind);
 		df->df_type = type;
 		df->df_flags = flags;
 		if (kind == D_ENUM) {
+			if (!first) first = df;
 			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;
+	if (last) {
+		/* Also meaning : enumeration */
+		last->df_value.df_enum.en_next = 0;
+		type->tp_value.tp_enum.en_enums = first;
+		type->tp_value.tp_enum.en_ncst = assval;
+	}
+}
+
+/*	Look for an identifier in the current visibility range.
+	If it is not defined, give an error message, and
+	create a dummy definition.
+*/
+struct def *
+lookfor(id, give_error)
+	struct idf *id;
+{
+	register struct scope *sc = currscope;
+	struct def *df;
+
+	while (sc) {
+		df = lookup(id, sc->sc_scope);
+		if (df) return df;
+		sc = nextvisible(sc);
+	}
+	if (give_error) error("Identifier \"%s\" not declared", id->id_text);
+	return define(id, CurrentScope, D_ERROR);
 }

+ 2 - 2
lang/m2/comp/error.c

@@ -132,7 +132,7 @@ _error(class, expr, fmt, argv)
 	case LEXERROR:
 	case CRASH:
 	case FATAL:
-		/*
+		/* ????
 		if (C_busy())
 			C_ms_err();
 		*/
@@ -164,7 +164,7 @@ _error(class, expr, fmt, argv)
 	switch (class)	{	
 	case WARNING:
 	case ERROR:
-		ln = /* expr ? expr->ex_line : */ dot.tk_lineno;
+		ln = /* ???? expr ? expr->ex_line : */ dot.tk_lineno;
 		break;
 	case LEXWARNING:
 	case LEXERROR:

+ 67 - 8
lang/m2/comp/expression.g

@@ -1,5 +1,15 @@
+/* E X P R E S S I O N S */
+
 {
 static char *RcsId = "$Header$";
+
+#include	<alloc.h>
+#include	<em_arith.h>
+#include	<em_label.h>
+#include	"LLlex.h"
+#include	"idf.h"
+#include	"def.h"
+#include	"scope.h"
 }
 
 number:
@@ -8,8 +18,44 @@ number:
 	REAL
 ;
 
-qualident:
-	IDENT selector*
+qualident(int types; struct def **pdf; char *str;)
+{
+	int scope;
+	register struct def *df;
+	struct def *lookfor();
+} :
+	IDENT		{ if (types) {
+				df = lookfor(dot.TOK_IDF, 1);
+				if (df->df_kind == D_ERROR) {
+					*pdf = df;
+					types = 0;
+				}
+			  }
+			}
+	[
+			{ if (types &&!(scope = has_selectors(df))) {
+				types = 0;
+				*pdf = ill_df;
+			  }
+			}
+		/* selector */
+		'.' IDENT
+			{ if (types) {
+				df = lookup(dot.TOK_IDF, scope);
+				if (!df) {
+					error("identifier \"%s\" not declared",
+					      dot.TOK_IDF->id_text);
+					types = 0;
+					df = ill_df;
+				}
+			  }
+			}
+	]*
+			{ if (types && !(types & df->df_kind)) {
+				error("identifier \"%s\" is not a %s",
+					dot.TOK_IDF, str);
+			  }
+			}
 ;
 
 selector:
@@ -52,8 +98,11 @@ MulOperator:
 	'*' | '/' | DIV | MOD | AND | '&'
 ;
 
-factor:
-	qualident
+factor
+{
+	struct def *df;
+} :
+	qualident(0, &df, (char *) 0)
 	[
 		designator_tail? ActualParameters?
 	|
@@ -83,15 +132,25 @@ element:
 	expression [ UPTO expression ]?
 ;
 
-designator:
-	qualident designator_tail?
+designator
+{
+	struct def *df;
+} :
+	qualident(0, &df, (char *) 0)
+	designator_tail?
 ;
 
 designator_tail:
 	visible_designator_tail
-	[ selector | visible_designator_tail ]*
+	[
+		selector
+	|
+		visible_designator_tail
+	]*
 ;
 
 visible_designator_tail:
-	'[' ExpList ']' | '^'
+	'[' ExpList ']'
+|
+	'^'
 ;

+ 4 - 8
lang/m2/comp/main.c

@@ -121,8 +121,6 @@ Option(str)
 	options[str[1]]++;	/* switch option on	*/
 }
 
-#define NULLTYPE	((struct type *) 0)
-
 add_standards()
 {
 	register struct def *df;
@@ -157,15 +155,13 @@ add_standards()
 	(void) Enter("NIL", D_CONST, nil_type, 0);
 	(void) Enter("PROC",
 		     D_TYPE,
-		     construct_type(PROCEDURE, NULLTYPE, (arith) 0),
+		     construct_type(PROCEDURE, NULLTYPE),
 		     0);
-	tp = construct_type(SUBRANGE, int_type, (arith) 0);
+	tp = construct_type(SUBRANGE, int_type);
 	tp->tp_value.tp_subrange.su_lb = 0;
 	tp->tp_value.tp_subrange.su_ub = wrd_size * 8 - 1;
-	(void) Enter("BITSET",
-		     D_TYPE,
-		     construct_type(SET, tp, wrd_size),
-		     0);
+	df = Enter("BITSET", D_TYPE, construct_type(SET, tp), 0);
+	df->df_type->tp_size = wrd_size;
 	df = Enter("FALSE", D_ENUM, bool_type, 0);
 	df->df_value.df_enum.en_val = 0;
 	df->df_value.df_enum.en_next = Enter("TRUE", D_ENUM, bool_type, 0);

+ 3 - 0
lang/m2/comp/misc.H

@@ -12,3 +12,6 @@ struct id_list {
 /* ALLOCDEF "id_list" */
 
 #define is_anon_idf(x)	((x)->id_text[0] == '#')
+
+extern struct idf
+	*gen_anon_idf();

+ 3 - 2
lang/m2/comp/program.g

@@ -83,7 +83,7 @@ DefinitionModule
 	MODULE IDENT	{ 
 			  df = define(dot.TOK_IDF, CurrentScope, D_MODULE);
 			  open_scope(CLOSEDSCOPE, 0);
-			  df->df_value.df_module.mo_scope = CurrentScope->sc_scope;
+			  df->df_value.df_module.mo_scope = CurrentScope;
 			}
 	';'
 	import(0)* 
@@ -98,12 +98,13 @@ DefinitionModule
 definition
 {
 	struct def *df;
+	struct type *tp;
 } :
 	CONST [ ConstantDeclaration ';' ]*
 |
 	TYPE
 	[ IDENT 
-	  [ '=' type 
+	  [ '=' type(&tp)
 	  | /* empty */
 	    /*
 	       Here, the exported type has a hidden implementation.

+ 73 - 8
lang/m2/comp/scope.C

@@ -4,12 +4,18 @@ static char *RcsId = "$Header$";
 
 #include	<assert.h>
 #include	<alloc.h>
+#include	<em_arith.h>
+#include	<em_label.h>
+#include	"LLlex.h"
+#include	"idf.h"
 #include	"scope.h"
+#include	"type.h"
+#include	"def.h"
 #include	"debug.h"
 
 static int maxscope;		/* maximum assigned scope number */
 
-struct scope *CurrentScope;
+struct scope *currscope;
 
 /* STATICALLOCDEF "scope" */
 
@@ -29,29 +35,32 @@ open_scope(scopetype, scopenr)
 	sc->sc_scope = scopenr == 0 ? ++maxscope : scopenr;
 	assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
 	DO_DEBUG(debug(1, "Opening a %s scope", scopetype == OPENSCOPE ? "open" : "closed"));
-	sc1 = CurrentScope;
+	sc1 = currscope;
 	if (scopetype == CLOSEDSCOPE) {
 		sc1 = new_scope();
-		sc1->sc_scope = 0;			/* Pervasive scope nr */
-		sc1->next = CurrentScope;
+		sc1->sc_scope = 0;		/* Pervasive scope nr */
+		sc1->next = currscope;
 	}
 	sc->next = sc1;
-	CurrentScope = sc;
+	currscope = sc;
 }
 
+static rem_forwards();
+
 close_scope()
 {
-	register struct scope *sc = CurrentScope;
+	register struct scope *sc = currscope;
 
 	assert(sc != 0);
 	DO_DEBUG(debug(1, "Closing a scope"));
+	if (sc->sc_forw) rem_forwards(sc->sc_forw);
 	if (sc->next && (sc->next->sc_scope == 0)) {
 		struct scope *sc1 = sc;
 
 		sc = sc->next;
 		free_scope(sc1);
 	}
-	CurrentScope = sc->next;
+	currscope = sc->next;
 	free_scope(sc);
 }
 
@@ -61,5 +70,61 @@ init_scope()
 
 	sc->sc_scope = 0;
 	sc->next = 0;
-	CurrentScope = sc;
+	currscope = sc;
+}
+
+int
+uniq_scope()
+{
+	return ++maxscope;
+}
+
+struct forwards {
+	struct forwards *next;
+	struct token fo_tok;
+	struct type **fo_ptyp;
+};
+
+/* STATICALLOCDEF "forwards" */
+
+/*	Enter a forward reference into a list belonging to the
+	current scope. This is used for POINTER declarations, which
+	may have forward references that must howewer be declared in the
+	same scope.
+*/
+Forward(tk, ptp)
+	struct token *tk;
+	struct type **ptp;
+{
+	register struct forwards *f = new_forwards();
+
+	f->fo_tok = *tk;
+	f->fo_ptyp = ptp;
+	f->next = currscope->sc_forw;
+	currscope->sc_forw = f;
+}
+
+/*	When closing a scope, all forward references must be resolved
+*/
+static
+rem_forwards(fo)
+	struct forwards *fo;
+{
+	register struct forwards *f;
+	struct token savetok;
+	register struct def *df;
+	struct def *lookfor();
+
+	savetok = dot;
+	while (f = fo) {
+		dot = f->fo_tok;
+		df = lookfor(dot.TOK_IDF, 1);
+		if (!(df->df_kind & (D_TYPE | D_HTYPE | D_ERROR))) {
+			error("identifier \"%s\" not a type", df->df_idf->id_text);
+		}
+		*(f->fo_ptyp) = df->df_type;
+		fo = f->next;
+		free_forwards(f);
+	}
+	dot = savetok;
 }

+ 4 - 1
lang/m2/comp/scope.h

@@ -7,6 +7,7 @@
 
 struct scope {
 	struct scope *next;
+	struct forwards *sc_forw;
 	int sc_scope;		/* The scope number. Scope number 0 indicates
 				   both the pervasive scope and the end of a
 				   visibility range
@@ -14,7 +15,9 @@ struct scope {
 };
 
 extern struct scope
-	*CurrentScope;
+	*currscope;
 
 #define nextvisible(x)	((x)->sc_scope ? (x)->next : (struct scope *) 0)
 #define scopeclosed(x)	((x)->next->sc_scope == 0)
+#define enclosing(x)	((x)->next->scope != 0 ? (struct scope *) 0 : (x)->next->next)
+#define CurrentScope	(currscope->sc_scope)

+ 1 - 0
lang/m2/comp/tokenname.c

@@ -86,6 +86,7 @@ struct tokenname tkstandard[] =	{	/* standard identifiers */
 	{CARDINAL, ""},
 	{LONGREAL, ""},
 	{SUBRANGE, ""},
+	{ENUMERATION, ""},
 	{ERRONEOUS, ""},
 	{0, ""}
 };

+ 3 - 1
lang/m2/comp/type.H

@@ -22,7 +22,7 @@ struct subrange {
 };
 
 struct array {
-	struct type *ar_index;	/* Type of index */
+	struct type *ar_elem;	/* Type of elements */
 	arith ar_lb, ar_ub;	/* Lower bound and upper bound */
 	label ar_descr;		/* Label of array descriptor */
 };
@@ -90,3 +90,5 @@ struct type
 	*create_type(),
 	*construct_type(),
 	*standard_type();
+
+#define NULLTYPE ((struct type *) 0)

+ 22 - 5
lang/m2/comp/type.c

@@ -64,9 +64,8 @@ create_type(fund)
 }
 
 struct type *
-construct_type(fund, tp, count)
+construct_type(fund, tp)
 	struct type *tp;
-	arith count;
 {
 	/*	fund must be a type constructor.
 		The pointer to the constructed type is returned.
@@ -82,13 +81,10 @@ construct_type(fund, tp, count)
 		break;
 	case SET:
 		dtp->tp_align = wrd_align;
-		dtp->tp_size = align((count + 7) / 8, wrd_align);
 		dtp->next = tp;
 		break;
 	case ARRAY:
 		dtp->tp_align = tp->tp_align;
-		if (tp->tp_size < 0) dtp->tp_size = -1;
-		else dtp->tp_size = count * tp->tp_size;
 		dtp->next = tp;
 		break;
 	case SUBRANGE:
@@ -134,3 +130,24 @@ init_types()
 	nil_type = standard_type(POINTER, ptr_align, ptr_size);
 	error_type = standard_type(ERRONEOUS, 1, (arith) 1);
 }
+
+int
+has_selectors(df)
+	register struct def *df;
+{
+
+	switch(df->df_kind) {
+	case D_MODULE:
+		return df->df_value.df_module.mo_scope;
+	case D_VARIABLE: {	
+		register struct type *tp = df->df_type;
+
+		if (tp->tp_fund == RECORD) {
+			return tp->tp_value.tp_record.rc_scopenr;
+		}
+		break;
+		}
+	}
+	error("no selectors for \"%s\"", df->df_idf->id_text);
+	return 0;
+}