made to fit on a PDP-11 again

lang/m2/comp/Version.c

@@ -1 +1 @@
-static char Version[] = "ACK Modula-2 compiler Version 0.33";
+static char Version[] = "ACK Modula-2 compiler Version 0.34";

lang/m2/comp/chk_expr.c

@@ -55,7 +55,7 @@ df_error(nd, mess, edf)
 
 STATIC int
 ex_error(nd, mess)
-	t_node	*nd;
+	register t_node	*nd;
 	char	*mess;
 {
 	node_error(nd, "\"%s\": %s", symbol2str(nd->nd_symb), mess);
@@ -67,37 +67,37 @@ MkCoercion(pnd, tp)
 	register t_type	*tp;
 {
 	/*	Make a coercion from the node indicated by *pnd to the
-		type indicated by tp.
+		type indicated by tp. If the node indicated by *pnd
+		is constant, try to do the coercion compile-time.
+		Coercions are inserted in the tree when
+		- the expression is not constant or
+		- we are in the second pass and the coercion might cause
+		  an error
 	*/
 	register t_node	*nd = *pnd;
 	register t_type	*nd_tp = nd->nd_type;
 	extern int	pass_1;
-	int		w = 0;
+	char		*wmess = 0;
 
 	if (nd_tp == tp || nd_tp->tp_fund == T_STRING /* Why ??? */) return;
 	nd_tp = BaseType(nd_tp);
 	if (nd->nd_class == Value &&
 	    nd_tp->tp_fund != T_REAL &&
 	    tp->tp_fund != T_REAL) {
+		/* Constant expression mot involving REALs */
 		switch(tp->tp_fund) {
 		case T_SUBRANGE:
 			if (! chk_bounds(tp->sub_lb, nd->nd_INT, 
 				BaseType(tp)->tp_fund) ||
 			    ! chk_bounds(nd->nd_INT, tp->sub_ub,
 				BaseType(tp)->tp_fund)) {
-				node_warning(nd,
-					     W_ORDINARY,
-					     "might cause range bound error");
-				w = 1;
+				wmess = "range bound";
 			}
 			break;
 		case T_ENUMERATION:
 		case T_CHAR:
 			if (nd->nd_INT < 0 || nd->nd_INT >= tp->enm_ncst) {
-				node_warning(nd,
-					     W_ORDINARY,
-					     "might cause range bound error");
-				w = 1;
+				wmess = "range bound";
 			}
 			break;
 		case T_INTORCARD:
@@ -105,10 +105,7 @@ MkCoercion(pnd, tp)
 		case T_POINTER:
 			if ((nd_tp->tp_fund == T_INTEGER && nd->nd_INT < 0) ||
 			    (nd->nd_INT & ~full_mask[(int)(tp->tp_size)])) {
-				node_warning(nd,
-					     W_ORDINARY,
-					     "might cause conversion error");
-				w = 1;
+				wmess = "conversion";
 			}
 			break;
 		case T_INTEGER:  {
@@ -118,15 +115,15 @@ MkCoercion(pnd, tp)
 			if ((nd_tp->tp_fund == T_INTEGER &&
 			     j != i && j != 0) ||
 			    (nd_tp->tp_fund != T_INTEGER && j)) {
-				node_warning(nd,
-					     W_ORDINARY,
-					     "might cause conversion error");
-				w = 1;
+				wmess = "conversion";
 			}
 			}
 			break;
 		}
-		if (!w || pass_1) {
+		if (wmess) {
+		   node_warning(nd, W_ORDINARY, "might cause %s error", wmess);
+		}
+		if (!wmess || pass_1) {
 			nd->nd_type = tp;
 			return;
 		}

lang/m2/comp/declar.g

@@ -68,11 +68,14 @@ ProcedureHeading(t_def **pdf; int type;)
 			[
 				';' FPSection(&pr, &parmaddr)
 			]*
-		]?
+		|
+		]
 		')'
 		[	':' qualtype(&tp)
-		]?
-	]?
+		|
+		]
+	|
+	]
 			{ CheckWithDef(*pdf, proc_type(tp, pr, parmaddr));
 #ifndef NOSTRICT
 			  if (tp && IsConstructed(tp)) {
@@ -128,10 +131,12 @@ declaration
  * 		[
  * 			';' FPSection(ppr, parmaddr)
  * 		]*
- * 	]?
+ *	|
+ * 	]
  * 	')'
  * 	[	':' qualtype(ptp)
- * 	]?
+ *	|
+ * 	]
  * ;
 */
 
