Initial revision

lang/m2/m2mm/LLlex.c

@@ -0,0 +1,445 @@
+/*
+ * (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	<alloc.h>
+#include	"idfsize.h"
+#include	"idf.h"
+#include	"LLlex.h"
+#include	"input.h"
+#include	"f_info.h"
+#include	"Lpars.h"
+#include	"class.h"
+
+struct token	dot,
+		aside;
+int		idfsize = IDFSIZE;
+int		ForeignFlag;
+
+static int	eofseen;
+extern char	options[];
+
+STATIC
+SkipComment()
+{
+	/*	Skip Modula-2 comments (* ... *).
+		Note that comments may be nested (par. 3.5).
+	*/
+	register int ch;
+	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, check that the object file is present
+			   and don't generate a rule for it.
+			*/
+			ForeignFlag = 1;
+			break;
+		default:
+			PushBack();
+			break;
+		}
+	}
+	for (;;) {
+		if (class(ch) == STNL) {
+			LineNumber++;
+		}
+		else if (ch == '(') {
+			LoadChar(ch);
+			if (ch == '*') CommentLevel++;
+			else continue;
+		}
+		else if (ch == '*') {
+			LoadChar(ch);
+			if (ch == ')') {
+				CommentLevel--;
+				if (CommentLevel < 0) break;
+			}
+			else continue;
+		}
+		else if (ch == EOI) {
+			lexerror("unterminated comment");
+			break;
+		}
+		LoadChar(ch);
+	}
+}
+
+STATIC
+GetString(upto)
+{
+	/*	Read a Modula-2 string, delimited by the character "upto".
+	*/
+	register int ch;
+	register char *p;
+	
+	while (LoadChar(ch), ch != upto)	{
+		if (class(ch) == STNL)	{
+			lexerror("newline in string");
+			LineNumber++;
+			break;
+		}
+		if (ch == EOI)	{
+			lexerror("end-of-file in string");
+			break;
+		}
+	}
+}
+
+static char *s_error = "illegal line directive";
+
+STATIC int
+getch()
+{
+	register int ch;
+
+	for (;;) {
+		LoadChar(ch);
+		if ((ch & 0200) && ch != EOI) {
+			error("non-ascii '\\%03o' read", ch & 0377);
+			continue;
+		}
+		break;
+	}
+	if (ch == EOI) {
+		eofseen = 1;
+		return '\n';
+	}
+	return 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
+		 */
+		ch = getch();
+		if (class(ch) == STNL) {
+			LineNumber++;
+			error(s_error);
+			return;
+		}
+	} while (class(ch) != STNUM);
+	while (class(ch) == STNUM)  {
+		i = i*10 + (ch - '0');
+		ch = getch();
+	}
+	while (ch != '"' && class(ch) != STNL) ch = getch();
+	if (ch == '"') {
+		c = buf;
+		do {
+			*c++ = ch = getch();
+			if (class(ch) == STNL) {
+				LineNumber++;
+				error(s_error);
+				return;
+			}
+		} while (ch != '"');
+		*--c = '\0';
+		do {
+			ch = getch();
+		} while (class(ch) != STNL);
+		/*
+		 * Remember the file name
+		 */
+		if (!eofseen && strcmp(FileName,buf)) {
+			FileName = Salloc(buf,(unsigned) strlen(buf) + 1);
+		}
+	}
+	if (eofseen) {
+		error(s_error);
+		return;
+	}
+	LineNumber = i;
+}
+
+char idfbuf[IDFSIZE + 2];
+
+int
+LLlex()
+{
+	/*	LLlex() is the Lexical Analyzer.
+		The putting aside of tokens is taken into account.
+	*/
+	register struct token *tk = &dot;
+	register int ch, nch;
+
+	if (ASIDE)	{	/* a token is put aside		*/
+		*tk = aside;
+		ASIDE = 0;
+		return tk->tk_symb;
+	}
+
+again1:
+	if (eofseen) {
+		eofseen = 0;
+		ch = EOI;
+	}
+	else {
+again:
+		LoadChar(ch);
+		if ((ch & 0200) && ch != EOI) {
+			error("non-ascii '\\%03o' read", ch & 0377);
+			goto again;
+		}
+	}
+
+	tk->tk_lineno = LineNumber;
+
+	switch (class(ch))	{
+
+	case STNL:
+		LineNumber++;
+		CheckForLineDirective();
+		goto again1;
+
+	case STSKIP:
+		goto again;
+
+	case STGARB:
+		if ((unsigned) ch - 040 < 0137)	{
+			lexerror("garbage char %c", ch);
+		}
+		else	lexerror("garbage char \\%03o", ch);
+		goto again;
+
+	case STSIMP:
+		if (ch == '(')	{
+			LoadChar(nch);
+			if (nch == '*')	{
+				SkipComment();
+				goto again;
+			}
+			else if (nch == EOI) eofseen = 1;
+			else PushBack();
+		}
+		if (ch == '&') return tk->tk_symb = AND;
+		if (ch == '~') return tk->tk_symb = NOT;
+		return tk->tk_symb = ch;
+
+	case STCOMP:
+		LoadChar(nch);
+		switch (ch)	{
+
+		case '.':
+			if (nch == '.')	{
+				return tk->tk_symb = UPTO;
+			}
+			break;
+
+		case ':':
+			if (nch == '=')	{
+				return tk->tk_symb = BECOMES;
+			}
+			break;
+
+		case '<':
+			if (nch == '=')	{
+				return tk->tk_symb = LESSEQUAL;
+			}
+			if (nch == '>') {
+				return tk->tk_symb = '#';
+			}
+			break;
+
+		case '>':
+			if (nch == '=')	{
+				return tk->tk_symb = GREATEREQUAL;
+			}
+			break;
+
+		default :
+			crash("(LLlex, STCOMP)");
+		}
+		if (nch == EOI) eofseen = 1;
+		else PushBack();
+		return tk->tk_symb = ch;
+
+	case STIDF:
+	{
+		register char *tag = &idfbuf[0];
+		register struct idf *id;
+
+		do	{
+			if (tag - idfbuf < idfsize) *tag++ = ch;
+			LoadChar(ch);
+		} while(in_idf(ch));
+
+		if (ch == EOI) eofseen = 1;
+		else PushBack();
+		*tag++ = '\0';
+
+		tk->TOK_IDF = id = findidf(idfbuf);
+		return tk->tk_symb = id && id->id_reserved ? id->id_reserved : IDENT;
+	}
+
+	case STSTR:
+		GetString(ch);
+		return tk->tk_symb = STRING;
+
+	case STNUM:
+	{
+		/*	The problem arising with the "parsing" of a number
+			is that we don't know the base in advance so we
+			have to read the number with the help of a rather
+			complex finite automaton.
+		*/
+		enum statetp {Oct,OptHex,Hex,Dec,OctEndOrHex,End,OptReal,Real};
+		register enum statetp state;
+		state = is_oct(ch) ? Oct : Dec;
+		LoadChar(ch);
+		for (;;) {
+			switch(state) {
+			case Oct:
+				while (is_oct(ch))	{
+					LoadChar(ch);
+				}
+				if (ch == 'B' || ch == 'C') {
+					state = OctEndOrHex;
+					break;
+				}
+				/* Fall Through */
+			case Dec:
+				while (is_dig(ch))	{
+					LoadChar(ch);
+				}
+				if (ch == 'D') state = OptHex;
+				else if (is_hex(ch)) state = Hex;
+				else if (ch == '.') state = OptReal;
+				else {
+					state = End;
+					if (ch == 'H') ;
+					else if (ch == EOI) eofseen = 1;
+					else PushBack();
+				}
+				break;
+
+			case OptHex:
+				LoadChar(ch);
+				if (is_hex(ch)) {
+					state = Hex;
+				}
+				else	state = End;
+				break;
+
+			case Hex:
+				while (is_hex(ch))	{
+					LoadChar(ch);
+				}
+				state = End;
+				if (ch != 'H') {
+					lexerror("H expected after hex number");
+					if (ch == EOI) eofseen = 1;
+					else PushBack();
+				}
+				break;
+
+			case OctEndOrHex:
+				LoadChar(ch);
+				if (ch == 'H') {
+					state = End;
+					break;
+				}
+				if (is_hex(ch)) {
+					state = Hex;
+					break;
+				}
+				if (ch == EOI) eofseen = 1;
+				else PushBack();
+				/* Fall through */
+				
+			case End:
+				return tk->tk_symb = INTEGER;
+
+			case OptReal:
+				/*	The '.' could be the first of the '..'
+					token. At this point, we need a
+					look-ahead of two characters.
+				*/
+				LoadChar(ch);
+				if (ch == '.') {
+					/*	Indeed the '..' token
+					*/
+					PushBack();
+					PushBack();
+					state = End;
+					break;
+				}
+				state = Real;
+				break;
+			}
+			if (state == Real) break;
+		}
+
+		while (is_dig(ch)) {
+			/* 	Fractional part
+			*/
+			LoadChar(ch);
+		}
+
+		if (ch == 'E' || ch == 'D') {
+			/*	Scale factor
+			*/
+			if (ch == 'D') {
+				LoadChar(ch);
+				if (!(ch == '+' || ch == '-' || is_dig(ch)))
+					goto noscale;
+			}
+			LoadChar(ch);
+			if (ch == '+' || ch == '-') {
+				/*	Signed scalefactor
+				*/
+				LoadChar(ch);
+			}
+			if (is_dig(ch)) {
+				do {
+					LoadChar(ch);
+				} while (is_dig(ch));
+			}
+			else {
+				lexerror("bad scale factor");
+			}
+		}
+
+noscale:
+		if (ch == EOI) eofseen = 1;
+		else PushBack();
+
+		return tk->tk_symb = REAL;
+
+		/*NOTREACHED*/
+	}
+
+	case STEOI:
+		return tk->tk_symb = -1;
+
+	case STCHAR:
+	default:
+		crash("(LLlex) Impossible character class");
+		/*NOTREACHED*/
+	}
+	/*NOTREACHED*/
+}

