d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Newer version, safety commit

Browse source
This commit is contained in:
ceriel 1986-04-03 00:44:39 +00:00
parent b89155a64a
commit 52d743f223
13 changed files with 261 additions and 134 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
lang/m2/comp/Makefile
View file

@ -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 enter.o
scope.o misc.o print.o enter.o defmodule.o
OBJ = $(COBJ) $(LOBJ) Lpars.o
GENFILES= tokenfile.c \
program.c declar.c expression.c statement.c \
@ -69,18 +69,19 @@ 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 def.h f_info.h idf.h input.h main.h standards.h type.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
idf.o: idf.h
input.o: f_info.h input.h
type.o: Lpars.h def.h def_sizes.h idf.h misc.h type.h
def.o: Lpars.h debug.h def.h idf.h main.h misc.h scope.h
def.o: Lpars.h debug.h def.h idf.h main.h misc.h scope.h type.h
scope.o: LLlex.h debug.h def.h idf.h scope.h type.h
misc.o: LLlex.h f_info.h idf.h misc.h
enter.o: def.h idf.h misc.h scope.h type.h
defmodule.o: LLlex.h def.h f_info.h idf.h input.h scope.h
tokenfile.o: Lpars.h
program.o: LLlex.h Lpars.h def.h idf.h main.h misc.h scope.h type.h
program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h misc.h scope.h type.h
declar.o: LLlex.h Lpars.h def.h idf.h misc.h scope.h type.h
expression.o: LLlex.h Lpars.h def.h idf.h scope.h
statement.o: Lpars.h

45
lang/m2/comp/declar.g
View file

@ -37,7 +37,7 @@ ProcedureHeading(struct def **pdf; int type;)
open_scope(OPENSCOPE, 0);
}
}
FormalParameters(type, &params, &tp)?
FormalParameters(type == D_PROCEDURE, &params, &tp)?
{
(*pdf)->df_type = tp = construct_type(PROCEDURE, tp);
tp->prc_params = params;
@ -133,8 +133,14 @@ TypeDeclaration
{ df->df_type = tp;
if ((df->df_flags&D_EXPORTED) &&
tp->tp_fund == ENUMERATION) {
exprt_literals(tp->enm_enums, enclosing(currscope));
exprt_literals(tp->enm_enums,
enclosing(CurrentScope));
}
if (df->df_kind == D_HTYPE &&
tp->tp_fund != POINTER) {
error("Opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
}
}
;
@ -246,27 +252,29 @@ ArrayType(struct type **ptp;)
RecordType(struct type **ptp;)
{
int scopenr;
struct scope scope;
}
:
RECORD
{ scopenr = uniq_scope(); }
FieldListSequence(scopenr)
{ scope.sc_scope = uniq_scope();
scope.next = CurrentScope;
}
FieldListSequence(&scope)
{
*ptp = standard_type(RECORD, record_align, (arith) 0 /* ???? */);
(*ptp)->rec_scopenr = scopenr;
(*ptp)->rec_scope = scope.sc_scope;
}
END
;
FieldListSequence(int scopenr;):
FieldList(scopenr)
FieldListSequence(struct scope *scope;):
FieldList(scope)
[
';' FieldList(scopenr)
';' FieldList(scope)
]*
;
FieldList(int scopenr;)
FieldList(struct scope *scope;)
{
struct id_list *FldList;
struct idf *id;
@ -283,21 +291,21 @@ FieldList(int scopenr;)
{ id = gen_anon_idf(); }
] /* Changed rule in new modula-2 */
':' qualident(D_TYPE|D_HTYPE, &df, "type")
{ df1 = define(id, scopenr, D_FIELD);
{ df1 = define(id, scope, D_FIELD);
df1->df_type = df->df_type;
}
OF variant(scopenr)
OF variant(scope)
[
'|' variant(scopenr)
'|' variant(scope)
]*
[ ELSE FieldListSequence(scopenr)
[ ELSE FieldListSequence(scope)
]?
END
]?
;
variant(int scopenr;):
[ CaseLabelList ':' FieldListSequence(scopenr) ]?
variant(struct scope *scope;):
[ CaseLabelList ':' FieldListSequence(scope) ]?
/* Changed rule in new modula-2 */
;
@ -330,7 +338,7 @@ PointerType(struct type **ptp;)
struct def *lookfor();
} :
POINTER TO
[ %if ( (df = lookup(dot.TOK_IDF, CurrentScope)))
[ %if ( (df = lookup(dot.TOK_IDF, CurrentScope->sc_scope)))
/* Either a Module or a Type, but in both cases defined
in this scope, so this is the correct identification
*/
@ -343,7 +351,8 @@ PointerType(struct type **ptp;)
}
else tp = df->df_type;
}
| %if (df = lookfor(dot.TOK_IDF, currscope, 0), df->df_kind == D_MODULE)
| %if (df = lookfor(dot.TOK_IDF, CurrentScope, 0),
df->df_kind == D_MODULE)
type(&tp)
|
IDENT

41
lang/m2/comp/def.c
View file

@ -25,6 +25,7 @@ struct def *ill_df = &illegal_def;
struct def *
define(id, scope, kind)
register struct idf *id;
struct scope *scope;
{
/* Declare an identifier in a scope, but first check if it
already has been defined. If so, error message.
@ -32,14 +33,14 @@ define(id, scope, kind)
register struct def *df;
register struct scope *sc;
DO_DEBUG(debug(4,"Defining identifier %s in scope %d", id->id_text, scope));
df = lookup(id, scope);
DO_DEBUG(debug(4,"Defining identifier %s in scope %d", id->id_text, scope->sc_scope));
df = lookup(id, scope->sc_scope);
if ( /* Already in this scope */
df
|| /* A closed scope, and id defined in the pervasive scope */
( CurrentScope == scope
&&
scopeclosed(currscope)
scopeclosed(CurrentScope)
&&
(df = lookup(id, 0)))
) {
@ -68,19 +69,14 @@ define(id, scope, kind)
}
df = new_def();
df->df_idf = id;
df->df_scope = scope;
df->df_scope = scope->sc_scope;
df->df_kind = kind;
df->next = id->id_def;
id->id_def = df;
/* enter the definition in the list of definitions in this scope */
sc = currscope;
while (sc->sc_scope != scope) {
sc = sc->next;
assert(sc != 0);
}
df->df_nextinscope = sc->sc_def;
sc->sc_def = df;
df->df_nextinscope = scope->sc_def;
scope->sc_def = df;
return df;
}
@ -135,7 +131,7 @@ Export(ids, qualified)
}
else {
df->df_flags |= D_EXPORTED;
df = define(ids->id_ptr, enclosing(currscope)->sc_scope,
df = define(ids->id_ptr, enclosing(CurrentScope),
D_IMPORT);
}
ids = ids->next;
@ -164,15 +160,15 @@ Import(ids, id, local)
int imp_kind;
#define FROM_MODULE 0
#define FROM_ENCLOSING 1
struct def *lookfor();
struct def *lookfor(), *GetDefinitionModule();
if (local) {
kind = D_IMPORT;
scope = enclosing(currscope)->sc_scope;
scope = enclosing(CurrentScope)->sc_scope;
if (!id) imp_kind = FROM_ENCLOSING;
else {
imp_kind = FROM_MODULE;
df = lookfor(id, enclosing(currscope), 1);
if (local) df = lookfor(id, enclosing(CurrentScope), 1);
else df = GetDefinitionModule(id);
if (df->df_kind != D_MODULE) {
/* enter all "ids" with type D_ERROR */
kind = D_ERROR;
@ -196,7 +192,10 @@ ids->id_ptr->id_text);
}
}
else {
df = lookfor(ids->id_ptr, enclosing(currscope), 0);
if (local) {
df = lookfor(ids->id_ptr,
enclosing(CurrentScope), 0);
} else df = GetDefinitionModule(ids->id_ptr);
if (df->df_kind == D_ERROR) {
error("identifier \"%s\" not visible in enclosing scope",
ids->id_ptr->id_text);
@ -206,13 +205,11 @@ ids->id_ptr->id_text);
if (df->df_kind == D_TYPE &&
df->df_type->tp_fund == ENUMERATION) {
/* Also import all enumeration literals */
exprt_literals(df->df_type->enm_enums, currscope);
exprt_literals(df->df_type->enm_enums,
CurrentScope);
}
ids = ids->next;
}
return;
}
/* ???? */
}
exprt_literals(df, toscope)
@ -223,7 +220,7 @@ exprt_literals(df, toscope)
as an import from the scope "toscope".
*/
while (df) {
define(df->df_idf, toscope->sc_scope, D_IMPORT)->imp_def = df;
define(df->df_idf, toscope, D_IMPORT)->imp_def = df;
df = df->enm_next;
}
}

66
lang/m2/comp/defmodule.c Normal file
View file

@ -0,0 +1,66 @@
/* D E F I N I T I O N M O D U L E S */
#include <assert.h>
#include <em_arith.h>
#include <em_label.h>
#include "idf.h"
#include "input.h"
#include "scope.h"
#include "def.h"
#include "LLlex.h"
#include "f_info.h"
GetFile(name)
char *name;
{
/* Try to find a file with basename "name" and extension ".def",
in the directories mentioned in "DEFPATH".
*/
extern char *DEFPATH[];
char buf[256];
(void) strcpy(buf, name);
if (strlen(buf) > 10) {
(void) strcpy(&buf[10], ".def");
}
else (void) strcat(buf, ".def");
if (! InsertFile(buf, DEFPATH, &(FileName))) {
fatal("Could'nt find a DEFINITION MODULE for \"%s\"", name);
}
LineNumber = 1;
}
struct def *
GetDefinitionModule(id)
struct idf *id;
{
/* Return a pointer to the "def" structure of the definition
module indicated by "id".
We may have to read the definition module itself.
*/
struct def *df;
df = lookup(id, GlobalScope->sc_scope);
if (!df) {
/* Read definition module. Make an exception for SYSTEM.
*/
if (!strcmp(id->id_text, "SYSTEM")) {
do_SYSTEM();
}
else {
GetFile(id->id_text);
DefModule();
}
df = lookup(id, GlobalScope->sc_scope);
}
assert(df != 0 && df->df_kind == D_MODULE);
return df;
}
AtEoIF()
{
/* Make the unstacking of input streams noticable by the
lexical analyzer
*/
return 1;
}

8
lang/m2/comp/enter.c
View file

@ -11,9 +11,6 @@ static char *RcsId = "$Header$";
#include "scope.h"
#include "misc.h"
extern struct idf *str2idf();
extern struct def *define();
struct def *
Enter(name, kind, type, pnam)
char *name;
@ -35,6 +32,7 @@ Enter(name, kind, type, pnam)
EnterIdList(idlist, kind, flags, type, scope)
register struct id_list *idlist;
struct type *type;
struct scope *scope;
{
register struct def *df;
struct def *first = 0, *last = 0;
@ -78,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);
return define(id, scope->sc_scope, D_ERROR);
if (give_error) error("identifier \"%s\" not declared", id->id_text);
return define(id, scope, D_ERROR);
}

3
lang/m2/comp/expression.g
View file

@ -26,7 +26,8 @@ qualident(int types; struct def **pdf; char *str;)
struct def *lookfor();
} :
IDENT { if (types) {
*pdf = df = lookfor(dot.TOK_IDF, currscope, 1);
df = lookfor(dot.TOK_IDF, CurrentScope, 1);
*pdf = df;
if (df->df_kind == D_ERROR) types = 0;
}
}

2
lang/m2/comp/input.h
View file

@ -5,5 +5,5 @@
#define INP_NPUSHBACK 2
#define INP_TYPE struct f_info
#define INP_VAR file_info
#define INP_READ_IN_ONE
#include <inp_pkg.spec>

41
lang/m2/comp/main.c
View file

@ -14,12 +14,15 @@ static char *RcsId = "$Header$";
#include "debug.h"
#include "type.h"
#include "def.h"
#include "scope.h"
#include "standards.h"
char options[128];
char *ProgName;
int state;
extern int err_occurred;
char *DEFPATH[128];
char *getenv();
main(argc, argv)
char *argv[];
@ -53,12 +56,13 @@ Compile(src)
extern struct tokenname tkidf[];
DO_DEBUG(debug(1,"Filename : %s", src));
if (! InsertFile(src, (char **) 0)) {
if (! InsertFile(src, (char **) 0, &src)) {
fprintf(STDERR,"%s: cannot open %s\n", ProgName, src);
return 0;
}
LineNumber = 1;
FileName = src;
init_DEFPATH();
init_idf();
reserve(tkidf);
init_scope();
@ -69,10 +73,13 @@ Compile(src)
LexScan();
else if (options['T'])
TimeScan();
else
else {
#endif DEBUG
(void) open_scope(CLOSEDSCOPE, 0);
GlobalScope = CurrentScope;
CompUnit();
#ifdef DEBUG
}
if (options['h']) hash_stat();
#endif DEBUG
if (err_occurred) return 0;
@ -169,3 +176,33 @@ add_standards()
df->df_value.df_enum.en_val = 1;
df->df_value.df_enum.en_next = 0;
}
init_DEFPATH()
{
register char *p = getenv("M2path");
register int i = 0;
if (p) {
while (*p) {
DEFPATH[i++] = p;
while (*p && *p != ':') p++;
if (*p) *p++ = '\0';
}
}
DEFPATH[i] = 0;
}
do_SYSTEM()
{
/* Simulate the reading of the SYSTEM definition module
*/
struct def *df;
struct idf *sys_id;
sys_id = str2idf("SYSTEM", 0);
df = define(sys_id, GlobalScope, D_MODULE);
open_scope(CLOSEDSCOPE, 0);
df->mod_scope = CurrentScope->sc_scope;
/* ???? */
close_scope();
}

53
lang/m2/comp/program.g
View file

@ -13,6 +13,7 @@ static char *RcsId = "$Header$";
#include "scope.h"
#include "def.h"
#include "type.h"
#include "debug.h"
}
/*
The grammar as given by Wirth is already almost LL(1); the
@ -31,6 +32,7 @@ static char *RcsId = "$Header$";
%lexical LLlex;
%start CompUnit, CompilationUnit;
%start DefModule, DefinitionModule;
ModuleDeclaration
{
@ -41,11 +43,11 @@ ModuleDeclaration
id = dot.TOK_IDF;
df = define(id, CurrentScope, D_MODULE);
open_scope(CLOSEDSCOPE, 0);
df->mod_scope = CurrentScope;
df->mod_scope = CurrentScope->sc_scope;
}
priority? ';'
import(1)*
export?
export(0)?
block
IDENT { close_scope();
match_id(id, dot.TOK_IDF);
@ -56,7 +58,7 @@ priority:
'[' ConstExpression ']'
;
export
export(int def;)
{
struct id_list *ExportList;
int QUALflag = 0;
@ -67,7 +69,8 @@ export
]?
IdentList(&ExportList) ';'
{
Export(ExportList, QUALflag);
if (!def) Export(ExportList, QUALflag);
else warning("export list in definition module ignored");
FreeIdList(ExportList);
}
;
@ -95,23 +98,31 @@ import(int local;)
DefinitionModule
{
struct def *df;
register struct def *df;
struct idf *id;
} :
DEFINITION { state = DEFINITION; }
MODULE IDENT { id = dot.TOK_IDF;
df = define(id, CurrentScope, D_MODULE);
df = define(id, GlobalScope, D_MODULE);
open_scope(CLOSEDSCOPE, 0);
df->mod_scope = CurrentScope;
df->mod_scope = CurrentScope->sc_scope;
DO_DEBUG(debug(1, "Definition module \"%s\"", id->id_text));
}
';'
import(0)*
/* export?
export(1)?
New Modula-2 does not have export lists in definition modules.
/* New Modula-2 does not have export lists in definition modules.
*/
definition* END IDENT '.'
{ close_scope();
{
df = CurrentScope->sc_def;
while (df) {
/* Make all definitions "QUALIFIED EXPORT" */
df->df_flags |= D_QEXPORTED;
df = df->df_nextinscope;
}
close_scope();
match_id(id, dot.TOK_IDF);
}
;
@ -124,7 +135,7 @@ definition
CONST [ ConstantDeclaration ';' ]*
|
TYPE
[ IDENT
[ IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
[ '=' type(&tp)
| /* empty */
/*
@ -132,6 +143,7 @@ definition
The export is said to be opaque.
It is restricted to pointer types.
*/
{ df->df_kind = D_HIDDEN; }
]
';'
]*
@ -141,19 +153,20 @@ definition
ProcedureHeading(&df, D_PROCHEAD) ';'
;
ProgramModule {
ProgramModule
{
struct idf *id;
struct def *df, *GetDefinitionModule();
int scope = 0;
} :
MODULE { if (state != IMPLEMENTATION) state = PROGRAM; }
IDENT { if (state == IMPLEMENTATION) {
/* ????
Read definition module,
Look for current identifier,
and find out its scope number
*/
}
IDENT {
id = dot.TOK_IDF;
open_scope(CLOSEDSCOPE, 0);
if (state == IMPLEMENTATION) {
df = GetDefinitionModule(id);
scope = df->mod_scope;
}
open_scope(CLOSEDSCOPE, scope);
}
priority?
';' import(0)*

55
lang/m2/comp/scope.C
View file

@ -15,41 +15,44 @@ static char *RcsId = "$Header$";
static int maxscope; /* maximum assigned scope number */
struct scope *currscope;
struct scope *CurrentScope, *GlobalScope;
/* STATICALLOCDEF "scope" */
/* Open a scope that is either open (automatic imports) or closed.
open_scope(scopetype, scope)
{
/* Open a scope that is either open (automatic imports) or closed.
A closed scope is handled by adding an extra entry to the list
with scope number 0. This has two purposes: it makes scope 0
visible, and it marks the end of a visibility list.
Scope 0 is the pervasive scope, the one that is always visible.
A disadvantage of this method is that we cannot open scope 0
explicitly.
*/
open_scope(scopetype, scopenr)
{
*/
register struct scope *sc = new_scope();
register struct scope *sc1;
sc->sc_scope = scopenr == 0 ? ++maxscope : scopenr;
sc->sc_scope = scope == 0 ? ++maxscope : scope;
sc->sc_forw = 0; sc->sc_def = 0;
assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
DO_DEBUG(debug(1, "Opening a %s scope", scopetype == OPENSCOPE ? "open" : "closed"));
sc1 = currscope;
DO_DEBUG(debug(1, "Opening a %s scope",
scopetype == OPENSCOPE ? "open" : "closed"));
sc1 = CurrentScope;
if (scopetype == CLOSEDSCOPE) {
sc1 = new_scope();
sc1->sc_scope = 0; /* Pervasive scope nr */
sc1->next = currscope;
sc1->sc_forw = 0; sc1->sc_def = 0;
sc1->next = CurrentScope;
}
sc->next = sc1;
currscope = sc;
CurrentScope = sc;
}
static rem_forwards();
close_scope()
{
register struct scope *sc = currscope;
register struct scope *sc = CurrentScope;
assert(sc != 0);
DO_DEBUG(debug(1, "Closing a scope"));
@ -60,7 +63,7 @@ close_scope()
sc = sc->next;
free_scope(sc1);
}
currscope = sc->next;
CurrentScope = sc->next;
free_scope(sc);
}
@ -69,8 +72,9 @@ init_scope()
register struct scope *sc = new_scope();
sc->sc_scope = 0;
sc->next = 0;
currscope = sc;
sc->sc_forw = 0;
sc->sc_def = 0;
CurrentScope = sc;
}
int
@ -87,29 +91,29 @@ struct forwards {
/* STATICALLOCDEF "forwards" */
/* Enter a forward reference into a list belonging to the
current scope. This is used for POINTER declarations, which
may have forward references that must howewer be declared in the
same scope.
*/
Forward(tk, ptp)
struct token *tk;
struct type **ptp;
{
/* Enter a forward reference into a list belonging to the
current scope. This is used for POINTER declarations, which
may have forward references that must howewer be declared in the
same scope.
*/
register struct forwards *f = new_forwards();
f->fo_tok = *tk;
f->fo_ptyp = ptp;
f->next = currscope->sc_forw;
currscope->sc_forw = f;
f->next = CurrentScope->sc_forw;
CurrentScope->sc_forw = f;
}
/* When closing a scope, all forward references must be resolved
*/
static
rem_forwards(fo)
struct forwards *fo;
{
/* When closing a scope, all forward references must be resolved
*/
register struct forwards *f;
struct token savetok;
register struct def *df;
@ -118,9 +122,10 @@ rem_forwards(fo)
savetok = dot;
while (f = fo) {
dot = f->fo_tok;
df = lookfor(dot.TOK_IDF, currscope, 1);
df = lookfor(dot.TOK_IDF, CurrentScope, 1);
if (!(df->df_kind & (D_TYPE | D_HTYPE | D_ERROR))) {
error("identifier \"%s\" not a type", df->df_idf->id_text);
error("identifier \"%s\" not a type",
df->df_idf->id_text);
}
*(f->fo_ptyp) = df->df_type;
fo = f->next;

4
lang/m2/comp/scope.h
View file

@ -16,9 +16,9 @@ struct scope {
};
extern struct scope
*currscope;
*CurrentScope,
*GlobalScope;
#define nextvisible(x) ((x)->sc_scope ? (x)->next : (struct scope *) 0)
#define scopeclosed(x) ((x)->next->sc_scope == 0)
#define enclosing(x) (scopeclosed(x) ? (x)->next->next : (x)->next)
#define CurrentScope (currscope->sc_scope)

4
lang/m2/comp/type.H
View file

@ -38,9 +38,9 @@ struct array {
};
struct record {
int rc_scopenr; /* Scope number of this record */
int rc_scope; /* Scope number of this record */
/* Members are in the symbol table */
#define rec_scopenr tp_value.tp_record.rc_scopenr
#define rec_scope tp_value.tp_record.rc_scope
};
struct proc {

2
lang/m2/comp/type.c
View file

@ -144,7 +144,7 @@ has_selectors(df)
register struct type *tp = df->df_type;
if (tp->tp_fund == RECORD) {
return tp->rec_scopenr;
return tp->rec_scope;
}
break;
}