diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile index 8fc8d53f0..2a2bd1f0a 100644 --- a/lang/m2/comp/Makefile +++ b/lang/m2/comp/Makefile @@ -14,7 +14,7 @@ LFLAGS = -p 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 + scope.o misc.o print.o enter.o OBJ = $(COBJ) $(LOBJ) Lpars.o GENFILES= tokenfile.c \ program.c declar.c expression.c statement.c \ @@ -69,17 +69,18 @@ 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 -main.o: LLlex.h Lpars.h debug.h f_info.h idf.h input.h main.h +main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h main.h standards.h type.h symbol2str.o: Lpars.h tokenname.o: Lpars.h idf.h tokenname.h idf.o: idf.h input.o: f_info.h input.h type.o: Lpars.h def.h def_sizes.h idf.h type.h def.o: Lpars.h def.h idf.h main.h scope.h -scope.o: scope.h +scope.o: debug.h scope.h misc.o: LLlex.h f_info.h idf.h misc.h +enter.o: def.h idf.h scope.h type.h tokenfile.o: Lpars.h -program.o: LLlex.h Lpars.h idf.h main.h misc.h +program.o: LLlex.h Lpars.h idf.h main.h misc.h scope.h declar.o: LLlex.h Lpars.h def.h idf.h misc.h scope.h type.h expression.o: Lpars.h statement.o: Lpars.h diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H index 21fe8cd22..ea7641377 100644 --- a/lang/m2/comp/def.H +++ b/lang/m2/comp/def.H @@ -49,6 +49,8 @@ struct def { /* list of definitions for a name */ #define D_PROCHEAD 0x08 /* A procedure heading in a definition module */ #define D_HIDDEN 0x09 /* A hidden type */ #define D_HTYPE 0x0A /* Definition of a hidden type seen */ +#define D_STDPROC 0x0B /* A standard procedure */ +#define D_STDFUNC 0x0C /* A standard function */ #define D_ISEXPORTED 0xFF /* Not yet defined */ char df_flags; #define D_ADDRESS 0x01 /* Set if address was taken */ @@ -65,6 +67,7 @@ struct def { /* list of definitions for a name */ struct enumval df_enum; struct field df_field; struct import df_import; + int df_stdname; /* Define for standard name */ } df_value; }; diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c index 100cbad54..336bee3af 100644 --- a/lang/m2/comp/def.c +++ b/lang/m2/comp/def.c @@ -16,14 +16,18 @@ struct def *h_def; /* Pointer to free list of def structures */ struct def * define(id, scope, kind) register struct idf *id; - struct scope *scope; + register struct scope *scope; { /* Declare an identifier in a scope, but first check if it already has been defined. If so, error message. */ - register struct def *df = lookup(id, scope); + register struct def *df = lookup(id, scope->sc_scope); - if (df) { + if ( /* Already in this scope */ + df + || /* A closed scope, and id defined in the pervasive scope */ + (scopeclosed(scope) && (df = lookup(id, 0))) + ) { switch(df->df_kind) { case D_PROCHEAD: if (kind == D_PROCEDURE) { @@ -57,7 +61,6 @@ define(id, scope, kind) struct def * lookup(id, scope) register struct idf *id; - struct scope *scope; { /* Look up a definition of an identifier in scope "scope". Make the "def" list self-organizing. @@ -69,7 +72,7 @@ lookup(id, scope) df1 = 0; df = id->id_def; while (df) { - if (df->df_scope == scope->sc_scope) { + if (df->df_scope == scope) { if (df1) { df1->next = df->next; df->next = id->id_def; diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c new file mode 100644 index 000000000..dc1d31106 --- /dev/null +++ b/lang/m2/comp/enter.c @@ -0,0 +1,29 @@ +/* H I G H L E V E L S Y M B O L E N T R Y A N D L O O K U P */ + +static char *RcsId = "$Header$"; + +#include +#include +#include "idf.h" +#include "def.h" +#include "type.h" +#include "scope.h" + +extern struct idf *str2idf(); +extern struct def *define(); + +Enter(name, kind, type, pnam) + char *name; + struct type *type; +{ + struct idf *id; + struct def *df; + + id = str2idf(name, 0); + if (!id) fatal("Out of core"); + df = define(id, CurrentScope, kind); + df->df_type = type; + if (kind == D_STDPROC || kind == D_STDFUNC) { + df->df_value.df_stdname = pnam; + } +} diff --git a/lang/m2/comp/error.c b/lang/m2/comp/error.c index 4a853a443..278a39d7c 100644 --- a/lang/m2/comp/error.c +++ b/lang/m2/comp/error.c @@ -170,6 +170,9 @@ _error(class, expr, fmt, argv) case LEXERROR: case CRASH: case FATAL: +#ifdef DEBUG + case VDEBUG: +#endif DEBUG ln = LineNumber; break; } @@ -180,8 +183,7 @@ _error(class, expr, fmt, argv) if (ln == last_ln) { /* we've seen this place before */ e_seen++; - if (e_seen == MAXERR_LINE) - fmt = "etc ..."; + if (e_seen == MAXERR_LINE) fmt = "etc ..."; else if (e_seen > MAXERR_LINE) /* and too often, I'd say ! */ @@ -192,14 +194,14 @@ _error(class, expr, fmt, argv) last_ln = ln; e_seen = 0; } - - if (FileName) - fprintf(ERROUT, "\"%s\", line %u: ", FileName, ln); - if (remark) - fprintf(ERROUT, "%s ", remark); #ifdef DEBUG } -#endif +#endif DEBUG + + if (FileName) fprintf(ERROUT, "\"%s\", line %u: ", FileName, ln); + + if (remark) fprintf(ERROUT, "%s ", remark); + doprnt(ERROUT, fmt, argv); /* contents of error */ fprintf(ERROUT, "\n"); } diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index 811118ab8..b245420a0 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -4,6 +4,7 @@ static char *RcsId = "$Header$"; #include #include +#include #include "input.h" #include "f_info.h" #include "idf.h" @@ -11,6 +12,9 @@ static char *RcsId = "$Header$"; #include "Lpars.h" #include "main.h" #include "debug.h" +#include "type.h" +#include "def.h" +#include "standards.h" char options[128]; char *ProgName; @@ -48,9 +52,7 @@ Compile(src) { extern struct tokenname tkidf[]; -#ifdef DEBUG - printf("%s\n", src); -#endif DEBUG + DO_DEBUG(debug(1,"Filename : %s", src)); if (! InsertFile(src, (char **) 0)) { fprintf(STDERR,"%s: cannot open %s\n", ProgName, src); return 0; @@ -61,6 +63,7 @@ Compile(src) reserve(tkidf); init_scope(); init_types(); + add_standards(); #ifdef DEBUG if (options['L']) LexScan(); @@ -117,3 +120,56 @@ Option(str) { options[str[1]]++; /* switch option on */ } + +#define NULLTYPE ((struct type *) 0) + +add_standards() +{ + register struct def *df; + register struct type *tp; + struct def *Enter(); + + (void) Enter("ABS", D_STDFUNC, NULLTYPE, S_ABS); + (void) Enter("CAP", D_STDFUNC, NULLTYPE, S_CAP); + (void) Enter("CHR", D_STDFUNC, NULLTYPE, S_CHR); + (void) Enter("FLOAT", D_STDFUNC, NULLTYPE, S_FLOAT); + (void) Enter("HIGH", D_STDFUNC, NULLTYPE, S_HIGH); + (void) Enter("HALT", D_STDPROC, NULLTYPE, S_HALT); + (void) Enter("EXCL", D_STDPROC, NULLTYPE, S_EXCL); + (void) Enter("DEC", D_STDPROC, NULLTYPE, S_DEC); + (void) Enter("INC", D_STDPROC, NULLTYPE, S_INC); + (void) Enter("VAL", D_STDFUNC, NULLTYPE, S_VAL); + (void) Enter("TRUNC", D_STDFUNC, NULLTYPE, S_TRUNC); + (void) Enter("SIZE", D_STDFUNC, NULLTYPE, S_SIZE); + (void) Enter("ORD", D_STDFUNC, NULLTYPE, S_ORD); + (void) Enter("ODD", D_STDFUNC, NULLTYPE, S_ODD); + (void) Enter("MAX", D_STDFUNC, NULLTYPE, S_MAX); + (void) Enter("MIN", D_STDFUNC, NULLTYPE, S_MIN); + (void) Enter("INCL", D_STDPROC, NULLTYPE, S_INCL); + + (void) Enter("CHAR", D_TYPE, char_type, 0); + (void) Enter("INTEGER", D_TYPE, int_type, 0); + (void) Enter("LONGINT", D_TYPE, longint_type, 0); + (void) Enter("REAL", D_TYPE, real_type, 0); + (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("PROC", + D_TYPE, + construct_type(PROCEDURE, NULLTYPE, (arith) 0), + 0); + tp = construct_type(SUBRANGE, int_type, (arith) 0); + tp->tp_value.tp_subrange.su_lb = 0; + tp->tp_value.tp_subrange.su_ub = wrd_size * 8 - 1; + (void) Enter("BITSET", + D_TYPE, + construct_type(SET, tp, wrd_size), + 0); + df = Enter("FALSE", D_ENUM, bool_type, 0); + df->df_value.df_enum.en_val = 0; + df->df_value.df_enum.en_next = Enter("TRUE", D_ENUM, bool_type, 0); + df = df->df_value.df_enum.en_next; + df->df_value.df_enum.en_val = 1; + df->df_value.df_enum.en_next = 0; +} diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g index 00c2c82fc..662ba71c7 100644 --- a/lang/m2/comp/program.g +++ b/lang/m2/comp/program.g @@ -9,6 +9,7 @@ static char *RcsId = "$Header$"; #include "misc.h" #include "main.h" #include "LLlex.h" +#include "scope.h" } /* The grammar as given by Wirth is already almost LL(1); the @@ -68,7 +69,7 @@ import(int local;) DefinitionModule: DEFINITION { state = DEFINITION; } - MODULE IDENT + MODULE IDENT { open_scope(CLOSEDSCOPE, 0); } ';' import(0)* /* export? @@ -76,6 +77,7 @@ DefinitionModule: New Modula-2 does not have export lists in definition modules. */ definition* END IDENT '.' + { close_scope(); } ; definition: @@ -101,7 +103,15 @@ definition: ProgramModule: MODULE { if (state != IMPLEMENTATION) state = PROGRAM; } - IDENT priority? ';' import(0)* block IDENT '.' + IDENT { if (state == IMPLEMENTATION) { + /* Re-open scope ??? */ + open_scope(CLOSEDSCOPE, 0); + } + else open_scope(CLOSEDSCOPE, 0); + } + priority? ';' import(0)* block IDENT + { close_scope(); } + '.' ; Module: diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C index 63cbdb773..f46f3cfde 100644 --- a/lang/m2/comp/scope.C +++ b/lang/m2/comp/scope.C @@ -5,6 +5,7 @@ static char *RcsId = "$Header$"; #include #include #include "scope.h" +#include "debug.h" static int maxscope; /* maximum assigned scope number */ @@ -27,6 +28,7 @@ open_scope(scopetype, scopenr) sc->sc_scope = scopenr == 0 ? ++maxscope : scopenr; assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE); + DO_DEBUG(debug(1, "Opening a %s scope", scopetype == OPENSCOPE ? "open" : "closed")); sc1 = CurrentScope; if (scopetype == CLOSEDSCOPE) { sc1 = new_scope(); @@ -42,6 +44,7 @@ close_scope() register struct scope *sc = CurrentScope; assert(sc != 0); + DO_DEBUG(debug(1, "Closing a scope")); if (sc->next && (sc->next->sc_scope == 0)) { struct scope *sc1 = sc; diff --git a/lang/m2/comp/scope.h b/lang/m2/comp/scope.h index a1caef49e..20e72ada7 100644 --- a/lang/m2/comp/scope.h +++ b/lang/m2/comp/scope.h @@ -17,3 +17,4 @@ extern struct scope *CurrentScope; #define nextvisible(x) ((x)->sc_scope ? (x)->next : (struct scope *) 0) +#define scopeclosed(x) ((x)->next->sc_scope == 0) diff --git a/lang/m2/comp/standards.h b/lang/m2/comp/standards.h new file mode 100644 index 000000000..179aa8926 --- /dev/null +++ b/lang/m2/comp/standards.h @@ -0,0 +1,24 @@ +/* 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 +#define S_DEC 4 +#define S_EXCL 5 +#define S_FLOAT 6 +#define S_HALT 7 +#define S_HIGH 8 +#define S_INC 9 +#define S_INCL 10 +#define S_MAX 11 +#define S_MIN 12 +#define S_ODD 13 +#define S_ORD 14 +#define S_SIZE 15 +#define S_TRUNC 16 +#define S_VAL 17 + +/* Standard procedures and functions defined in the SYSTEM module ... */ +/* PM ??? */ diff --git a/lang/m2/comp/tokenname.c b/lang/m2/comp/tokenname.c index e18ff871a..97020e030 100644 --- a/lang/m2/comp/tokenname.c +++ b/lang/m2/comp/tokenname.c @@ -80,11 +80,11 @@ struct tokenname tkinternal[] = { /* internal keywords */ }; struct tokenname tkstandard[] = { /* standard identifiers */ - {CHAR, "CHAR"}, - {BOOLEAN, "BOOLEAN"}, - {LONGINT, "LONGINT"}, - {CARDINAL, "CARDINAL"}, - {LONGREAL, "LONGREAL"}, + {CHAR, ""}, + {BOOLEAN, ""}, + {LONGINT, ""}, + {CARDINAL, ""}, + {LONGREAL, ""}, {SUBRANGE, ""}, {ERRONEOUS, ""}, {0, ""} diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H index 6b76f1bb7..ca59a1f05 100644 --- a/lang/m2/comp/type.H +++ b/lang/m2/comp/type.H @@ -56,12 +56,14 @@ struct type { /* ALLOCDEF "type" */ extern struct type + *bool_type, *char_type, *int_type, *card_type, *longint_type, *real_type, *longreal_type, + *nil_type, *error_type; extern int diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 856a5c05c..37fb537a1 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -40,6 +40,7 @@ struct type *longint_type, *real_type, *longreal_type, + *nil_type, *error_type; struct paramlist *h_paramlist; @@ -130,5 +131,6 @@ 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); error_type = standard_type(ERRONEOUS, 1, (arith) 1); }