From ec9929d93902f241a6d8b6752fdf947e19c2efa5 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.H | 9 ++ lang/m2/comp/misc.c | 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 158bc296..03bf5bfa 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 c6cc4a40..056d981a 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 a6386621..ff87da62 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 a38abbe0..2e170d38 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 00000000..e8f8e3a4 --- /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 63913e73..37583965 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 401571d5..95392b72 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 7b9b4b18..6ad8ca34 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 50f88e54..4fdcfa0f 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 d415d7a9..46dc12b4 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 37874808..b143b2c1 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 878bc2c6..c5ed8472 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 670c29d1..40a8d48a 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 12a6e068..229fcbf4 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 3462d4b2..e50947d9 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 40d613eb..f8dfcf78 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 d5f68767..d402a780 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 09e66db0..d04ccf19 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 4b6bb97b..690dd9b0 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 52debbc7..019eadcd 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 468abbe0..db6f665d 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 542d18e8..ba91265b 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 7efbec72..4d8c0402 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 6fc41b52..6429ef7d 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 62e72bb5..2c9fa76b 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 48f0525a..7a884d6d 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 74ac774b..f52c3524 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 c4c297a0..8966441f 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 f76a098a..7e398ba9 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 906af4cb..d79a9126 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.H b/lang/m2/comp/misc.H index 8d8b48ed..a781f091 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/misc.c b/lang/m2/comp/misc.c index dc589d6f..cf258117 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/node.H b/lang/m2/comp/node.H index 0bb5a28b..0a6f3766 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 2ca29e60..1aa825dd 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 4a7c86b1..da084b7c 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 40d8113a..034ff445 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 790e0ad2..6fbde4af 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 2fd385b3..e1491cbd 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 3f1bd60a..e229ff75 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 875ea1ea..37203017 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 294ef077..009a7498 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 223c2a66..c78f50bd 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 79ccdc4c..b3a4720d 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 b22559c3..9bca0e90 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 cea61145..784e921b 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 ffd5aa42..565fb8b1 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 4fce4011..f8328455 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 4222dbeb..877af272 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 ee7cc60c..0486bcaf 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)