lang/m2/m2mm/LLlex.h

@@ -0,0 +1,28 @@
+/*
+ * (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 */
+
+/* stripped down version of the one in the Modula-2 compiler */
+
+/* $Header$ */
+
+/* Token structure. Keep it small, as it is part of a parse-tree node
+*/
+struct token	{
+	short tk_symb;			/* token itself	*/
+	unsigned short tk_lineno;	/* linenumber on which it occurred */
+	struct idf *tk_idf;		/* IDENT	*/
+};
+
+#define TOK_IDF	tk_idf
+
+extern struct token	dot, aside;
+extern int		ForeignFlag;
+
+#define DOT	dot.tk_symb
+#define ASIDE	aside.tk_symb

lang/m2/m2mm/LLmessage.c

@@ -0,0 +1,52 @@
+/*
+ * (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 */
+
+/* stripped down version from the one in the Modula-2 compiler */
+
+/* $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
+	insert tokens in the token stream.
+*/
+
+#include	"idf.h"
+#include	"LLlex.h"
+#include	"Lpars.h"
+
+extern char		*symbol2str();
+extern struct idf	*gen_anon_idf();
+
+LLmessage(tk)
+	register int tk;
+{
+	if (tk > 0)	{
+		/* if (tk > 0), it represents the token to be inserted.
+		*/
+		register struct token *dotp = ˙
+
+		error("%s missing", symbol2str(tk));
+
+		aside = *dotp;
+
+		dotp->tk_symb = tk;
+
+		switch (tk)	{
+		/* The operands need some body */
+		case IDENT:
+			dotp->TOK_IDF = gen_anon_idf();
+			break;
+		}
+	}
+	else if (tk  < 0) {
+		error("garbage at end of program");
+	}
+	else	error("%s deleted", symbol2str(dot.tk_symb));
+}

lang/m2/m2mm/Makefile

@@ -0,0 +1,147 @@
+#
+EMHOME =	../../..
+MHDIR =		$(EMHOME)/modules/h
+PKGDIR =	$(EMHOME)/modules/pkg
+LIBDIR =	$(EMHOME)/modules/lib
+LLGEN =		$(EMHOME)/bin/LLgen
+MKDEP =		$(EMHOME)/bin/mkdep
+
+INCLUDES = -I$(MHDIR) -I$(PKGDIR) -I$(EMHOME)/h
+
+GF =	program.g declar.g expression.g statement.g
+GENGFILES=	tokenfile.g
+GFILES =$(GENGFILES) $(GF)
+LLGENOPTIONS = -v
+PROFILE =
+CFLAGS = $(PROFILE) $(INCLUDES) -DSTATIC=
+LINTFLAGS = -DSTATIC= -DNORCSID
+MALLOC = $(LIBDIR)/malloc.o
+LDFLAGS = -i $(PROFILE)
+LSRC =	tokenfile.c program.c declar.c expression.c statement.c
+LOBJ =	tokenfile.o program.o declar.o expression.o statement.o
+CSRC =	LLlex.c LLmessage.c error.c main.c lib.c \
+	tokenname.c idf.c input.c misc.c options.c
+COBJ =	LLlex.o LLmessage.o error.o main.o lib.o \
+	tokenname.o idf.o input.o misc.o options.o char.o symbol2str.o
+GENC=	$(LSRC) symbol2str.c char.c Lpars.c
+SRC =	$(CSRC) $(GENC)
+OBJ =	$(COBJ) $(LOBJ) Lpars.o
+GENH =	Lpars.h
+HSRC =	main.h LLlex.h class.h f_info.h idf.h input.h tokenname.h
+HFILES =$(GENH) $(HSRC)
+#
+GENFILES = $(GENGFILES) $(GENC) $(GENH)
+
+all:	Cfiles
+	make "EMHOME="$(EMHOME) m2mm
+
+install:	all
+	cp m2mm $(EMHOME)/bin
+
+cmp:	all
+	cmp m2mm $(EMHOME)/bin/m2mm
+
+opr:
+	make "EMHOME="$(EMHOME) pr | opr
+
+pr:
+	@pr Makefile $(GF) $(HFILES) $(CSRC)
+
+clean:
+	rm -f $(OBJ) $(GENFILES) LLfiles Cfiles tab LL.output
+
+lint:	Cfiles
+	lint $(INCLUDES) $(LINTFLAGS) $(SRC) \
+		$(LIBDIR)/llib-linput.ln \
+		$(LIBDIR)/llib-lalloc.ln \
+		$(LIBDIR)/llib-lprint.ln \
+		$(LIBDIR)/llib-lstring.ln \
+		$(LIBDIR)/llib-lsystem.ln
+
+# entry points not to be used directly
+Cfiles:	LLfiles $(GENC) $(GENH) Makefile
+
+LLfiles:	$(GFILES)
+	$(LLGEN) $(LLGENOPTIONS) $(GFILES)
+	@touch LLfiles
+
+tokenfile.g:	tokenname.c make.tokfile
+	make.tokfile <tokenname.c >tokenfile.g
+
+symbol2str.c:	tokenname.c make.tokcase
+	make.tokcase <tokenname.c >symbol2str.c
+
+char.c: char.tab tab
+	tab -fchar.tab >char.c
+
+tab: 
+	$(CC) tab.c -o tab
+
+depend:	Cfiles
+	sed '/^#AUTOAUTO/,$$d' Makefile > Makefile.new
+	echo '#AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO' >> Makefile.new
+	$(MKDEP) $(SRC) |\
+		sed 's/\.c:/\.o:/' >> Makefile.new
+	mv Makefile Makefile.old
+	mv Makefile.new Makefile
+
+m2mm:	$(OBJ)
+	$(CC) $(LDFLAGS) $(OBJ) $(LIBDIR)/libinput.a $(LIBDIR)/liballoc.a $(MALLOC) $(LIBDIR)/libprint.a $(LIBDIR)/libstring.a $(LIBDIR)/libsystem.a -o m2mm
+	size m2mm
+
+#AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
+LLlex.o: LLlex.h
+LLlex.o: Lpars.h
+LLlex.o: class.h
+LLlex.o: f_info.h
+LLlex.o: file_list.h
+LLlex.o: idf.h
+LLlex.o: idfsize.h
+LLlex.o: input.h
+LLlex.o: inputtype.h
+LLmessage.o: LLlex.h
+LLmessage.o: Lpars.h
+LLmessage.o: file_list.h
+LLmessage.o: idf.h
+error.o: LLlex.h
+error.o: f_info.h
+error.o: input.h
+error.o: inputtype.h
+main.o: LLlex.h
+main.o: Lpars.h
+main.o: f_info.h
+main.o: file_list.h
+main.o: idf.h
+main.o: input.h
+main.o: inputtype.h
+main.o: tokenname.h
+tokenname.o: Lpars.h
+tokenname.o: file_list.h
+tokenname.o: idf.h
+tokenname.o: tokenname.h
+idf.o: file_list.h
+idf.o: idf.h
+input.o: f_info.h
+input.o: input.h
+input.o: inputtype.h
+misc.o: LLlex.h
+misc.o: f_info.h
+misc.o: file_list.h
+misc.o: idf.h
+options.o: main.h
+tokenfile.o: Lpars.h
+program.o: LLlex.h
+program.o: Lpars.h
+program.o: f_info.h
+program.o: file_list.h
+program.o: idf.h
+program.o: main.h
+declar.o: Lpars.h
+expression.o: Lpars.h
+statement.o: LLlex.h
+statement.o: Lpars.h
+statement.o: file_list.h
+statement.o: idf.h
+symbol2str.o: Lpars.h
+char.o: class.h
+Lpars.o: Lpars.h

