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 tokenname.o: Lpars.h idf.h tokenname.h
idf.o: idf.h idf.o: idf.h
input.o: f_info.h input.h input.o: f_info.h input.h
type.o: Lpars.h def.h def_sizes.h idf.h type.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 scope.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 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 misc.o: LLlex.h f_info.h idf.h misc.h
enter.o: def.h idf.h misc.h scope.h type.h enter.o: def.h idf.h misc.h scope.h type.h

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

@ -31,13 +31,17 @@ ProcedureHeading(struct def **pdf; int type;)
struct paramlist *params = 0; struct paramlist *params = 0;
} : } :
PROCEDURE IDENT PROCEDURE IDENT
{ assert(type == D_PROCEDURE || type == D_PROCHEAD); { assert(type & (D_PROCEDURE | D_PROCHEAD));
*pdf = define(dot.TOK_IDF, CurrentScope, type); *pdf = define(dot.TOK_IDF, CurrentScope, type);
if (type == D_PROCEDURE) { if (type == D_PROCEDURE) {
open_scope(OPENSCOPE, 0); open_scope(OPENSCOPE, 0);
} }
} }
FormalParameters(type, &params, &tp)? FormalParameters(type, &params, &tp)?
{
(*pdf)->df_type = tp = construct_type(PROCEDURE, tp);
tp->prc_params = params;
}
; ;
block: block:
@ -63,54 +67,47 @@ FormalParameters(int doparams; struct paramlist **pr; struct type **tp;)
} : } :
'(' '('
[ [
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)) ';' FPSection(doparams, &(pr1->next))
]* ]*
]? ]?
')' ')'
{ *tp = 0; } { *tp = 0; }
[ ':' qualident(D_TYPE | D_HTYPE, &df, "type") [ ':' 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;) FPSection(int doparams; struct paramlist **ppr;)
{ {
struct id_list *FPList; struct id_list *FPList;
register struct id_list *pid; struct paramlist *ParamList();
register struct paramlist *pr = 0; struct type *tp;
int VARflag = 0; int VARp = 0;
} : } :
[ [
VAR { VARflag = 1; } VAR { VARp = 1; }
]? ]?
IdentList(&FPList) ':' FormalType IdentList(&FPList) ':' FormalType(&tp)
{ {
if (doparams) { if (doparams) {
EnterIdList(FPList, EnterIdList(FPList, D_VARIABLE, VARp, tp, CurrentScope);
D_VARIABLE, }
VARflag, *ppr = ParamList(FPList, tp);
(struct type *) 0 /* ???? */, FreeIdList(FPList);
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);
}
; ;
FormalType FormalType(struct type **tp;)
{ {
struct def *df; struct def *df;
int ARRAYflag = 0; int ARRAYflag = 0;
@ -118,6 +115,12 @@ FormalType
[ ARRAY OF { ARRAYflag = 1; } [ ARRAY OF { ARRAYflag = 1; }
]? ]?
qualident(D_TYPE | D_HTYPE, &df, "type") 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 TypeDeclaration
@ -127,8 +130,7 @@ TypeDeclaration
}: }:
IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); } IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
'=' type(&tp) '=' type(&tp)
{ df->df_type = tp; { df->df_type = tp; }
}
; ;
type(struct type **ptp;): type(struct type **ptp;):
@ -148,17 +150,19 @@ type(struct type **ptp;):
SimpleType(struct type **ptp;) SimpleType(struct type **ptp;)
{ {
struct def *df; struct def *df;
struct type *tp;
} : } :
qualident(D_TYPE | D_HTYPE, &df, "type") qualident(D_TYPE | D_HTYPE, &df, "type")
[ [
/* nothing */
| |
SubrangeType(ptp) SubrangeType(ptp)
/* /* The subrange type is given a base type by the
* The subrange type is given a base type by the qualident (this is new modula-2).
* qualident (this is new modula-2). */
*/ {
{ /* ???? (*ptp)->next = df->df_type; */ } chk_basesubrange(*ptp, tp);
}
] ]
| |
enumeration(ptp) enumeration(ptp)
@ -228,11 +232,11 @@ ArrayType(struct type **ptp;)
} }
[ [
',' SimpleType(&tp) ',' SimpleType(&tp)
{ tp2 = tp2->tp_value.tp_arr.ar_elem = { tp2 = tp2->arr_elem =
construct_type(ARRAY, tp); construct_type(ARRAY, tp);
} }
]* OF type(&tp) ]* OF type(&tp)
{ tp2->tp_value.tp_arr.ar_elem = tp; } { tp2->arr_elem = tp; }
; ;
RecordType(struct type **ptp;) RecordType(struct type **ptp;)
@ -245,7 +249,7 @@ RecordType(struct type **ptp;)
FieldListSequence(scopenr) FieldListSequence(scopenr)
{ {
*ptp = standard_type(RECORD, record_align, (arith) 0 /* ???? */); *ptp = standard_type(RECORD, record_align, (arith) 0 /* ???? */);
(*ptp)->tp_value.tp_record.rc_scopenr = scopenr; (*ptp)->rec_scopenr = scopenr;
} }
END 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;) PointerType(struct type **ptp;)
{ {
struct type *tp; struct type *tp;
register struct def *df; struct def *df;
struct def *lookfor(); struct def *lookfor();
} : } :
POINTER TO POINTER TO
[ %if ( (df = lookup(dot.TOK_IDF, CurrentScope))) [ %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) { if (!df->df_type) {
error("type \"%s\" not declared", error("type \"%s\" not declared",
df->df_idf->id_text); 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) | %if (df = lookfor(dot.TOK_IDF, 0), df->df_kind == D_MODULE)
type(&tp) type(&tp)
{ *ptp = construct_type(POINTER, tp); }
| |
IDENT IDENT
{ *ptp = construct_type(POINTER, NULLTYPE); { tp = NULLTYPE; }
Forward(&dot, &((*ptp)->next));
}
] ]
{
*ptp = construct_type(POINTER, tp);
if (!tp) Forward(&dot, &((*ptp)->next));
}
; ;
ProcedureType(struct type **ptp;): ProcedureType(struct type **ptp;)
PROCEDURE FormalTypeList? {
{ *ptp = 0; } 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 def *df;
struct type *tp;
struct paramlist *p;
int VARp;
} : } :
'(' [ VAR? FormalType [ ',' VAR? FormalType ]* ]? ')' '(' { *ppr = 0; }
[ ':' qualident(1, &df, "type") [
[ 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 { struct module {
int mo_priority; /* Priority of a module */ int mo_priority; /* Priority of a module */
int mo_scope; /* Scope of this 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 { struct variable {
char va_fixedaddress; /* Flag, set if an address was given */
arith va_off; /* Address or offset of variable */ arith va_off; /* Address or offset of variable */
#define var_off df_value.df_variable.va_off
}; };
struct constant { 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 { struct enumval {
unsigned int en_val; /* Value of this enumeration literal */ unsigned int en_val; /* Value of this enumeration literal */
struct def *en_next; /* Next 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 { struct field {
arith fld_off; arith fd_off;
struct variant { struct variant {
struct caselabellist *fld_cases; struct caselabellist *v_cases;
label fld_casedescr; label v_casedescr;
struct def *fld_varianttag; struct def *v_varianttag;
} *fld_variant; } *fd_variant;
#define fld_off df_value.df_field.fd_off
#define fld_variant df_value.df_field.fd_variant
}; };
struct import { struct import {
int im_scopenr; /* Scope number from which imported */ 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 { /* 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 */ struct idf *df_idf; /* link back to the name */
int df_scope; /* Scope in which this definition resides */ int df_scope; /* Scope in which this definition resides */
short df_kind; /* The kind of this definition: */ short df_kind; /* The kind of this definition: */
#define D_MODULE 0x0001 #define D_MODULE 0x0001 /* A module */
#define D_PROCEDURE 0x0002 #define D_PROCEDURE 0x0002 /* Procedure of function */
#define D_VARIABLE 0x0004 #define D_VARIABLE 0x0004 /* A variable */
#define D_FIELD 0x0008 #define D_FIELD 0x0008 /* A field in a record */
#define D_TYPE 0x0010 #define D_TYPE 0x0010 /* A type */
#define D_ENUM 0x0020 #define D_ENUM 0x0020 /* An enumeration literal */
#define D_CONST 0x0040 #define D_CONST 0x0040 /* A constant */
#define D_IMPORT 0x0080 #define D_IMPORT 0x0080 /* An imported definition */
#define D_PROCHEAD 0x0100 /* A procedure heading in a definition module */ #define D_PROCHEAD 0x0100 /* A procedure heading in a definition module */
#define D_HIDDEN 0x0200 /* A hidden type */ #define D_HIDDEN 0x0200 /* A hidden type */
#define D_HTYPE 0x0400 /* Definition of a hidden type seen */ #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 <alloc.h>
#include <em_arith.h> #include <em_arith.h>
#include <em_label.h> #include <em_label.h>
#include <assert.h>
#include "Lpars.h" #include "Lpars.h"
#include "def.h" #include "def.h"
#include "idf.h" #include "idf.h"
#include "misc.h"
#include "main.h" #include "main.h"
#include "scope.h" #include "scope.h"
#include "debug.h" #include "debug.h"
@ -15,7 +17,7 @@ static char *RcsId = "$Header$";
struct def *h_def; /* Pointer to free list of def structures */ struct def *h_def; /* Pointer to free list of def structures */
static struct def illegal_def = 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; struct def *ill_df = &illegal_def;
@ -27,6 +29,7 @@ define(id, scope, kind)
already has been defined. If so, error message. already has been defined. If so, error message.
*/ */
register struct def *df; register struct def *df;
register struct scope *sc;
DO_DEBUG(debug(4,"Defining identifier %s in scope %d", id->id_text, scope)); DO_DEBUG(debug(4,"Defining identifier %s in scope %d", id->id_text, scope));
df = lookup(id, scope); df = lookup(id, scope);
@ -66,6 +69,15 @@ define(id, scope, kind)
df->df_kind = kind; df->df_kind = kind;
df->next = id->id_def; df->next = id->id_def;
id->id_def = df; 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; return df;
} }
@ -85,6 +97,14 @@ lookup(id, scope)
DO_DEBUG(debug(4,"Looking for identifier %s in scope %d", id->id_text, scope)); DO_DEBUG(debug(4,"Looking for identifier %s in scope %d", id->id_text, scope));
while (df) { while (df) {
if (df->df_scope == scope) { 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) { if (df1) {
df1->next = df->next; df1->next = df->next;
df->next = id->id_def; df->next = id->id_def;
@ -97,3 +117,78 @@ lookup(id, scope)
} }
return 0; 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) { if (last) {
/* Also meaning : enumeration */ /* Also meaning : enumeration */
last->df_value.df_enum.en_next = 0; last->df_value.df_enum.en_next = 0;
type->tp_value.tp_enum.en_enums = first; type->enm_enums = first;
type->tp_value.tp_enum.en_ncst = assval; 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(); struct def *lookfor();
} : } :
IDENT { if (types) { IDENT { if (types) {
df = lookfor(dot.TOK_IDF, 1); *pdf = df = lookfor(dot.TOK_IDF, 1);
if (df->df_kind == D_ERROR) { if (df->df_kind == D_ERROR) types = 0;
*pdf = df;
types = 0;
}
} }
} }
[ [
@ -53,7 +50,7 @@ qualident(int types; struct def **pdf; char *str;)
]* ]*
{ if (types && !(types & df->df_kind)) { { if (types && !(types & df->df_kind)) {
error("identifier \"%s\" is not a %s", 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), construct_type(PROCEDURE, NULLTYPE),
0); 0);
tp = construct_type(SUBRANGE, int_type); tp = construct_type(SUBRANGE, int_type);
tp->tp_value.tp_subrange.su_lb = 0; tp->sub_lb = 0;
tp->tp_value.tp_subrange.su_ub = wrd_size * 8 - 1; tp->sub_ub = wrd_size * 8 - 1;
df = Enter("BITSET", D_TYPE, construct_type(SET, tp), 0); df = Enter("BITSET", D_TYPE, construct_type(SET, tp), 0);
df->df_type->tp_size = wrd_size; df->df_type->tp_size = wrd_size;
df = Enter("FALSE", D_ENUM, bool_type, 0); df = Enter("FALSE", D_ENUM, bool_type, 0);

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

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

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

@ -8,6 +8,7 @@
struct scope { struct scope {
struct scope *next; struct scope *next;
struct forwards *sc_forw; struct forwards *sc_forw;
struct def *sc_def; /* list of definitions in this scope */
int sc_scope; /* The scope number. Scope number 0 indicates int sc_scope; /* The scope number. Scope number 0 indicates
both the pervasive scope and the end of a both the pervasive scope and the end of a
visibility range visibility range
@ -19,5 +20,5 @@ extern struct scope
#define nextvisible(x) ((x)->sc_scope ? (x)->next : (struct scope *) 0) #define nextvisible(x) ((x)->sc_scope ? (x)->next : (struct scope *) 0)
#define scopeclosed(x) ((x)->next->sc_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) #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 */ struct def *en_enums; /* Definitions of enumeration literals */
unsigned int en_ncst; /* Number of constants */ unsigned int en_ncst; /* Number of constants */
label en_rck; /* Label of range check descriptor */ 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 { struct subrange {
arith su_lb, su_ub; /* Lower bound and upper bound */ arith su_lb, su_ub; /* Lower bound and upper bound */
label su_rck; /* Label of range check descriptor */ 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 array {
struct type *ar_elem; /* Type of elements */ struct type *ar_elem; /* Type of elements */
arith ar_lb, ar_ub; /* Lower bound and upper bound */ arith ar_lb, ar_ub; /* Lower bound and upper bound */
label ar_descr; /* Label of array descriptor */ 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 { struct record {
int rc_scopenr; /* Scope number of this record */ int rc_scopenr; /* Scope number of this record */
/* Members are in the symbol table */ /* Members are in the symbol table */
#define rec_scopenr tp_value.tp_record.rc_scopenr
}; };
struct proc { struct proc {
struct paramlist *pr_params; struct paramlist *pr_params;
#define prc_params tp_value.tp_proc.pr_params
}; };
struct type { struct type {

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

@ -11,6 +11,7 @@ static char *RcsId = "$Header$";
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
#include "idf.h" #include "idf.h"
#include "misc.h"
/* To be created dynamically in main() from defaults or from command /* To be created dynamically in main() from defaults or from command
line parameters. line parameters.
@ -143,7 +144,7 @@ has_selectors(df)
register struct type *tp = df->df_type; register struct type *tp = df->df_type;
if (tp->tp_fund == RECORD) { if (tp->tp_fund == RECORD) {
return tp->tp_value.tp_record.rc_scopenr; return tp->rec_scopenr;
} }
break; break;
} }
@ -151,3 +152,58 @@ has_selectors(df)
error("no selectors for \"%s\"", df->df_idf->id_text); error("no selectors for \"%s\"", df->df_idf->id_text);
return 0; 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;
}