From c8453bb3f7ab97cb50e5115750be6bdf91a5d965 Mon Sep 17 00:00:00 2001 From: ceriel Date: Thu, 3 Apr 1986 17:41:26 +0000 Subject: [PATCH] newer version, safety commit --- lang/m2/comp/LLlex.c | 15 ++++++----- lang/m2/comp/Makefile | 13 +++++---- lang/m2/comp/def.c | 53 ++++++++++++++++++++++++++++++++++-- lang/m2/comp/enter.c | 2 +- lang/m2/comp/error.c | 8 +++--- lang/m2/comp/expression.g | 3 +-- lang/m2/comp/main.c | 57 +++++++++++++++++++++++++-------------- lang/m2/comp/main.h | 12 ++++++--- lang/m2/comp/misc.c | 15 +++++++++-- lang/m2/comp/program.g | 38 +++++++++++++++++++------- lang/m2/comp/standards.h | 6 ++++- lang/m2/comp/tokenname.c | 2 ++ lang/m2/comp/type.H | 3 ++- lang/m2/comp/type.c | 7 +++-- 14 files changed, 175 insertions(+), 59 deletions(-) diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c index dedcca453..0eaa1730e 100644 --- a/lang/m2/comp/LLlex.c +++ b/lang/m2/comp/LLlex.c @@ -19,12 +19,12 @@ long str2long(); struct token dot, aside; -/* Skip Modula-2 like comment (* ... *). - Note that comment may be nested. -*/ static SkipComment() { + /* Skip Modula-2 comments (* ... *). + Note that comments may be nested (par. 3.5). + */ register int ch; register int NestLevel = 0; @@ -62,6 +62,8 @@ SkipComment() static char * GetString(upto) { + /* Read a Modula-2 string, delimited by the character "upto". + */ register int ch; int str_size; char *str = Malloc(str_size = 32); @@ -88,12 +90,12 @@ GetString(upto) return str; } -/* LLlex() plays the role of Lexical Analyzer for the parser. - The putting aside of tokens is taken into account. -*/ int LLlex() { + /* LLlex() plays the role of Lexical Analyzer for the parser. + The putting aside of tokens is taken into account. + */ register struct token *tk = ˙ char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 1]; register int ch, nch; @@ -378,4 +380,3 @@ Sdec: } /*NOTREACHED*/ } - diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile index b88cbb48a..211f60ec7 100644 --- a/lang/m2/comp/Makefile +++ b/lang/m2/comp/Makefile @@ -4,17 +4,20 @@ HDIR = ../../em/h PKGDIR = ../../em/pkg LIBDIR = ../../em/lib + INCLUDES = -I$(HDIR) -I$(PKGDIR) -I/user1/erikb/em/h + LSRC = tokenfile.g program.g declar.g expression.g statement.g CC = cc GEN = LLgen GENOPTIONS = -CFLAGS = -DDEBUG -p $(INCLUDES) -LFLAGS = -p +PROFILE = +CFLAGS = -DDEBUG $(PROFILE) $(INCLUDES) +LFLAGS = $(PROFILE) LOBJ = tokenfile.o program.o declar.o expression.o statement.o COBJ = LLlex.o LLmessage.o char.o error.o main.o \ symbol2str.o tokenname.o idf.o input.o type.o def.o \ - scope.o misc.o print.o enter.o defmodule.o + scope.o misc.o enter.o defmodule.o OBJ = $(COBJ) $(LOBJ) Lpars.o GENFILES= tokenfile.c \ program.c declar.c expression.c statement.c \ @@ -29,7 +32,7 @@ LLfiles: $(LSRC) @touch LLfiles main: $(OBJ) Makefile - $(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libcomp.a $(LIBDIR)/malloc.o /user1/erikb/em/lib/libstr.a /user1/erikb/em/lib/libsystem.a -o main + $(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libcomp.a $(LIBDIR)/malloc.o /user1/erikb/em/lib/libprint.a /user1/erikb/em/lib/libstr.a /user1/erikb/em/lib/libsystem.a -o main size main clean: @@ -68,7 +71,7 @@ depend: LLlex.o: LLlex.h Lpars.h class.h f_info.h idf.h input.h LLmessage.o: LLlex.h Lpars.h idf.h char.o: class.h -error.o: LLlex.h f_info.h input.h +error.o: LLlex.h f_info.h input.h main.h main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h main.h scope.h standards.h type.h symbol2str.o: Lpars.h tokenname.o: Lpars.h idf.h tokenname.h diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c index 9a51998fe..231364b10 100644 --- a/lang/m2/comp/def.c +++ b/lang/m2/comp/def.c @@ -52,7 +52,7 @@ define(id, scope, kind) } break; case D_HIDDEN: - if (kind == D_TYPE && state == IMPLEMENTATION) { + if (kind == D_TYPE && !DefinitionModule) { df->df_kind = D_HTYPE; return df; } @@ -145,7 +145,7 @@ Import(ids, id, local) /* "ids" is a list of imported identifiers. If "id" is a null-pointer, the identifiers are imported from the enclosing scope. Otherwise they are imported from the module - indicated by "id", ehich must be visible in the enclosing scope. + indicated by "id", which must be visible in the enclosing scope. An exception must be made for imports of the Compilation Unit. This case is indicated by the value 0 of the flag "local". In this case, if "id" is a null pointer, the "ids" identifiers @@ -224,3 +224,52 @@ exprt_literals(df, toscope) df = df->enm_next; } } + +RemImports(pdf) + struct def **pdf; +{ + /* Remove all imports from a definition module. This is + neccesary because the implementation module might import + them again. + */ + register struct def *df = *pdf, *df1 = 0; + + while (df) { + if (df->df_kind == D_IMPORT) { + RemFromId(df); + if (df1) { + df1->df_nextinscope = df->df_nextinscope; + free_def(df); + df = df1->df_nextinscope; + } + else { + *pdf = df->df_nextinscope; + free_def(df); + df = *pdf; + } + } + else { + df1 = df; + df = df->df_nextinscope; + } + } +} + +RemFromId(df) + struct def *df; +{ + /* Remove definition "df" from the definition list + */ + register struct idf *id = df->df_idf; + register struct def *df1; + + if (id->id_def == df) id->id_def = df->next; + else { + df1 = id->id_def; + while (df1->next != df) { + assert(df1->next != 0); + df1 = df1->next; + } + df1->next = df->next; + } +} diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c index 1912eabd0..245e33eaa 100644 --- a/lang/m2/comp/enter.c +++ b/lang/m2/comp/enter.c @@ -76,6 +76,6 @@ lookfor(id, scope, give_error) if (df) return df; sc = nextvisible(sc); } - if (give_error) error("identifier \"%s\" not declared", id->id_text); + if (give_error) id_not_declared(id); return define(id, scope, D_ERROR); } diff --git a/lang/m2/comp/error.c b/lang/m2/comp/error.c index 1a769bce5..d3b23f402 100644 --- a/lang/m2/comp/error.c +++ b/lang/m2/comp/error.c @@ -12,6 +12,7 @@ static char *RcsId = "$Header$"; #include "input.h" #include "f_info.h" #include "LLlex.h" +#include "main.h" #define MAXERR_LINE 5 /* Number of error messages on one line ... */ #define ERROUT STDERR @@ -32,7 +33,6 @@ static char *RcsId = "$Header$"; int err_occurred; extern char *symbol2str(); -extern char options[]; /* There are three general error-message functions: lexerror() lexical and pre-processor error messages @@ -198,10 +198,10 @@ _error(class, expr, fmt, argv) } #endif DEBUG - if (FileName) fprintf(ERROUT, "\"%s\", line %u: ", FileName, ln); + if (FileName) fprint(ERROUT, "\"%s\", line %u: ", FileName, ln); - if (remark) fprintf(ERROUT, "%s ", remark); + if (remark) fprint(ERROUT, "%s ", remark); doprnt(ERROUT, fmt, argv); /* contents of error */ - fprintf(ERROUT, "\n"); + fprint(ERROUT, "\n"); } diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g index 7f1c3ca38..d325eac5c 100644 --- a/lang/m2/comp/expression.g +++ b/lang/m2/comp/expression.g @@ -43,10 +43,9 @@ qualident(int types; struct def **pdf; char *str;) module = (df->df_kind == D_MODULE); df = lookup(dot.TOK_IDF, scope); if (!df) { - error("identifier \"%s\" not declared", - dot.TOK_IDF->id_text); types = 0; df = ill_df; + id_not_declared(dot.TOK_IDF); } else if (module && diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index 8cccad745..caa9c4ee4 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -17,12 +17,13 @@ static char *RcsId = "$Header$"; #include "scope.h" #include "standards.h" -char options[128]; -char *ProgName; -int state; +char options[128]; +int DefinitionModule; +int SYSTEMModule = 0; +char *ProgName; extern int err_occurred; -char *DEFPATH[128]; -char *getenv(); +char *DEFPATH[128]; +char *getenv(); main(argc, argv) char *argv[]; @@ -40,11 +41,11 @@ main(argc, argv) } Nargv[Nargc] = 0; /* terminate the arg vector */ if (Nargc != 2) { - fprintf(STDERR, "%s: Use one file argument\n", ProgName); + fprint(STDERR, "%s: Use one file argument\n", ProgName); return 1; } #ifdef DEBUG - printf("Mod2 compiler -- Debug version\n"); + print("Mod2 compiler -- Debug version\n"); #endif DEBUG DO_DEBUG(debug(1,"Debugging level: %d", options['D'])); return !Compile(Nargv[1]); @@ -57,7 +58,7 @@ Compile(src) DO_DEBUG(debug(1,"Filename : %s", src)); if (! InsertFile(src, (char **) 0, &src)) { - fprintf(STDERR,"%s: cannot open %s\n", ProgName, src); + fprint(STDERR,"%s: cannot open %s\n", ProgName, src); return 0; } LineNumber = 1; @@ -92,23 +93,23 @@ LexScan() register int symb; while ((symb = LLlex()) != EOI) { - printf(">>> %s ", symbol2str(symb)); + print(">>> %s ", symbol2str(symb)); switch(symb) { case IDENT: - printf("%s\n", dot.TOK_IDF->id_text); + print("%s\n", dot.TOK_IDF->id_text); break; case INTEGER: - printf("%ld\n", dot.TOK_INT); + print("%ld\n", dot.TOK_INT); break; case REAL: - printf("%s\n", dot.TOK_REL); + print("%s\n", dot.TOK_REL); break; case STRING: - printf("\"%s\"\n", dot.TOK_STR); + print("\"%s\"\n", dot.TOK_STR); break; default: @@ -159,7 +160,7 @@ add_standards() (void) Enter("LONGREAL", D_TYPE, longreal_type, 0); (void) Enter("BOOLEAN", D_TYPE, bool_type, 0); (void) Enter("CARDINAL", D_TYPE, card_type, 0); - (void) Enter("NIL", D_CONST, nil_type, 0); + (void) Enter("NIL", D_CONST, address_type, 0); (void) Enter("PROC", D_TYPE, construct_type(PROCEDURE, NULLTYPE), @@ -196,13 +197,29 @@ do_SYSTEM() { /* Simulate the reading of the SYSTEM definition module */ - struct def *df; - struct idf *sys_id; + char *SYSTEM = "\ +DEFINITION MODULE SYSTEM;\n\ +PROCEDURE NEWPROCESS(P:PROC; A:ADDRESS; n:CARDINAL; VAR p1:ADDRESS);\n\ +PROCEDURE TRANSFER(VAR p1,p2:ADDRESS);\n\ +END SYSTEM.\n"; - sys_id = str2idf("SYSTEM", 0); - df = define(sys_id, GlobalScope, D_MODULE); open_scope(CLOSEDSCOPE, 0); - df->mod_scope = CurrentScope->sc_scope; - /* ???? */ + (void) Enter("WORD", D_TYPE, word_type, 0); + (void) Enter("ADDRESS", D_TYPE, address_type, 0); + (void) Enter("ADR", D_STDFUNC, NULLTYPE, S_ADR); + (void) Enter("TSIZE", D_STDFUNC, NULLTYPE, S_TSIZE); + if (!InsertText(SYSTEM, strlen(SYSTEM))) { + fatal("Could not insert text"); + } + SYSTEMModule = 1; + DefModule(); close_scope(); + SYSTEMModule = 0; +} + +AtEoIT() +{ + /* Make the end of the text noticable + */ + return 1; } diff --git a/lang/m2/comp/main.h b/lang/m2/comp/main.h index 884d2b345..fd4502bea 100644 --- a/lang/m2/comp/main.h +++ b/lang/m2/comp/main.h @@ -2,7 +2,13 @@ /* $Header$ */ -extern int - state; /* Indicates what we are compiling: A DEFINITION, - an IMPLEMENTATION, or a PROGRAM module +extern char options[]; /* Indicating which options were given */ + +extern int DefinitionModule; + /* Flag indicating that we are reading a definition + module + */ + +extern int SYSTEMModule;/* Flag indicating that we are handling the SYSTEM + module */ diff --git a/lang/m2/comp/misc.c b/lang/m2/comp/misc.c index 7199fc11c..7a5439785 100644 --- a/lang/m2/comp/misc.c +++ b/lang/m2/comp/misc.c @@ -48,9 +48,20 @@ gen_anon_idf() */ static int name_cnt; char buff[100]; - char *sprintf(); + char *sprint(); - sprintf(buff, "#%d in %s, line %u", + sprint(buff, "#%d in %s, line %u", ++name_cnt, FileName, LineNumber); return str2idf(buff, 1); } + +id_not_declared(id) + struct idf *id; +{ + /* The identifier "id" is not declared. If it is not generated, + give an error message + */ + if (!is_anon_idf(id)) { + error("identifier \"%s\" not declared", id->id_text); + } +} diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g index 68c5be233..994f6c407 100644 --- a/lang/m2/comp/program.g +++ b/lang/m2/comp/program.g @@ -14,6 +14,9 @@ static char *RcsId = "$Header$"; #include "def.h" #include "type.h" #include "debug.h" + +static struct idf *impl_name = 0; +static struct def *impl_df; } /* The grammar as given by Wirth is already almost LL(1); the @@ -101,30 +104,41 @@ DefinitionModule register struct def *df; struct idf *id; } : - DEFINITION { state = DEFINITION; } + DEFINITION MODULE IDENT { id = dot.TOK_IDF; df = define(id, GlobalScope, D_MODULE); - open_scope(CLOSEDSCOPE, 0); + if (!SYSTEMModule) open_scope(CLOSEDSCOPE, 0); df->mod_scope = CurrentScope->sc_scope; + DefinitionModule = 1; DO_DEBUG(debug(1, "Definition module \"%s\"", id->id_text)); } ';' import(0)* export(1)? - /* New Modula-2 does not have export lists in definition modules. + For the time being, we ignore export lists here, and a + warning is issued. */ - definition* END IDENT '.' + definition* END IDENT { + if (id == impl_name) { + /* Just read the definition module of the + implementation module being compiled + */ + RemImports(&(CurrentScope->sc_def)); + impl_df = CurrentScope->sc_def; + } df = CurrentScope->sc_def; while (df) { /* Make all definitions "QUALIFIED EXPORT" */ df->df_flags |= D_QEXPORTED; df = df->df_nextinscope; } - close_scope(); + if (!SYSTEMModule) close_scope(); + DefinitionModule = 0; match_id(id, dot.TOK_IDF); } + '.' ; definition @@ -153,20 +167,23 @@ definition ProcedureHeading(&df, D_PROCHEAD) ';' ; -ProgramModule +ProgramModule(int state;) { struct idf *id; struct def *df, *GetDefinitionModule(); int scope = 0; } : - MODULE { if (state != IMPLEMENTATION) state = PROGRAM; } + MODULE IDENT { id = dot.TOK_IDF; if (state == IMPLEMENTATION) { + impl_name = id; df = GetDefinitionModule(id); scope = df->mod_scope; } + DefinitionModule = 0; open_scope(CLOSEDSCOPE, scope); + CurrentScope->sc_def = impl_df; } priority? ';' import(0)* @@ -177,13 +194,16 @@ ProgramModule '.' ; -Module: +Module +{ + int state = PROGRAM; +} : DefinitionModule | [ IMPLEMENTATION { state = IMPLEMENTATION; } ]? - ProgramModule + ProgramModule(state) ; CompilationUnit: diff --git a/lang/m2/comp/standards.h b/lang/m2/comp/standards.h index 179aa8926..c7841b0bf 100644 --- a/lang/m2/comp/standards.h +++ b/lang/m2/comp/standards.h @@ -21,4 +21,8 @@ #define S_VAL 17 /* Standard procedures and functions defined in the SYSTEM module ... */ -/* PM ??? */ + +#define S_ADR 20 +#define S_TSIZE 21 +#define S_NEWPROCESS 22 +#define S_TRANSFER 23 diff --git a/lang/m2/comp/tokenname.c b/lang/m2/comp/tokenname.c index 6d16fe3fb..10c28ac87 100644 --- a/lang/m2/comp/tokenname.c +++ b/lang/m2/comp/tokenname.c @@ -88,6 +88,8 @@ struct tokenname tkstandard[] = { /* standard identifiers */ {SUBRANGE, ""}, {ENUMERATION, ""}, {ERRONEOUS, ""}, + {WORD, ""}, + {ADDRESS, ""}, {0, ""} }; diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H index f2ebb8022..2de207c91 100644 --- a/lang/m2/comp/type.H +++ b/lang/m2/comp/type.H @@ -75,7 +75,8 @@ extern struct type *longint_type, *real_type, *longreal_type, - *nil_type, + *word_type, + *address_type, *error_type; extern int diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 3d5fe9090..520b2b68b 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -41,7 +41,8 @@ struct type *longint_type, *real_type, *longreal_type, - *nil_type, + *word_type, + *address_type, *error_type; struct paramlist *h_paramlist; @@ -128,8 +129,10 @@ init_types() card_type = standard_type(CARDINAL, int_align, int_size); real_type = standard_type(REAL, real_align, real_size); longreal_type = standard_type(LONGREAL, lreal_align, lreal_size); - nil_type = standard_type(POINTER, ptr_align, ptr_size); + word_type = standard_type(WORD, wrd_align, wrd_size); + address_type = construct_type(POINTER, word_type); error_type = standard_type(ERRONEOUS, 1, (arith) 1); + } int -- 2.34.1