make to work on sun, added copyright, etc

lang/m2/comp/LLlex.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* L E X I C A L   A N A L Y S E R   F O R   M O D U L A - 2 */
 
+/* $Header$ */
+
 #include	"debug.h"
 #include	"idfsize.h"
 #include	"numsize.h"
@@ -25,7 +34,8 @@ long str2long();
 struct token	dot,
 		aside;
 struct type	*toktype;
-int		 idfsize = IDFSIZE;
+int		idfsize = IDFSIZE;
+int		ForeignFlag;
 #ifdef DEBUG
 extern int	cntlines;
 #endif
@@ -42,6 +52,19 @@ SkipComment()
 	register int CommentLevel = 0;
 
 	LoadChar(ch);
+	if (ch == '$') {
+		LoadChar(ch);
+		switch(ch) {
+		case 'F':
+			/* Foreign; This definition module has an
+			   implementation in another language.
+			   In this case, don't generate prefixes in front
+			   of the names
+			*/
+			ForeignFlag = 1;
+			break;
+		}
+	}
 	for (;;) {
 		if (class(ch) == STNL) {
 			LineNumber++;
@@ -138,10 +161,20 @@ linedirective() {
 	/*	Read a line directive
 	*/
 	register int	ch;
+}
+
+CheckForLineDirective()
+{
+	register int ch = getch();
 	register int	i = 0;
 	char		buf[IDFSIZE + 2];
 	register char	*c = buf;
 
+
+	if (ch != '#') {
+		PushBack();
+		return;
+	}
 	do {	/*
 		 * Skip to next digit
 		 * Do not skip newlines
@@ -153,10 +186,10 @@ linedirective() {
 			return;
 		}
 	} while (class(ch) != STNUM);
-	do  {
+	while (class(ch) == STNUM)  {
 		i = i*10 + (ch - '0');
 		ch = getch();
-	} while (class(ch) == STNUM);
+	}
 	while (ch != '"' && class(ch) != STNL) ch = getch();
 	if (ch == '"') {
 		c = buf;
@@ -206,7 +239,7 @@ LLlex()
 
 	tk->tk_lineno = LineNumber;
 
-again2:
+again1:
 	if (eofseen) {
 		eofseen = 0;
 		ch = EOI;
@@ -214,7 +247,6 @@ again2:
 	else {
 again:
 		LoadChar(ch);
-again1:
 		if ((ch & 0200) && ch != EOI) {
 			error("non-ascii '\\%03o' read", ch & 0377);
 			goto again;
@@ -229,10 +261,8 @@ again1:
 		cntlines++;
 #endif
 		tk->tk_lineno++;
-		LoadChar(ch);
+		CheckForLineDirective();
-		if (ch != '#') goto again1;
+		goto again1;
-		linedirective();
-		goto again2;
 
 	case STSKIP:
 		goto again;

lang/m2/comp/LLlex.h

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* T O K E N   D E S C R I P T O R   D E F I N I T I O N */
 
+/* $Header$ */
+
 /* Structure to store a string constant
 */
 struct string {

lang/m2/comp/LLmessage.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* S Y N T A X   E R R O R   R E P O R T I N G */
 
+/* $Header$ */
+
 /*	Defines the LLmessage routine. LLgen-generated parsers require the
 	existence of a routine of that name.
 	The routine must do syntax-error reporting and must be able to

lang/m2/comp/Makefile

@@ -13,9 +13,9 @@ CURRDIR =	.
 INCLUDES = -I$(MHDIR) -I$(EMHOME)/h -I$(PKGDIR)
 
 GFILES =	tokenfile.g program.g declar.g expression.g statement.g
-LLGENOPTIONS =
+LLGENOPTIONS = -v
 PROFILE =
-CFLAGS = $(PROFILE) $(INCLUDES) -DSTATIC=
+CFLAGS = $(PROFILE) $(INCLUDES) -O -DSTATIC=
 LINTFLAGS = -DSTATIC= -DNORCSID
 MALLOC = $(LIBDIR)/malloc.o
 LFLAGS = $(PROFILE)
@@ -61,7 +61,8 @@ install:	all
 	cp $(CURRDIR)/main $(EMHOME)/lib/em_m2
 
 clean:
-	rm -f $(OBJ) $(GENFILES) LLfiles hfiles Cfiles tab clashes $(CURRDIR)/main
+	rm -f $(OBJ) $(GENFILES) LLfiles hfiles Cfiles tab clashes \
+		$(CURRDIR)/main LL.output
 	(cd .. ; rm -rf Xsrc)
 
 lint:	Cfiles
@@ -132,36 +133,266 @@ $(CURRDIR)/main:	$(OBJ)
 	size $(CURRDIR)/main
 
 #AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
-LLlex.o: LLlex.h Lpars.h class.h const.h debug.h debugcst.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h warning.h
+LLlex.o: LLlex.h
-LLmessage.o: LLlex.h Lpars.h idf.h
+LLlex.o: Lpars.h
+LLlex.o: class.h
+LLlex.o: const.h
+LLlex.o: debug.h
+LLlex.o: debugcst.h
+LLlex.o: f_info.h
+LLlex.o: idf.h
+LLlex.o: idfsize.h
+LLlex.o: input.h
+LLlex.o: inputtype.h
+LLlex.o: numsize.h
+LLlex.o: strsize.h
+LLlex.o: type.h
+LLlex.o: warning.h
+LLmessage.o: LLlex.h
+LLmessage.o: Lpars.h
+LLmessage.o: idf.h
 char.o: class.h
-error.o: LLlex.h debug.h debugcst.h errout.h f_info.h input.h inputtype.h main.h node.h warning.h
+error.o: LLlex.h
-main.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h input.h inputtype.h ndir.h node.h scope.h standards.h tokenname.h type.h warning.h
+error.o: debug.h
+error.o: debugcst.h
+error.o: errout.h
+error.o: f_info.h
+error.o: input.h
+error.o: inputtype.h
+error.o: main.h
+error.o: node.h
+error.o: warning.h
+main.o: LLlex.h
+main.o: Lpars.h
+main.o: debug.h
+main.o: debugcst.h
+main.o: def.h
+main.o: f_info.h
+main.o: idf.h
+main.o: input.h
+main.o: inputtype.h
+main.o: ndir.h
+main.o: node.h
+main.o: scope.h
+main.o: standards.h
+main.o: tokenname.h
+main.o: type.h
+main.o: warning.h
 symbol2str.o: Lpars.h
-tokenname.o: Lpars.h idf.h tokenname.h
+tokenname.o: Lpars.h
+tokenname.o: idf.h
+tokenname.o: tokenname.h
 idf.o: idf.h
-input.o: def.h f_info.h idf.h input.h inputtype.h scope.h
+input.o: def.h
-type.o: LLlex.h const.h debug.h debugcst.h def.h idf.h maxset.h node.h scope.h target_sizes.h type.h walk.h
+input.o: f_info.h
-def.o: LLlex.h Lpars.h debug.h debugcst.h def.h idf.h main.h node.h scope.h type.h
+input.o: idf.h
-scope.o: LLlex.h debug.h debugcst.h def.h idf.h node.h scope.h type.h
+input.o: input.h
-misc.o: LLlex.h f_info.h idf.h misc.h node.h
+input.o: inputtype.h
-enter.o: LLlex.h debug.h debugcst.h def.h idf.h main.h misc.h node.h scope.h type.h
+input.o: scope.h
-defmodule.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h input.h inputtype.h main.h misc.h node.h scope.h type.h
+type.o: LLlex.h
-typequiv.o: LLlex.h debug.h debugcst.h def.h node.h type.h warning.h
+type.o: chk_expr.h
-node.o: LLlex.h debug.h debugcst.h def.h node.h type.h
+type.o: const.h
-cstoper.o: LLlex.h Lpars.h debug.h debugcst.h idf.h node.h standards.h target_sizes.h type.h warning.h
+type.o: debug.h
-chk_expr.o: LLlex.h Lpars.h chk_expr.h const.h debug.h debugcst.h def.h idf.h misc.h node.h scope.h standards.h type.h warning.h
+type.o: debugcst.h
-options.o: idfsize.h main.h ndir.h type.h warning.h
+type.o: def.h
-walk.o: LLlex.h Lpars.h chk_expr.h debug.h debugcst.h def.h desig.h f_info.h idf.h main.h node.h scope.h type.h walk.h warning.h
+type.o: idf.h
-casestat.o: LLlex.h Lpars.h debug.h debugcst.h density.h desig.h node.h type.h walk.h
+type.o: maxset.h
-desig.o: LLlex.h debug.h debugcst.h def.h desig.h node.h scope.h type.h
+type.o: node.h
-code.o: LLlex.h Lpars.h debug.h debugcst.h def.h desig.h node.h scope.h standards.h type.h walk.h
+type.o: scope.h
-tmpvar.o: debug.h debugcst.h def.h main.h scope.h type.h
+type.o: target_sizes.h
-lookup.o: LLlex.h debug.h debugcst.h def.h idf.h misc.h node.h scope.h type.h
+type.o: type.h
-next.o: debug.h debugcst.h
+type.o: walk.h
+def.o: LLlex.h
+def.o: Lpars.h
+def.o: debug.h
+def.o: debugcst.h
+def.o: def.h
+def.o: idf.h
+def.o: main.h
+def.o: node.h
+def.o: scope.h
+def.o: type.h
+scope.o: LLlex.h
+scope.o: debug.h
+scope.o: debugcst.h
+scope.o: def.h
+scope.o: idf.h
+scope.o: node.h
+scope.o: scope.h
+scope.o: type.h
+misc.o: LLlex.h
+misc.o: f_info.h
+misc.o: idf.h
+misc.o: misc.h
+misc.o: node.h
+enter.o: LLlex.h
+enter.o: debug.h
+enter.o: debugcst.h
+enter.o: def.h
+enter.o: idf.h
+enter.o: main.h
+enter.o: misc.h
+enter.o: node.h
+enter.o: scope.h
+enter.o: type.h
+defmodule.o: LLlex.h
+defmodule.o: Lpars.h
+defmodule.o: debug.h
+defmodule.o: debugcst.h
+defmodule.o: def.h
+defmodule.o: f_info.h
+defmodule.o: idf.h
+defmodule.o: input.h
+defmodule.o: inputtype.h
+defmodule.o: main.h
+defmodule.o: misc.h
+defmodule.o: node.h
+defmodule.o: scope.h
+defmodule.o: type.h
+typequiv.o: LLlex.h
+typequiv.o: debug.h
+typequiv.o: debugcst.h
+typequiv.o: def.h
+typequiv.o: node.h
+typequiv.o: type.h
+typequiv.o: warning.h
+node.o: LLlex.h
+node.o: debug.h
+node.o: debugcst.h
+node.o: def.h
+node.o: node.h
+node.o: type.h
+cstoper.o: LLlex.h
+cstoper.o: Lpars.h
+cstoper.o: debug.h
+cstoper.o: debugcst.h
+cstoper.o: idf.h
+cstoper.o: node.h
+cstoper.o: standards.h
+cstoper.o: target_sizes.h
+cstoper.o: type.h
+cstoper.o: warning.h
+chk_expr.o: LLlex.h
+chk_expr.o: Lpars.h
+chk_expr.o: chk_expr.h
+chk_expr.o: const.h
+chk_expr.o: debug.h
+chk_expr.o: debugcst.h
+chk_expr.o: def.h
+chk_expr.o: idf.h
+chk_expr.o: misc.h
+chk_expr.o: node.h
+chk_expr.o: scope.h
+chk_expr.o: standards.h
+chk_expr.o: type.h
+chk_expr.o: warning.h
+options.o: idfsize.h
+options.o: main.h
+options.o: ndir.h
+options.o: type.h
+options.o: warning.h
+walk.o: LLlex.h
+walk.o: Lpars.h
+walk.o: chk_expr.h
+walk.o: debug.h
+walk.o: debugcst.h
+walk.o: def.h
+walk.o: desig.h
+walk.o: f_info.h
+walk.o: idf.h
+walk.o: main.h
+walk.o: node.h
+walk.o: scope.h
+walk.o: type.h
+walk.o: walk.h
+walk.o: warning.h
+casestat.o: LLlex.h
+casestat.o: Lpars.h
+casestat.o: debug.h
+casestat.o: debugcst.h
+casestat.o: density.h
+casestat.o: desig.h
+casestat.o: node.h
+casestat.o: type.h
+casestat.o: walk.h
+desig.o: LLlex.h
+desig.o: debug.h
+desig.o: debugcst.h
+desig.o: def.h
+desig.o: desig.h
+desig.o: node.h
+desig.o: scope.h
+desig.o: type.h
+code.o: LLlex.h
+code.o: Lpars.h
+code.o: debug.h
+code.o: debugcst.h
+code.o: def.h
+code.o: desig.h
+code.o: node.h
+code.o: scope.h
+code.o: standards.h
+code.o: type.h
+code.o: walk.h
+tmpvar.o: debug.h
+tmpvar.o: debugcst.h
+tmpvar.o: def.h
+tmpvar.o: main.h
+tmpvar.o: scope.h
+tmpvar.o: type.h
+lookup.o: LLlex.h
+lookup.o: debug.h
+lookup.o: debugcst.h
+lookup.o: def.h
+lookup.o: idf.h
+lookup.o: misc.h
+lookup.o: node.h
+lookup.o: scope.h
+lookup.o: type.h
+next.o: debug.h
+next.o: debugcst.h
 tokenfile.o: Lpars.h
-program.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h main.h node.h scope.h type.h warning.h
+program.o: LLlex.h
-declar.o: LLlex.h Lpars.h chk_expr.h debug.h debugcst.h def.h idf.h main.h misc.h node.h scope.h type.h warning.h
+program.o: Lpars.h
-expression.o: LLlex.h Lpars.h chk_expr.h const.h debug.h debugcst.h def.h idf.h node.h type.h warning.h
+program.o: debug.h
-statement.o: LLlex.h Lpars.h def.h idf.h node.h scope.h type.h
+program.o: debugcst.h
+program.o: def.h
+program.o: f_info.h
+program.o: idf.h
+program.o: main.h
+program.o: node.h
+program.o: scope.h
+program.o: type.h
+program.o: warning.h
+declar.o: LLlex.h
+declar.o: Lpars.h
+declar.o: chk_expr.h
+declar.o: debug.h
+declar.o: debugcst.h
+declar.o: def.h
+declar.o: idf.h
+declar.o: main.h
+declar.o: misc.h
+declar.o: node.h
+declar.o: scope.h
+declar.o: type.h
+declar.o: warning.h
+expression.o: LLlex.h
+expression.o: Lpars.h
+expression.o: chk_expr.h
+expression.o: const.h
+expression.o: debug.h
+expression.o: debugcst.h
+expression.o: def.h
+expression.o: idf.h
+expression.o: node.h
+expression.o: type.h
+expression.o: warning.h
+statement.o: LLlex.h
+statement.o: Lpars.h
+statement.o: def.h
+statement.o: idf.h
+statement.o: node.h
+statement.o: scope.h
+statement.o: type.h
 Lpars.o: Lpars.h

lang/m2/comp/SYSTEM.h

@@ -0,0 +1,18 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
+/* S Y S T E M   M O D U L E   T E X T */
+
+/* $Header$ */
+
+/* Text of SYSTEM module, for as far as it can be expressed in Modula-2 */
+
+#define SYSTEMTEXT "DEFINITION MODULE SYSTEM;\n\
+TYPE	PROCESS = ADDRESS;\n\
+PROCEDURE NEWPROCESS(P:PROC; A:ADDRESS; n:CARDINAL; VAR p1:ADDRESS);\n\
+PROCEDURE TRANSFER(VAR p1,p2:ADDRESS);\n\
+END SYSTEM.\n"

lang/m2/comp/casestat.C

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* C A S E   S T A T E M E N T   C O D E   G E N E R A T I O N */
 
+/* $Header$ */
+
 /*	Generation of case statements is done by first creating a
 	description structure for the statement, build a list of the
 	case-labels, then generating a case description in the code,

lang/m2/comp/chk_expr.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* E X P R E S S I O N   C H E C K I N G */
 
+/* $Header$ */
+
 /*	Check expressions, and try to evaluate them as far as possible.
 */
 
@@ -1203,11 +1212,7 @@ int (*ExprChkTable[])() = {
 };
 
 int (*DesigChkTable[])() = {
-#ifdef DEBUG
+	no_desig,
-	ChkValue,
-#else
-	done_before,
-#endif
 	ChkArr,
 	no_desig,
 	no_desig,

lang/m2/comp/chk_expr.h

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* E X P R E S S I O N   C H E C K I N G */
 
+/* $Header$ */
+
 extern int	(*ExprChkTable[])();	/* table of expression checking
 					   functions, indexed by node class
 					*/

lang/m2/comp/class.h

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* U S E   O F   C H A R A C T E R   C L A S S E S */
 
+/* $Header$ */
+
 /*	As a starter, chars are divided into classes, according to which
 	token they can be the start of.
 	At present such a class number is supposed to fit in 4 bits.

lang/m2/comp/code.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* C O D E   G E N E R A T I O N   R O U T I N E S */
 
+/* $Header$ */
+
 /*	Code generation for expressions and coercions
 */
 

lang/m2/comp/const.h

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* C O N S T A N T S   F O R   E X P R E S S I O N   H A N D L I N G */
 
+/* $Header$ */
+
 extern long
 	mach_long_sign;	/* sign bit of the machine long */
 extern int

lang/m2/comp/cstoper.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* C O N S T A N T   E X P R E S S I O N   H A N D L I N G */
 
+/* $Header$ */
+
 #include	"debug.h"
 #include	"target_sizes.h"
 

lang/m2/comp/debug.h

@@ -1,5 +1,13 @@
-/* A debugging macro
+/*
-*/
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
+/* D E B U G G I N G   M A C R O */
+
+/* $Header$ */
 
 #include "debugcst.h"
 

lang/m2/comp/declar.g

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* D E C L A R A T I O N S */
 
+/* $Header$ */
+
 {
 #include	"debug.h"
 
@@ -21,25 +30,27 @@
 
 int		proclevel = 0;		/* nesting level of procedures */
 int		return_occurred;	/* set if a return occurs in a block */
+
+#define needs_static_link()	(proclevel > 1)
+
 }
 
 ProcedureDeclaration
 {
 	struct def *df;
 } :
-			{ ++proclevel; }
+			{	++proclevel; }
 	ProcedureHeading(&df, D_PROCEDURE)
 	';' block(&(df->prc_body))
 	IDENT
-			{ EndProc(df, dot.TOK_IDF);
+			{	EndProc(df, dot.TOK_IDF);
-			  --proclevel;
+				--proclevel;
 			}
 ;
 
 ProcedureHeading(struct def **pdf; int type;)
 {
 	struct type *tp = 0;
-#define needs_static_link()	(proclevel > 1)
 	arith parmaddr = needs_static_link() ? pointer_size : 0;
 	struct paramlist *pr = 0;
 } :
@@ -67,11 +78,11 @@ block(struct node **pnd;) :
 ;
 
 declaration:
-	CONST [ %persistent ConstantDeclaration ';' ]*
+	CONST [ ConstantDeclaration ';' ]*
 |
-	TYPE [ %persistent TypeDeclaration ';' ]*
+	TYPE [ TypeDeclaration ';' ]*
 |
-	VAR [ %persistent VariableDeclaration ';' ]*
+	VAR [ VariableDeclaration ';' ]*
 |
 	ProcedureDeclaration ';'
 |
@@ -171,20 +182,7 @@ enumeration(struct type **ptp;)
 	struct node *EnumList;
 } :
 	'(' IdentList(&EnumList) ')'
-		{ register struct type *tp =
+		{ *ptp = enum_type(EnumList); }
-		  	standard_type(T_ENUMERATION, int_align, int_size);
-
-		  *ptp = tp;
-		  EnterEnumList(EnumList, tp);
-		  if (ufit(tp->enm_ncst-1, 1)) {
-			tp->tp_size = 1;
-			tp->tp_align = 1;
-		  }
-		  else if (ufit(tp->enm_ncst-1, short_size)) {
-			tp->tp_size = short_size;
-			tp->tp_align = short_align;
-		  }
-		}
 ;
 
 IdentList(struct node **p;)
@@ -244,10 +242,7 @@ RecordType(struct type **ptp;)
 }
 :
 	RECORD
-		{ open_scope(OPENSCOPE);	/* scope for fields of record */
+		{ scope = open_and_close_scope(OPENSCOPE); }
-		  scope = CurrentScope;
-		  close_scope(0);
-		}
 	FieldListSequence(scope, &size, &xalign)
 		{ if (size == 0) {
 			warning(W_ORDINARY, "empty record declaration");
@@ -271,13 +266,13 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 	struct node *FldList;
 	register struct idf *id = 0;
 	struct type *tp;
-	struct node *nd1;
+	struct node *nd;
-	register struct node *nd;
 	arith tcnt, max;
 } :
 [
 	IdentList(&FldList) ':' type(&tp)
-			{ *palign = lcm(*palign, tp->tp_align);
+			{
+			  *palign = lcm(*palign, tp->tp_align);
 			  EnterFieldList(FldList, tp, scope, cnt);
 			}
 |
@@ -285,8 +280,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 	/* Also accept old fashioned Modula-2 syntax, but give a warning.
 	   Sorry for the complicated code.
 	*/
-	[ qualident(&nd1)
+	[ qualident(&nd)
-			{ nd = nd1; }
 	  [ ':' qualtype(&tp)
 			/* This is correct, in both kinds of Modula-2, if
 		   	   the first qualident is a single identifier.
@@ -300,25 +294,20 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 	  |		/* Old fashioned! the first qualident now represents
 			   the type
 			*/
-			{ warning(W_OLDFASHIONED, "old fashioned Modula-2 syntax; ':' missing");
+			{ warning(W_OLDFASHIONED,
-			  if (ChkDesignator(nd) &&
+			      "old fashioned Modula-2 syntax; ':' missing");
-			      (nd->nd_class != Def ||
+			  tp = qualified_type(nd);
-			       !(nd->nd_def->df_kind&(D_ERROR|D_ISTYPE)) ||
-			       !nd->nd_def->df_type)) {
-				node_error(nd, "type expected");
-				tp = error_type;
-			  }
-			  else tp = nd->nd_def->df_type;
-			  FreeNode(nd);
 			}
 	  ]
 	| ':' qualtype(&tp)
 	  /* Aha, third edition. Well done! */
 	]
-			{ if (id) {
+			{
-			  	register struct def *df = define(id,
+			  *palign = lcm(*palign, tp->tp_align);
-								 scope,
+			  if (id) {
-								 D_FIELD);
+			  	register struct def *df = 
+					define(id, scope, D_FIELD);
+
 			  	if (!(tp->tp_fund & T_DISCRETE)) {
 					error("illegal type in variant");
 			  	}
@@ -351,7 +340,7 @@ variant(struct scope *scope; arith *cnt; struct type *tp; int *palign;)
 		CaseLabelList(&tp, &nd)
 			{ /* Ignore the cases for the time being.
 			     Maybe a checking version will be supplied
-			     later ??? (Improbable)
+			     later ???
 			  */
 			  FreeNode(nd);
 			}
@@ -403,73 +392,21 @@ SetType(struct type **ptp;) :
 	have to be declared yet, so be careful about identifying
 	type-identifiers
 */
-PointerType(struct type **ptp;)
+PointerType(struct type **ptp;) :
-{
-	register struct node *nd = 0;
-} :
 	POINTER TO
-			{ *ptp = construct_type(T_POINTER, NULLTYPE); }
+	[ %if	(type_or_forward(ptp))
-	[ %if	( lookup(dot.TOK_IDF, CurrentScope, 1)
-			/* Either a Module or a Type, but in both cases defined
-		   	   in this scope, so this is the correct identification
-			*/
-		||
-		  ( nd = new_node(),
-		    nd->nd_token = dot,
-		    lookfor(nd, CurrVis, 0)->df_kind == D_MODULE
-		  )
-			/* A Modulename in one of the enclosing scopes.
-			   It is not clear from the language definition that
-			   it is correct to handle these like this, but
-			   existing compilers do it like this, and the
-			   alternative is difficult with a lookahead of only
-			   one token.
-			   ???
-			*/
-		)
 	  type(&((*ptp)->next)) 
-			{ if (nd) free_node(nd); }
 	|
-	  IDENT		{ if (nd) {
+	  IDENT
-				/* nd could be a null pointer, if we had a
-				   syntax error exactly at this alternation.
-				   MORAL: Be careful with %if resolvers with
-				   side effects!
-				*/
-				Forward(nd, (*ptp));
-			  }
-			}
 	]
 ;
 
 qualtype(struct type **ptp;)
 {
-	register struct node *nd;
+	struct node *nd;
-	struct node *nd1;		/* because &nd is illegal */
 } :
-	qualident(&nd1)
+	qualident(&nd)
-		{ nd = nd1;
+		{ *ptp = qualified_type(nd); }
-		  *ptp = error_type;
-		  if (ChkDesignator(nd)) {
-			if (nd->nd_class != Def) {
-				node_error(nd, "type expected");
-			}
-			else {
-				register struct def *df = nd->nd_def;
-
-				if (df->df_kind&(D_ISTYPE|D_FORWARD|D_ERROR)) {
-				    if (! df->df_type) {
-node_error(nd,"type \"%s\" not (yet) declared", df->df_idf->id_text);
-				    }
-				    else *ptp = df->df_type;
-				}
-				else {
-node_error(nd,"identifier \"%s\" is not a type", df->df_idf->id_text);
-				}
-			}
-		  }
-		  FreeNode(nd);
-		}
 ;
 
 ProcedureType(struct type **ptp;)

lang/m2/comp/def.H

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* I D E N T I F I E R   D E S C R I P T O R   S T R U C T U R E */
 
+/* $Header$ */
+
 struct module {
 	struct node *mo_priority;/* priority of a module */
 	struct scopelist *mo_vis;/* scope of this module */
@@ -106,6 +115,7 @@ struct def	{		/* list of definitions for a name */
 #define D_EXPORTED	0x20	/* set if exported */
 #define D_QEXPORTED	0x40	/* set if qualified exported */
 #define D_BUSY		0x80	/* set if busy reading this definition module */
+#define D_FOREIGN	0x100	/* set for foreign language modules */
 	struct type *df_type;
 	union {
 		struct module df_module;

lang/m2/comp/def.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* D E F I N I T I O N   M E C H A N I S M */
 
+/* $Header$ */
+
 #include	"debug.h"
 
 #include	<alloc.h>
@@ -234,8 +243,13 @@ DeclProc(type, id)
 		*/
 		df = define(id, CurrentScope, type);
 		df->for_node = MkLeaf(Name, &dot);
-		sprint(buf,"%s_%s",CurrentScope->sc_name,id->id_text);
+		if (CurrentScope->sc_definedby->df_flags & D_FOREIGN) {
-		df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1));
+			df->for_name = id->id_text;
+		}
+		else {
+			sprint(buf,"%s_%s",CurrentScope->sc_name,id->id_text);
+			df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1));
+		}
 		if (CurrVis == Defined->mod_vis) {
 			/* The current module will define this routine.
 			   make sure the name is exported.

lang/m2/comp/defmodule.c

@@ -1,10 +1,20 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* D E F I N I T I O N   M O D U L E S */
 
+/* $Header$ */
+
 #include	"debug.h"
 
 #include	<assert.h>
 #include	<em_arith.h>
 #include	<em_label.h>
+#include	<alloc.h>
 
 #include	"idf.h"
 #include	"input.h"
@@ -24,6 +34,28 @@ long	sys_filesize();
 
 struct idf *DefId;
 
+STATIC char *
+getwdir(fn)
+	char *fn;
+{
+	register char *p;
+	char *strrindex();
+
+	p = strrindex(fn, '/');
+	while (p && *(p + 1) == '\0') {	/* remove trailing /'s */
+		*p = '\0';
+		p = strrindex(fn, '/');
+	}
+
+	if (p) {
+		*p = '\0';
+		fn = Salloc(fn, p - &fn[0] + 1);
+		*p = '/';
+		return fn;
+	}
+	else return ".";
+}
+
 STATIC
 GetFile(name)
 	char *name;
@@ -33,14 +65,17 @@ GetFile(name)
 	*/
 	char buf[15];
 	char *strcpy(), *strcat();
+	static char *WorkingDir = ".";
 
 	strncpy(buf, name, 10);
 	buf[10] = '\0';			/* maximum length */
 	strcat(buf, ".def");
+	DEFPATH[0] = WorkingDir;
 	if (! InsertFile(buf, DEFPATH, &(FileName))) {
 		error("could not find a DEFINITION MODULE for \"%s\"", name);
 		return 0;
 	}
+	WorkingDir = getwdir(FileName);
 	LineNumber = 1;
 	DO_DEBUG(options['F'], debug("File %s : %ld characters", FileName, sys_filesize(FileName)));
 	return 1;
@@ -64,20 +99,26 @@ GetDefinitionModule(id, incr)
 	if (!df) {
 		/* Read definition module. Make an exception for SYSTEM.
 		*/
+		DefId = id;
 		if (!strcmp(id->id_text, "SYSTEM")) {
 			do_SYSTEM();
+			df = lookup(id, GlobalScope, 1);
 		}
 		else {
+			extern int ForeignFlag;
+
+			ForeignFlag = 0;
 			open_scope(CLOSEDSCOPE);
 			if (!is_anon_idf(id) && GetFile(id->id_text)) {
-				DefId = id;
 				DefModule();
-				if (level == 1) {
+				df = lookup(id, GlobalScope, 1);
+				if (level == 1 &&
+				    (!df || !(df->df_flags & D_FOREIGN))) {
 					/* The module is directly imported by
-					   the currently defined module, so we
+					   the currently defined module, and
-					   have to remember its name because
+					   is not foreign, so we have to
-					   we have to call its initialization
+					   remember its name because we have 
-					   routine
+					   to call its initialization routine
 					*/
 					static struct node *nd_end;
 					register struct node *n;
@@ -91,10 +132,13 @@ GetDefinitionModule(id, incr)
 					nd_end = n;
 				}
 			}
+			else {
+				df = lookup(id, GlobalScope, 1);
+				CurrentScope->sc_name = id->id_text;
+			}
 			vis = CurrVis;
 			close_scope(SC_CHKFORW);
 		}
-		df = lookup(id, GlobalScope, 1);
 		if (! df) {
 			df = MkDef(id, GlobalScope, D_ERROR);
 			df->df_type = error_type;

lang/m2/comp/desig.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* D E S I G N A T O R   E V A L U A T I O N */
 
+/* $Header$ */
+
 /*	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"
@@ -43,11 +52,11 @@ properly(ds, size, al)
 	arith wordmodsz = word_size % size;	/* 0 if dividor of wordsize */
 
 	if (szmodword && wordmodsz) return 0;
-	if (al >= word_size) return 1;
+	if (al >= word_align) return 1;
 	if (szmodword && al >= szmodword) return 1;
 
 	return ds->dsg_kind == DSG_FIXED &&
-	       ((! szmodword && ds->dsg_offset % word_size == 0) ||
+	       ((! szmodword && ds->dsg_offset % word_align == 0) ||
 		(! wordmodsz && ds->dsg_offset % size == 0));
 }
 

lang/m2/comp/desig.h

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* 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.

lang/m2/comp/enter.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* H I G H   L E V E L   S Y M B O L   E N T R Y */
 
+/* $Header$ */
+
 #include	"debug.h"
 
 #include	<alloc.h>
@@ -94,12 +103,10 @@ EnterVarList(Idlist, type, local)
 	*/
 	register struct def *df;
 	register struct node *idlist = Idlist;
-	register struct scopelist *sc;
+	register struct scopelist *sc = CurrVis;
 	char buf[256];
 	extern char *sprint();
 
-	sc = CurrVis;
-
 	if (local) {
 		/* Find the closest enclosing open scope. This
 		   is the procedure that we are dealing with
@@ -136,9 +143,15 @@ EnterVarList(Idlist, type, local)
 		else {
 			/* Global name, possibly external
 			*/
-			sprint(buf,"%s_%s", sc->sc_scope->sc_name,
+			if (sc->sc_scope->sc_definedby->df_flags & D_FOREIGN) {
+				df->var_name = df->df_idf->id_text;
+			}
+			else {
+				sprint(buf,"%s_%s", sc->sc_scope->sc_name,
 					    df->df_idf->id_text);
-			df->var_name = Salloc(buf, (unsigned)(strlen(buf)+1));
+				df->var_name = Salloc(buf,
+						(unsigned)(strlen(buf)+1));
+			}
 			df->df_flags |= D_NOREG;
 
  			if (DefinitionModule) {

lang/m2/comp/error.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* E R R O R   A N D   D I A G N O S T I C   R O U T I N E S */
 
+/* $Header$ */
+
 /*	This file contains the (non-portable) error-message and diagnostic
 	giving functions.  Be aware that they are called with a variable
 	number of arguments!

lang/m2/comp/expression.g

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* E X P R E S S I O N S */
 
+/* $Header$ */
+
 {
 #include	"debug.h"
 

lang/m2/comp/f_info.h

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* F I L E   D E S C R I P T O R   S T R U C T U R E */
 
+/* $Header$ */
+
 struct f_info {
 	unsigned short f_lineno;
 	char *f_filename;

lang/m2/comp/idf.c

@@ -1,4 +1,13 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* I N S T A N T I A T I O N   O F   I D F   P A C K A G E */
 
+/* $Header$ */
+
 #include	"idf.h"
 #include	<idf_pkg.body>

lang/m2/comp/idf.h

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* U S E R   D E C L A R E D   P A R T   O F   I D F */
 
+/* $Header$ */
+
 struct id_u {
 	int id_res;
 	struct def *id_df;

lang/m2/comp/input.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* I N S T A N T I A T I O N   O F   I N P U T   P A C K A G E */
 
+/* $Header$ */
+
 #include	"f_info.h"
 struct f_info	file_info;
 #include	"input.h"

lang/m2/comp/input.h

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* I N S T A N T I A T I O N   O F   I N P U T   M O D U L E */
 
+/* $Header$ */
+
 #include	"inputtype.h"
 
 #define INP_NPUSHBACK 2

lang/m2/comp/lookup.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* L O O K U P   R O U T I N E S */
 
+/* $Header$ */
+
 #include	"debug.h"
 
 #include	<em_arith.h>

lang/m2/comp/main.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* M A I N   P R O G R A M */
 
+/* $Header$ */
+
 #include	"debug.h"
 #include	"ndir.h"
 
@@ -19,6 +28,7 @@
 #include	"tokenname.h"
 #include	"node.h"
 #include	"warning.h"
+#include	"SYSTEM.h"
 
 int		state;			/* either IMPLEMENTATION or PROGRAM */
 char		options[128];
@@ -67,8 +77,6 @@ Compile(src, dst)
 	}
 	LineNumber = 1;
 	FileName = src;
-	DEFPATH[0] = ".";
-	DEFPATH[NDIRS] = 0;
 	init_idf();
 	InitCst();
 	reserve(tkidf);
@@ -88,6 +96,7 @@ Compile(src, dst)
 	if (! C_open(dst)) fatal("could not open output file");
 	C_magic();
 	C_ms_emx(word_size, pointer_size);
+	CheckForLineDirective();
 	CompUnit();
 	C_ms_src((arith) (LineNumber - 1), FileName);
 	if (!err_occurred) {
@@ -186,26 +195,19 @@ AddStandards()
 	df->enm_next = 0;
 }
 
-/* How do you like that! Modula-2 in a C-program.
-*/
-char SYSTEM[] = "\
-DEFINITION MODULE SYSTEM;\n\
-TYPE	PROCESS = ADDRESS;\n\
-PROCEDURE NEWPROCESS(P:PROC; A:ADDRESS; n:CARDINAL; VAR p1:ADDRESS);\n\
-PROCEDURE TRANSFER(VAR p1,p2:ADDRESS);\n\
-END SYSTEM.\n";
-
 do_SYSTEM()
 {
 	/*	Simulate the reading of the SYSTEM definition module
 	*/
+	static char systemtext[] = SYSTEMTEXT;
+
 	open_scope(CLOSEDSCOPE);
 	Enter("WORD", D_TYPE, word_type, 0);
 	Enter("BYTE", D_TYPE, byte_type, 0);
 	Enter("ADDRESS", D_TYPE, address_type, 0);
 	Enter("ADR", D_PROCEDURE, std_type, S_ADR);
 	Enter("TSIZE", D_PROCEDURE, std_type, S_TSIZE);
-	if (!InsertText(SYSTEM, sizeof(SYSTEM) - 1)) {
+	if (!InsertText(systemtext, sizeof(systemtext) - 1)) {
 		fatal("could not insert text");
 	}
 	DefModule();

lang/m2/comp/main.h

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* S O M E   G L O B A L   V A R I A B L E S */
 
+/* $Header$ */
+
 extern char options[];	/* indicating which options were given */
 
 extern int DefinitionModule;

lang/m2/comp/misc.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* M I S C E L L A N E O U S    R O U T I N E S */
 
+/* $Header$ */
+
 #include	<alloc.h>
 #include	<em_arith.h>
 #include	<em_label.h>

lang/m2/comp/misc.h

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* M I S C E L L A N E O U S */
 
+/* $Header$ */
+
 #define is_anon_idf(x)		((x)->id_text[0] == '#')
 #define id_not_declared(x)	(not_declared("identifier", (x), ""))
 

lang/m2/comp/node.H

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* N O D E   O F   A N   A B S T R A C T   P A R S E T R E E */
 
+/* $Header$ */
+
 struct node {
 	struct node *next;
 #define nd_left	next

lang/m2/comp/node.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* N O D E   O F   A N   A B S T R A C T   P A R S E T R E E */
 
+/* $Header$ */
+
 #include	"debug.h"
 
 #include	<em_label.h>

lang/m2/comp/options.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* U S E R   O P T I O N - H A N D L I N G */
 
+/* $Header$ */
+
 #include	"idfsize.h"
 #include	"ndir.h"
 
@@ -18,7 +27,7 @@ recognize some keywords!
 #endif
 
 extern int	idfsize;
-static int	ndirs;
+static int	ndirs = 1;
 int		warning_classes;
 
 DoOption(text)
@@ -26,17 +35,16 @@ DoOption(text)
 {
 	switch(*text++)	{
 
-	default:
+	case '-':
-		options[text[-1]]++;	/* flags, debug options etc.	*/
+		options[*text]++;	/* debug options etc.	*/
 		break;
-					/* recognized flags:
-						-L: don't generate fil/lin
-						-p: generate procentry/procexit
-						-w: no warnings
-						-n: no register messages
-					   and many more if DEBUG
-					*/
 
+	case 'L':	/* no fil/lin */
+	case 'p':	/* call procentry/procexit */
+	case 'n':	/* no register messages */
+	case 'x':	/* every name global */
+		options[text[-1]]++;
+		break;
 
 	case 'w':
 		if (*text) {

lang/m2/comp/program.g

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* O V E R A L L   S T R U C T U R E */
 
+/* $Header$ */
+
 {
 #include	"debug.h"
 
@@ -118,14 +127,17 @@ DefinitionModule
 	struct node *exportlist;
 	int dummy;
 	extern struct idf *DefId;
+	extern int ForeignFlag;
 } :
 	DEFINITION
 	MODULE IDENT	{ df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
 			  df->df_flags |= D_BUSY;
+			  if (ForeignFlag) df->df_flags |= D_FOREIGN;
 			  if (!Defined) Defined = df;
+		  	  CurrentScope->sc_definedby = df;
 			  if (df->df_idf != DefId) {
-				error("DEFINITION MODULE name is not \"%s\"",
+				error("DEFINITION MODULE name is \"%s\", not \"%s\"",
-					DefId->id_text);
+					df->df_idf->id_text, DefId->id_text);
 			  }
 			  CurrentScope->sc_name = df->df_idf->id_text;
 			  df->mod_vis = CurrVis;
@@ -207,8 +219,8 @@ ProgramModule
 			open_scope(CLOSEDSCOPE);
 			df->mod_vis = CurrVis;
 			CurrentScope->sc_name = "_M2M";
+		  	CurrentScope->sc_definedby = df;
 		  }
-		  CurrentScope->sc_definedby = df;
 		}
 	priority(df)
 	';' import(0)*

lang/m2/comp/scope.C

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* S C O P E   M E C H A N I S M */
 
+/* $Header$ */
+
 #include	"debug.h"
 
 #include	<assert.h>
@@ -44,6 +53,17 @@ open_scope(scopetype)
 	CurrVis = ls;
 }
 
+struct scope *
+open_and_close_scope(scopetype)
+{
+	struct scope *sc;
+
+	open_scope(scopetype);
+	sc = CurrentScope;
+	close_scope();
+	return sc;
+}
+
 InitScope()
 {
 	register struct scope *sc = new_scope();
@@ -60,25 +80,6 @@ InitScope()
 	CurrVis = ls;
 }
 
-Forward(tk, ptp)
-	struct node *tk;
-	struct type *ptp;
-{
-	/*	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.
-	*/
-	register struct def *df = define(tk->nd_IDF, CurrentScope, D_FORWTYPE);
-
-	if (df->df_kind == D_TYPE) {
-		ptp->next = df->df_type;
-		return;
-	}
-	df->df_forw_type = ptp;
-	df->df_forw_node = tk;
-}
-
 STATIC
 chk_proc(df)
 	register struct def *df;

lang/m2/comp/scope.h

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* S C O P E   M E C H A N I S M */
 
+/* $Header$ */
+
 #define OPENSCOPE	0	/* Indicating an open scope */
 #define CLOSEDSCOPE	1	/* Indicating a closed scope (module) */
 
@@ -40,3 +49,5 @@ extern struct scopelist
 #define enclosing(x)	((x)->sc_encl)
 #define scopeclosed(x)	((x)->sc_scopeclosed)
 #define nextvisible(x)	((x)->next)		/* use with scopelists */
+
+struct scope *open_and_close_scope();

lang/m2/comp/standards.h

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* S T A N D A R D   P R O C E D U R E S   A N D   F U N C T I O N S */
 
+/* $Header$ */
+
 #define S_ABS	1
 #define S_CAP	2
 #define S_CHR	3

lang/m2/comp/statement.g

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* S T A T E M E N T S */
 
+/* $Header$ */
+
 {
 #include	<assert.h>
 #include	<em_arith.h>
@@ -147,7 +156,13 @@ CaseStatement(struct node **pnd;)
 		case(&(nd->nd_right), &tp)
 			{ nd = nd->nd_right; }
 	]*
-	[ ELSE StatementSequence(&(nd->nd_right)) ]?
+	[ ELSE StatementSequence(&(nd->nd_right))
+			{ if (! nd->nd_right) {
+				nd->nd_right = MkLeaf(Stat, &dot);
+				nd->nd_right->nd_symb = ';';
+			  }
+			}
+	]?
 	END
 ;
 

lang/m2/comp/tmpvar.C

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* T E M P O R A R Y   V A R I A B L E S */
 
+/* $Header$ */
+
 /*	Code for the allocation and de-allocation of temporary variables,
 	allowing re-use.
 	The routines use "ProcScope" instead of "CurrentScope", because

lang/m2/comp/tokenname.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* T O K E N   D E F I N I T I O N S */
 
+/* $Header$ */
+
 #include	"tokenname.h"
 #include	"Lpars.h"
 #include	"idf.h"

lang/m2/comp/tokenname.h

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* T O K E N N A M E   S T R U C T U R E */
 
+/* $Header$ */
+
 struct tokenname	{	/*	Used for defining the name of a
 					token as identified by its symbol
 				*/

lang/m2/comp/type.H

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* T Y P E   D E S C R I P T O R   S T R U C T U R E */
 
+/* $Header$ */
+
 struct paramlist {		/* structure for parameterlist of a PROCEDURE */
 	struct paramlist *next;
 	struct def *par_def;	/* "df" of parameter */
@@ -131,6 +140,8 @@ struct type
 	*set_type(),
 	*subr_type(),
 	*proc_type(),
+	*enum_type(),
+	*qualified_type(),
 	*RemoveEqual();	/* All from type.c */
 
 #define NULLTYPE ((struct type *) 0)

lang/m2/comp/type.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /*	T Y P E   D E F I N I T I O N   M E C H A N I S M	 */
 
+/* $Header$ */
+
 #include	"target_sizes.h"
 #include	"debug.h"
 #include	"maxset.h"
@@ -18,6 +27,7 @@
 #include	"const.h"
 #include	"scope.h"
 #include	"walk.h"
+#include	"chk_expr.h"
 
 int
 	word_align = AL_WORD,
@@ -100,9 +110,10 @@ align(pos, al)
 	arith pos;
 	int al;
 {
-	arith i;
+	arith i = pos % al;
 
-	return pos + ((i = pos % al) ? al - i : 0);
+	if (i) return pos + al - i;
+	return pos;
 }
 
 struct type *
@@ -113,8 +124,10 @@ standard_type(fund, align, size)
 {
 	register struct type *tp = new_type();
 
+	if (align == 0) align = 1;
+
 	tp->tp_fund = fund;
-	tp->tp_align = align ? align : 1;
+	tp->tp_align = align;
 	tp->tp_size = size;
 
 	return tp;
@@ -192,6 +205,59 @@ InitTypes()
 	error_type = standard_type(T_CHAR, 1, (arith) 1);
 }
 
+STATIC
+u_small(tp, n)
+	register struct type *tp;
+	arith n;
+{
+	if (ufit(n, 1)) {
+		tp->tp_size = 1;
+		tp->tp_align = 1;
+	}
+	else if (ufit(n, short_size)) {
+		tp->tp_size = short_size;
+		tp->tp_align = short_align;
+	}
+}
+
+struct type *
+enum_type(EnumList)
+	struct node *EnumList;
+{
+	register struct type *tp =
+		standard_type(T_ENUMERATION, int_align, int_size);
+
+	EnterEnumList(EnumList, tp);
+	u_small(tp, (arith) (tp->enm_ncst-1));
+	return tp;
+}
+
+struct type *
+qualified_type(nd)
+	struct node *nd;
+{
+	struct type *tp = error_type;
+
+	if (ChkDesignator(nd)) {
+		if (nd->nd_class != Def) node_error(nd, "type expected");
+		else {
+			register struct def *df = nd->nd_def;
+
+			if (df->df_kind&(D_ISTYPE|D_FORWARD|D_ERROR)) {
+			    if (! df->df_type) {
+node_error(nd,"type \"%s\" not (yet) declared", df->df_idf->id_text);
+			    }
+			    else tp = df->df_type;
+			}
+			else {
+node_error(nd,"identifier \"%s\" is not a type", df->df_idf->id_text);
+			}
+		}
+	}
+	FreeNode(nd);
+	return tp;
+}
+
 chk_basesubrange(tp, base)
 	register struct type *tp, *base;
 {
@@ -275,14 +341,7 @@ subr_type(lb, ub)
 	res->tp_size = tp->tp_size;
 	res->tp_align = tp->tp_align;
 	if (tp == card_type) {
-		if (ufit(res->sub_ub, 1)) {
+		u_small(res, res->sub_ub);
-			res->tp_size = 1;
-			res->tp_align = 1;
-		}
-		else if (ufit(res->sub_ub, 2)) {
-			res->tp_size = short_size;
-			res->tp_align = short_align;
-		}
 	}
 	else if (tp == int_type) {
 		if (fit(res->sub_lb, 1) && fit(res->sub_ub, 1)) {
@@ -505,6 +564,54 @@ RemoveEqual(tpx)
 	return tpx;
 }
 
+int
+type_or_forward(ptp)
+	struct type **ptp;
+{
+	struct node *nd = 0;
+
+	*ptp = construct_type(T_POINTER, NULLTYPE);
+	if (lookup(dot.TOK_IDF, CurrentScope, 1)
+		/* Either a Module or a Type, but in both cases defined
+		   in this scope, so this is the correct identification
+		*/
+	    ||
+	    ( nd = new_node(),
+	      nd->nd_token = dot,
+	      lookfor(nd, CurrVis, 0)->df_kind == D_MODULE
+	    )
+		/* A Modulename in one of the enclosing scopes.
+		   It is not clear from the language definition that
+		   it is correct to handle these like this, but
+		   existing compilers do it like this, and the
+		   alternative is difficult with a lookahead of only
+		   one token.
+		   ???
+		*/
+	   ) {
+		if (nd) free_node(nd);
+		return 1;
+	}
+	/*	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.
+	*/
+	{
+		register struct def *df =
+			define(nd->nd_IDF, CurrentScope, D_FORWTYPE);
+
+		if (df->df_kind == D_TYPE) {
+			(*ptp)->next = df->df_type;
+		}
+		else {
+			df->df_forw_type = *ptp;
+			df->df_forw_node = nd;
+		}
+	}
+	return 0;
+}
+
 int
 gcd(m, n)
 	register int m, n;

lang/m2/comp/typequiv.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* T Y P E   E Q U I V A L E N C E */
 
+/* $Header$ */
+
 /*	Routines for testing type equivalence, type compatibility, and
 	assignment compatibility
 */

lang/m2/comp/walk.c

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* P A R S E   T R E E   W A L K E R */
 
+/* $Header$ */
+
 /*	Routines to walk through parts of the parse tree, and generate
 	code for these parts.
 */
@@ -42,6 +51,9 @@ static struct node	*priority;
 STATIC
 DoPriority()
 {
+	/*	For the time being (???), handle priorities by calls to
+		the runtime system
+	*/
 	if (priority) {
 		C_loc(priority->nd_INT);
 		C_cal("_stackprio");
@@ -111,10 +123,11 @@ WalkModule(module)
 		register struct node *nd = Modules;
 
 		if (state == IMPLEMENTATION) {
-			label l1 = ++data_label;
+			/* We don't actually prevent recursive calls,
-			/* we don't actually prevent recursive calls,
 			   but do nothing if called recursively
 			*/
+			label l1 = ++data_label;
+
 			C_df_dlb(l1);
 			C_bss_cst(word_size, (arith) 0, 1);
 			/* if this one is set to non-zero, the initialization
@@ -422,6 +435,9 @@ WalkStat(nd, exit_label)
 
 	if (! options['L']) C_lin((arith) nd->nd_lineno);
 	switch(nd->nd_symb) {
+	case ';':
+		break;
+
 	case BECOMES:
 		DoAssign(nd, left, right);
 		break;

lang/m2/comp/walk.h

@@ -1,5 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
 /* P A R S E   T R E E   W A L K E R */
 
+/* $Header$ */
+
 /*	Definition of WalkNode macro
 */
 

lang/m2/comp/warning.h

@@ -1,3 +1,14 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
+/* W A R N I N G   C L A S S E S */
+
+/* $Header$ */
+
 /* Warning classes, at the moment three of them:
    Strict (R)
    Ordinary (W)