lang/m2/m2mm/char.tab

@@ -0,0 +1,54 @@
+% character tables for mod2 compiler
+% $Header$
+%S129
+%F	%s,
+%
+%	CHARACTER CLASSES
+%
+%C
+STGARB:\000-\200
+STSKIP: \r\t
+STNL:\012\013\014
+STSIMP:#&()*+,-/;=[]^{|}~
+STCOMP:.:<>
+STIDF:a-zA-Z
+STSTR:"'
+STNUM:0-9
+STEOI:\200
+%T#include "class.h"
+%Tchar tkclass[] = {
+%p
+%T};
+%
+%	INIDF
+%
+%C
+1:a-zA-Z0-9
+%Tchar inidf[] = {
+%F	%s,
+%p
+%T};
+%
+%	ISDIG
+%
+%C
+1:0-9
+%Tchar isdig[] = {
+%p
+%T};
+%
+%	ISHEX
+%
+%C
+1:a-fA-F
+%Tchar ishex[] = {
+%p
+%T};
+%
+%	ISOCT
+%
+%C
+1:0-7
+%Tchar isoct[] = {
+%p
+%T};

lang/m2/m2mm/class.h

@@ -0,0 +1,45 @@
+/*
+ * (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.
+*/
+
+#define	class(ch)	(tkclass[ch])
+
+/*	Being the start of a token is, fortunately, a mutual exclusive
+	property, so, as there are less than 16 classes they can be
+	packed in 4 bits.
+*/
+
+#define	STSKIP	0	/* spaces and so on: skipped characters		*/
+#define	STNL	1	/* newline character(s): update linenumber etc.	*/
+#define	STGARB	2	/* garbage ascii character: not allowed		*/
+#define	STSIMP	3	/* this character can occur as token		*/
+#define	STCOMP	4	/* this one can start a compound token		*/
+#define	STIDF	5	/* being the initial character of an identifier	*/
+#define	STCHAR	6	/* the starter of a character constant		*/
+#define	STSTR	7	/* the starter of a string			*/
+#define	STNUM	8	/* the starter of a numeric constant		*/
+#define	STEOI	9	/* End-Of-Information mark			*/
+
+/*	But occurring inside a token is not, so we need 1 bit for each
+	class.  This is implemented as a collection of tables to speed up
+	the decision whether a character has a special meaning.
+*/
+#define	in_idf(ch)	((unsigned)ch < 0177 && inidf[ch])
+#define	is_oct(ch)	((unsigned)ch < 0177 && isoct[ch])
+#define	is_dig(ch)	((unsigned)ch < 0177 && isdig[ch])
+#define	is_hex(ch)	((unsigned)ch < 0177 && ishex[ch])
+
+extern char tkclass[];
+extern char inidf[], isoct[], isdig[], ishex[];

lang/m2/m2mm/declar.g

@@ -0,0 +1,266 @@
+/*
+ * (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 */
+
+/* stripped down version of the one in the Modula-2 compiler */
+
+/* $Header$ */
+
+ProcedureHeading :
+	PROCEDURE IDENT
+	[
+		'('
+		[
+			FPSection
+			[
+				';' FPSection
+			]*
+		]?
+		')'
+		[	':' qualtype
+		]?
+	]?
+;
+
+block :
+	[	%persistent
+		declaration
+	]*
+	[	%default
+		BEGIN
+		StatementSequence
+	|
+	]
+	END
+;
+
+declaration :
+	CONST [ ConstantDeclaration ';' ]*
+|
+	TYPE [ TypeDeclaration ';' ]*
+|
+	VAR [ VariableDeclaration ';' ]*
+|
+	ProcedureHeading ';'
+	block
+	IDENT
+	';'
+|
+	ModuleDeclaration ';'
+;
+
+FPSection :
+	var IdentList ':' FormalType
+;
+
+FormalType :
+	ARRAY OF qualtype
+|
+	 qualtype
+;
+
+TypeDeclaration :
+	IDENT
+	'=' type
+;
+
+type :
+	%default SimpleType
+|
+	ArrayType
+|
+	RecordType
+|
+	SetType
+|
+	PointerType
+|
+	ProcedureType
+;
+
+SimpleType :
+	qualtype
+	[
+		/* nothing */
+	|
+		SubrangeType
+		/* The subrange type is given a base type by the
+		   qualident (this is new modula-2).
+		*/
+	]
+|
+	enumeration
+|
+	SubrangeType
+;
+
+enumeration :
+	'(' IdentList ')'
+;
+
+IdentList :
+	IDENT
+	[ %persistent
+		',' IDENT
+	]*
+;
+
+SubrangeType :
+	/*
+	   This is not exactly the rule in the new report, but see
+	   the rule for "SimpleType".
+	*/
+	'[' ConstExpression
+	UPTO ConstExpression
+	']'
+;
+
+ArrayType :
+	ARRAY SimpleType
+	[
+		',' SimpleType
+	]* OF type
+;
+
+RecordType :
+	RECORD
+	FieldListSequence
+	END
+;
+
+FieldListSequence :
+	FieldList
+	[
+		';' FieldList
+	]*
+;
+
+FieldList :
+[
+	IdentList ':' type
+|
+	CASE
+	/* Also accept old fashioned Modula-2 syntax, but give a warning.
+	   Sorry for the complicated code.
+	*/
+	[ qualident
+	  [ ':' qualtype
+			/* This is correct, in both kinds of Modula-2, if
+		   	   the first qualident is a single identifier.
+			*/
+	  |		/* Old fashioned! the first qualident now represents
+			   the type
+			*/
+	  ]
+	| ':' qualtype
+	  /* Aha, third edition. Well done! */
+	]
+	OF variant
+	[
+	  '|' variant
+	]*
+	[ ELSE FieldListSequence
+	]?
+	END
+]?
+;
+
+variant :
+	[
+		CaseLabelList
+		':' FieldListSequence
+	]?
+			/* Changed rule in new modula-2 */
+;
+
+CaseLabelList :
+	CaseLabels
+	[	
+		',' CaseLabels
+	]*
+;
+
+CaseLabels :
+	ConstExpression
+	[
+		UPTO
+		ConstExpression
+	]?
+;
+
+SetType :
+	SET OF SimpleType
+;
+
+/*	In a pointer type definition, the type pointed at does not
+	have to be declared yet, so be careful about identifying
+	type-identifiers
+*/
+PointerType :
+	POINTER TO type
+;
+
+qualtype :
+	qualident
+;
+
+ProcedureType :
+	PROCEDURE 
+	[
+	  	FormalTypeList
+	|
+	]
+;
+
+FormalTypeList :
+	'('
+	[
+		VarFormalType
+		[
+			',' VarFormalType
+		]*
+	]?
+	')'
+	[ ':' qualtype
+	|
+	]
+;
+
+VarFormalType :
+	var
+	FormalType
+;
+
+var :
+	[
+		VAR
+	|
+		/* empty */
+	]
+;
+
+ConstantDeclaration :
+	IDENT
+	'=' ConstExpression
+;
+
+VariableDeclaration :
+	IdentAddr
+	[ %persistent
+		',' IdentAddr
+	]*
+	':' type
+;
+
+IdentAddr :
+	IDENT
+	[	'['
+		ConstExpression
+		']'
+	]?
+;

lang/m2/m2mm/error.c

