--- /dev/null
+/*
+ * (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 = ˙
+ 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*/
+}
--- /dev/null
+/*
+ * (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
--- /dev/null
+/*
+ * (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));
+}
--- /dev/null
+#
+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
--- /dev/null
+% 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};
--- /dev/null
+/*
+ * (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[];
--- /dev/null
+/*
+ * (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
+ ']'
+ ]?
+;
--- /dev/null
+/*
+ * (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");
+}
--- /dev/null
+/*
+ * (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
+ ]*
+ ']'
+|
+ '^'
+]
+;
--- /dev/null
+/*
+ * (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
--- /dev/null
+struct file_list {
+ char *a_filename;
+ char *a_dir;
+ struct idf *a_idf;
+ struct file_list *a_next;
+};
--- /dev/null
+/*
+ * (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>
--- /dev/null
+/*
+ * (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>
--- /dev/null
+#define IDFSIZE 128 /* maximum significant length of an identifier */
--- /dev/null
+/*
+ * (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;
+}
--- /dev/null
+/*
+ * (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>
--- /dev/null
+#define INP_READ_IN_ONE 1 /* read input file in one */
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+.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.
--- /dev/null
+/*
+ * (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);
+ }
+ }
+ }
+}
--- /dev/null
+/*
+ * (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;
--- /dev/null
+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--
--- /dev/null
+sed '
+/{[A-Z]/!d
+s/.*{//
+s/,.*//
+s/.*/%token &;/
+'
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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;
+ }
+}
--- /dev/null
+/*
+ * (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);
+ }
+;
--- /dev/null
+/*
+ * (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
+ |
+ ]
+;
--- /dev/null
+/* @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);
+ }
+ }
+}
--- /dev/null
+/*
+ * (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++;
+ }
+}
--- /dev/null
+/*
+ * (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;
+};
public / ack.git / commitdiff