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

safety commit, newer version

Browse source
This commit is contained in:
ceriel 1986-03-27 17:37:41 +00:00
parent 851a68883c
commit f2764393be
15 changed files with 444 additions and 126 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
lang/m2/comp/Makefile
View file

@ -76,12 +76,12 @@ 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 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 scope.h
scope.o: debug.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 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
tokenfile.o: Lpars.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 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 declar.o: LLlex.h Lpars.h def.h idf.h misc.h scope.h type.h
expression.o: Lpars.h expression.o: LLlex.h Lpars.h def.h idf.h scope.h
statement.o: Lpars.h statement.o: Lpars.h
Lpars.o: Lpars.h Lpars.o: Lpars.h

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

@ -27,15 +27,17 @@ ProcedureDeclaration
ProcedureHeading(struct def **pdf; int type;) ProcedureHeading(struct def **pdf; int type;)
{ {
struct type *tp;
struct paramlist *params = 0;
} : } :
PROCEDURE IDENT PROCEDURE IDENT
{ assert(type == D_PROCEDURE || type == D_PROCHEAD); { assert(type == D_PROCEDURE || type == D_PROCHEAD);
*pdf = define(dot.TOK_IDF, CurrentScope, D_PROCHEAD); *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, &((*pdf)->df_type))? FormalParameters(type, &params, &tp)?
; ;
block: block:
@ -54,15 +56,31 @@ declaration:
ModuleDeclaration ';' ModuleDeclaration ';'
; ;
FormalParameters(int doparams; struct type **tp;) : FormalParameters(int doparams; struct paramlist **pr; struct type **tp;)
'(' [ FPSection(doparams) [ ';' FPSection(doparams)]* ]? ')' {
[ ':' qualident struct def *df;
register struct paramlist *pr1;
} :
'('
[
FPSection(doparams, pr)
[
{ for (pr1 = *pr; pr1->next; pr1 = pr1->next) ; }
';' FPSection(doparams, &(pr1->next))
]*
]?
')'
{ *tp = 0; }
[ ':' qualident(D_TYPE | D_HTYPE, &df, "type")
{ /* ???? *tp = df->df_type; */ }
]? ]?
; ;
FPSection(int doparams;) FPSection(int doparams; struct paramlist **ppr;)
{ {
struct id_list *FPList; struct id_list *FPList;
register struct id_list *pid;
register struct paramlist *pr = 0;
int VARflag = 0; int VARflag = 0;
} : } :
[ [
@ -74,70 +92,88 @@ FPSection(int doparams;)
EnterIdList(FPList, EnterIdList(FPList,
D_VARIABLE, D_VARIABLE,
VARflag, VARflag,
(struct type *) 0 /* ???? */ (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); FreeIdList(FPList);
} }
; ;
FormalType: FormalType
[ ARRAY OF ]? qualident {
struct def *df;
int ARRAYflag = 0;
} :
[ ARRAY OF { ARRAYflag = 1; }
]?
qualident(D_TYPE | D_HTYPE, &df, "type")
; ;
TypeDeclaration TypeDeclaration
{ {
struct def *df; struct def *df;
struct idf *id; struct type *tp;
}: }:
IDENT { id = dot.TOK_IDF; } IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
'=' type { df = define(id, CurrentScope, D_TYPE); '=' type(&tp)
/* ???? */ { df->df_type = tp;
} }
; ;
type: type(struct type **ptp;):
SimpleType SimpleType(ptp)
| |
ArrayType ArrayType(ptp)
| |
RecordType RecordType(ptp)
| |
SetType SetType(ptp)
| |
PointerType PointerType(ptp)
| |
ProcedureType ProcedureType(ptp)
; ;
SimpleType: SimpleType(struct type **ptp;)
qualident {
struct def *df;
} :
qualident(D_TYPE | D_HTYPE, &df, "type")
[ [
| |
SubrangeType 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; */ }
] ]
| |
enumeration enumeration(ptp)
| |
SubrangeType SubrangeType(ptp)
; ;
enumeration enumeration(struct type **ptp;)
{ {
struct id_list *EnumList; struct id_list *EnumList;
} : } :
'(' IdentList(&EnumList) ')' '(' IdentList(&EnumList) ')'
{ {
EnterIdList(EnumList, *ptp = standard_type(ENUMERATION,int_align,int_size);
D_ENUM, EnterIdList(EnumList, D_ENUM, 0, *ptp, CurrentScope);
0,
(struct type *) 0 /* ???? */
);
FreeIdList(EnumList); FreeIdList(EnumList);
} }
@ -157,43 +193,102 @@ IdentList(struct id_list **p;)
{ q->next = 0; } { q->next = 0; }
; ;
SubrangeType: SubrangeType(struct type **ptp;)
{
struct type *tp;
}:
/* /*
This is not exactly the rule in the new report, but see This is not exactly the rule in the new report, but see
the rule for "SimpleType". the rule for "SimpleType".
*/ */
'[' ConstExpression UPTO ConstExpression ']' '[' ConstExpression
UPTO ConstExpression
']'
/*
Evaluate the expressions. Check that they are indeed constant.
???
Leave the basetype of the subrange in tp;
*/
{
/* For the time being: */
tp = int_type;
tp = construct_type(SUBRANGE, tp, (arith) 0);
*ptp = tp;
}
; ;
ArrayType: ArrayType(struct type **ptp;)
ARRAY SimpleType [ ',' SimpleType ]* OF type {
struct type *tp;
register struct type *tp2;
} :
ARRAY SimpleType(&tp)
{
*ptp = tp2 = construct_type(ARRAY, tp);
}
[
',' SimpleType(&tp)
{ tp2 = tp2->tp_value.tp_arr.ar_elem =
construct_type(ARRAY, tp);
}
]* OF type(&tp)
{ tp2->tp_value.tp_arr.ar_elem = tp; }
; ;
RecordType: RecordType(struct type **ptp;)
RECORD FieldListSequence END {
int scopenr;
}
:
RECORD
{ scopenr = uniq_scope(); }
FieldListSequence(scopenr)
{
*ptp = standard_type(RECORD, record_align, (arith) 0 /* ???? */);
(*ptp)->tp_value.tp_record.rc_scopenr = scopenr;
}
END
; ;
FieldListSequence: FieldListSequence(int scopenr;):
FieldList [ ';' FieldList ]* FieldList(scopenr)
[
';' FieldList(scopenr)
]*
; ;
FieldList FieldList(int scopenr;)
{ {
struct id_list *FldList; struct id_list *FldList;
struct idf *id;
struct def *df, *df1;
struct type *tp;
} : } :
[ [
IdentList(&FldList) ':' type IdentList(&FldList) ':' type(&tp)
| |
CASE IDENT? /* Changed rule in new modula-2 */ CASE
':' qualident [
OF variant [ '|' variant ]* IDENT { id = dot.TOK_IDF; }
[ ELSE FieldListSequence ]? |
{ id = gen_anon_idf(); }
] /* Changed rule in new modula-2 */
':' qualident(D_TYPE|D_HTYPE, &df, "type")
{ df1 = define(id, scopenr, D_FIELD);
df1->df_type = df->df_type;
}
OF variant(scopenr)
[
'|' variant(scopenr)
]*
[ ELSE FieldListSequence(scopenr)
]?
END END
]? ]?
; ;
variant: variant(int scopenr;):
[ CaseLabelList ':' FieldListSequence ]? [ CaseLabelList ':' FieldListSequence(scopenr) ]?
/* Changed rule in new modula-2 */ /* Changed rule in new modula-2 */
; ;
@ -205,21 +300,59 @@ CaseLabels:
ConstExpression [ UPTO ConstExpression ]? ConstExpression [ UPTO ConstExpression ]?
; ;
SetType: SetType(struct type **ptp;)
SET OF SimpleType {
struct type *tp;
} :
SET OF SimpleType(&tp)
{
*ptp = construct_type(SET, tp, (arith) 0 /* ???? */);
}
; ;
PointerType: PointerType(struct type **ptp;)
POINTER TO type {
struct type *tp;
register struct def *df;
struct def *lookfor();
} :
POINTER TO
[ %if ( (df = lookup(dot.TOK_IDF, CurrentScope)))
IDENT
{
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);
}
*ptp = 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));
}
]
; ;
ProcedureType: ProcedureType(struct type **ptp;):
PROCEDURE FormalTypeList? PROCEDURE FormalTypeList?
{ *ptp = 0; }
; ;
FormalTypeList: FormalTypeList
{
struct def *df;
} :
'(' [ VAR? FormalType [ ',' VAR? FormalType ]* ]? ')' '(' [ VAR? FormalType [ ',' VAR? FormalType ]* ]? ')'
[ ':' qualident ]? [ ':' qualident(1, &df, "type")
]?
; ;
ConstantDeclaration ConstantDeclaration
@ -236,17 +369,14 @@ ConstantDeclaration
VariableDeclaration VariableDeclaration
{ {
struct id_list *VarList; struct id_list *VarList;
struct type *tp;
} : } :
IdentList(&VarList) IdentList(&VarList)
[ [
ConstExpression ConstExpression
]? ]?
':' type ':' type(&tp)
{ EnterIdList(VarList, { EnterIdList(VarList, D_VARIABLE, 0, tp, CurrentScope);
D_VARIABLE,
0,
(struct type *) 0 /* ???? */
);
FreeIdList(VarList); FreeIdList(VarList);
} }
; ;

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