@@ -0,0 +1,146 @@
+/*
+ * (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 */
+
+/* stripped down version from the one in the Modula-2 compiler */
+/* $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!
+*/
+
+#include	<system.h>
+#include	"input.h"
+#include	"f_info.h"
+#include	"LLlex.h"
+
+/* error classes */
+#define	ERROR		1
+#define	LEXERROR	3
+#define	CRASH		5
+#define	FATAL		6
+
+int err_occurred;
+
+extern char *symbol2str();
+
+/*	There are three general error-message functions:
+		lexerror()	lexical and pre-processor error messages
+		error()		syntactic and semantic error messages
+		node_error()	errors in nodes
+	The difference lies in the place where the file name and line
+	number come from.
+	Lexical errors report from the global variables LineNumber and
+	FileName, node errors get their information from the
+	node, whereas other errors use the information in the token.
+*/
+
+/*VARARGS1*/
+error(fmt, args)
+	char *fmt;
+{
+	_error(ERROR, fmt, &args);
+}
+
+/*VARARGS1*/
+Gerror(fmt, args)
+	char *fmt;
+{
+	char *fn = FileName;
+
+	FileName = 0;
+	_error(ERROR, fmt, &args);
+	FileName = fn;
+}
+
+/*VARARGS1*/
+lexerror(fmt, args)
+	char *fmt;
+{
+	_error(LEXERROR, fmt, &args);
+}
+
+/*VARARGS1*/
+fatal(fmt, args)
+	char *fmt;
+	int args;
+{
+
+	_error(FATAL, fmt, &args);
+	sys_stop(S_EXIT);
+}
+
+/*VARARGS1*/
+crash(fmt, args)
+	char *fmt;
+	int args;
+{
+
+	_error(CRASH, fmt, &args);
+#ifdef DEBUG
+	sys_stop(S_ABORT);
+#else
+	sys_stop(S_EXIT);
+#endif
+}
+
+_error(class, fmt, argv)
+	int class;
+	char *fmt;
+	int argv[];
+{
+	/*	_error attempts to limit the number of error messages
+		for a given line to MAXERR_LINE.
+	*/
+	unsigned int ln = 0;
+	register char *remark = 0;
+	
+	/*	Since name and number are gathered from different places
+		depending on the class, we first collect the relevant
+		values and then decide what to print.
+	*/
+	/* preliminaries */
+	switch (class)	{
+	case ERROR:
+	case LEXERROR:
+	case CRASH:
+	case FATAL:
+		err_occurred = 1;
+		break;
+	}
+
+	/* the remark */
+	switch (class)	{	
+	case CRASH:
+		remark = "CRASH\007";
+		break;
+	case FATAL:
+		remark = "fatal error --";
+		break;
+	}
+	
+	/* the place */
+	switch (class)	{	
+	case ERROR:
+		ln = dot.tk_lineno;
+		break;
+	case LEXERROR:
+	case CRASH:
+	case FATAL:
+		ln = LineNumber;
+		break;
+	}
+	
+	if (FileName) fprint(STDERR, "\"%s\", line %u: ", FileName, ln);
+
+	if (remark) fprint(STDERR, "%s ", remark);
+
+	doprnt(STDERR, fmt, argv);		/* contents of error */
+	fprint(STDERR, "\n");
+}

lang/m2/m2mm/expression.g

@@ -0,0 +1,146 @@
+/*
+ * (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 */
+
+/* stripped down version of the one in the Modula-2 compiler */
+
+/* $Header$ */
+
+qualident :
+	IDENT
+	[
+		selector
+	]*
+;
+
+selector :
+	'.' IDENT
+;
+
+ExpList :
+	expression
+	[
+		','
+		expression
+	]*
+;
+
+ConstExpression :
+	expression
+	/*
+	 * Changed rule in new Modula-2.
+	 */
+;
+
+expression :
+	SimpleExpression
+	[
+		/* relation */
+		[ '=' | '#' | '<' | LESSEQUAL | '>' | GREATEREQUAL | IN ]
+		SimpleExpression
+	]?
+;
+
+SimpleExpression :
+	[
+		[ '+' | '-' ]
+	]?
+	term
+	[
+		/* AddOperator */
+		[ '+' | '-' | OR ]
+		term
+	]*
+;
+
+term :
+	factor
+	[
+		/* MulOperator */
+		[ '*' | '/' | DIV | MOD | AND ]
+		factor
+	]*
+;
+
+factor :
+	qualident
+	[
+		designator_tail?
+		[
+			ActualParameters
+		]?
+	|
+		bare_set
+	]
+|
+	bare_set
+| %default
+	[
+		%default
+		INTEGER
+	|
+		REAL
+	|
+		STRING
+	]
+|
+	'(' expression ')'
+|
+	NOT factor
+;
+
+bare_set :
+	'{'
+	[
+		element
+		[
+			',' element
+		]*
+	]?
+	'}'
+;
+
+ActualParameters :
+	'(' ExpList? ')'
+;
+
+element :
+	expression
+	[
+		UPTO
+		expression
+	]?
+;
+
+designator :
+	qualident
+	designator_tail?
+;
+
+designator_tail :
+	visible_designator_tail
+	[ %persistent
+		%default
+		selector
+	|
+		visible_designator_tail
+	]*
+;
+
+visible_designator_tail :
+[
+	'['
+		expression
+		[
+			',' expression
+		]*
+	']'
+|
+	'^'
+]
+;

lang/m2/m2mm/f_info.h

@@ -0,0 +1,21 @@
+/*
+ * (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;
+	char *f_workingdir;
+};
+
+extern struct f_info file_info;
+#define LineNumber file_info.f_lineno
+#define FileName file_info.f_filename
+#define WorkingDir file_info.f_workingdir

lang/m2/m2mm/file_list.h

@@ -0,0 +1,6 @@
+struct file_list {
+	char *a_filename;
+	char *a_dir;
+	struct idf *a_idf;
+	struct file_list *a_next;
+};

lang/m2/m2mm/idf.c

@@ -0,0 +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/m2mm/idf.h

@@ -0,0 +1,40 @@
+/*
+ * (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$ */
+
+#include "file_list.h"
+
+struct lnk {
+	struct lnk *lnk_next;
+	struct idf *lnk_imp;
+};
+
+struct id_u {
+	int id_res;
+	int id_tp;		/* PROGRAM OR IMPLEMENTATION OR DEFINITION */
+	struct lnk *id_defimp;	/* imported by definition module */
+	struct lnk *id_modimp;	/* imported by implementation module */
+	char *id_d;		/* directory */
+	struct file_list *id_mdep;	/* module depends on: */
+	struct file_list *id_ddep;	/* definition module depends on: */
+	char *id_df;		/* name of definition module */
+};
+
+#define IDF_TYPE	struct id_u
+#define id_reserved	id_user.id_res
+#define id_type		id_user.id_tp
+#define id_defimports	id_user.id_defimp
+#define id_modimports	id_user.id_modimp
+#define id_dir		id_user.id_d
+#define id_mdependson	id_user.id_mdep
+#define id_ddependson	id_user.id_ddep
+#define id_def		id_user.id_df
+
+#include	<idf_pkg.spec>

lang/m2/m2mm/idfsize.h

@@ -0,0 +1 @@
+#define	IDFSIZE	128	/* maximum significant length of an identifier	*/

lang/m2/m2mm/input.c

@@ -0,0 +1,31 @@
+/*
+ * (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"
+#include	<inp_pkg.body>
+
+
+AtEoIF()
+{
+	/*	Make the unstacking of input streams noticable to the
+	   	lexical analyzer
+	*/
+	return 1;
+}
+
+AtEoIT()
+{
+	/*	Make the end of the text noticable
+	*/
+	return 1;
+}

lang/m2/m2mm/input.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
+ */
+
+/* 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
+#define INP_TYPE	struct f_info
+#define INP_VAR		file_info
+
+#include <inp_pkg.spec>

lang/m2/m2mm/inputtype.h

@@ -0,0 +1 @@
+#define INP_READ_IN_ONE	1	/* read input file in one	*/

lang/m2/m2mm/lib.c

@@ -0,0 +1,32 @@
+/*
+ * (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 I B R A R Y */
+
+/* $Header$ */
+
+#include <em_path.h>
+
+static char lib_dir[128] = EM_DIR;
+
+is_library_dir(d)
+	char *d;
+{
+	/*	Check if directory d is a directory containing
+		"system" definition modules. Return 1 if it is, 0 otherwise.
+	*/
+
+	return strcmp(lib_dir, d) == 0 ? 1 : 0;
+}
+
+init_lib()
+{
+	extern char *strcat();
+
+	strcat(lib_dir, "/lib/m2");
+	AddInclDir(lib_dir);
+}

lang/m2/m2mm/m2mm.1