@@ -362,10 +367,12 @@ FieldList(t_scope *scope; arith *cnt; int *palign;)
 	]*
 	[ ELSE FieldListSequence(scope, &tcnt, palign)
 			{ if (tcnt > max) max = tcnt; }
-	]?
+	|
+	]
 	END
 			{ *cnt = max; }
-]?
+|
+]
 ;
 
 variant(t_scope *scope; arith *cnt; t_type *tp; int *palign;)
@@ -381,7 +388,8 @@ variant(t_scope *scope; arith *cnt; t_type *tp; int *palign;)
 			  FreeNode(nd);
 			}
 		':' FieldListSequence(scope, cnt, palign)
-	]?
+	|
+	]
 			/* Changed rule in new modula-2 */
 ;
 
@@ -426,7 +434,8 @@ CaseLabels(t_type **ptp; register t_node **pnd;)
 			  }
 
 			}
-	]?
+	|
+	]
 			{
 			  *ptp = nd->nd_type;
 			}
@@ -482,7 +491,8 @@ FormalTypeList(t_type **ptp;)
 		[
 			',' VarFormalType(&pr, &parmaddr)
 		]*
-	]?
+	|
+	]
 	')'
 	[ ':' qualtype(ptp)
 	|		{ *ptp = 0; }
@@ -547,6 +557,7 @@ IdentAddr(t_node **pnd;)
 	[	'['
 		ConstExpression(&(nd->nd_left))
 		']'
-	]?
+	|
+	]
 			{ *pnd = nd; }
 ;

lang/m2/comp/def.c

@@ -194,9 +194,9 @@ end_definition_list(pdf)
 		them again.
 		Also, mark all other definitions "QUALIFIED EXPORT".
 	*/
-	register t_def *df = *pdf;
+	register t_def *df;
 
-	while (df) {
+	while (df = *pdf) {
 		if (df->df_kind & D_IMPORTED) {
 			if (! (df->df_flags & D_USED)) {
 				warning(W_ORDINARY, "identifier \"%s\" imported but not used", df->df_idf->id_text);
@@ -209,7 +209,6 @@ end_definition_list(pdf)
 			df->df_flags |= D_QEXPORTED;
 			pdf = &(df->df_nextinscope);
 		}
-		df = *pdf;
 	}
 }
 

lang/m2/comp/enter.c

@@ -479,31 +479,24 @@ node_error(FromId,"identifier \"%s\" does not represent a module",module_name);
 	if (!forwflag) FreeNode(FromId);
 }
 
-EnterGlobalImportList(idlist)
+EnterImportList(idlist, local)
 	register t_node *idlist;
 {
 	/*	Import "idlist" from the enclosing scope.
-		Definition modules must be read for "idlist".
+		If the import is not local, definition modules must be read
+		for "idlist".
 	*/
+	t_scope *sc = enclosing(CurrVis)->sc_scope;
 	extern t_def *GetDefinitionModule();
 	struct f_info f;
 	
 	f = file_info;
 
 	for (; idlist; idlist = idlist->nd_left) {
-		DoImport(GetDefinitionModule(idlist->nd_IDF, 1), CurrentScope);
+		DoImport(local ?
+			   ForwDef(idlist, sc) :
+			   GetDefinitionModule(idlist->nd_IDF, 1), 
+			 CurrentScope);
 		file_info = f;
 	}
 }
-
-EnterImportList(idlist)
-	register t_node *idlist;
-{
-	/*	Import "idlist" from the enclosing scope.
-	*/
-	t_scope *sc = enclosing(CurrVis)->sc_scope;
-
-	for (; idlist; idlist = idlist->nd_left) {
-		DoImport(ForwDef(idlist, sc), CurrentScope);
-	}
-}

lang/m2/comp/expression.g

@@ -103,7 +103,8 @@ expression(t_node **pnd;)
 		[ '=' | '#' | '<' | LESSEQUAL | '>' | GREATEREQUAL | IN ]
 			{ *pnd = dot2node(Oper, *pnd, NULLNODE); }
 		SimpleExpression(&((*pnd)->nd_right))
-	]?
+	|
+	]
 ;
 
 /* Inline in expression
@@ -121,7 +122,8 @@ SimpleExpression(t_node **pnd;)
 			{ nd = dot2leaf(Uoper);
 			  /* priority of unary operator ??? */
 			}