@ -38,21 +38,24 @@ struct def { /* list of definitions for a name */
struct def *next; struct def *next;
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 */
char df_kind; /* The kind of this definition: */ short df_kind; /* The kind of this definition: */
#define D_MODULE 0x00 #define D_MODULE 0x0001
#define D_PROCEDURE 0x01 #define D_PROCEDURE 0x0002
#define D_VARIABLE 0x02 #define D_VARIABLE 0x0004
#define D_FIELD 0x03 #define D_FIELD 0x0008
#define D_TYPE 0x04 #define D_TYPE 0x0010
#define D_ENUM 0x05 #define D_ENUM 0x0020
#define D_CONST 0x06 #define D_CONST 0x0040
#define D_IMPORT 0x07 #define D_IMPORT 0x0080
#define D_PROCHEAD 0x08 /* A procedure heading in a definition module */ #define D_PROCHEAD 0x0100 /* A procedure heading in a definition module */
#define D_HIDDEN 0x09 /* A hidden type */ #define D_HIDDEN 0x0200 /* A hidden type */
#define D_HTYPE 0x0A /* Definition of a hidden type seen */ #define D_HTYPE 0x0400 /* Definition of a hidden type seen */
#define D_STDPROC 0x0B /* A standard procedure */ #define D_STDPROC 0x0800 /* A standard procedure */
#define D_STDFUNC 0x0C /* A standard function */ #define D_STDFUNC 0x1000 /* A standard function */
#define D_ISEXPORTED 0xFF /* Not yet defined */ #define D_ERROR 0x2000 /* A compiler generated definition for an
undefined variable
*/
#define D_ISEXPORTED 0x4000 /* Not yet defined */
char df_flags; char df_flags;
#define D_ADDRESS 0x01 /* Set if address was taken */ #define D_ADDRESS 0x01 /* Set if address was taken */
#define D_USED 0x02 /* Set if used */ #define D_USED 0x02 /* Set if used */
@ -74,6 +77,9 @@ struct def { /* list of definitions for a name */
/* ALLOCDEF "def" */ /* ALLOCDEF "def" */
struct def extern struct def
*define(), *define(),
*lookup(); *lookup(),
*ill_df;
#define NULLDEF ((struct def *) 0)

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

@ -14,21 +14,30 @@ 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 =
{0, 0, -20 /* Illegal scope */, D_ERROR};
struct def *ill_df = &illegal_def;
struct def * struct def *
define(id, scope, kind) define(id, scope, kind)
register struct idf *id; register struct idf *id;
register struct scope *scope;
{ {
/* Declare an identifier in a scope, but first check if it /* Declare an identifier in a scope, but first check if it
already has been defined. If so, error message. already has been defined. If so, error message.
*/ */
register struct def *df = lookup(id, scope->sc_scope); register struct def *df;
DO_DEBUG(debug(3,"Defining identifier %s in scope %d", id->id_text, scope->sc_scope)); DO_DEBUG(debug(4,"Defining identifier %s in scope %d", id->id_text, scope));
df = lookup(id, scope);
if ( /* Already in this scope */ if ( /* Already in this scope */
df df
|| /* A closed scope, and id defined in the pervasive scope */ || /* A closed scope, and id defined in the pervasive scope */
(scopeclosed(scope) && (df = lookup(id, 0))) ( CurrentScope == scope
&&
scopeclosed(currscope)
&&
(df = lookup(id, 0)))
) { ) {
switch(df->df_kind) { switch(df->df_kind) {
case D_PROCHEAD: case D_PROCHEAD:
@ -43,17 +52,17 @@ define(id, scope, kind)
return df; return df;
} }
break; break;
case D_ERROR:
case D_ISEXPORTED: case D_ISEXPORTED:
df->df_kind = kind; df->df_kind = kind;
return df; return df;
break;
} }
error("Identifier \"%s\" already declared", id->id_text); error("identifier \"%s\" already declared", id->id_text);
return df; return df;
} }
df = new_def(); df = new_def();
df->df_idf = id; df->df_idf = id;
df->df_scope = scope->sc_scope; df->df_scope = scope;
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;
@ -73,7 +82,7 @@ lookup(id, scope)
df1 = 0; df1 = 0;
df = id->id_def; df = id->id_def;
DO_DEBUG(debug(3,"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 (df1) { if (df1) {

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

@ -32,24 +32,50 @@ Enter(name, kind, type, pnam)
return df; return df;
} }
EnterIdList(idlist, kind, flags, type) EnterIdList(idlist, kind, flags, type, scope)
register struct id_list *idlist; register struct id_list *idlist;
struct type *type; struct type *type;
{ {
register struct def *df; register struct def *df;
struct def *last = 0; struct def *first = 0, *last = 0;
int assval = 0; int assval = 0;
while (idlist) { while (idlist) {
df = define(idlist->id_ptr, CurrentScope, kind); df = define(idlist->id_ptr, scope, kind);
df->df_type = type; df->df_type = type;
df->df_flags = flags; df->df_flags = flags;
if (kind == D_ENUM) { if (kind == D_ENUM) {
if (!first) first = df;
df->df_value.df_enum.en_val = assval++; df->df_value.df_enum.en_val = assval++;
if (last) last->df_value.df_enum.en_next = df; if (last) last->df_value.df_enum.en_next = df;
last = df; last = df;
} }
idlist = idlist->next; idlist = idlist->next;
} }
if (last) last->df_value.df_enum.en_next = 0; 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;
}
}
/* Look for an identifier in the current visibility range.
If it is not defined, give an error message, and
create a dummy definition.
*/
struct def *
lookfor(id, give_error)
struct idf *id;
{
register struct scope *sc = currscope;
struct def *df;
while (sc) {
df = lookup(id, sc->sc_scope);
if (df) return df;
sc = nextvisible(sc);
}
if (give_error) error("Identifier \"%s\" not declared", id->id_text);
return define(id, CurrentScope, D_ERROR);
} }

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

@ -132,7 +132,7 @@ _error(class, expr, fmt, argv)
case LEXERROR: case LEXERROR:
case CRASH: case CRASH:
case FATAL: case FATAL:
/* /* ????
if (C_busy()) if (C_busy())
C_ms_err(); C_ms_err();
*/ */
@ -164,7 +164,7 @@ _error(class, expr, fmt, argv)
switch (class) { switch (class) {
case WARNING: case WARNING:
case ERROR: case ERROR:
ln = /* expr ? expr->ex_line : */ dot.tk_lineno; ln = /* ???? expr ? expr->ex_line : */ dot.tk_lineno;
break; break;
case LEXWARNING: case LEXWARNING:
case LEXERROR: case LEXERROR:

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

@ -1,5 +1,15 @@
/* E X P R E S S I O N S */
{ {
static char *RcsId = "$Header$"; static char *RcsId = "$Header$";
#include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
#include "LLlex.h"
#include "idf.h"
#include "def.h"
#include "scope.h"
} }
number: number:
@ -8,8 +18,44 @@ number:
REAL REAL
; ;
qualident: qualident(int types; struct def **pdf; char *str;)
IDENT selector* {
int scope;
register struct def *df;
struct def *lookfor();
} :
IDENT { if (types) {
df = lookfor(dot.TOK_IDF, 1);
if (df->df_kind == D_ERROR) {
*pdf = df;
types = 0;
}
}
}
[
{ if (types &&!(scope = has_selectors(df))) {
types = 0;
*pdf = ill_df;
}
}
/* selector */
'.' IDENT
{ if (types) {
df = lookup(dot.TOK_IDF, scope);
if (!df) {
error("identifier \"%s\" not declared",
dot.TOK_IDF->id_text);
types = 0;
df = ill_df;
}
}
}
]*
{ if (types && !(types & df->df_kind)) {
error("identifier \"%s\" is not a %s",
dot.TOK_IDF, str);
}
}
; ;
selector: selector:
@ -52,8 +98,11 @@ MulOperator:
'*' | '/' | DIV | MOD | AND | '&' '*' | '/' | DIV | MOD | AND | '&'
; ;
factor: factor
qualident {
struct def *df;
} :
qualident(0, &df, (char *) 0)
[ [
designator_tail? ActualParameters? designator_tail? ActualParameters?
| |
@ -83,15 +132,25 @@ element:
expression [ UPTO expression ]? expression [ UPTO expression ]?
; ;
designator: designator
qualident designator_tail? {
struct def *df;
} :
qualident(0, &df, (char *) 0)
designator_tail?
; ;
designator_tail: designator_tail:
visible_designator_tail visible_designator_tail
[ selector | visible_designator_tail ]* [
selector
|
visible_designator_tail
]*
; ;
visible_designator_tail: visible_designator_tail:
'[' ExpList ']' | '^' '[' ExpList ']'
|
'^'
; ;

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

@ -121,8 +121,6 @@ Option(str)
options[str[1]]++; /* switch option on */ options[str[1]]++; /* switch option on */
} }
#define NULLTYPE ((struct type *) 0)
add_standards() add_standards()
{ {
register struct def *df; register struct def *df;
@ -157,15 +155,13 @@ add_standards()
(void) Enter("NIL", D_CONST, nil_type, 0); (void) Enter("NIL", D_CONST, nil_type, 0);
(void) Enter("PROC", (void) Enter("PROC",
D_TYPE, D_TYPE,
construct_type(PROCEDURE, NULLTYPE, (arith) 0), construct_type(PROCEDURE, NULLTYPE),
0); 0);
tp = construct_type(SUBRANGE, int_type, (arith) 0); tp = construct_type(SUBRANGE, int_type);
tp->tp_value.tp_subrange.su_lb = 0; tp->tp_value.tp_subrange.su_lb = 0;
tp->tp_value.tp_subrange.su_ub = wrd_size * 8 - 1; tp->tp_value.tp_subrange.su_ub = wrd_size * 8 - 1;
(void) Enter("BITSET", df = Enter("BITSET", D_TYPE, construct_type(SET, tp), 0);
D_TYPE, df->df_type->tp_size = wrd_size;
construct_type(SET, tp, wrd_size),
0);
df = Enter("FALSE", D_ENUM, bool_type, 0); df = Enter("FALSE", D_ENUM, bool_type, 0);
df->df_value.df_enum.en_val = 0; df->df_value.df_enum.en_val = 0;
df->df_value.df_enum.en_next = Enter("TRUE", D_ENUM, bool_type, 0); df->df_value.df_enum.en_next = Enter("TRUE", D_ENUM, bool_type, 0);

3
lang/m2/comp/misc.H
View file

@ -12,3 +12,6 @@ struct id_list {
/* ALLOCDEF "id_list" */ /* ALLOCDEF "id_list" */
#define is_anon_idf(x) ((x)->id_text[0] == '#') #define is_anon_idf(x) ((x)->id_text[0] == '#')
extern struct idf
*gen_anon_idf();

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

@ -83,7 +83,7 @@ DefinitionModule
MODULE IDENT { MODULE IDENT {
df = define(dot.TOK_IDF, CurrentScope, D_MODULE); df = define(dot.TOK_IDF, CurrentScope, D_MODULE);
open_scope(CLOSEDSCOPE, 0); open_scope(CLOSEDSCOPE, 0);
df->df_value.df_module.mo_scope = CurrentScope->sc_scope; df->df_value.df_module.mo_scope = CurrentScope;
} }
';' ';'
import(0)* import(0)*
@ -98,12 +98,13 @@ DefinitionModule
definition definition
{ {
struct def *df; struct def *df;
struct type *tp;
} : } :
CONST [ ConstantDeclaration ';' ]* CONST [ ConstantDeclaration ';' ]*
| |
TYPE TYPE
[ IDENT [ IDENT
[ '=' type [ '=' type(&tp)
| /* empty */ | /* empty */
/* /*
Here, the exported type has a hidden implementation. Here, the exported type has a hidden implementation.

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

@ -4,12 +4,18 @@ static char *RcsId = "$Header$";
#include <assert.h> #include <assert.h>
#include <alloc.h> #include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
#include "LLlex.h"
#include "idf.h"
#include "scope.h" #include "scope.h"
#include "type.h"
#include "def.h"
#include "debug.h" #include "debug.h"
static int maxscope; /* maximum assigned scope number */ static int maxscope; /* maximum assigned scope number */
struct scope *CurrentScope; struct scope *currscope;
/* STATICALLOCDEF "scope" */ /* STATICALLOCDEF "scope" */
@ -29,29 +35,32 @@ open_scope(scopetype, scopenr)
sc->sc_scope = scopenr == 0 ? ++maxscope : scopenr; sc->sc_scope = scopenr == 0 ? ++maxscope : scopenr;
assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE); assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
DO_DEBUG(debug(1, "Opening a %s scope", scopetype == OPENSCOPE ? "open" : "closed")); DO_DEBUG(debug(1, "Opening a %s scope", scopetype == OPENSCOPE ? "open" : "closed"));
sc1 = CurrentScope; sc1 = currscope;
if (scopetype == CLOSEDSCOPE) { if (scopetype == CLOSEDSCOPE) {
sc1 = new_scope(); sc1 = new_scope();
sc1->sc_scope = 0; /* Pervasive scope nr */ sc1->sc_scope = 0; /* Pervasive scope nr */
sc1->next = CurrentScope; sc1->next = currscope;
} }
sc->next = sc1; sc->next = sc1;
CurrentScope = sc; currscope = sc;
} }
static rem_forwards();
close_scope() close_scope()
{ {
register struct scope *sc = CurrentScope; register struct scope *sc = currscope;
assert(sc != 0); assert(sc != 0);
DO_DEBUG(debug(1, "Closing a scope")); DO_DEBUG(debug(1, "Closing a scope"));
if (sc->sc_forw) rem_forwards(sc->sc_forw);
if (sc->next && (sc->next->sc_scope == 0)) { if (sc->next && (sc->next->sc_scope == 0)) {
struct scope *sc1 = sc; struct scope *sc1 = sc;
sc = sc->next; sc = sc->next;
free_scope(sc1); free_scope(sc1);
} }
CurrentScope = sc->next; currscope = sc->next;
free_scope(sc); free_scope(sc);
} }
@ -61,5 +70,61 @@ init_scope()
sc->sc_scope = 0; sc->sc_scope = 0;
sc->next = 0; sc->next = 0;
CurrentScope = sc; currscope = sc;
}
int
uniq_scope()
{
return ++maxscope;
}
struct forwards {
struct forwards *next;
struct token fo_tok;
struct type **fo_ptyp;
};
/* 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;
{
register struct forwards *f = new_forwards();
f->fo_tok = *tk;
f->fo_ptyp = ptp;
f->next = currscope->sc_forw;
currscope->sc_forw = f;
}
/* When closing a scope, all forward references must be resolved
*/
static
rem_forwards(fo)
struct forwards *fo;
{
register struct forwards *f;
struct token savetok;
register struct def *df;
struct def *lookfor();
savetok = dot;
while (f = fo) {
dot = f->fo_tok;
df = lookfor(dot.TOK_IDF, 1);
if (!(df->df_kind & (D_TYPE | D_HTYPE | D_ERROR))) {
error("identifier \"%s\" not a type", df->df_idf->id_text);
}
*(f->fo_ptyp) = df->df_type;
fo = f->next;
free_forwards(f);
}
dot = savetok;
} }

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

@ -7,6 +7,7 @@
struct scope { struct scope {
struct scope *next; struct scope *next;
struct forwards *sc_forw;
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
@ -14,7 +15,9 @@ struct scope {
}; };
extern struct scope extern struct scope
*CurrentScope; *currscope;
#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 CurrentScope (currscope->sc_scope)

1
lang/m2/comp/tokenname.c
View file

@ -86,6 +86,7 @@ struct tokenname tkstandard[] = { /* standard identifiers */
{CARDINAL, ""}, {CARDINAL, ""},
{LONGREAL, ""}, {LONGREAL, ""},
{SUBRANGE, ""}, {SUBRANGE, ""},
{ENUMERATION, ""},
{ERRONEOUS, ""}, {ERRONEOUS, ""},
{0, ""} {0, ""}
}; };

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

@ -22,7 +22,7 @@ struct subrange {
}; };
struct array { struct array {
struct type *ar_index; /* Type of index */ 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 */
}; };
@ -90,3 +90,5 @@ struct type
*create_type(), *create_type(),
*construct_type(), *construct_type(),
*standard_type(); *standard_type();
#define NULLTYPE ((struct type *) 0)

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

@ -64,9 +64,8 @@ create_type(fund)
} }
struct type * struct type *
construct_type(fund, tp, count) construct_type(fund, tp)
struct type *tp; struct type *tp;
arith count;
{ {
/* fund must be a type constructor. /* fund must be a type constructor.
The pointer to the constructed type is returned. The pointer to the constructed type is returned.
@ -82,13 +81,10 @@ construct_type(fund, tp, count)
break; break;
case SET: case SET:
dtp->tp_align = wrd_align; dtp->tp_align = wrd_align;
dtp->tp_size = align((count + 7) / 8, wrd_align);
dtp->next = tp; dtp->next = tp;
break; break;
case ARRAY: case ARRAY:
dtp->tp_align = tp->tp_align; dtp->tp_align = tp->tp_align;
if (tp->tp_size < 0) dtp->tp_size = -1;
else dtp->tp_size = count * tp->tp_size;
dtp->next = tp; dtp->next = tp;
break; break;
case SUBRANGE: case SUBRANGE:
@ -134,3 +130,24 @@ init_types()
nil_type = standard_type(POINTER, ptr_align, ptr_size); nil_type = standard_type(POINTER, ptr_align, ptr_size);
error_type = standard_type(ERRONEOUS, 1, (arith) 1); error_type = standard_type(ERRONEOUS, 1, (arith) 1);
} }
int
has_selectors(df)
register struct def *df;
{
switch(df->df_kind) {
case D_MODULE:
return df->df_value.df_module.mo_scope;
case D_VARIABLE: {
register struct type *tp = df->df_type;
if (tp->tp_fund == RECORD) {
return tp->tp_value.tp_record.rc_scopenr;
}
break;
}
}
error("no selectors for \"%s\"", df->df_idf->id_text);
return 0;
}