From fbc041576123380bae31a6cb243f87f25dbdf821 Mon Sep 17 00:00:00 2001 From: ceriel Date: Wed, 29 Apr 1987 10:22:07 +0000 Subject: [PATCH] make to work on sun, added copyright, etc --- lang/m2/comp/LLlex.c | 48 +++++-- lang/m2/comp/LLlex.h | 9 ++ lang/m2/comp/LLmessage.c | 9 ++ lang/m2/comp/Makefile | 293 ++++++++++++++++++++++++++++++++++---- lang/m2/comp/SYSTEM.h | 18 +++ lang/m2/comp/casestat.C | 9 ++ lang/m2/comp/chk_expr.c | 15 +- lang/m2/comp/chk_expr.h | 9 ++ lang/m2/comp/class.h | 9 ++ lang/m2/comp/code.c | 9 ++ lang/m2/comp/const.h | 9 ++ lang/m2/comp/cstoper.c | 9 ++ lang/m2/comp/debug.h | 12 +- lang/m2/comp/declar.g | 143 ++++++------------- lang/m2/comp/def.H | 10 ++ lang/m2/comp/def.c | 18 ++- lang/m2/comp/defmodule.c | 58 +++++++- lang/m2/comp/desig.c | 13 +- lang/m2/comp/desig.h | 9 ++ lang/m2/comp/enter.c | 23 ++- lang/m2/comp/error.c | 9 ++ lang/m2/comp/expression.g | 9 ++ lang/m2/comp/f_info.h | 9 ++ lang/m2/comp/idf.c | 9 ++ lang/m2/comp/idf.h | 9 ++ lang/m2/comp/input.c | 9 ++ lang/m2/comp/input.h | 9 ++ lang/m2/comp/lookup.c | 9 ++ lang/m2/comp/main.c | 26 ++-- lang/m2/comp/main.h | 9 ++ lang/m2/comp/misc.c | 9 ++ lang/m2/comp/misc.h | 9 ++ lang/m2/comp/node.H | 9 ++ lang/m2/comp/node.c | 9 ++ lang/m2/comp/options.c | 28 ++-- lang/m2/comp/program.g | 18 ++- lang/m2/comp/scope.C | 39 ++--- lang/m2/comp/scope.h | 11 ++ lang/m2/comp/standards.h | 9 ++ lang/m2/comp/statement.g | 17 ++- lang/m2/comp/tmpvar.C | 9 ++ lang/m2/comp/tokenname.c | 9 ++ lang/m2/comp/tokenname.h | 9 ++ lang/m2/comp/type.H | 11 ++ lang/m2/comp/type.c | 129 +++++++++++++++-- lang/m2/comp/typequiv.c | 9 ++ lang/m2/comp/walk.c | 20 ++- lang/m2/comp/walk.h | 9 ++ lang/m2/comp/warning.h | 11 ++ 49 files changed, 989 insertions(+), 224 deletions(-) create mode 100644 lang/m2/comp/SYSTEM.h diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c index 158bc2965..03bf5bfad 100644 --- a/lang/m2/comp/LLlex.c +++ b/lang/m2/comp/LLlex.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* L E X I C A L A N A L Y S E R F O R M O D U L A - 2 */ +/* $Header$ */ + #include "debug.h" #include "idfsize.h" #include "numsize.h" @@ -25,7 +34,8 @@ long str2long(); struct token dot, aside; struct type *toktype; -int idfsize = IDFSIZE; +int idfsize = IDFSIZE; +int ForeignFlag; #ifdef DEBUG extern int cntlines; #endif @@ -42,6 +52,19 @@ SkipComment() register int CommentLevel = 0; LoadChar(ch); + if (ch == '$') { + LoadChar(ch); + switch(ch) { + case 'F': + /* Foreign; This definition module has an + implementation in another language. + In this case, don't generate prefixes in front + of the names + */ + ForeignFlag = 1; + break; + } + } for (;;) { if (class(ch) == STNL) { LineNumber++; @@ -138,10 +161,20 @@ linedirective() { /* Read a line directive */ register int ch; +} + +CheckForLineDirective() +{ + register int ch = getch(); register int i = 0; char buf[IDFSIZE + 2]; register char *c = buf; + + if (ch != '#') { + PushBack(); + return; + } do { /* * Skip to next digit * Do not skip newlines @@ -153,10 +186,10 @@ linedirective() { return; } } while (class(ch) != STNUM); - do { + while (class(ch) == STNUM) { i = i*10 + (ch - '0'); ch = getch(); - } while (class(ch) == STNUM); + } while (ch != '"' && class(ch) != STNL) ch = getch(); if (ch == '"') { c = buf; @@ -206,7 +239,7 @@ LLlex() tk->tk_lineno = LineNumber; -again2: +again1: if (eofseen) { eofseen = 0; ch = EOI; @@ -214,7 +247,6 @@ again2: else { again: LoadChar(ch); -again1: if ((ch & 0200) && ch != EOI) { error("non-ascii '\\%03o' read", ch & 0377); goto again; @@ -229,10 +261,8 @@ again1: cntlines++; #endif tk->tk_lineno++; - LoadChar(ch); - if (ch != '#') goto again1; - linedirective(); - goto again2; + CheckForLineDirective(); + goto again1; case STSKIP: goto again; diff --git a/lang/m2/comp/LLlex.h b/lang/m2/comp/LLlex.h index c6cc4a406..056d981ae 100644 --- a/lang/m2/comp/LLlex.h +++ b/lang/m2/comp/LLlex.h @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* T O K E N D E S C R I P T O R D E F I N I T I O N */ +/* $Header$ */ + /* Structure to store a string constant */ struct string { diff --git a/lang/m2/comp/LLmessage.c b/lang/m2/comp/LLmessage.c index a63866212..ff87da62d 100644 --- a/lang/m2/comp/LLmessage.c +++ b/lang/m2/comp/LLmessage.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* S Y N T A X E R R O R R E P O R T I N G */ +/* $Header$ */ + /* Defines the LLmessage routine. LLgen-generated parsers require the existence of a routine of that name. The routine must do syntax-error reporting and must be able to diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile index a38abbe0f..2e170d384 100644 --- a/lang/m2/comp/Makefile +++ b/lang/m2/comp/Makefile @@ -13,9 +13,9 @@ CURRDIR = . INCLUDES = -I$(MHDIR) -I$(EMHOME)/h -I$(PKGDIR) GFILES = tokenfile.g program.g declar.g expression.g statement.g -LLGENOPTIONS = +LLGENOPTIONS = -v PROFILE = -CFLAGS = $(PROFILE) $(INCLUDES) -DSTATIC= +CFLAGS = $(PROFILE) $(INCLUDES) -O -DSTATIC= LINTFLAGS = -DSTATIC= -DNORCSID MALLOC = $(LIBDIR)/malloc.o LFLAGS = $(PROFILE) @@ -61,7 +61,8 @@ install: all cp $(CURRDIR)/main $(EMHOME)/lib/em_m2 clean: - rm -f $(OBJ) $(GENFILES) LLfiles hfiles Cfiles tab clashes $(CURRDIR)/main + rm -f $(OBJ) $(GENFILES) LLfiles hfiles Cfiles tab clashes \ + $(CURRDIR)/main LL.output (cd .. ; rm -rf Xsrc) lint: Cfiles @@ -132,36 +133,266 @@ $(CURRDIR)/main: $(OBJ) size $(CURRDIR)/main #AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO -LLlex.o: LLlex.h Lpars.h class.h const.h debug.h debugcst.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h warning.h -LLmessage.o: LLlex.h Lpars.h idf.h +LLlex.o: LLlex.h +LLlex.o: Lpars.h +LLlex.o: class.h +LLlex.o: const.h +LLlex.o: debug.h +LLlex.o: debugcst.h +LLlex.o: f_info.h +LLlex.o: idf.h +LLlex.o: idfsize.h +LLlex.o: input.h +LLlex.o: inputtype.h +LLlex.o: numsize.h +LLlex.o: strsize.h +LLlex.o: type.h +LLlex.o: warning.h +LLmessage.o: LLlex.h +LLmessage.o: Lpars.h +LLmessage.o: idf.h char.o: class.h -error.o: LLlex.h debug.h debugcst.h errout.h f_info.h input.h inputtype.h main.h node.h warning.h -main.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h input.h inputtype.h ndir.h node.h scope.h standards.h tokenname.h type.h warning.h +error.o: LLlex.h +error.o: debug.h +error.o: debugcst.h +error.o: errout.h +error.o: f_info.h +error.o: input.h +error.o: inputtype.h +error.o: main.h +error.o: node.h +error.o: warning.h +main.o: LLlex.h +main.o: Lpars.h +main.o: debug.h +main.o: debugcst.h +main.o: def.h +main.o: f_info.h +main.o: idf.h +main.o: input.h +main.o: inputtype.h +main.o: ndir.h +main.o: node.h +main.o: scope.h +main.o: standards.h +main.o: tokenname.h +main.o: type.h +main.o: warning.h symbol2str.o: Lpars.h -tokenname.o: Lpars.h idf.h tokenname.h +tokenname.o: Lpars.h +tokenname.o: idf.h +tokenname.o: tokenname.h idf.o: idf.h -input.o: def.h f_info.h idf.h input.h inputtype.h scope.h -type.o: LLlex.h const.h debug.h debugcst.h def.h idf.h maxset.h node.h scope.h target_sizes.h type.h walk.h -def.o: LLlex.h Lpars.h debug.h debugcst.h def.h idf.h main.h node.h scope.h type.h -scope.o: LLlex.h debug.h debugcst.h def.h idf.h node.h scope.h type.h -misc.o: LLlex.h f_info.h idf.h misc.h node.h -enter.o: LLlex.h debug.h debugcst.h def.h idf.h main.h misc.h node.h scope.h type.h -defmodule.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h input.h inputtype.h main.h misc.h node.h scope.h type.h -typequiv.o: LLlex.h debug.h debugcst.h def.h node.h type.h warning.h -node.o: LLlex.h debug.h debugcst.h def.h node.h type.h -cstoper.o: LLlex.h Lpars.h debug.h debugcst.h idf.h node.h standards.h target_sizes.h type.h warning.h -chk_expr.o: LLlex.h Lpars.h chk_expr.h const.h debug.h debugcst.h def.h idf.h misc.h node.h scope.h standards.h type.h warning.h -options.o: idfsize.h main.h ndir.h type.h warning.h -walk.o: LLlex.h Lpars.h chk_expr.h debug.h debugcst.h def.h desig.h f_info.h idf.h main.h node.h scope.h type.h walk.h warning.h -casestat.o: LLlex.h Lpars.h debug.h debugcst.h density.h desig.h node.h type.h walk.h -desig.o: LLlex.h debug.h debugcst.h def.h desig.h node.h scope.h type.h -code.o: LLlex.h Lpars.h debug.h debugcst.h def.h desig.h node.h scope.h standards.h type.h walk.h -tmpvar.o: debug.h debugcst.h def.h main.h scope.h type.h -lookup.o: LLlex.h debug.h debugcst.h def.h idf.h misc.h node.h scope.h type.h -next.o: debug.h debugcst.h +input.o: def.h +input.o: f_info.h +input.o: idf.h +input.o: input.h +input.o: inputtype.h +input.o: scope.h +type.o: LLlex.h +type.o: chk_expr.h +type.o: const.h +type.o: debug.h +type.o: debugcst.h +type.o: def.h +type.o: idf.h +type.o: maxset.h +type.o: node.h +type.o: scope.h +type.o: target_sizes.h +type.o: type.h +type.o: walk.h +def.o: LLlex.h +def.o: Lpars.h +def.o: debug.h +def.o: debugcst.h +def.o: def.h +def.o: idf.h +def.o: main.h +def.o: node.h +def.o: scope.h +def.o: type.h +scope.o: LLlex.h +scope.o: debug.h +scope.o: debugcst.h +scope.o: def.h +scope.o: idf.h +scope.o: node.h +scope.o: scope.h +scope.o: type.h +misc.o: LLlex.h +misc.o: f_info.h +misc.o: idf.h +misc.o: misc.h +misc.o: node.h +enter.o: LLlex.h +enter.o: debug.h +enter.o: debugcst.h +enter.o: def.h +enter.o: idf.h +enter.o: main.h +enter.o: misc.h +enter.o: node.h +enter.o: scope.h +enter.o: type.h +defmodule.o: LLlex.h +defmodule.o: Lpars.h +defmodule.o: debug.h +defmodule.o: debugcst.h +defmodule.o: def.h +defmodule.o: f_info.h +defmodule.o: idf.h +defmodule.o: input.h +defmodule.o: inputtype.h +defmodule.o: main.h +defmodule.o: misc.h +defmodule.o: node.h +defmodule.o: scope.h +defmodule.o: type.h +typequiv.o: LLlex.h +typequiv.o: debug.h +typequiv.o: debugcst.h +typequiv.o: def.h +typequiv.o: node.h +typequiv.o: type.h +typequiv.o: warning.h +node.o: LLlex.h +node.o: debug.h +node.o: debugcst.h +node.o: def.h +node.o: node.h +node.o: type.h +cstoper.o: LLlex.h +cstoper.o: Lpars.h +cstoper.o: debug.h +cstoper.o: debugcst.h +cstoper.o: idf.h +cstoper.o: node.h +cstoper.o: standards.h +cstoper.o: target_sizes.h +cstoper.o: type.h +cstoper.o: warning.h +chk_expr.o: LLlex.h +chk_expr.o: Lpars.h +chk_expr.o: chk_expr.h +chk_expr.o: const.h +chk_expr.o: debug.h +chk_expr.o: debugcst.h +chk_expr.o: def.h +chk_expr.o: idf.h +chk_expr.o: misc.h +chk_expr.o: node.h +chk_expr.o: scope.h +chk_expr.o: standards.h +chk_expr.o: type.h +chk_expr.o: warning.h +options.o: idfsize.h +options.o: main.h +options.o: ndir.h +options.o: type.h +options.o: warning.h +walk.o: LLlex.h +walk.o: Lpars.h +walk.o: chk_expr.h +walk.o: debug.h +walk.o: debugcst.h +walk.o: def.h +walk.o: desig.h +walk.o: f_info.h +walk.o: idf.h +walk.o: main.h +walk.o: node.h +walk.o: scope.h +walk.o: type.h +walk.o: walk.h +walk.o: warning.h +casestat.o: LLlex.h +casestat.o: Lpars.h +casestat.o: debug.h +casestat.o: debugcst.h +casestat.o: density.h +casestat.o: desig.h +casestat.o: node.h +casestat.o: type.h +casestat.o: walk.h +desig.o: LLlex.h +desig.o: debug.h +desig.o: debugcst.h +desig.o: def.h +desig.o: desig.h +desig.o: node.h +desig.o: scope.h +desig.o: type.h +code.o: LLlex.h +code.o: Lpars.h +code.o: debug.h +code.o: debugcst.h +code.o: def.h +code.o: desig.h +code.o: node.h +code.o: scope.h +code.o: standards.h +code.o: type.h +code.o: walk.h +tmpvar.o: debug.h +tmpvar.o: debugcst.h +tmpvar.o: def.h +tmpvar.o: main.h +tmpvar.o: scope.h +tmpvar.o: type.h +lookup.o: LLlex.h +lookup.o: debug.h +lookup.o: debugcst.h +lookup.o: def.h +lookup.o: idf.h +lookup.o: misc.h +lookup.o: node.h +lookup.o: scope.h +lookup.o: type.h +next.o: debug.h +next.o: debugcst.h tokenfile.o: Lpars.h -program.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h main.h node.h scope.h type.h warning.h -declar.o: LLlex.h Lpars.h chk_expr.h debug.h debugcst.h def.h idf.h main.h misc.h node.h scope.h type.h warning.h -expression.o: LLlex.h Lpars.h chk_expr.h const.h debug.h debugcst.h def.h idf.h node.h type.h warning.h -statement.o: LLlex.h Lpars.h def.h idf.h node.h scope.h type.h +program.o: LLlex.h +program.o: Lpars.h +program.o: debug.h +program.o: debugcst.h +program.o: def.h +program.o: f_info.h +program.o: idf.h +program.o: main.h +program.o: node.h +program.o: scope.h +program.o: type.h +program.o: warning.h +declar.o: LLlex.h +declar.o: Lpars.h +declar.o: chk_expr.h +declar.o: debug.h +declar.o: debugcst.h +declar.o: def.h +declar.o: idf.h +declar.o: main.h +declar.o: misc.h +declar.o: node.h +declar.o: scope.h +declar.o: type.h +declar.o: warning.h +expression.o: LLlex.h +expression.o: Lpars.h +expression.o: chk_expr.h +expression.o: const.h +expression.o: debug.h +expression.o: debugcst.h +expression.o: def.h +expression.o: idf.h +expression.o: node.h +expression.o: type.h +expression.o: warning.h +statement.o: LLlex.h +statement.o: Lpars.h +statement.o: def.h +statement.o: idf.h +statement.o: node.h +statement.o: scope.h +statement.o: type.h Lpars.o: Lpars.h diff --git a/lang/m2/comp/SYSTEM.h b/lang/m2/comp/SYSTEM.h new file mode 100644 index 000000000..e8f8e3a4e --- /dev/null +++ b/lang/m2/comp/SYSTEM.h @@ -0,0 +1,18 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + +/* S Y S T E M M O D U L E T E X T */ + +/* $Header$ */ + +/* Text of SYSTEM module, for as far as it can be expressed in Modula-2 */ + +#define SYSTEMTEXT "DEFINITION MODULE SYSTEM;\n\ +TYPE PROCESS = ADDRESS;\n\ +PROCEDURE NEWPROCESS(P:PROC; A:ADDRESS; n:CARDINAL; VAR p1:ADDRESS);\n\ +PROCEDURE TRANSFER(VAR p1,p2:ADDRESS);\n\ +END SYSTEM.\n" diff --git a/lang/m2/comp/casestat.C b/lang/m2/comp/casestat.C index 63913e73e..37583965b 100644 --- a/lang/m2/comp/casestat.C +++ b/lang/m2/comp/casestat.C @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* C A S E S T A T E M E N T C O D E G E N E R A T I O N */ +/* $Header$ */ + /* Generation of case statements is done by first creating a description structure for the statement, build a list of the case-labels, then generating a case description in the code, diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index 401571d5f..95392b720 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* E X P R E S S I O N C H E C K I N G */ +/* $Header$ */ + /* Check expressions, and try to evaluate them as far as possible. */ @@ -1203,11 +1212,7 @@ int (*ExprChkTable[])() = { }; int (*DesigChkTable[])() = { -#ifdef DEBUG - ChkValue, -#else - done_before, -#endif + no_desig, ChkArr, no_desig, no_desig, diff --git a/lang/m2/comp/chk_expr.h b/lang/m2/comp/chk_expr.h index 7b9b4b187..6ad8ca344 100644 --- a/lang/m2/comp/chk_expr.h +++ b/lang/m2/comp/chk_expr.h @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* E X P R E S S I O N C H E C K I N G */ +/* $Header$ */ + extern int (*ExprChkTable[])(); /* table of expression checking functions, indexed by node class */ diff --git a/lang/m2/comp/class.h b/lang/m2/comp/class.h index 50f88e540..4fdcfa0ff 100644 --- a/lang/m2/comp/class.h +++ b/lang/m2/comp/class.h @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* U S E O F C H A R A C T E R C L A S S E S */ +/* $Header$ */ + /* As a starter, chars are divided into classes, according to which token they can be the start of. At present such a class number is supposed to fit in 4 bits. diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index d415d7a9e..46dc12b49 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* C O D E G E N E R A T I O N R O U T I N E S */ +/* $Header$ */ + /* Code generation for expressions and coercions */ diff --git a/lang/m2/comp/const.h b/lang/m2/comp/const.h index 378748082..b143b2c1b 100644 --- a/lang/m2/comp/const.h +++ b/lang/m2/comp/const.h @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* C O N S T A N T S F O R E X P R E S S I O N H A N D L I N G */ +/* $Header$ */ + extern long mach_long_sign; /* sign bit of the machine long */ extern int diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c index 878bc2c6f..c5ed84722 100644 --- a/lang/m2/comp/cstoper.c +++ b/lang/m2/comp/cstoper.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* C O N S T A N T E X P R E S S I O N H A N D L I N G */ +/* $Header$ */ + #include "debug.h" #include "target_sizes.h" diff --git a/lang/m2/comp/debug.h b/lang/m2/comp/debug.h index 670c29d18..40a8d48a1 100644 --- a/lang/m2/comp/debug.h +++ b/lang/m2/comp/debug.h @@ -1,5 +1,13 @@ -/* A debugging macro -*/ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + +/* D E B U G G I N G M A C R O */ + +/* $Header$ */ #include "debugcst.h" diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 12a6e0689..229fcbf41 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* D E C L A R A T I O N S */ +/* $Header$ */ + { #include "debug.h" @@ -21,25 +30,27 @@ int proclevel = 0; /* nesting level of procedures */ int return_occurred; /* set if a return occurs in a block */ + +#define needs_static_link() (proclevel > 1) + } ProcedureDeclaration { struct def *df; } : - { ++proclevel; } + { ++proclevel; } ProcedureHeading(&df, D_PROCEDURE) ';' block(&(df->prc_body)) IDENT - { EndProc(df, dot.TOK_IDF); - --proclevel; + { EndProc(df, dot.TOK_IDF); + --proclevel; } ; ProcedureHeading(struct def **pdf; int type;) { struct type *tp = 0; -#define needs_static_link() (proclevel > 1) arith parmaddr = needs_static_link() ? pointer_size : 0; struct paramlist *pr = 0; } : @@ -67,11 +78,11 @@ block(struct node **pnd;) : ; declaration: - CONST [ %persistent ConstantDeclaration ';' ]* + CONST [ ConstantDeclaration ';' ]* | - TYPE [ %persistent TypeDeclaration ';' ]* + TYPE [ TypeDeclaration ';' ]* | - VAR [ %persistent VariableDeclaration ';' ]* + VAR [ VariableDeclaration ';' ]* | ProcedureDeclaration ';' | @@ -171,20 +182,7 @@ enumeration(struct type **ptp;) struct node *EnumList; } : '(' IdentList(&EnumList) ')' - { register struct type *tp = - standard_type(T_ENUMERATION, int_align, int_size); - - *ptp = tp; - EnterEnumList(EnumList, tp); - if (ufit(tp->enm_ncst-1, 1)) { - tp->tp_size = 1; - tp->tp_align = 1; - } - else if (ufit(tp->enm_ncst-1, short_size)) { - tp->tp_size = short_size; - tp->tp_align = short_align; - } - } + { *ptp = enum_type(EnumList); } ; IdentList(struct node **p;) @@ -244,10 +242,7 @@ RecordType(struct type **ptp;) } : RECORD - { open_scope(OPENSCOPE); /* scope for fields of record */ - scope = CurrentScope; - close_scope(0); - } + { scope = open_and_close_scope(OPENSCOPE); } FieldListSequence(scope, &size, &xalign) { if (size == 0) { warning(W_ORDINARY, "empty record declaration"); @@ -271,13 +266,13 @@ FieldList(struct scope *scope; arith *cnt; int *palign;) struct node *FldList; register struct idf *id = 0; struct type *tp; - struct node *nd1; - register struct node *nd; + struct node *nd; arith tcnt, max; } : [ IdentList(&FldList) ':' type(&tp) - { *palign = lcm(*palign, tp->tp_align); + { + *palign = lcm(*palign, tp->tp_align); EnterFieldList(FldList, tp, scope, cnt); } | @@ -285,8 +280,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;) /* Also accept old fashioned Modula-2 syntax, but give a warning. Sorry for the complicated code. */ - [ qualident(&nd1) - { nd = nd1; } + [ qualident(&nd) [ ':' qualtype(&tp) /* This is correct, in both kinds of Modula-2, if the first qualident is a single identifier. @@ -300,25 +294,20 @@ FieldList(struct scope *scope; arith *cnt; int *palign;) | /* Old fashioned! the first qualident now represents the type */ - { warning(W_OLDFASHIONED, "old fashioned Modula-2 syntax; ':' missing"); - if (ChkDesignator(nd) && - (nd->nd_class != Def || - !(nd->nd_def->df_kind&(D_ERROR|D_ISTYPE)) || - !nd->nd_def->df_type)) { - node_error(nd, "type expected"); - tp = error_type; - } - else tp = nd->nd_def->df_type; - FreeNode(nd); + { warning(W_OLDFASHIONED, + "old fashioned Modula-2 syntax; ':' missing"); + tp = qualified_type(nd); } ] | ':' qualtype(&tp) /* Aha, third edition. Well done! */ ] - { if (id) { - register struct def *df = define(id, - scope, - D_FIELD); + { + *palign = lcm(*palign, tp->tp_align); + if (id) { + register struct def *df = + define(id, scope, D_FIELD); + if (!(tp->tp_fund & T_DISCRETE)) { error("illegal type in variant"); } @@ -351,7 +340,7 @@ variant(struct scope *scope; arith *cnt; struct type *tp; int *palign;) CaseLabelList(&tp, &nd) { /* Ignore the cases for the time being. Maybe a checking version will be supplied - later ??? (Improbable) + later ??? */ FreeNode(nd); } @@ -403,73 +392,21 @@ SetType(struct type **ptp;) : have to be declared yet, so be careful about identifying type-identifiers */ -PointerType(struct type **ptp;) -{ - register struct node *nd = 0; -} : +PointerType(struct type **ptp;) : POINTER TO - { *ptp = construct_type(T_POINTER, NULLTYPE); } - [ %if ( lookup(dot.TOK_IDF, CurrentScope, 1) - /* Either a Module or a Type, but in both cases defined - in this scope, so this is the correct identification - */ - || - ( nd = new_node(), - nd->nd_token = dot, - lookfor(nd, CurrVis, 0)->df_kind == D_MODULE - ) - /* A Modulename in one of the enclosing scopes. - It is not clear from the language definition that - it is correct to handle these like this, but - existing compilers do it like this, and the - alternative is difficult with a lookahead of only - one token. - ??? - */ - ) + [ %if (type_or_forward(ptp)) type(&((*ptp)->next)) - { if (nd) free_node(nd); } | - IDENT { if (nd) { - /* nd could be a null pointer, if we had a - syntax error exactly at this alternation. - MORAL: Be careful with %if resolvers with - side effects! - */ - Forward(nd, (*ptp)); - } - } + IDENT ] ; qualtype(struct type **ptp;) { - register struct node *nd; - struct node *nd1; /* because &nd is illegal */ + struct node *nd; } : - qualident(&nd1) - { nd = nd1; - *ptp = error_type; - if (ChkDesignator(nd)) { - if (nd->nd_class != Def) { - node_error(nd, "type expected"); - } - else { - register struct def *df = nd->nd_def; - - if (df->df_kind&(D_ISTYPE|D_FORWARD|D_ERROR)) { - if (! df->df_type) { -node_error(nd,"type \"%s\" not (yet) declared", df->df_idf->id_text); - } - else *ptp = df->df_type; - } - else { -node_error(nd,"identifier \"%s\" is not a type", df->df_idf->id_text); - } - } - } - FreeNode(nd); - } + qualident(&nd) + { *ptp = qualified_type(nd); } ; ProcedureType(struct type **ptp;) diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H index 3462d4b25..e50947d96 100644 --- a/lang/m2/comp/def.H +++ b/lang/m2/comp/def.H @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* I D E N T I F I E R D E S C R I P T O R S T R U C T U R E */ +/* $Header$ */ + struct module { struct node *mo_priority;/* priority of a module */ struct scopelist *mo_vis;/* scope of this module */ @@ -106,6 +115,7 @@ struct def { /* list of definitions for a name */ #define D_EXPORTED 0x20 /* set if exported */ #define D_QEXPORTED 0x40 /* set if qualified exported */ #define D_BUSY 0x80 /* set if busy reading this definition module */ +#define D_FOREIGN 0x100 /* set for foreign language modules */ struct type *df_type; union { struct module df_module; diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c index 40d613eb4..f8dfcf783 100644 --- a/lang/m2/comp/def.c +++ b/lang/m2/comp/def.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* D E F I N I T I O N M E C H A N I S M */ +/* $Header$ */ + #include "debug.h" #include @@ -234,8 +243,13 @@ DeclProc(type, id) */ df = define(id, CurrentScope, type); df->for_node = MkLeaf(Name, &dot); - sprint(buf,"%s_%s",CurrentScope->sc_name,id->id_text); - df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1)); + if (CurrentScope->sc_definedby->df_flags & D_FOREIGN) { + df->for_name = id->id_text; + } + else { + sprint(buf,"%s_%s",CurrentScope->sc_name,id->id_text); + df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1)); + } if (CurrVis == Defined->mod_vis) { /* The current module will define this routine. make sure the name is exported. diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c index d5f68767e..d402a7805 100644 --- a/lang/m2/comp/defmodule.c +++ b/lang/m2/comp/defmodule.c @@ -1,10 +1,20 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* D E F I N I T I O N M O D U L E S */ +/* $Header$ */ + #include "debug.h" #include #include #include +#include #include "idf.h" #include "input.h" @@ -24,6 +34,28 @@ long sys_filesize(); struct idf *DefId; +STATIC char * +getwdir(fn) + char *fn; +{ + register char *p; + char *strrindex(); + + p = strrindex(fn, '/'); + while (p && *(p + 1) == '\0') { /* remove trailing /'s */ + *p = '\0'; + p = strrindex(fn, '/'); + } + + if (p) { + *p = '\0'; + fn = Salloc(fn, p - &fn[0] + 1); + *p = '/'; + return fn; + } + else return "."; +} + STATIC GetFile(name) char *name; @@ -33,14 +65,17 @@ GetFile(name) */ char buf[15]; char *strcpy(), *strcat(); + static char *WorkingDir = "."; strncpy(buf, name, 10); buf[10] = '\0'; /* maximum length */ strcat(buf, ".def"); + DEFPATH[0] = WorkingDir; if (! InsertFile(buf, DEFPATH, &(FileName))) { error("could not find a DEFINITION MODULE for \"%s\"", name); return 0; } + WorkingDir = getwdir(FileName); LineNumber = 1; DO_DEBUG(options['F'], debug("File %s : %ld characters", FileName, sys_filesize(FileName))); return 1; @@ -64,20 +99,26 @@ GetDefinitionModule(id, incr) if (!df) { /* Read definition module. Make an exception for SYSTEM. */ + DefId = id; if (!strcmp(id->id_text, "SYSTEM")) { do_SYSTEM(); + df = lookup(id, GlobalScope, 1); } else { + extern int ForeignFlag; + + ForeignFlag = 0; open_scope(CLOSEDSCOPE); if (!is_anon_idf(id) && GetFile(id->id_text)) { - DefId = id; DefModule(); - if (level == 1) { + df = lookup(id, GlobalScope, 1); + if (level == 1 && + (!df || !(df->df_flags & D_FOREIGN))) { /* The module is directly imported by - the currently defined module, so we - have to remember its name because - we have to call its initialization - routine + the currently defined module, and + is not foreign, so we have to + remember its name because we have + to call its initialization routine */ static struct node *nd_end; register struct node *n; @@ -91,10 +132,13 @@ GetDefinitionModule(id, incr) nd_end = n; } } + else { + df = lookup(id, GlobalScope, 1); + CurrentScope->sc_name = id->id_text; + } vis = CurrVis; close_scope(SC_CHKFORW); } - df = lookup(id, GlobalScope, 1); if (! df) { df = MkDef(id, GlobalScope, D_ERROR); df->df_type = error_type; diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c index 09e66db07..d04ccf19f 100644 --- a/lang/m2/comp/desig.c +++ b/lang/m2/comp/desig.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* D E S I G N A T O R E V A L U A T I O N */ +/* $Header$ */ + /* Code generation for designators. This file contains some routines that generate code common to address as well as value computations, and leave a description in a "desig" @@ -43,11 +52,11 @@ properly(ds, size, al) arith wordmodsz = word_size % size; /* 0 if dividor of wordsize */ if (szmodword && wordmodsz) return 0; - if (al >= word_size) return 1; + if (al >= word_align) return 1; if (szmodword && al >= szmodword) return 1; return ds->dsg_kind == DSG_FIXED && - ((! szmodword && ds->dsg_offset % word_size == 0) || + ((! szmodword && ds->dsg_offset % word_align == 0) || (! wordmodsz && ds->dsg_offset % size == 0)); } diff --git a/lang/m2/comp/desig.h b/lang/m2/comp/desig.h index 4b6bb97bb..690dd9b05 100644 --- a/lang/m2/comp/desig.h +++ b/lang/m2/comp/desig.h @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* D E S I G N A T O R D E S C R I P T I O N S */ +/* $Header$ */ + /* Generating code for designators is not particularly easy, especially if you don't know wether you want the address or the value. The next structure is used to generate code for designators. diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c index 52debbc75..019eadcd2 100644 --- a/lang/m2/comp/enter.c +++ b/lang/m2/comp/enter.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* H I G H L E V E L S Y M B O L E N T R Y */ +/* $Header$ */ + #include "debug.h" #include @@ -94,12 +103,10 @@ EnterVarList(Idlist, type, local) */ register struct def *df; register struct node *idlist = Idlist; - register struct scopelist *sc; + register struct scopelist *sc = CurrVis; char buf[256]; extern char *sprint(); - sc = CurrVis; - if (local) { /* Find the closest enclosing open scope. This is the procedure that we are dealing with @@ -136,9 +143,15 @@ EnterVarList(Idlist, type, local) else { /* Global name, possibly external */ - sprint(buf,"%s_%s", sc->sc_scope->sc_name, + if (sc->sc_scope->sc_definedby->df_flags & D_FOREIGN) { + df->var_name = df->df_idf->id_text; + } + else { + sprint(buf,"%s_%s", sc->sc_scope->sc_name, df->df_idf->id_text); - df->var_name = Salloc(buf, (unsigned)(strlen(buf)+1)); + df->var_name = Salloc(buf, + (unsigned)(strlen(buf)+1)); + } df->df_flags |= D_NOREG; if (DefinitionModule) { diff --git a/lang/m2/comp/error.c b/lang/m2/comp/error.c index 468abbe04..db6f665d2 100644 --- a/lang/m2/comp/error.c +++ b/lang/m2/comp/error.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* E R R O R A N D D I A G N O S T I C R O U T I N E S */ +/* $Header$ */ + /* This file contains the (non-portable) error-message and diagnostic giving functions. Be aware that they are called with a variable number of arguments! diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g index 542d18e8e..ba91265be 100644 --- a/lang/m2/comp/expression.g +++ b/lang/m2/comp/expression.g @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* E X P R E S S I O N S */ +/* $Header$ */ + { #include "debug.h" diff --git a/lang/m2/comp/f_info.h b/lang/m2/comp/f_info.h index 7efbec727..4d8c04020 100644 --- a/lang/m2/comp/f_info.h +++ b/lang/m2/comp/f_info.h @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* F I L E D E S C R I P T O R S T R U C T U R E */ +/* $Header$ */ + struct f_info { unsigned short f_lineno; char *f_filename; diff --git a/lang/m2/comp/idf.c b/lang/m2/comp/idf.c index 6fc41b525..6429ef7d1 100644 --- a/lang/m2/comp/idf.c +++ b/lang/m2/comp/idf.c @@ -1,4 +1,13 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* I N S T A N T I A T I O N O F I D F P A C K A G E */ +/* $Header$ */ + #include "idf.h" #include diff --git a/lang/m2/comp/idf.h b/lang/m2/comp/idf.h index 62e72bb57..2c9fa76b5 100644 --- a/lang/m2/comp/idf.h +++ b/lang/m2/comp/idf.h @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* U S E R D E C L A R E D P A R T O F I D F */ +/* $Header$ */ + struct id_u { int id_res; struct def *id_df; diff --git a/lang/m2/comp/input.c b/lang/m2/comp/input.c index 48f0525a1..7a884d6dc 100644 --- a/lang/m2/comp/input.c +++ b/lang/m2/comp/input.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* I N S T A N T I A T I O N O F I N P U T P A C K A G E */ +/* $Header$ */ + #include "f_info.h" struct f_info file_info; #include "input.h" diff --git a/lang/m2/comp/input.h b/lang/m2/comp/input.h index 74ac774bd..f52c3524c 100644 --- a/lang/m2/comp/input.h +++ b/lang/m2/comp/input.h @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* I N S T A N T I A T I O N O F I N P U T M O D U L E */ +/* $Header$ */ + #include "inputtype.h" #define INP_NPUSHBACK 2 diff --git a/lang/m2/comp/lookup.c b/lang/m2/comp/lookup.c index c4c297a09..8966441f9 100644 --- a/lang/m2/comp/lookup.c +++ b/lang/m2/comp/lookup.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* L O O K U P R O U T I N E S */ +/* $Header$ */ + #include "debug.h" #include diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index f76a098a2..7e398ba9e 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* M A I N P R O G R A M */ +/* $Header$ */ + #include "debug.h" #include "ndir.h" @@ -19,6 +28,7 @@ #include "tokenname.h" #include "node.h" #include "warning.h" +#include "SYSTEM.h" int state; /* either IMPLEMENTATION or PROGRAM */ char options[128]; @@ -67,8 +77,6 @@ Compile(src, dst) } LineNumber = 1; FileName = src; - DEFPATH[0] = "."; - DEFPATH[NDIRS] = 0; init_idf(); InitCst(); reserve(tkidf); @@ -88,6 +96,7 @@ Compile(src, dst) if (! C_open(dst)) fatal("could not open output file"); C_magic(); C_ms_emx(word_size, pointer_size); + CheckForLineDirective(); CompUnit(); C_ms_src((arith) (LineNumber - 1), FileName); if (!err_occurred) { @@ -186,26 +195,19 @@ AddStandards() df->enm_next = 0; } -/* How do you like that! Modula-2 in a C-program. -*/ -char SYSTEM[] = "\ -DEFINITION MODULE SYSTEM;\n\ -TYPE PROCESS = ADDRESS;\n\ -PROCEDURE NEWPROCESS(P:PROC; A:ADDRESS; n:CARDINAL; VAR p1:ADDRESS);\n\ -PROCEDURE TRANSFER(VAR p1,p2:ADDRESS);\n\ -END SYSTEM.\n"; - do_SYSTEM() { /* Simulate the reading of the SYSTEM definition module */ + static char systemtext[] = SYSTEMTEXT; + open_scope(CLOSEDSCOPE); Enter("WORD", D_TYPE, word_type, 0); Enter("BYTE", D_TYPE, byte_type, 0); Enter("ADDRESS", D_TYPE, address_type, 0); Enter("ADR", D_PROCEDURE, std_type, S_ADR); Enter("TSIZE", D_PROCEDURE, std_type, S_TSIZE); - if (!InsertText(SYSTEM, sizeof(SYSTEM) - 1)) { + if (!InsertText(systemtext, sizeof(systemtext) - 1)) { fatal("could not insert text"); } DefModule(); diff --git a/lang/m2/comp/main.h b/lang/m2/comp/main.h index 906af4cbd..d79a91266 100644 --- a/lang/m2/comp/main.h +++ b/lang/m2/comp/main.h @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* S O M E G L O B A L V A R I A B L E S */ +/* $Header$ */ + extern char options[]; /* indicating which options were given */ extern int DefinitionModule; diff --git a/lang/m2/comp/misc.c b/lang/m2/comp/misc.c index dc589d6f7..cf2581179 100644 --- a/lang/m2/comp/misc.c +++ b/lang/m2/comp/misc.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* M I S C E L L A N E O U S R O U T I N E S */ +/* $Header$ */ + #include #include #include diff --git a/lang/m2/comp/misc.h b/lang/m2/comp/misc.h index 8d8b48ed4..a781f091b 100644 --- a/lang/m2/comp/misc.h +++ b/lang/m2/comp/misc.h @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* M I S C E L L A N E O U S */ +/* $Header$ */ + #define is_anon_idf(x) ((x)->id_text[0] == '#') #define id_not_declared(x) (not_declared("identifier", (x), "")) diff --git a/lang/m2/comp/node.H b/lang/m2/comp/node.H index 0bb5a28ba..0a6f37667 100644 --- a/lang/m2/comp/node.H +++ b/lang/m2/comp/node.H @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* N O D E O F A N A B S T R A C T P A R S E T R E E */ +/* $Header$ */ + struct node { struct node *next; #define nd_left next diff --git a/lang/m2/comp/node.c b/lang/m2/comp/node.c index 2ca29e60d..1aa825ddb 100644 --- a/lang/m2/comp/node.c +++ b/lang/m2/comp/node.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* N O D E O F A N A B S T R A C T P A R S E T R E E */ +/* $Header$ */ + #include "debug.h" #include diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c index 4a7c86b17..da084b7cf 100644 --- a/lang/m2/comp/options.c +++ b/lang/m2/comp/options.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* U S E R O P T I O N - H A N D L I N G */ +/* $Header$ */ + #include "idfsize.h" #include "ndir.h" @@ -18,7 +27,7 @@ recognize some keywords! #endif extern int idfsize; -static int ndirs; +static int ndirs = 1; int warning_classes; DoOption(text) @@ -26,17 +35,16 @@ DoOption(text) { switch(*text++) { - default: - options[text[-1]]++; /* flags, debug options etc. */ + case '-': + options[*text]++; /* debug options etc. */ break; - /* recognized flags: - -L: don't generate fil/lin - -p: generate procentry/procexit - -w: no warnings - -n: no register messages - and many more if DEBUG - */ + case 'L': /* no fil/lin */ + case 'p': /* call procentry/procexit */ + case 'n': /* no register messages */ + case 'x': /* every name global */ + options[text[-1]]++; + break; case 'w': if (*text) { diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g index 40d8113a2..034ff445d 100644 --- a/lang/m2/comp/program.g +++ b/lang/m2/comp/program.g @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* O V E R A L L S T R U C T U R E */ +/* $Header$ */ + { #include "debug.h" @@ -118,14 +127,17 @@ DefinitionModule struct node *exportlist; int dummy; extern struct idf *DefId; + extern int ForeignFlag; } : DEFINITION MODULE IDENT { df = define(dot.TOK_IDF, GlobalScope, D_MODULE); df->df_flags |= D_BUSY; + if (ForeignFlag) df->df_flags |= D_FOREIGN; if (!Defined) Defined = df; + CurrentScope->sc_definedby = df; if (df->df_idf != DefId) { - error("DEFINITION MODULE name is not \"%s\"", - DefId->id_text); + error("DEFINITION MODULE name is \"%s\", not \"%s\"", + df->df_idf->id_text, DefId->id_text); } CurrentScope->sc_name = df->df_idf->id_text; df->mod_vis = CurrVis; @@ -207,8 +219,8 @@ ProgramModule open_scope(CLOSEDSCOPE); df->mod_vis = CurrVis; CurrentScope->sc_name = "_M2M"; + CurrentScope->sc_definedby = df; } - CurrentScope->sc_definedby = df; } priority(df) ';' import(0)* diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C index 790e0ad24..6fbde4afb 100644 --- a/lang/m2/comp/scope.C +++ b/lang/m2/comp/scope.C @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* S C O P E M E C H A N I S M */ +/* $Header$ */ + #include "debug.h" #include @@ -44,6 +53,17 @@ open_scope(scopetype) CurrVis = ls; } +struct scope * +open_and_close_scope(scopetype) +{ + struct scope *sc; + + open_scope(scopetype); + sc = CurrentScope; + close_scope(); + return sc; +} + InitScope() { register struct scope *sc = new_scope(); @@ -60,25 +80,6 @@ InitScope() CurrVis = ls; } -Forward(tk, ptp) - struct node *tk; - struct type *ptp; -{ - /* Enter a forward reference into a list belonging to the - current scope. This is used for POINTER declarations, which - may have forward references that must howewer be declared in the - same scope. - */ - register struct def *df = define(tk->nd_IDF, CurrentScope, D_FORWTYPE); - - if (df->df_kind == D_TYPE) { - ptp->next = df->df_type; - return; - } - df->df_forw_type = ptp; - df->df_forw_node = tk; -} - STATIC chk_proc(df) register struct def *df; diff --git a/lang/m2/comp/scope.h b/lang/m2/comp/scope.h index 2fd385b30..e1491cbd3 100644 --- a/lang/m2/comp/scope.h +++ b/lang/m2/comp/scope.h @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* S C O P E M E C H A N I S M */ +/* $Header$ */ + #define OPENSCOPE 0 /* Indicating an open scope */ #define CLOSEDSCOPE 1 /* Indicating a closed scope (module) */ @@ -40,3 +49,5 @@ extern struct scopelist #define enclosing(x) ((x)->sc_encl) #define scopeclosed(x) ((x)->sc_scopeclosed) #define nextvisible(x) ((x)->next) /* use with scopelists */ + +struct scope *open_and_close_scope(); diff --git a/lang/m2/comp/standards.h b/lang/m2/comp/standards.h index 3f1bd60af..e229ff759 100644 --- a/lang/m2/comp/standards.h +++ b/lang/m2/comp/standards.h @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* S T A N D A R D P R O C E D U R E S A N D F U N C T I O N S */ +/* $Header$ */ + #define S_ABS 1 #define S_CAP 2 #define S_CHR 3 diff --git a/lang/m2/comp/statement.g b/lang/m2/comp/statement.g index 875ea1ea2..372030178 100644 --- a/lang/m2/comp/statement.g +++ b/lang/m2/comp/statement.g @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* S T A T E M E N T S */ +/* $Header$ */ + { #include #include @@ -147,7 +156,13 @@ CaseStatement(struct node **pnd;) case(&(nd->nd_right), &tp) { nd = nd->nd_right; } ]* - [ ELSE StatementSequence(&(nd->nd_right)) ]? + [ ELSE StatementSequence(&(nd->nd_right)) + { if (! nd->nd_right) { + nd->nd_right = MkLeaf(Stat, &dot); + nd->nd_right->nd_symb = ';'; + } + } + ]? END ; diff --git a/lang/m2/comp/tmpvar.C b/lang/m2/comp/tmpvar.C index 294ef0775..009a7498e 100644 --- a/lang/m2/comp/tmpvar.C +++ b/lang/m2/comp/tmpvar.C @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* T E M P O R A R Y V A R I A B L E S */ +/* $Header$ */ + /* Code for the allocation and de-allocation of temporary variables, allowing re-use. The routines use "ProcScope" instead of "CurrentScope", because diff --git a/lang/m2/comp/tokenname.c b/lang/m2/comp/tokenname.c index 223c2a66d..c78f50bd9 100644 --- a/lang/m2/comp/tokenname.c +++ b/lang/m2/comp/tokenname.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* T O K E N D E F I N I T I O N S */ +/* $Header$ */ + #include "tokenname.h" #include "Lpars.h" #include "idf.h" diff --git a/lang/m2/comp/tokenname.h b/lang/m2/comp/tokenname.h index 79ccdc4cd..b3a4720dd 100644 --- a/lang/m2/comp/tokenname.h +++ b/lang/m2/comp/tokenname.h @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* T O K E N N A M E S T R U C T U R E */ +/* $Header$ */ + struct tokenname { /* Used for defining the name of a token as identified by its symbol */ diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H index b22559c3c..9bca0e904 100644 --- a/lang/m2/comp/type.H +++ b/lang/m2/comp/type.H @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* T Y P E D E S C R I P T O R S T R U C T U R E */ +/* $Header$ */ + struct paramlist { /* structure for parameterlist of a PROCEDURE */ struct paramlist *next; struct def *par_def; /* "df" of parameter */ @@ -131,6 +140,8 @@ struct type *set_type(), *subr_type(), *proc_type(), + *enum_type(), + *qualified_type(), *RemoveEqual(); /* All from type.c */ #define NULLTYPE ((struct type *) 0) diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index cea61145a..784e921b5 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* T Y P E D E F I N I T I O N M E C H A N I S M */ +/* $Header$ */ + #include "target_sizes.h" #include "debug.h" #include "maxset.h" @@ -18,6 +27,7 @@ #include "const.h" #include "scope.h" #include "walk.h" +#include "chk_expr.h" int word_align = AL_WORD, @@ -100,9 +110,10 @@ align(pos, al) arith pos; int al; { - arith i; + arith i = pos % al; - return pos + ((i = pos % al) ? al - i : 0); + if (i) return pos + al - i; + return pos; } struct type * @@ -113,8 +124,10 @@ standard_type(fund, align, size) { register struct type *tp = new_type(); + if (align == 0) align = 1; + tp->tp_fund = fund; - tp->tp_align = align ? align : 1; + tp->tp_align = align; tp->tp_size = size; return tp; @@ -192,6 +205,59 @@ InitTypes() error_type = standard_type(T_CHAR, 1, (arith) 1); } +STATIC +u_small(tp, n) + register struct type *tp; + arith n; +{ + if (ufit(n, 1)) { + tp->tp_size = 1; + tp->tp_align = 1; + } + else if (ufit(n, short_size)) { + tp->tp_size = short_size; + tp->tp_align = short_align; + } +} + +struct type * +enum_type(EnumList) + struct node *EnumList; +{ + register struct type *tp = + standard_type(T_ENUMERATION, int_align, int_size); + + EnterEnumList(EnumList, tp); + u_small(tp, (arith) (tp->enm_ncst-1)); + return tp; +} + +struct type * +qualified_type(nd) + struct node *nd; +{ + struct type *tp = error_type; + + if (ChkDesignator(nd)) { + if (nd->nd_class != Def) node_error(nd, "type expected"); + else { + register struct def *df = nd->nd_def; + + if (df->df_kind&(D_ISTYPE|D_FORWARD|D_ERROR)) { + if (! df->df_type) { +node_error(nd,"type \"%s\" not (yet) declared", df->df_idf->id_text); + } + else tp = df->df_type; + } + else { +node_error(nd,"identifier \"%s\" is not a type", df->df_idf->id_text); + } + } + } + FreeNode(nd); + return tp; +} + chk_basesubrange(tp, base) register struct type *tp, *base; { @@ -275,14 +341,7 @@ subr_type(lb, ub) res->tp_size = tp->tp_size; res->tp_align = tp->tp_align; if (tp == card_type) { - if (ufit(res->sub_ub, 1)) { - res->tp_size = 1; - res->tp_align = 1; - } - else if (ufit(res->sub_ub, 2)) { - res->tp_size = short_size; - res->tp_align = short_align; - } + u_small(res, res->sub_ub); } else if (tp == int_type) { if (fit(res->sub_lb, 1) && fit(res->sub_ub, 1)) { @@ -505,6 +564,54 @@ RemoveEqual(tpx) return tpx; } +int +type_or_forward(ptp) + struct type **ptp; +{ + struct node *nd = 0; + + *ptp = construct_type(T_POINTER, NULLTYPE); + if (lookup(dot.TOK_IDF, CurrentScope, 1) + /* Either a Module or a Type, but in both cases defined + in this scope, so this is the correct identification + */ + || + ( nd = new_node(), + nd->nd_token = dot, + lookfor(nd, CurrVis, 0)->df_kind == D_MODULE + ) + /* A Modulename in one of the enclosing scopes. + It is not clear from the language definition that + it is correct to handle these like this, but + existing compilers do it like this, and the + alternative is difficult with a lookahead of only + one token. + ??? + */ + ) { + if (nd) free_node(nd); + return 1; + } + /* Enter a forward reference into a list belonging to the + current scope. This is used for POINTER declarations, which + may have forward references that must howewer be declared in the + same scope. + */ + { + register struct def *df = + define(nd->nd_IDF, CurrentScope, D_FORWTYPE); + + if (df->df_kind == D_TYPE) { + (*ptp)->next = df->df_type; + } + else { + df->df_forw_type = *ptp; + df->df_forw_node = nd; + } + } + return 0; +} + int gcd(m, n) register int m, n; diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c index ffd5aa42b..565fb8b12 100644 --- a/lang/m2/comp/typequiv.c +++ b/lang/m2/comp/typequiv.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* T Y P E E Q U I V A L E N C E */ +/* $Header$ */ + /* Routines for testing type equivalence, type compatibility, and assignment compatibility */ diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index 4fce40119..f8328455e 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* P A R S E T R E E W A L K E R */ +/* $Header$ */ + /* Routines to walk through parts of the parse tree, and generate code for these parts. */ @@ -42,6 +51,9 @@ static struct node *priority; STATIC DoPriority() { + /* For the time being (???), handle priorities by calls to + the runtime system + */ if (priority) { C_loc(priority->nd_INT); C_cal("_stackprio"); @@ -111,10 +123,11 @@ WalkModule(module) register struct node *nd = Modules; if (state == IMPLEMENTATION) { - label l1 = ++data_label; - /* we don't actually prevent recursive calls, + /* We don't actually prevent recursive calls, but do nothing if called recursively */ + label l1 = ++data_label; + C_df_dlb(l1); C_bss_cst(word_size, (arith) 0, 1); /* if this one is set to non-zero, the initialization @@ -422,6 +435,9 @@ WalkStat(nd, exit_label) if (! options['L']) C_lin((arith) nd->nd_lineno); switch(nd->nd_symb) { + case ';': + break; + case BECOMES: DoAssign(nd, left, right); break; diff --git a/lang/m2/comp/walk.h b/lang/m2/comp/walk.h index 4222dbeb5..877af2723 100644 --- a/lang/m2/comp/walk.h +++ b/lang/m2/comp/walk.h @@ -1,5 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + /* P A R S E T R E E W A L K E R */ +/* $Header$ */ + /* Definition of WalkNode macro */ diff --git a/lang/m2/comp/warning.h b/lang/m2/comp/warning.h index ee7cc60c6..0486bcafc 100644 --- a/lang/m2/comp/warning.h +++ b/lang/m2/comp/warning.h @@ -1,3 +1,14 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + +/* W A R N I N G C L A S S E S */ + +/* $Header$ */ + /* Warning classes, at the moment three of them: Strict (R) Ordinary (W)