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;
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);
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;
}
/*NOTREACHED*/
}
-
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 \
@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:
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
}
break;
case D_HIDDEN:
- if (kind == D_TYPE && state == IMPLEMENTATION) {
+ if (kind == D_TYPE && !DefinitionModule) {
df->df_kind = D_HTYPE;
return df;
}
/* "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
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;
+ }
+}
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);
}
#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
int err_occurred;
extern char *symbol2str();
-extern char options[];
/* There are three general error-message functions:
lexerror() lexical and pre-processor error messages
}
#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");
}
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 &&
#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[];
}
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]);
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;
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:
(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),
{
/* 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;
}
/* $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
*/
*/
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);
+ }
+}
#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
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
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)*
'.'
;
-Module:
+Module
+{
+ int state = PROGRAM;
+} :
DefinitionModule
|
[
IMPLEMENTATION { state = IMPLEMENTATION; }
]?
- ProgramModule
+ ProgramModule(state)
;
CompilationUnit:
#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
{SUBRANGE, ""},
{ENUMERATION, ""},
{ERRONEOUS, ""},
+ {WORD, ""},
+ {ADDRESS, ""},
{0, ""}
};
*longint_type,
*real_type,
*longreal_type,
- *nil_type,
+ *word_type,
+ *address_type,
*error_type;
extern int
*longint_type,
*real_type,
*longreal_type,
- *nil_type,
+ *word_type,
+ *address_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);
+ 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
public / ack.git / commitdiff