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 \
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
#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 */
struct enumval df_enum;
struct field df_field;
struct import df_import;
+ int df_stdname; /* Define for standard name */
} df_value;
};
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) {
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.
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;
--- /dev/null
+/* 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 <em_arith.h>
+#include <em_label.h>
+#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;
+ }
+}
case LEXERROR:
case CRASH:
case FATAL:
+#ifdef DEBUG
+ case VDEBUG:
+#endif DEBUG
ln = LineNumber;
break;
}
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 ! */
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");
}
#include <system.h>
#include <em_arith.h>
+#include <em_label.h>
#include "input.h"
#include "f_info.h"
#include "idf.h"
#include "Lpars.h"
#include "main.h"
#include "debug.h"
+#include "type.h"
+#include "def.h"
+#include "standards.h"
char options[128];
char *ProgName;
{
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;
reserve(tkidf);
init_scope();
init_types();
+ add_standards();
#ifdef DEBUG
if (options['L'])
LexScan();
{
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;
+}
#include "misc.h"
#include "main.h"
#include "LLlex.h"
+#include "scope.h"
}
/*
The grammar as given by Wirth is already almost LL(1); the
DefinitionModule:
DEFINITION { state = DEFINITION; }
- MODULE IDENT
+ MODULE IDENT { open_scope(CLOSEDSCOPE, 0); }
';'
import(0)*
/* export?
New Modula-2 does not have export lists in definition modules.
*/
definition* END IDENT '.'
+ { close_scope(); }
;
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:
#include <assert.h>
#include <alloc.h>
#include "scope.h"
+#include "debug.h"
static int maxscope; /* maximum assigned scope number */
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();
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;
*CurrentScope;
#define nextvisible(x) ((x)->sc_scope ? (x)->next : (struct scope *) 0)
+#define scopeclosed(x) ((x)->next->sc_scope == 0)
--- /dev/null
+/* 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 ??? */
};
struct tokenname tkstandard[] = { /* standard identifiers */
- {CHAR, "CHAR"},
- {BOOLEAN, "BOOLEAN"},
- {LONGINT, "LONGINT"},
- {CARDINAL, "CARDINAL"},
- {LONGREAL, "LONGREAL"},
+ {CHAR, ""},
+ {BOOLEAN, ""},
+ {LONGINT, ""},
+ {CARDINAL, ""},
+ {LONGREAL, ""},
{SUBRANGE, ""},
{ERRONEOUS, ""},
{0, ""}
/* 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
*longint_type,
*real_type,
*longreal_type,
+ *nil_type,
*error_type;
struct paramlist *h_paramlist;
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);
}
public / ack.git / commitdiff