@@ -0,0 +1,44 @@
+.TH M2MM 1ACK
+.ad
+.SH NAME
+m2mm \- Modula-2 makefile generator
+.SH SYNOPSIS
+\fBm2mm\fP [ \fB-I\fPdir \fB-M\fPflags \fB-C\fPcompiler \fB-S\fPsuffix ] file ...
+.SH DESCRIPTION
+.I M2mm
+is a makefile generator and fast syntax checker for Modula-2 programs.
+The makefile is produced on standard output.
+.I M2mm
+will generate rules to produce an object file
+for every module used in the argument files.
+In addition, it will generate a rule to make a program, for each of the
+program modules given as argument.
+Using 
+.IR make (1)
+without an argument will make all these programs.
+.PP
+In the makefile, the variables \fBMOD\fP, \fBM2FLAGS\fP, \fBIFLAGS\fP, and
+\fBSUFFIX\fP will be defined.
+The generated rules have the following form:
+.DS
+\fIname\fP.$(SUFFIX): ...
+	$(MOD) -c $(M2FLAGS) $(IFLAGS) \fIname\fP.mod
+.DE
+.I M2mm
+recognizes the following options:
+.IP \fB-I\fP\fIdir\fP
+Add \fIdir\fP to the list of directories where definition modules are 
+looked for. Also add the flag to \fBIFLAGS\fP.
+The default value for \fBIFLAGS\fP is empty.
+.IP \fB-M\fP\fIflags\fP
+Set \fBM2FLAGS\fP to \fIflags\fP.
+.IP \fB-C\fP\fIcompiler\fP
+Set \fBMOD\fP to \fIcompiler\fP.
+The default value for \fBMOD\fP is "ack" (for the time being).
+.IP \fB-S\fPsuffix
+Set \fBSUFFIX\fP to \fIsuffix\fP.
+The default suffix is "o".
+.SH SEE ALSO
+.IR make "(1), " modula-2 (1)
+.SH DIAGNOSTICS
+Are intended to be self-explanatory.

lang/m2/m2mm/main.c

@@ -0,0 +1,412 @@
+/*
+ * (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 */
+
+/* stripped down version from the one in the Modula-2 compiler */
+
+/* $Header$ */
+
+#include	<alloc.h>
+
+#include	"input.h"
+#include	"f_info.h"
+#include	"idf.h"
+#include	"LLlex.h"
+#include	"Lpars.h"
+#include	"tokenname.h"
+
+int		state;			/* either IMPLEMENTATION or PROGRAM */
+char		options[128];
+int		DefinitionModule; 
+char		*ProgName;
+char		**DEFPATH;
+int		nDEF, mDEF;
+struct file_list *CurrentArg;
+extern int 	err_occurred;
+extern int 	Roption;
+extern char	*strrindex();
+extern char	*strcpy(), *strcat();
+
+char *
+getwdir(fn)
+        register char *fn;
+{
+        register char *p;
+
+        p = strrindex(fn, '/');
+        while (p && *(p + 1) == '\0') { /* remove trailing /'s */
+                *p = '\0';
+                p = strrindex(fn, '/');
+        }
+
+        if (p) {
+		register char **d = DEFPATH;
+
+                *p = '\0';
+		while (*d && strcmp(*d, fn) != 0) d++;
+                if (*d) {
+                	*p = '/';
+			return *d;
+		}
+                fn = Salloc(fn, (unsigned) (p - &fn[0] + 1));
+		*p = '/';
+		return fn;
+        }
+        return ".";
+}
+
+static struct file_list *arglist;
+
+char *mflags = "";
+char *compiler = "ack";
+char *suff = "o";
+
+main(argc, argv)
+	register char **argv;
+{
+	extern struct tokenname tkidf[];
+	extern char *getwdir();
+	int i;
+
+	ProgName = *argv++;
+	DEFPATH = (char **) Malloc(10 * sizeof(char *));
+	mDEF = 10;
+	nDEF = 1;
+
+	while (--argc > 0) {
+		if (**argv == '-')
+			DoOption((*argv++) + 1);
+		else {
+			Add(&arglist, *argv, getwdir(*argv), 1);
+			argv++;
+		}
+	}
+
+	init_idf();
+	reserve(tkidf);
+	print("IFLAGS =");
+	for (i = 1; i < nDEF; i++) {
+		print(" -I%s", DEFPATH[i]);
+	}
+	print("\nM2FLAGS = %s\nMOD = %s\nSUFFIX = %s\n", mflags, compiler, suff);
+	init_lib();
+	ProcessArgs();
+	find_dependencies();
+	print_dep();
+	programs();
+	exit(err_occurred);
+}
+
+struct file_list *
+new_file_list()
+{
+	static struct file_list *p;
+	static int cnt;
+	extern char *calloc();
+
+	if (cnt--) return p++;
+	p = (struct file_list *)calloc(50, sizeof(struct file_list));
+	cnt = 49;
+	return p++;
+}
+
+Add(parglist, f, d, copy)
+	char *f, *d;
+	struct file_list **parglist;
+{
+	register struct file_list *a = *parglist, *b = 0;
+
+	while (a && strcmp(a->a_filename, f) != 0) {
+		b = a;
+		a = a->a_next;
+	}
+	if (a) return 0;
+	a = new_file_list();
+	if (copy) {
+		a->a_filename = Salloc(f, (unsigned) (strlen(f)+1));
+	}
+	else {
+		a->a_filename = f;
+	}
+	a->a_dir = d;
+	if (! b) *parglist = a;
+	else b->a_next = a;
+	return 1;
+}
+
+ProcessArgs()
+{
+	register struct file_list *a = arglist;
+	char *fn;
+
+	while (a) {
+		register char *p = strrindex(a->a_filename, '.');
+
+		CurrentArg = a;
+		DEFPATH[0] = a->a_dir;
+		if ( p && strcmp(p, ".def") == 0) {
+			ForeignFlag = 0;
+			if (! InsertFile(a->a_filename, DEFPATH, &fn)) {
+				Gerror("Could not find %s", a->a_filename);
+				a = a->a_next;
+				continue;
+			}
+			FileName = fn;
+			a->a_dir = WorkingDir = getwdir(FileName);
+			DefModule();
+		}
+		else if (p && strcmp(p, ".mod") == 0) {
+			if (! InsertFile(a->a_filename, DEFPATH, &fn)) {
+				Gerror("Could not find %s", a->a_filename);
+				*p = 0;		/* prevent from being used
+						   later
+						*/
+				a->a_filename = Salloc(a->a_filename,
+							strlen(a->a_filename) + 
+							11);
+				strcat(a->a_filename, ".$(SUFFIX)");
+				a = a->a_next;
+				continue;
+			}
+			FileName = fn;
+			a->a_dir = WorkingDir = getwdir(FileName);
+			CompUnit();
+		}
+		else fatal("No Modula-2 file: %s", a->a_filename);
+		a = a->a_next;
+	}
+}
+
+No_Mem()
+{
+	fatal("out of memory");
+}
+
+C_failed()
+{
+	fatal("write failed");
+}
+
+AddToList(name, ext)
+	char *name, *ext;
+{
+	/*	Try to find a file with basename "name" and extension ".def",
+		in the directories mentioned in "DEFPATH".
+	*/
+	char buf[15];
+	char *strncpy();
+
+	if (strcmp(name, "SYSTEM") != 0 && ! is_library_dir(WorkingDir)) {
+		strncpy(buf, name, 10);
+		buf[10] = '\0';			/* maximum length */
+		strcat(buf, ext);
+		Add(&arglist, buf, WorkingDir, 1);
+		return 1;
+	}
+	return 0;
+}
+
+find_dependencies()
+{
+	register struct file_list *arg = arglist;
+
+	print("\nall:\t");
+	while (arg) {
+		char *dotspot = strrindex(arg->a_filename, '.');
+
+		if (dotspot && strcmp(dotspot, ".mod") == 0) {
+			register struct idf *id = arg->a_idf;
+
+			if (id) {
+				if (id->id_type == PROGRAM) {
+					print("%s ", id->id_text);
+				}
+				file_dep(id);
+			}
+		}
+		arg = arg->a_next;
+	}
+	print("\n\n");
+}
+
+file_dep(id)
+	register struct idf *id;
+{
+	register struct lnk *m;
+
+	if (id->id_ddependson || id->id_mdependson) return;
+	if (id->id_def) Add(&(id->id_mdependson), id->id_def, id->id_dir, 0);
+	for (m = id->id_defimports; m; m = m->lnk_next) {
+		register struct idf *iid = m->lnk_imp;
+
+		Add(&(id->id_mdependson), iid->id_def, iid->id_dir, 0);
+		if (Add(&(id->id_ddependson), iid->id_def, iid->id_dir, 0)) {
+			register struct file_list *p;
+
+			file_dep(iid);
+			for (p = iid->id_ddependson; p; p = p->a_next) {
+				Add(&(id->id_ddependson), p->a_filename,
+				    p->a_dir, 0);
+				Add(&(id->id_mdependson), p->a_filename,
+				    p->a_dir, 0);
+			}
+		}
+	}
+	for (m = id->id_modimports; m; m = m->lnk_next) {
+		register struct idf *iid = m->lnk_imp;
+
+		if (Add(&(id->id_mdependson), iid->id_def, iid->id_dir, 0)) {
+			register struct file_list *p;
+
+			file_dep(iid);
+			for (p = iid->id_ddependson; p; p = p->a_next) {
+				Add(&(id->id_mdependson), p->a_filename,
+				    p->a_dir, 0);
+			}
+		}
+	}
+}
+
+char *
+object(arg)
+	register struct file_list *arg;
+{
+	static char buf[512];
+	char *dotp = strrindex(arg->a_filename, '.');
+
+	buf[0] = 0;
+/*
+	if (strcmp(arg->a_dir, ".") != 0) {
+		strcpy(buf, arg->a_dir);
+		strcat(buf, "/");
+	}
+*/
+	*dotp = 0;
+	strcat(buf, arg->a_filename);
+	*dotp = '.';
+	strcat(buf, ".$(SUFFIX)");
+	return buf;
+}
+
+pr_arg(a)
+	register struct file_list *a;
+{
+	if (strcmp(a->a_dir, ".") == 0) {
+		print(a->a_filename);
+	}
+	else	print("%s/%s", a->a_dir, a->a_filename);
+}
+
+print_dep()
+{
+	register struct file_list *arg = arglist;
+
+	while (arg) {
+		char *dotspot = strrindex(arg->a_filename, '.');
+
+		if (dotspot && strcmp(dotspot, ".mod") == 0) {
+			register struct idf *id = arg->a_idf;
+
+			if (id) {
+				char *obj = object(arg);
+				register struct file_list *a;
+
+				print("%s: \\\n\t", obj);
+				pr_arg(arg);
+				for (a = id->id_mdependson; a; a = a->a_next) {
+					print(" \\\n\t");
+					pr_arg(a);
+				}
+				print("\n\t$(MOD) -c $(M2FLAGS) $(IFLAGS) ");
+				pr_arg(arg);
+				print("\n");
+			}
+		}
+		arg = arg->a_next;
+	}
+}
+
+prog_dep(id)
+	register struct idf *id;
+{
+	register struct lnk *m;
+	register struct file_list *p;
+
+	id->id_mdependson = 0;
+	id->id_def = 0;
+	if (strlen(id->id_text) >= 10) id->id_text[10] = 0;
+	Add(&(id->id_mdependson), id->id_text, id->id_dir, 0);
+	for (m = id->id_modimports; m; m = m->lnk_next) {
+		register struct idf *iid = m->lnk_imp;
+
+		if (Add(&(id->id_mdependson), iid->id_text, iid->id_dir, 0)) {
+			if (iid->id_def) prog_dep(iid);
+			for (p = iid->id_mdependson; p; p = p->a_next) {
+				Add(&(id->id_mdependson), p->a_filename,
+				    p->a_dir, 0);
+			}
+		}
+	}
+}
+
+module_in_arglist(n)
+	char *n;
+{
+	register struct file_list *a;
+
+	for (a = arglist; a; a = a->a_next) {
+		char *dotp = strrindex(a->a_filename, '.');
+
+		if (dotp && strcmp(dotp, ".mod") == 0) {
+			*dotp = 0;
+			if (strcmp(a->a_filename, n) == 0) {
+				*dotp = '.';
+				return 1;
+			}
+			*dotp = '.';
+		}
+	}
+	return 0;
+}
+
+pr_prog_dep(id)
+	register struct idf *id;
+{
+	register struct file_list *p;
+
+	print("\nOBS_%s = ", id->id_text);
+	for (p = id->id_mdependson; p; p = p->a_next) {
+		if (module_in_arglist(p->a_filename)) {
+			print("\\\n\t%s.$(SUFFIX)", p->a_filename);
+		}
+		else if (! is_library_dir(p->a_dir))  {
+			print("\\\n\t%s/%s.$(SUFFIX)", p->a_dir, p->a_filename);
+		}
+	}
+	print("\n\n");
+	print("%s:\t$(OBS_%s)\n", id->id_text, id->id_text);
+	print("\t$(MOD) -.mod -o %s $(M2FLAGS) $(OBS_%s)\n", id->id_text, id->id_text);
+}
+
+programs()
+{
+	register struct file_list *a;
+
+	for (a = arglist; a; a = a->a_next) {
+		char *dotspot = strrindex(a->a_filename, '.');
+
+		if (dotspot && strcmp(dotspot, ".mod") == 0) {
+			register struct idf *id = a->a_idf;
+
+			if (id && id->id_type == PROGRAM) {
+				prog_dep(id);
+				pr_prog_dep(id);
+			}
+		}
+	}
+}

