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
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, ¶ms, &tp)?
+ {
+ (*pdf)->df_type = tp = construct_type(PROCEDURE, tp);
+ tp->prc_params = params;
+ }
;
block:
} :
'('
[
- FPSection(doparams, pr)
+ 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; */ }
+ [ ':' qualident(D_TYPE | D_HTYPE, &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
- {
- if (doparams) {
- EnterIdList(FPList,
- D_VARIABLE,
- VARflag,
- (struct type *) 0 /* ???? */,
- 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;
- FreeIdList(FPList);
- }
+ IdentList(&FPList) ':' FormalType(&tp)
+ {
+ if (doparams) {
+ EnterIdList(FPList, D_VARIABLE, VARp, tp, CurrentScope);
+ }
+ *ppr = ParamList(FPList, tp);
+ FreeIdList(FPList);
+ }
;
-FormalType
+FormalType(struct type **tp;)
{
struct def *df;
int ARRAYflag = 0;
[ 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
}:
IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
'=' type(&tp)
- { df->df_type = tp;
- }
+ { df->df_type = tp; }
;
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).
- */
- { /* ???? (*ptp)->next = df->df_type; */ }
+ /* The subrange type is given a base type by the
+ qualident (this is new modula-2).
+ */
+ {
+ chk_basesubrange(*ptp, tp);
+ }
]
|
enumeration(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;)
FieldListSequence(scopenr)
{
*ptp = standard_type(RECORD, record_align, (arith) 0 /* ???? */);
- (*ptp)->tp_value.tp_record.rc_scopenr = scopenr;
+ (*ptp)->rec_scopenr = scopenr;
}
END
;
}
;
+/* 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; }
]?
;
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 */
#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"
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;
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);
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;
}
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;
}
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;
+ }
+ /* ???? */
+}
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;
}
}
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;
}
}
[
]*
{ if (types && !(types & df->df_kind)) {
error("identifier \"%s\" is not a %s",
- dot.TOK_IDF, str);
+ df->df_idf->id_text, str);
}
}
;
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);
%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:
]?
IdentList(&ExportList) ';'
{
+ Export(ExportList, QUALflag);
FreeIdList(ExportList);
}
;
name, otherwise the names in the import list are module names.
*/
{
+ Import(ImportList, id, local);
FreeIdList(ImportList);
}
;
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)*
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
ProcedureHeading(&df, D_PROCHEAD) ';'
;
-ProgramModule:
+ProgramModule {
+ struct idf *id;
+} :
MODULE { if (state != IMPLEMENTATION) state = PROGRAM; }
IDENT { if (state == IMPLEMENTATION) {
/* ????
Look for current identifier,
and find out its scope number
*/
- open_scope(CLOSEDSCOPE, 0);
}
- else open_scope(CLOSEDSCOPE, 0);
+ id = dot.TOK_IDF;
+ open_scope(CLOSEDSCOPE, 0);
+ }
+ priority?
+ ';' import(0)*
+ block IDENT
+ { close_scope();
+ match_id(id, dot.TOK_IDF);
}
- priority? ';' import(0)* block IDENT
- { close_scope(); }
'.'
;
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
#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)
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 {
#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.
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;
}
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;
+}