-	]?
+	|
+	]
 	term(pnd)
 			{ if (nd) {
 				nd->nd_right = *pnd;
@@ -170,11 +172,12 @@ factor(register t_node **p;)
 } :
 	qualident(p)
 	[
-		designator_tail(p)?
+		designator_tail(p)
 		[
 			{ *p = dot2node(Call, *p, NULLNODE); }
 			ActualParameters(&((*p)->nd_right))
-		]?
+		|
+		]
 	|
 		bare_set(&nd)
 			{ nd->nd_left = *p; *p = nd; }
@@ -229,7 +232,8 @@ bare_set(t_node **pnd;)
 		[	{ nd = nd->nd_right; }
 			',' element(nd)
 		]*
-	]?
+	|
+	]
 	'}'
 ;
 
@@ -246,7 +250,8 @@ element(register t_node *nd;)
 		UPTO
 			{ nd1 = dot2node(Link, nd1, NULLNODE);}
 		expression(&(nd1->nd_right))
-	]?
+	|
+	]
 			{ nd->nd_right = dot2node(Link, nd1, NULLNODE);
 			  nd->nd_right->nd_symb = ',';
 			}
@@ -255,7 +260,7 @@ element(register t_node *nd;)
 designator(t_node **pnd;)
 :
 	qualident(pnd)
-	designator_tail(pnd)?
+	designator_tail(pnd)
 ;
 
 designator_tail(t_node **pnd;):
@@ -266,6 +271,7 @@ designator_tail(t_node **pnd;):
 	|
 		visible_designator_tail(pnd)
 	]*
+|
 ;
 
 visible_designator_tail(t_node **pnd;)

lang/m2/comp/program.g

@@ -50,46 +50,44 @@
 ModuleDeclaration
 {
 	register t_def	*df;
-	t_node *exportlist = 0;
+	t_node		*exportlist;
 	int		qualified;
 } :
 	MODULE IDENT	{ df = DefineLocalModule(dot.TOK_IDF); }
-	priority(df)
+	priority(&(df->mod_priority))
 	';'
 	import(1)*
-	export(&qualified, &exportlist)?
+	export(&qualified, &exportlist)
 	block(&(df->mod_body))
-	IDENT		{ if (exportlist) {
-				EnterExportList(exportlist, qualified);
-			  }
+	IDENT		{ EnterExportList(exportlist, qualified);
 			  close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
 			  match_id(df->df_idf, dot.TOK_IDF);
 			}
 ;
 
-priority(register t_def *df;):
+priority(register t_node **prio;):
 	[
-		'[' ConstExpression(&(df->mod_priority)) ']'
-			{ if (!(df->mod_priority->nd_type->tp_fund &
-				T_CARDINAL)) {
-				node_error(df->mod_priority,
-					   "illegal priority");
+		'[' ConstExpression(prio) ']'
+			{ if (! ((*prio)->nd_type->tp_fund & T_CARDINAL)) {
+				node_error(*prio, "illegal priority");
 			  }
 			}
 	|
-			{ df->mod_priority = 0; }
 	]
 ;
 
 export(int *QUALflag; t_node **ExportList;):
+				{ *ExportList = 0; *QUALflag = D_EXPORTED; }
+	[
 		EXPORT
 		[
 			QUALIFIED
 				{ *QUALflag = D_QEXPORTED; }
 		|
-			{ *QUALflag = D_EXPORTED; }
 		]
 		IdentList(ExportList) ';'
+	|
+	]
 ;
 
 import(int local;)
@@ -106,7 +104,8 @@ import(int local;)
 			  }
 			  else df = GetDefinitionModule(dot.TOK_IDF, 1);
 			}
-	]?
+	|
+	]
 	IMPORT IdentList(&ImportList) ';'
 	/*
 	   When parsing a global module, this is the place where we must
@@ -117,8 +116,7 @@ import(int local;)
 			{ if (FromId) {
 				EnterFromImportList(ImportList, df, FromId);
 			  }
-			  else if (local) EnterImportList(ImportList);
-			  else EnterGlobalImportList(ImportList);
+			  else EnterImportList(ImportList, local);
 			  FreeNode(ImportList);
 			}
 ;
@@ -130,31 +128,31 @@ DefinitionModule
 	int		dummy;
 	extern t_idf	*DefId;
 	extern int	ForeignFlag;
+	register t_scope *currscope = CurrentScope;
 } :
 	DEFINITION
 	MODULE IDENT	{ df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
-			  df->df_flags |= D_BUSY;
-			  df->df_flags |= ForeignFlag;
+			  df->df_flags |= D_BUSY | ForeignFlag;
 			  if (!Defined) Defined = df;
-		  	  CurrentScope->sc_definedby = df;
+		  	  currscope->sc_definedby = df;
 			  if (DefId && df->df_idf != DefId) {
 				error("DEFINITION MODULE name is \"%s\", not \"%s\"",
 					df->df_idf->id_text, DefId->id_text);
 			  }
-			  CurrentScope->sc_name = df->df_idf->id_text;
+			  currscope->sc_name = df->df_idf->id_text;
 			  df->mod_vis = CurrVis;
 			  df->df_type = standard_type(T_RECORD, 1, (arith) 1);
-			  df->df_type->rec_scope = df->mod_vis->sc_scope;
+			  df->df_type->rec_scope = currscope;
 			  DefinitionModule++;
 			}
 	';'
 	import(0)* 
-	[
 	export(&dummy, &exportlist)
 		/*	New Modula-2 does not have export lists in definition
 			modules. Issue a warning.
 		*/
 			{ 
+			  if (exportlist) {
 #ifndef STRICT_3RD_ED
 			    if (! options['3'])
 node_warning(exportlist, W_OLDFASHIONED, "export list in definition module ignored");
@@ -163,11 +161,9 @@ node_warning(exportlist, W_OLDFASHIONED, "export list in definition module ignor
 				error("export list not allowed in definition module");
 			    FreeNode(exportlist);
 			  }
-	|
-		/* empty */
-	]
+			}
 	definition* END IDENT