lang/m2/m2mm/main.h

@@ -0,0 +1,17 @@
+/*
+ * (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 char **DEFPATH;	/* search path for DEFINITION MODULE's */
+extern int mDEF, nDEF;
+extern int state;	/* either IMPLEMENTATION or PROGRAM */
+extern struct file_list *CurrentArg;

lang/m2/m2mm/make.tokcase

@@ -0,0 +1,34 @@
+cat <<'--EOT--'
+#include "Lpars.h"
+
+char *
+symbol2str(tok)
+	int tok;
+{
+	static char buf[2] = { '\0', '\0' };
+
+	if (040 <= tok && tok < 0177) {
+		buf[0] = tok;
+		buf[1] = '\0';
+		return buf;
+	}
+	switch (tok) {
+--EOT--
+sed '
+/{[A-Z]/!d
+s/.*{\(.*\),.*\(".*"\).*$/	case \1 :\
+		return \2;/
+'
+cat <<'--EOT--'
+	case '\n':
+	case '\f':
+	case '\v':
+	case '\r':
+	case '\t':
+		buf[0] = tok;
+		return buf;
+	default:
+		return "bad token";
+	}
+}
+--EOT--

lang/m2/m2mm/make.tokfile

@@ -0,0 +1,6 @@
+sed '
+/{[A-Z]/!d
+s/.*{//
+s/,.*//
+s/.*/%token	&;/
+'

lang/m2/m2mm/misc.c

@@ -0,0 +1,31 @@
+/*
+ * (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 */
+
+/* stripped version from the one in the Modula-2 compiler */
+
+/* $Header$ */
+
+#include	"f_info.h"
+#include	"idf.h"
+#include	"LLlex.h"
+
+struct idf *
+gen_anon_idf()
+{
+	/*	A new idf is created out of nowhere, to serve as an
+		anonymous name.
+	*/
+	static int name_cnt;
+	char buff[100];
+	char *sprint();
+
+	sprint(buff, "#%d in %s, line %u",
+			++name_cnt, FileName, LineNumber);
+	return str2idf(buff, 1);
+}

lang/m2/m2mm/options.c

@@ -0,0 +1,80 @@
+/*
+ * (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 */
+
+/* stripped down version from the one in the Modula-2 compiler */
+
+/* $Header$ */
+
+#include	<alloc.h>
+#include	"main.h"
+
+static int	ndirs = 1;
+
+DoOption(text)
+	register char *text;
+{
+	extern char *mflags;
+	extern char *suff;
+	extern char *compiler;
+
+	switch(*text++)	{
+
+	case 'I' :
+		AddInclDir(text);
+		break;
+	
+	case 'M':
+		mflags = text;
+		break;
+
+	case 'C':
+		compiler = text;
+		break;
+
+	case 'S':
+		suff = text;
+		break;
+
+	default:
+		Gerror("Unrecognized option: -%s", text-1);
+		break;
+	}
+}
+
+AddInclDir(text)
+	char *text;
+{
+	register int i;
+	register char *new = text;
+
+	if (! *text) {
+		DEFPATH[ndirs] = 0;
+		return;
+	}
+
+	if (++nDEF > mDEF) {
+		char **n = (char **)
+			Malloc((unsigned)((10+mDEF)*sizeof(char *)));
+
+		for (i = 0; i < mDEF; i++) {
+			n[i] = DEFPATH[i];
+		}
+		free((char *) DEFPATH);
+		DEFPATH = n;
+		mDEF += 10;
+	}
+
+	i = ndirs++;
+	while (new) {
+		register char *tmp = DEFPATH[i];
+
+		DEFPATH[i++] = new;
+		new = tmp;
+	}
+}

lang/m2/m2mm/program.g

@@ -0,0 +1,237 @@
+/*
+ * (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 */
+
+/* stripped down version of the one in the Modula-2 compiler */
+
+/* $Header$ */
+
+/*
+	The grammar as given by Wirth is already almost LL(1); the
+	main problem is that the full form of a qualified designator
+	may be:
+		[ module_ident '.' ]* IDENT [ '.' field_ident ]*
+	which is quite confusing to an LL(1) parser. Rather than
+	resorting to context-sensitive techniques, I have decided
+	to render this as:
+		IDENT [ '.' IDENT ]*
+	on the grounds that it is quite natural to consider the first
+	IDENT to be the name of the object and regard the others as
+	field identifiers.
+*/
+
+{
+#include	"main.h"
+#include	"idf.h"
+#include	"f_info.h"
+#include	"LLlex.h"
+
+struct lnk *
+new_lnk()
+{
+	static struct lnk *p;
+	static int cnt;
+	extern char *calloc();
+
+	if (cnt--) return p++;
+	p = (struct lnk *)calloc(50, sizeof(struct lnk));
+	cnt = 49;
+	return p++;
+}
+}
+
+%lexical LLlex;
+
+%start	CompUnit, CompilationUnit;
+%start	DefModule, DefinitionModule;
+
+ModuleDeclaration :
+	MODULE IDENT
+	priority
+	';'
+	import((struct lnk **) 0)*
+	export?
+	block
+	IDENT
+;
+
+priority:
+	[
+		'[' ConstExpression ']'
+	|
+	]
+;
+
+export :
+	EXPORT
+	[
+		QUALIFIED
+	|
+	]
+	IdentList ';'
+;
+
+import(register struct lnk **p;)
+{
+	register struct idf *fromid = 0;
+	struct idf *id;
+}
+:
+				{ if (p) while (*p) p = &((*p)->lnk_next); }
+	[ FROM
+	  identifier(&id)	{ fromid = id;
+				  if (p) {
+					if (AddToList(fromid->id_text, ".def")) {
+						*p = new_lnk();
+						(*p)->lnk_imp = fromid;
+					}
+				  }
+				}
+	]?
+	IMPORT 
+	identifier(&id)		{ if (! fromid && p) {
+					if (AddToList(id->id_text, ".def")) {
+						*p = new_lnk();
+						(*p)->lnk_imp = id;
+						p = &((*p)->lnk_next);
+					}
+				  }
+				}
+	[
+		',' identifier(&id)
+				{ if (! fromid && p) {
+					if (AddToList(id->id_text, ".def")) {
+						*p = new_lnk();
+						(*p)->lnk_imp = id;
+						p = &((*p)->lnk_next);
+					}
+				  }
+				}
+	]*
+	';'
+	/*
+	   When parsing a global module, this is the place where we must
+	   read already compiled definition modules.
+	   If the FROM clause is present, the identifier in it is a module
+	   name, otherwise the names in the import list are module names.
+	*/
+;
+
+DefinitionModule
+{
+	struct idf *id;
+	extern char *strrindex();
+}
+:
+	DEFINITION
+	MODULE identifier(&id)
+			{ if (! ForeignFlag) {
+				AddToList(id->id_text, ".mod");
+			  }
+			  if (! id->id_type) {
+				id->id_type = DEFINITION;
+			  }
+			  else if (id->id_type != IMPLEMENTATION) {
+				error("multiple declaration for module %s",
+					id->id_text);
+			  }
+			  if (! id->id_dir) {
+				id->id_dir = WorkingDir;
+			  }
+			  else if (strcmp(id->id_dir, WorkingDir)) {
+				Gerror("definition and implementation of module %s reside in different directories", id->id_text);
+			  }
+			  id->id_def = strrindex(FileName, '/');
+			  if (! id->id_def) id->id_def = FileName;
+			  else (id->id_def)++;
+			  CurrentArg->a_idf = id;
+			}
+	';'
+	import(&(id->id_defimports))* 
+	[
+		export
+	|
+		/* empty */
+	]
+	definition* END IDENT
+	'.'
+;
+
+definition :
+	CONST [ %persistent ConstantDeclaration ';' ]*
+|
+	TYPE
+	[ %persistent
+	  IDENT
+	  [ '=' type
+	  | /* empty */
+	    /*
+	       Here, the exported type has a hidden implementation.
+	       The export is said to be opaque.
+	       It is restricted to pointer types.
+	    */
+	  ]
+	  ';'
+	]*
+|
+	VAR [ %persistent VariableDeclaration ';' ]*
+|
+	ProcedureHeading
+	';'
+;
+
+ProgramModule
+{
+	struct idf *id;
+}
+:
+	MODULE
+	identifier(&id)	{ if (! id->id_type) {
+				id->id_type = state;
+			  }
+			  else if (id->id_type != DEFINITION ||
+				   state != IMPLEMENTATION) {
+				error("multiple declaration for module %s",
+					id->id_text);
+			  }
+			  if (! id->id_dir) {
+				id->id_dir = WorkingDir;
+			  }
+			  else if (strcmp(id->id_dir, WorkingDir)) {
+				Gerror("definition and implementation of module %s reside in different directories", id->id_text);
+			  }
+			  CurrentArg->a_idf = id;
+			}
+	priority
+	';' import(&(id->id_modimports))*
+	block IDENT
+	'.'
+;
+
+Module:
+	DEFINITION
+				{ fatal("Definition module in .mod file"); }
+|	%default
+	[
+		IMPLEMENTATION	{ state = IMPLEMENTATION; }
+	|
+		/* empty */	{ state = PROGRAM; }
+	]
+	ProgramModule
+;
+
+CompilationUnit:
+	Module
+;
+
+identifier(struct idf **id;):
+	IDENT
+				{ extern char idfbuf[];
+				  *id = str2idf(idfbuf);
+				}
+;

lang/m2/m2mm/statement.g

@@ -0,0 +1,136 @@
+/*
+ * (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 */
+
+/* stripped down version from the one in the Modula-2 compiler */
+
+/* $Header$ */
+
+{
+#include	"idf.h"
+#include	"LLlex.h"
+
+static int loopcount;
+}
+
+statement :
+[
+	/*
+	 * This part is not in the reference grammar. The reference grammar
+	 * states : assignment | ProcedureCall | ...
+	 * but this gives LL(1) conflicts
+	 */
+	designator
+	[
+		ActualParameters?
+	|
+		[ BECOMES	
+		| '='		{ error("':=' expected instead of '='");
+				  DOT = BECOMES;
+				}
+		]
+		expression
+	]
+	/*
+	 * end of changed part
+	 */
+|
+	IfStatement
+|
+	CaseStatement
+|
+	WHILE
+	expression
+	DO
+	StatementSequence
+	END
+|
+	REPEAT
+	StatementSequence
+	UNTIL
+	expression
+|
+				{ loopcount++; }
+	LOOP
+	StatementSequence
+	END
+				{ loopcount--; }
+|
+	ForStatement
+|
+	WithStatement
+|
+	EXIT
+			{ if (!loopcount) error("EXIT not in a LOOP"); }
+|
+	ReturnStatement
+|
+	/* empty */
+]
+;
+
+StatementSequence :
+	statement
+	[ %persistent
+		';'
+		statement
+	]*
+;
+
+IfStatement :
+	IF expression
+	THEN StatementSequence
+	[
+		ELSIF expression
+		THEN StatementSequence
+	]*
+	[
+		ELSE StatementSequence
+	]?
+	END
+;
+
+CaseStatement :
+	CASE expression
+	OF case
+	[
+		'|' case
+	]*
+	[ ELSE StatementSequence
+	]?
+	END
+;
+
+case :
+	[ CaseLabelList ':'
+	  StatementSequence
+	]?
+;
+
+ForStatement :
+	FOR IDENT BECOMES expression TO expression
+	[
+		BY ConstExpression
+	|
+	]
+	DO StatementSequence
+	END
+;
+
+WithStatement :
+	WITH designator DO StatementSequence
+	END
+;
+
+ReturnStatement :
+	RETURN
+	[
+		expression
+	|
+	]
+;

lang/m2/m2mm/tab.c

@@ -0,0 +1,295 @@
+/*	@cc tab.c -o $INSTALLDIR/tab@
+	tab - table generator 
+
+	Author: Erik Baalbergen (..tjalk!erikb)
+*/
+
+#include <stdio.h> 
+
+static char *RcsId = "$Header$";
+
+#define MAXTAB	10000
+#define MAXBUF	10000
+#define COMCOM	'-'
+#define FILECOM	'%'
+
+int InputForm = 'c';
+char OutputForm[MAXBUF] = "%s,\n";
+int TabSize = 257;
+char *Table[MAXTAB];
+char *Name;
+char *ProgCall;
+
+main(argc, argv)
+	char *argv[];
+{
+	ProgCall = *argv++;
+	argc--;
+	while (argc-- > 0) {
+		if (**argv == COMCOM) {
+			option(*argv++);
+		}
+		else {
+			process(*argv++, InputForm);
+		}
+	}
+}
+
+char *
+Salloc(s)
+	char *s;
+{
+	char *malloc();
+	char *ns = malloc(strlen(s) + 1);
+
+	if (ns) {
+		strcpy(ns, s);
+	}
+	return ns;
+}
+
+option(str)
+	char *str;
+{
+	/*	note that *str indicates the source of the option:
+		either COMCOM (from command line) or FILECOM (from a file).
+	*/
+	switch (*++str) {
+
+	case ' ':	/* command */
+	case '\t':
+	case '\0':
+		break;
+	case 'I':
+		InputForm = *++str;
+		break;
+	case 'f':
+		if (*++str == '\0') {
+			fprintf(stderr, "%s: -f: name expected\n", ProgCall);
+			exit(1);
+		}
+		DoFile(str);
+		break;
+	case 'F':
+		sprintf(OutputForm, "%s\n", ++str);
+		break;
+	case 'T':
+		printf("%s\n", ++str);
+		break;
+	case 'p':
+		PrintTable();
+		break;
+	case 'C':
+		ClearTable();
+		break;
+	case 'S':
+	{
+		register i = stoi(++str);
+
+		if (i <= 0 || i > MAXTAB) {
+			fprintf(stderr, "%s: size would exceed maximum\n",
+				ProgCall);
+		}
+		else {
+			TabSize = i;
+		}
+		break;
+	}
+	default:
+		fprintf(stderr, "%s: bad option -%s\n", ProgCall, str);
+	}
+}
+
+ClearTable()
+{
+	register i;
+
+	for (i = 0; i < MAXTAB; i++) {
+		Table[i] = 0;
+	}
+}
+
+PrintTable()
+{
+	register i;
+
+	for (i = 0; i < TabSize; i++) {
+		if (Table[i]) {
+			printf(OutputForm, Table[i]);
+		}
+		else {
+			printf(OutputForm, "0");
+		}
+	}
+}
+
+process(str, format)
+	char *str;
+{
+	char *cstr = str;
+	char *Name = cstr;	/* overwrite original string!	*/
+
+	/* strip of the entry name
+	*/
+	while (*str && *str != ':') {
+		if (*str == '\\') {
+			++str;
+		}
+		*cstr++ = *str++;
+	}
+
+	if (*str != ':') {
+		fprintf(stderr, "%s: bad specification: \"%s\", ignored\n",
+			ProgCall, Name);
+		return 0;
+	}
+	*cstr = '\0';
+	str++;
+
+	switch (format) {
+
+	case 'c':
+		return c_proc(str, Name);
+	default:
+		fprintf(stderr, "%s: bad input format\n", ProgCall);
+	}
+	return 0;
+}
+
+c_proc(str, Name)
+	char *str;
+	char *Name;
+{
+	int ch, ch2;
+	int quoted();
+
+	while (*str)	{
+		if (*str == '\\')	{
+			ch = quoted(&str);
+		}
+		else	{
+			ch = *str++;
+		}
+		if (*str == '-')	{
+			if (*++str == '\\')	{
+				ch2 = quoted(&str);
+			}
+			else	{
+				if (ch2 = *str++);
+				else str--;
+			}
+			if (ch > ch2)	{
+				fprintf(stderr, "%s: bad range\n", ProgCall);
+				return 0;
+			}
+			if (ch >= 0 && ch2 <= 255)
+				while (ch <= ch2)
+					Table[ch++] = Salloc(Name);
+		}
+		else	{
+			if (ch >= 0 && ch <= 255)
+				Table[ch] = Salloc(Name);
+		}
+	}
+	return 1;
+}
+			
+int
+quoted(pstr)
+	char **pstr;
+{
+	register int ch;
+	register int i;
+	register char *str = *pstr;
+
+	if ((*++str >= '0') && (*str <= '9'))	{
+		ch = 0;
+		for (i = 0; i < 3; i++)	{
+			ch = 8 * ch + *str - '0';
+			if (*++str < '0' || *str > '9')
+				break;
+		}
+	}
+	else	{
+		switch (*str++)	{
+
+		case 'n':
+			ch = '\n';
+			break;
+		case 't':
+			ch = '\t';
+			break;
+		case 'b':
+			ch = '\b';
+			break;
+		case 'r':
+			ch = '\r';
+			break;
+		case 'f':
+			ch = '\f';
+			break;
+		default :
+			ch = *str;
+		}
+	}
+	*pstr = str;
+	return ch & 0377;
+}
+
+int
+stoi(str)
+	char *str;
+{
+	register i = 0;
+
+	while (*str >= '0' && *str <= '9') {
+		i = i * 10 + *str++ - '0';
+	}
+	return i;
+}
+
+char *
+getline(s, n, fp)
+	char *s;
+	FILE *fp;
+{
+	register c = getc(fp);
+	char *str = s;
+
+	while (n--) {
+		if (c == EOF) {
+			return NULL;
+		}
+		else
+		if (c == '\n') {
+			*str++ = '\0';
+			return s;
+		}
+		*str++ = c;
+		c = getc(fp);
+	}
+	s[n - 1] = '\0';
+	return s;
+}
+
+#define BUFSIZE 1024
+
+DoFile(name)
+	char *name;
+{
+	char text[BUFSIZE];
+	FILE *fp;
+
+	if ((fp = fopen(name, "r")) == NULL) {
+		fprintf(stderr, "%s: cannot read file %s\n", ProgCall, name);
+		exit(1);
+	}
+	while (getline(text, BUFSIZE, fp) != NULL) {
+		if (text[0] == FILECOM) {
+			option(text);
+		}
+		else {
+			process(text, InputForm);
+		}
+	}
+}

lang/m2/m2mm/tokenname.c

@@ -0,0 +1,113 @@
+/*
+ * (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"
+
+/*	To centralize the declaration of %tokens, their presence in this
+	file is taken as their declaration. The Makefile will produce
+	a grammar file (tokenfile.g) from this file. This scheme ensures
+	that all tokens have a printable name.
+	Also, the "token2str.c" file is produced from this file.
+*/
+
+#ifdef ___XXX___
+struct tokenname tkspec[] =	{	/* the names of the special tokens */
+	{IDENT, "identifier"},
+	{STRING, "string"},
+	{INTEGER, "number"},
+	{REAL, "real"},
+	{0, ""}
+};
+
+struct tokenname tkcomp[] =	{	/* names of the composite tokens */
+	{LESSEQUAL, "<="},
+	{GREATEREQUAL, ">="},
+	{UPTO, ".."},
+	{BECOMES, ":="},
+	{0, ""}
+};
+#endif
+
+struct tokenname tkidf[] =	{	/* names of the identifier tokens */
+	{AND, "AND"},
+	{ARRAY, "ARRAY"},
+	{BEGIN, "BEGIN"},
+	{BY, "BY"},
+	{CASE, "CASE"},
+	{CONST, "CONST"},
+	{DEFINITION, "DEFINITION"},
+	{DIV, "DIV"},
+	{DO, "DO"},
+	{ELSE, "ELSE"},
+	{ELSIF, "ELSIF"},
+	{END, "END"},
+	{EXIT, "EXIT"},
+	{EXPORT, "EXPORT"},
+	{FOR, "FOR"},
+	{FROM, "FROM"},
+	{IF, "IF"},
+	{IMPLEMENTATION, "IMPLEMENTATION"},
+	{IMPORT, "IMPORT"},
+	{IN, "IN"},
+	{LOOP, "LOOP"},
+	{MOD, "MOD"},
+	{MODULE, "MODULE"},
+	{NOT, "NOT"},
+	{OF, "OF"},
+	{OR, "OR"},
+	{POINTER, "POINTER"},
+	{PROCEDURE, "PROCEDURE"},
+	{QUALIFIED, "QUALIFIED"},
+	{RECORD, "RECORD"},
+	{REPEAT, "REPEAT"},
+	{RETURN, "RETURN"},
+	{SET, "SET"},
+	{THEN, "THEN"},
+	{TO, "TO"},
+	{TYPE, "TYPE"},
+	{UNTIL, "UNTIL"},
+	{VAR, "VAR"},
+	{WHILE, "WHILE"},
+	{WITH, "WITH"},
+	{0, ""}
+};
+
+#ifdef ___XXX___
+struct tokenname tkinternal[] = {	/* internal keywords	*/
+	{PROGRAM, ""},
+	{COERCION, ""},
+	{0, "0"}
+};
+
+struct tokenname tkstandard[] =	{	/* standard identifiers */
+	{0, ""}
+};
+#endif
+
+/* Some routines to handle tokennames */
+
+reserve(resv)
+	register struct tokenname *resv;
+{
+	/*	The names of the tokens described in resv are entered
+		as reserved words.
+	*/
+	register struct idf *p;
+
+	while (resv->tn_symbol)	{
+		p = str2idf(resv->tn_name, 0);
+		if (!p) fatal("out of Memory");
+		p->id_reserved = resv->tn_symbol;
+		resv++;
+	}
+}

lang/m2/m2mm/tokenname.h

@@ -0,0 +1,17 @@
+/*
+ * (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
+				*/
+	int tn_symbol;
+	char *tn_name;
+};