newer version, safety commit
This commit is contained in:
ceriel
parent
4c75213caa
commit
c8453bb3f7
|
|
@ -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*/
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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");
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 &&
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
*/
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -88,6 +88,8 @@ struct tokenname tkstandard[] = { /* standard identifiers */
|
|||
{SUBRANGE, ""},
|
||||
{ENUMERATION, ""},
|
||||
{ERRONEOUS, ""},
|
||||
{WORD, ""},
|
||||
{ADDRESS, ""},
|
||||
{0, ""}
|
||||
};
|
||||
|
||||
|
|
|
|||
|
|
@ -75,7 +75,8 @@ extern struct type
|
|||
*longint_type,
|
||||
*real_type,
|
||||
*longreal_type,
|
||||
*nil_type,
|
||||
*word_type,
|
||||
*address_type,
|
||||
*error_type;
|
||||
|
||||
extern int
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue