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-03-29 01:04:49 +00:00
parent ad1feaf35c
commit fac31cce07
11 changed files with 339 additions and 102 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
lang/m2/comp/Makefile
View file

@ -74,8 +74,8 @@ 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 debug.h def.h idf.h main.h scope.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
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

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

@ -31,13 +31,17 @@ ProcedureHeading(struct def **pdf; int type;)
struct paramlist *params = 0;
} :
PROCEDURE IDENT
{ assert(type == D_PROCEDURE || type == D_PROCHEAD);
{ assert(type & (D_PROCEDURE | D_PROCHEAD));
*pdf = define(dot.TOK_IDF, CurrentScope, type);
if (type == D_PROCEDURE) {
open_scope(OPENSCOPE, 0);
}
}
FormalParameters(type, &params, &tp)?
{
(*pdf)->df_type = tp = construct_type(PROCEDURE, tp);
tp->prc_params = params;
}
;
block:
@ -64,53 +68,46 @@ FormalParameters(int doparams; struct paramlist **pr; struct type **tp;)
'('
[
FPSection(doparams, pr)
{ pr1 = *pr; }
[
{ for (pr1 = *pr; pr1->next; pr1 = pr1->next) ; }
{ for (; pr1->next; pr1 = pr1->next) ; }
';' FPSection(doparams, &(pr1->next))
]*
]?
')'
{ *tp = 0; }
[ ':' qualident(D_TYPE | D_HTYPE, &df, "type")
{ /* ???? *tp = df->df_type; */ }
{ *tp = df->df_type; }
]?
;
/* In the next nonterminal, "doparams" is a flag indicating whether
the identifiers representing the parameters must be added to the
symbol table. We must not do so when reading a Definition Module,
because in this case we only read the header. The Implementation
might contain different identifiers representing the same paramters.
*/
FPSection(int doparams; struct paramlist **ppr;)
{
struct id_list *FPList;
register struct id_list *pid;
register struct paramlist *pr = 0;
int VARflag = 0;
struct paramlist *ParamList();
struct type *tp;
int VARp = 0;
} :
[
VAR { VARflag = 1; }
VAR { VARp = 1; }
]?
IdentList(&FPList) ':' FormalType
IdentList(&FPList) ':' FormalType(&tp)
{
if (doparams) {
EnterIdList(FPList,
D_VARIABLE,
VARflag,
(struct type *) 0 /* ???? */,
CurrentScope
);
EnterIdList(FPList, D_VARIABLE, VARp, tp, CurrentScope);
}
*ppr = pr = new_paramlist();
pr->par_type = 0; /* ??? */
pr->par_var = VARflag;
for (pid = FPList->next; pid; pid = pid->next) {
pr->next = new_paramlist();
pr = pr->next;
pr->par_type = 0; /* ??? */
pr->par_var = VARflag;
}
pr->next = 0;
*ppr = ParamList(FPList, tp);
FreeIdList(FPList);
}
;
FormalType
FormalType(struct type **tp;)
{
struct def *df;
int ARRAYflag = 0;
@ -118,6 +115,12 @@ FormalType
[ ARRAY OF { ARRAYflag = 1; }
]?
qualident(D_TYPE | D_HTYPE, &df, "type")
{ if (ARRAYflag) {
*tp = construct_type(ARRAY, NULLTYPE);
(*tp)->arr_elem = df->df_type;
}
else *tp = df->df_type;
}
;
TypeDeclaration
@ -127,8 +130,7 @@ TypeDeclaration
}:
IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
'=' type(&tp)
{ df->df_type = tp;
}
{ df->df_type = tp; }
;
type(struct type **ptp;):
@ -148,17 +150,19 @@ type(struct type **ptp;):
SimpleType(struct type **ptp;)
{
struct def *df;
struct type *tp;
} :
qualident(D_TYPE | D_HTYPE, &df, "type")
[
/* nothing */
|
SubrangeType(ptp)
/*
* The subrange type is given a base type by the
* qualident (this is new modula-2).
/* The subrange type is given a base type by the
qualident (this is new modula-2).
*/
{ /* ???? (*ptp)->next = df->df_type; */ }
{
chk_basesubrange(*ptp, tp);
}
]
|
enumeration(ptp)
@ -228,11 +232,11 @@ ArrayType(struct type **ptp;)
}
[
',' SimpleType(&tp)
{ tp2 = tp2->tp_value.tp_arr.ar_elem =
{ tp2 = tp2->arr_elem =
construct_type(ARRAY, tp);
}
]* OF type(&tp)
{ tp2->tp_value.tp_arr.ar_elem = tp; }
{ tp2->arr_elem = tp; }
;
RecordType(struct type **ptp;)
@ -245,7 +249,7 @@ RecordType(struct type **ptp;)
FieldListSequence(scopenr)
{
*ptp = standard_type(RECORD, record_align, (arith) 0 /* ???? */);
(*ptp)->tp_value.tp_record.rc_scopenr = scopenr;
(*ptp)->rec_scopenr = scopenr;
}
END
;
@ -310,48 +314,87 @@ SetType(struct type **ptp;)
}
;
/* In a pointer type definition, the type pointed at does not
have to be declared yet, so be careful about identifying
type-identifiers
*/
PointerType(struct type **ptp;)
{
struct type *tp;
register struct def *df;
struct def *df;
struct def *lookfor();
} :
POINTER TO
[ %if ( (df = lookup(dot.TOK_IDF, CurrentScope)))
IDENT
/* Either a Module or a Type, but in both cases defined
in this scope, so this is the correct identification
*/
qualident(D_TYPE|D_HTYPE, &df, "type")
{
if (!(df->df_kind & (D_TYPE | D_HTYPE))) {
error("\"%s\" is not a type identifier",
df->df_idf->id_text);
}
if (!df->df_type) {
error("type \"%s\" not declared",
df->df_idf->id_text);
tp = error_type;
}
*ptp = df->df_type;
else tp = df->df_type;
}
| %if (df = lookfor(dot.TOK_IDF, 0), df->df_kind == D_MODULE)
type(&tp)
{ *ptp = construct_type(POINTER, tp); }
|
IDENT
{ *ptp = construct_type(POINTER, NULLTYPE);
Forward(&dot, &((*ptp)->next));
}
{ tp = NULLTYPE; }
]
{
*ptp = construct_type(POINTER, tp);
if (!tp) Forward(&dot, &((*ptp)->next));
}
;
ProcedureType(struct type **ptp;):
PROCEDURE FormalTypeList?
{ *ptp = 0; }
ProcedureType(struct type **ptp;)
{
struct paramlist *pr = 0;
struct type *tp = 0;
} :
PROCEDURE FormalTypeList(&pr, &tp)?
{ *ptp = construct_type(PROCEDURE, tp);
(*ptp)->prc_params = pr;
}
;
FormalTypeList
FormalTypeList(struct paramlist **ppr; struct type **ptp;)
{
struct def *df;
struct type *tp;
struct paramlist *p;
int VARp;
} :
'(' [ VAR? FormalType [ ',' VAR? FormalType ]* ]? ')'
[ ':' qualident(1, &df, "type")
'(' { *ppr = 0; }
[
[ VAR { VARp = 1; }
| { VARp = 0; }
]
FormalType(&tp)
{ *ppr = p = new_paramlist();
p->par_type = tp;
p->par_var = VARp;
}
[
','
[ VAR {VARp = 1; }
| {VARp = 0; }
]
FormalType(&tp)
{ p->next = new_paramlist();
p = p->next;
p->par_type = tp;
p->par_var = VARp;
}
]*
{ p->next = 0; }
]?
')'
[ ':' qualident(D_TYPE|D_HTYPE, &df, "type")
{ *ptp = df->df_type; }
]?
;

42
lang/m2/comp/def.H
View file

@ -5,48 +5,58 @@
struct module {
int mo_priority; /* Priority of a module */
int mo_scope; /* Scope of this module */
#define mod_priority df_value.df_module.mo_priority
#define mod_scope df_value.df_module.mo_scope
};
struct variable {
char va_fixedaddress; /* Flag, set if an address was given */
arith va_off; /* Address or offset of variable */
#define var_off df_value.df_variable.va_off
};
struct constant {
struct expr *co_const; /* A constant expression */
arith co_const; /* result of a constant expression */
#define con_const df_value.df_variable.con_const
};
struct enumval {
unsigned int en_val; /* Value of this enumeration literal */
struct def *en_next; /* Next enumeration literal */
#define enm_val df_value.df_enum.en_val
#define enm_next df_value.df_enum.en_next
};
struct field {
arith fld_off;
arith fd_off;
struct variant {
struct caselabellist *fld_cases;
label fld_casedescr;
struct def *fld_varianttag;
} *fld_variant;
struct caselabellist *v_cases;
label v_casedescr;
struct def *v_varianttag;
} *fd_variant;
#define fld_off df_value.df_field.fd_off
#define fld_variant df_value.df_field.fd_variant
};
struct import {
int im_scopenr; /* Scope number from which imported */
#define imp_scopenr df_value.df_import.im_scopenr
};
struct def { /* list of definitions for a name */
struct def *next;
struct def *next; /* next definition in definitions chain */
struct def *df_nextinscope;
/* link all definitions in a scope */
struct idf *df_idf; /* link back to the name */
int df_scope; /* Scope in which this definition resides */
short df_kind; /* The kind of this definition: */
#define D_MODULE 0x0001
#define D_PROCEDURE 0x0002
#define D_VARIABLE 0x0004
#define D_FIELD 0x0008
#define D_TYPE 0x0010
#define D_ENUM 0x0020
#define D_CONST 0x0040
#define D_IMPORT 0x0080
#define D_MODULE 0x0001 /* A module */
#define D_PROCEDURE 0x0002 /* Procedure of function */
#define D_VARIABLE 0x0004 /* A variable */
#define D_FIELD 0x0008 /* A field in a record */
#define D_TYPE 0x0010 /* A type */
#define D_ENUM 0x0020 /* An enumeration literal */
#define D_CONST 0x0040 /* A constant */
#define D_IMPORT 0x0080 /* An imported definition */
#define D_PROCHEAD 0x0100 /* A procedure heading in a definition module */
#define D_HIDDEN 0x0200 /* A hidden type */
#define D_HTYPE 0x0400 /* Definition of a hidden type seen */

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

@ -5,9 +5,11 @@ static char *RcsId = "$Header$";
#include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
#include <assert.h>
#include "Lpars.h"
#include "def.h"
#include "idf.h"
#include "misc.h"
#include "main.h"
#include "scope.h"
#include "debug.h"
@ -15,7 +17,7 @@ static char *RcsId = "$Header$";
struct def *h_def; /* Pointer to free list of def structures */
static struct def illegal_def =
{0, 0, -20 /* Illegal scope */, D_ERROR};
{0, 0, 0, -20 /* Illegal scope */, D_ERROR};
struct def *ill_df = &illegal_def;
@ -27,6 +29,7 @@ define(id, scope, kind)
already has been defined. If so, error message.
*/
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);
@ -66,6 +69,15 @@ define(id, scope, kind)
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;
return df;
}
@ -85,6 +97,14 @@ lookup(id, scope)
DO_DEBUG(debug(4,"Looking for identifier %s in scope %d", id->id_text, scope));
while (df) {
if (df->df_scope == scope) {
if (df->df_kind == D_IMPORT) {
df = lookup(id, df->imp_scopenr);
assert(df != 0);
return df;
/* ??? But this does damage to the self-
organizing character of the list
*/
}
if (df1) {
df1->next = df->next;
df->next = id->id_def;
@ -97,3 +117,78 @@ lookup(id, scope)
}
return 0;
}
/* From the current scope, the list of identifiers "ids" is
exported. Note this fact. If the export is not qualified, make
all the "ids" visible in the enclosing scope by defining them
in this scope as "imported".
*/
Export(ids, qualified)
register struct id_list *ids;
{
register struct def *df;
while (ids) {
df = define(ids->id_ptr, CurrentScope, D_ISEXPORTED);
if (qualified) {
df->df_flags |= D_QEXPORTED;
}
else {
df->df_flags |= D_EXPORTED;
df = define(ids->id_ptr, enclosing(currscope)->sc_scope,
D_IMPORT);
}
ids = ids->next;
}
}
/* "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.
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
are all module identifiers. Their Definition Modules must be read.
Otherwise "id" is a module identifier whose Definition Module must
be read. "ids" then represents a list of identifiers defined in
this module.
*/
Import(ids, id, local)
register struct id_list *ids;
struct idf *id;
{
register struct def *df;
int scope;
int kind;
struct def *lookfor();
if (local) {
kind = D_IMPORT;
if (!id) scope = enclosing(currscope)->sc_scope;
else {
df = lookfor(id, 1);
if (df->df_kind != D_MODULE) {
if (df->df_kind != D_ERROR) {
error("identifier \"%s\" does not represent a module", id->id_text);
}
/* enter all "ids" with type D_ERROR */
kind = D_ERROR;
scope = enclosing(currscope)->sc_scope;
}
else scope = df->mod_scope;
}
while (ids) {
df = lookup(ids->id_ptr, scope);
if (!df) {
error("identifier \"%s\" not declared",
ids->id_ptr->id_text);
}
df = define(ids->id_ptr, CurrentScope, D_IMPORT);
df->imp_scopenr = scope;
ids = ids->next;
}
return;
}
/* ???? */
}

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

@ -55,8 +55,8 @@ EnterIdList(idlist, kind, flags, type, scope)
if (last) {
/* Also meaning : enumeration */
last->df_value.df_enum.en_next = 0;
type->tp_value.tp_enum.en_enums = first;
type->tp_value.tp_enum.en_ncst = assval;
type->enm_enums = first;
type->enm_ncst = assval;
}
}

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

@ -25,11 +25,8 @@ qualident(int types; struct def **pdf; char *str;)
struct def *lookfor();
} :
IDENT { if (types) {
df = lookfor(dot.TOK_IDF, 1);
if (df->df_kind == D_ERROR) {
*pdf = df;
types = 0;
}
*pdf = df = lookfor(dot.TOK_IDF, 1);
if (df->df_kind == D_ERROR) types = 0;
}
}
[
@ -53,7 +50,7 @@ qualident(int types; struct def **pdf; char *str;)
]*
{ if (types && !(types & df->df_kind)) {
error("identifier \"%s\" is not a %s",
dot.TOK_IDF, str);
df->df_idf->id_text, str);
}
}
;

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

@ -158,8 +158,8 @@ add_standards()
construct_type(PROCEDURE, NULLTYPE),
0);
tp = construct_type(SUBRANGE, int_type);
tp->tp_value.tp_subrange.su_lb = 0;
tp->tp_value.tp_subrange.su_ub = wrd_size * 8 - 1;
tp->sub_lb = 0;
tp->sub_ub = wrd_size * 8 - 1;
df = Enter("BITSET", D_TYPE, construct_type(SET, tp), 0);
df->df_type->tp_size = wrd_size;
df = Enter("FALSE", D_ENUM, bool_type, 0);

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

@ -32,8 +32,20 @@ static char *RcsId = "$Header$";
%start CompUnit, CompilationUnit;
ModuleDeclaration:
MODULE IDENT priority? ';' import(1)* export? block IDENT
ModuleDeclaration
{
struct idf *id;
} :
MODULE IDENT { open_scope(CLOSEDSCOPE, 0);
id = dot.TOK_IDF;
}
priority? ';'
import(1)*
export?
block
IDENT { close_scope();
match_id(id, dot.TOK_IDF);
}
;
priority:
@ -51,6 +63,7 @@ export
]?
IdentList(&ExportList) ';'
{
Export(ExportList, QUALflag);
FreeIdList(ExportList);
}
;
@ -71,6 +84,7 @@ import(int local;)
name, otherwise the names in the import list are module names.
*/
{
Import(ImportList, id, local);
FreeIdList(ImportList);
}
;
@ -78,12 +92,13 @@ import(int local;)
DefinitionModule
{
struct def *df;
struct idf *id;
} :
DEFINITION { state = DEFINITION; }
MODULE IDENT {
df = define(dot.TOK_IDF, CurrentScope, D_MODULE);
MODULE IDENT { id = dot.TOK_IDF;
df = define(id, CurrentScope, D_MODULE);
open_scope(CLOSEDSCOPE, 0);
df->df_value.df_module.mo_scope = CurrentScope;
df->mod_scope = CurrentScope;
}
';'
import(0)*
@ -92,7 +107,9 @@ DefinitionModule
New Modula-2 does not have export lists in definition modules.
*/
definition* END IDENT '.'
{ close_scope(); }
{ close_scope();
match_id(id, dot.TOK_IDF);
}
;
definition
@ -120,7 +137,9 @@ definition
ProcedureHeading(&df, D_PROCHEAD) ';'
;
ProgramModule:
ProgramModule {
struct idf *id;
} :
MODULE { if (state != IMPLEMENTATION) state = PROGRAM; }
IDENT { if (state == IMPLEMENTATION) {
/* ????
@ -128,12 +147,16 @@ ProgramModule:
Look for current identifier,
and find out its scope number
*/
}
id = dot.TOK_IDF;
open_scope(CLOSEDSCOPE, 0);
}
else open_scope(CLOSEDSCOPE, 0);
priority?
';' import(0)*
block IDENT
{ close_scope();
match_id(id, dot.TOK_IDF);
}
priority? ';' import(0)* block IDENT
{ close_scope(); }
'.'
;

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

@ -8,6 +8,7 @@
struct scope {
struct scope *next;
struct forwards *sc_forw;
struct def *sc_def; /* list of definitions in this scope */
int sc_scope; /* The scope number. Scope number 0 indicates
both the pervasive scope and the end of a
visibility range
@ -19,5 +20,5 @@ extern struct scope
#define nextvisible(x) ((x)->sc_scope ? (x)->next : (struct scope *) 0)
#define scopeclosed(x) ((x)->next->sc_scope == 0)
#define enclosing(x) ((x)->next->scope != 0 ? (struct scope *) 0 : (x)->next->next)
#define enclosing(x) (scopeclosed(x) ? (x)->next->next : (x)->next)
#define CurrentScope (currscope->sc_scope)

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

@ -14,26 +14,38 @@ struct enume {
struct def *en_enums; /* Definitions of enumeration literals */
unsigned int en_ncst; /* Number of constants */
label en_rck; /* Label of range check descriptor */
#define enm_enums tp_value.tp_enum.en_enums
#define enm_ncst tp_value.tp_enum.en_ncst
#define enm_rck tp_value.tp_enum.enm_rck
};
struct subrange {
arith su_lb, su_ub; /* Lower bound and upper bound */
label su_rck; /* Label of range check descriptor */
#define sub_lb tp_value.tp_subrange.su_lb
#define sub_ub tp_value.tp_subrange.su_ub
#define sub_rck tp_value.tp_subrange.su_rck
};
struct array {
struct type *ar_elem; /* Type of elements */
arith ar_lb, ar_ub; /* Lower bound and upper bound */
label ar_descr; /* Label of array descriptor */
#define arr_elem tp_value.tp_arr.ar_elem
#define arr_lb tp_value.tp_arr.ar_lb
#define arr_ub tp_value.tp_arr.ar_ub
#define arr_descr tp_value.tp_arr.ar_descr
};
struct record {
int rc_scopenr; /* Scope number of this record */
/* Members are in the symbol table */
#define rec_scopenr tp_value.tp_record.rc_scopenr
};
struct proc {
struct paramlist *pr_params;
#define prc_params tp_value.tp_proc.pr_params
};
struct type {

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

@ -11,6 +11,7 @@ static char *RcsId = "$Header$";
#include "def.h"
#include "type.h"
#include "idf.h"
#include "misc.h"
/* To be created dynamically in main() from defaults or from command
line parameters.
@ -143,7 +144,7 @@ has_selectors(df)
register struct type *tp = df->df_type;
if (tp->tp_fund == RECORD) {
return tp->tp_value.tp_record.rc_scopenr;
return tp->rec_scopenr;
}
break;
}
@ -151,3 +152,58 @@ has_selectors(df)
error("no selectors for \"%s\"", df->df_idf->id_text);
return 0;
}
/* Create a parameterlist of a procedure and return a pointer to it.
"ids" indicates the list of identifiers, "tp" their type, and
"VARp" is set when the parameters are VAR-parameters.
Actually, "ids" is only used because it tells us how many parameters
there were with this type.
*/
struct paramlist *
ParamList(ids, tp, VARp)
register struct id_list *ids;
struct type *tp;
{
register struct paramlist *pr;
struct paramlist *pstart;
pstart = pr = new_paramlist();
pr->par_type = tp;
pr->par_var = VARp;
for (ids = ids->next; ids; ids = ids->next) {
pr->next = new_paramlist();
pr = pr->next;
pr->par_type = tp;
pr->par_var = VARp;
}
pr->next = 0;
return pstart;
}
/* A subrange had a specified base. Check that the bases conform ...
*/
chk_basesubrange(tp, base)
register struct type *tp, *base;
{
if (base->tp_fund == SUBRANGE) {
/* Check that the bounds of "tp" fall within the range
of "base"
*/
if (base->sub_lb > tp->sub_lb || base->sub_ub < tp->sub_ub) {
error("Base type has insufficient range");
}
base = base->next;
}
if (base->tp_fund == ENUMERATION || base->tp_fund == CHAR) {
if (tp->next != base) {
error("Specified base does not conform");
}
}
else if (base != card_type && base != int_type) {
error("Illegal base for a subrange");
}
else if (base != tp->next && base != int_type) {
error("Specified base does not conform");
}
tp->next = base;
}