-			{ end_definition_list(&(CurrentScope->sc_def));
+			{ end_definition_list(&(currscope->sc_def));
 			  DefinitionModule--;
 			  match_id(df->df_idf, dot.TOK_IDF);
 			  df->df_flags &= ~D_BUSY;
@@ -201,8 +197,7 @@ definition
 |
 	VAR [ %persistent VariableDeclaration ';' ]*
 |
-	ProcedureHeading(&dummy, D_PROCHEAD)
-	';'
+	ProcedureHeading(&dummy, D_PROCHEAD) ';'
 ;
 
 ProgramModule
@@ -223,7 +218,7 @@ ProgramModule
 		  	CurrentScope->sc_definedby = df;
 		  }
 		}
-	priority(df)
+	priority(&(df->mod_priority))
 	';' import(0)*
 	block(&(df->mod_body)) IDENT
 		{ close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
@@ -232,7 +227,7 @@ ProgramModule
 	'.'
 ;
 
-Module:
+CompilationUnit:
 			{ error("Compiling a definition module");
 			  open_scope(CLOSEDSCOPE);
 			  state = DEFINITION;
@@ -241,13 +236,11 @@ Module:
 			{ close_scope(SC_CHKFORW); }
 |	%default
 	[
-		IMPLEMENTATION	{ state = IMPLEMENTATION; }
+		IMPLEMENTATION
+			{ state = IMPLEMENTATION; }
 	|
-		/* empty */	{ state = PROGRAM; }
+		/* empty */
+			{ state = PROGRAM; }
 	]
 	ProgramModule
 ;
-
-CompilationUnit:
-	Module
-;

lang/m2/comp/statement.g

@@ -166,7 +166,8 @@ IfStatement(t_node **pnd;)
 	[
 		ELSE
 		StatementSequence(&(nd->nd_right))
-	]?
+	|
+	]
 	END
 ;
 
@@ -186,7 +187,8 @@ CaseStatement(t_node **pnd;)
 			{ nd = nd->nd_right; }
 	]*
 	[ ELSE StatementSequence(&(nd->nd_right))
-	]?
+	|
+	]
 	END
 ;
 
@@ -194,7 +196,8 @@ case(t_node **pnd; t_type **ptp;) :
 	[ CaseLabelList(ptp, pnd)
 	  ':'		{ *pnd = dot2node(Link, *pnd, NULLNODE); }
 	  StatementSequence(&((*pnd)->nd_right))
-	]?
+	|
+	]
 			{ *pnd = dot2node(Link, *pnd, NULLNODE);
 			  (*pnd)->nd_symb = '|';
 			}