From: ceriel Date: Thu, 24 Sep 1987 13:01:27 +0000 (+0000) Subject: Initial revision X-Git-Tag: release-5-5~3835 X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=e30234fce85b8782c6583e0ac01a70518343efdb;p=ack.git Initial revision --- diff --git a/lang/m2/m2mm/LLlex.c b/lang/m2/m2mm/LLlex.c new file mode 100644 index 000000000..fd1e36100 --- /dev/null +++ b/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 +#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*/ +} diff --git a/lang/m2/m2mm/LLlex.h b/lang/m2/m2mm/LLlex.h new file mode 100644 index 000000000..a0bb1a21f --- /dev/null +++ b/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 diff --git a/lang/m2/m2mm/LLmessage.c b/lang/m2/m2mm/LLmessage.c new file mode 100644 index 000000000..6a4c25634 --- /dev/null +++ b/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)); +} diff --git a/lang/m2/m2mm/Makefile b/lang/m2/m2mm/Makefile new file mode 100644 index 000000000..998af5086 --- /dev/null +++ b/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 tokenfile.g + +symbol2str.c: tokenname.c make.tokcase + make.tokcase 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 diff --git a/lang/m2/m2mm/char.tab b/lang/m2/m2mm/char.tab new file mode 100644 index 000000000..e4f57402f --- /dev/null +++ b/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}; diff --git a/lang/m2/m2mm/class.h b/lang/m2/m2mm/class.h new file mode 100644 index 000000000..4fdcfa0ff --- /dev/null +++ b/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[]; diff --git a/lang/m2/m2mm/declar.g b/lang/m2/m2mm/declar.g new file mode 100644 index 000000000..3b5984f69 --- /dev/null +++ b/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 + ']' + ]? +; diff --git a/lang/m2/m2mm/error.c b/lang/m2/m2mm/error.c new file mode 100644 index 000000000..0adbb74db --- /dev/null +++ b/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 +#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"); +} diff --git a/lang/m2/m2mm/expression.g b/lang/m2/m2mm/expression.g new file mode 100644 index 000000000..3fe53ee33 --- /dev/null +++ b/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 + ]* + ']' +| + '^' +] +; diff --git a/lang/m2/m2mm/f_info.h b/lang/m2/m2mm/f_info.h new file mode 100644 index 000000000..452d8a3fe --- /dev/null +++ b/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 diff --git a/lang/m2/m2mm/file_list.h b/lang/m2/m2mm/file_list.h new file mode 100644 index 000000000..9529e8c56 --- /dev/null +++ b/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; +}; diff --git a/lang/m2/m2mm/idf.c b/lang/m2/m2mm/idf.c new file mode 100644 index 000000000..6429ef7d1 --- /dev/null +++ b/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 diff --git a/lang/m2/m2mm/idf.h b/lang/m2/m2mm/idf.h new file mode 100644 index 000000000..b66768c01 --- /dev/null +++ b/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 diff --git a/lang/m2/m2mm/idfsize.h b/lang/m2/m2mm/idfsize.h new file mode 100644 index 000000000..38bebbf00 --- /dev/null +++ b/lang/m2/m2mm/idfsize.h @@ -0,0 +1 @@ +#define IDFSIZE 128 /* maximum significant length of an identifier */ diff --git a/lang/m2/m2mm/input.c b/lang/m2/m2mm/input.c new file mode 100644 index 000000000..92183b3fb --- /dev/null +++ b/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 + + +AtEoIF() +{ + /* Make the unstacking of input streams noticable to the + lexical analyzer + */ + return 1; +} + +AtEoIT() +{ + /* Make the end of the text noticable + */ + return 1; +} diff --git a/lang/m2/m2mm/input.h b/lang/m2/m2mm/input.h new file mode 100644 index 000000000..f52c3524c --- /dev/null +++ b/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 diff --git a/lang/m2/m2mm/inputtype.h b/lang/m2/m2mm/inputtype.h new file mode 100644 index 000000000..dc9a8535d --- /dev/null +++ b/lang/m2/m2mm/inputtype.h @@ -0,0 +1 @@ +#define INP_READ_IN_ONE 1 /* read input file in one */ diff --git a/lang/m2/m2mm/lib.c b/lang/m2/m2mm/lib.c new file mode 100644 index 000000000..3666e80ba --- /dev/null +++ b/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 + +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); +} diff --git a/lang/m2/m2mm/m2mm.1 b/lang/m2/m2mm/m2mm.1 new file mode 100644 index 000000000..861b92c04 --- /dev/null +++ b/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. diff --git a/lang/m2/m2mm/main.c b/lang/m2/m2mm/main.c new file mode 100644 index 000000000..1ec48ea38 --- /dev/null +++ b/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 + +#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); + } + } + } +} diff --git a/lang/m2/m2mm/main.h b/lang/m2/m2mm/main.h new file mode 100644 index 000000000..5358e2114 --- /dev/null +++ b/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; diff --git a/lang/m2/m2mm/make.tokcase b/lang/m2/m2mm/make.tokcase new file mode 100755 index 000000000..ef32292f9 --- /dev/null +++ b/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-- diff --git a/lang/m2/m2mm/make.tokfile b/lang/m2/m2mm/make.tokfile new file mode 100755 index 000000000..494b7e3cc --- /dev/null +++ b/lang/m2/m2mm/make.tokfile @@ -0,0 +1,6 @@ +sed ' +/{[A-Z]/!d +s/.*{// +s/,.*// +s/.*/%token &;/ +' diff --git a/lang/m2/m2mm/misc.c b/lang/m2/m2mm/misc.c new file mode 100644 index 000000000..ce1f443b1 --- /dev/null +++ b/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); +} diff --git a/lang/m2/m2mm/options.c b/lang/m2/m2mm/options.c new file mode 100644 index 000000000..e91a32483 --- /dev/null +++ b/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 +#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; + } +} diff --git a/lang/m2/m2mm/program.g b/lang/m2/m2mm/program.g new file mode 100644 index 000000000..b097cb943 --- /dev/null +++ b/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); + } +; diff --git a/lang/m2/m2mm/statement.g b/lang/m2/m2mm/statement.g new file mode 100644 index 000000000..74a7b8c4a --- /dev/null +++ b/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 + | + ] +; diff --git a/lang/m2/m2mm/tab.c b/lang/m2/m2mm/tab.c new file mode 100644 index 000000000..17065cf9b --- /dev/null +++ b/lang/m2/m2mm/tab.c @@ -0,0 +1,295 @@ +/* @cc tab.c -o $INSTALLDIR/tab@ + tab - table generator + + Author: Erik Baalbergen (..tjalk!erikb) +*/ + +#include + +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); + } + } +} diff --git a/lang/m2/m2mm/tokenname.c b/lang/m2/m2mm/tokenname.c new file mode 100644 index 000000000..e719acd2f --- /dev/null +++ b/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++; + } +} diff --git a/lang/m2/m2mm/tokenname.h b/lang/m2/m2mm/tokenname.h new file mode 100644 index 000000000..b3a4720dd --- /dev/null +++ b/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; +};