register struct string *str = &string;
register char *p;
- str->s_str = p = Malloc(str->s_length = ISTRSIZE);
+ str->s_str = p = Malloc((unsigned int) (str->s_length = ISTRSIZE));
LoadChar(ch);
while (ch != upto) {
if (class(ch) == STNL) {
*p++ = ch;
if (p - str->s_str == str->s_length) {
str->s_str = Srealloc(str->s_str,
- str->s_length + RSTRSIZE);
+ (unsigned int) str->s_length + RSTRSIZE);
p = str->s_str + str->s_length;
str->s_length += RSTRSIZE;
}
/* $Header$ */
struct string {
- unsigned int s_length; /* length of a string */
+ arith s_length; /* length of a string */
char *s_str; /* the string itself */
};
"flag". Here, a definition "df" is checked against it.
*/
+ if (df->df_kind == D_ERROR) return 0;
+
if ((flag & VARIABLE) &&
!(df->df_kind & (D_FIELD|D_VARIABLE))) {
node_error(expp, "variable expected");
expp->nd_type = error_type;
if (expp->nd_class == Name) {
- expp->nd_def = lookfor(expp, CurrentScope, 1);
+ expp->nd_def = lookfor(expp, CurrVis, 1);
expp->nd_class = Def;
expp->nd_type = expp->nd_def->df_type;
if (expp->nd_type == error_type) return 0;
expp->nd_symb = INTEGER;
}
else {
+ char *fn;
+ int ln;
+
assert(df->df_kind == D_CONST);
+ ln = expp->nd_lineno;
+ fn = expp->nd_filename;
*expp = *(df->con_const);
+ expp->nd_lineno = ln;
+ expp->nd_filename = fn;
}
}
}
if (!TstAssCompat(tpl, tpr->next)) {
/* Assignment compatible ???
- I don't know! Should we be allowed th check
+ I don't know! Should we be allowed to check
if a CARDINAL is a member of a BITSET???
*/
case '-':
case '*':
switch(tpl->tp_fund) {
+ case T_POINTER:
+ if (tpl != address_type) break;
+ /* Fall through */
case T_INTEGER:
case T_CARDINAL:
case T_INTORCARD:
case DIV:
case MOD:
- if (tpl->tp_fund & T_INTORCARD) {
+ if ((tpl->tp_fund & T_INTORCARD) || tpl == address_type) {
if (left->nd_class==Value && right->nd_class==Value) {
cstbin(expp);
}
{
/* Check an unary operation.
*/
- register struct type *tpr = expp->nd_right->nd_type;
+ register struct node *right = expp->nd_right;
+ register struct type *tpr = right->nd_type;
if (tpr->tp_fund == T_SUBRANGE) tpr = tpr->next;
expp->nd_type = tpr;
switch(expp->nd_symb) {
case '+':
if (tpr->tp_fund & T_NUMERIC) {
- expp->nd_token = expp->nd_right->nd_token;
- FreeNode(expp->nd_right);
+ expp->nd_token = right->nd_token;
+ FreeNode(right);
expp->nd_right = 0;
return 1;
}
case '-':
if (tpr->tp_fund & T_INTORCARD) {
- if (expp->nd_right->nd_class == Value) {
+ if (right->nd_class == Value) {
cstunary(expp);
}
return 1;
}
else if (tpr->tp_fund == T_REAL) {
- if (expp->nd_right->nd_class == Value) {
- expp->nd_token = expp->nd_right->nd_token;
+ if (right->nd_class == Value) {
+ expp->nd_token = right->nd_token;
if (*(expp->nd_REL) == '-') {
expp->nd_REL++;
}
else expp->nd_REL--;
- FreeNode(expp->nd_right);
+ FreeNode(right);
expp->nd_right = 0;
}
return 1;
case NOT:
case '~':
if (tpr == bool_type) {
- if (expp->nd_right->nd_class == Value) {
+ if (right->nd_class == Value) {
cstunary(expp);
}
return 1;
getvariable(arg)
register struct node *arg;
{
+ struct def *df;
+ register struct node *left;
+
arg = arg->nd_right;
if (!arg) {
node_error(arg, "too few parameters supplied");
return 0;
}
- if (! chk_designator(arg->nd_left, DESIGNATOR)) return 0;
- if (arg->nd_left->nd_class == Oper || arg->nd_left->nd_class == Uoper) {
+ left = arg->nd_left;
+
+ if (! chk_designator(left, DESIGNATOR)) return 0;
+ if (left->nd_class == Oper || left->nd_class == Uoper) {
return arg;
}
- if (arg->nd_left->nd_class != Def ||
- !(arg->nd_left->nd_def->df_kind & (D_VARIABLE|D_FIELD))) {
+ df = 0;
+ if (left->nd_class == Link) df = left->nd_right->nd_def;
+ else if (left->nd_class == Def) df = left->nd_def;
+
+ if (!df || !(df->df_kind & (D_VARIABLE|D_FIELD))) {
node_error(arg, "variable expected");
return 0;
}
return 0;
}
if (!(arg = getarg(arg, T_DISCRETE))) return 0;
- if (!TstCompat(tp->next, arg->nd_left->nd_type)) {
+ if (!TstAssCompat(tp->next, arg->nd_left->nd_type)) {
+ /* What type of compatibility do we want here?
+ apparently assignment compatibility! ??? ???
+ */
node_error(arg, "unexpected type");
return 0;
}
';' block(&(df->prc_body)) IDENT
{
match_id(dot.TOK_IDF, df->df_idf);
- df->prc_scope = CurrentScope;
+ df->prc_vis = CurrVis;
close_scope(SC_CHKFORW|SC_REVERSE);
proclevel--;
currentdef = savecurr;
'=' type(&tp)
{ if (df->df_type) free_type(df->df_type);
df->df_type = tp;
- if ((df->df_flags&D_EXPORTED) &&
- tp->tp_fund == T_ENUMERATION) {
- exprt_literals(tp->enm_enums,
- enclosing(CurrentScope));
- }
if (df->df_kind == D_HTYPE &&
tp->tp_fund != T_POINTER) {
-error("Opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
+error("opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
}
}
;
else tp = df->df_type;
}
| %if ( nd = new_node(), nd->nd_token = dot,
- df = lookfor(nd, CurrentScope, 0), free_node(nd),
+ df = lookfor(nd, CurrVis, 0), free_node(nd),
df->df_kind == D_MODULE)
type(&tp)
|
struct module {
arith mo_priority; /* priority of a module */
- struct scope *mo_scope; /* scope of this module */
+ struct scopelist *mo_vis;/* scope of this module */
struct node *mo_body; /* body of this module */
int mo_number; /* number of this module */
#define mod_priority df_value.df_module.mo_priority
-#define mod_scope df_value.df_module.mo_scope
+#define mod_vis df_value.df_module.mo_vis
#define mod_body df_value.df_module.mo_body
#define mod_number df_value.df_module.mo_number
};
};
struct dfproc {
- struct scope *pr_scope; /* scope of procedure */
+ struct scopelist *pr_vis; /* scope of procedure */
short pr_level; /* depth level of this procedure */
arith pr_nbpar; /* number of bytes parameters */
struct node *pr_body; /* body of this procedure */
-#define prc_scope df_value.df_proc.pr_scope
+#define prc_vis df_value.df_proc.pr_vis
#define prc_level df_value.df_proc.pr_level
#define prc_nbpar df_value.df_proc.pr_nbpar
#define prc_body df_value.df_proc.pr_body
};
struct dforward {
- struct scope *fo_scope;
+ struct scopelist *fo_vis;
struct node *fo_node;
char *fo_name;
#define for_node df_value.df_forward.fo_node
-#define for_scope df_value.df_forward.fo_scope
+#define for_vis df_value.df_forward.fo_vis
+#define for_scopes df_value.df_forward.fo_scopes
#define for_name df_value.df_forward.fo_name
};
register struct def *df;
df = new_def();
- df->df_flags = 0;
+ clear((char *) df, sizeof (*df));
df->df_idf = id;
df->df_scope = scope;
df->df_kind = kind;
- df->df_type = 0;
df->next = id->id_def;
id->id_def = df;
if ( /* Already in this scope */
df
|| /* A closed scope, and id defined in the pervasive scope */
- ( CurrentScope == scope
- &&
+ (
scopeclosed(scope)
&&
(df = lookup(id, PervasiveScope)))
return df;
}
break;
+
case D_FORWMODULE:
if (kind == D_FORWMODULE) {
return df;
}
+
if (kind == D_MODULE) {
FreeNode(df->for_node);
- df->mod_scope = df->for_scope;
+ df->mod_vis = df->for_vis;
df->df_kind = kind;
return df;
}
break;
+
case D_FORWARD:
if (kind != D_FORWARD) {
FreeNode(df->for_node);
}
- /* Fall Through */
+
+ df->df_kind = kind;
+ return df;
+
case D_ERROR:
df->df_kind = kind;
return df;
}
+
if (kind != D_ERROR) {
error("identifier \"%s\" already declared", id->id_text);
}
+
return df;
}
+
return MkDef(id, scope, kind);
}
retval = df->imp_def;
assert(retval != 0);
}
-
if (df1) {
df1->next = df->next;
df->next = id->id_def;
return 0;
}
-Export(ids, qualified)
+DoImport(df, scope)
+ struct def *df;
+ struct scope *scope;
+{
+ register struct def *df1;
+
+ if (df->df_kind == D_TYPE && df->df_type->tp_fund == T_ENUMERATION) {
+ /* Also import all enumeration literals
+ */
+ df1 = df->df_type->enm_enums;
+ while (df1) {
+ define(df1->df_idf, scope, D_IMPORT)->imp_def = df1;
+ df1 = df1->enm_next;
+ }
+ }
+ else if (df->df_kind == D_MODULE) {
+ /* Also import all definitions that are exported from this
+ module
+ */
+ df1 = df->mod_vis->sc_scope->sc_def;
+ while (df1) {
+ if (df1->df_flags & D_EXPORTED) {
+ define(df1->df_idf, scope, D_IMPORT)->imp_def = df1;
+ }
+ df1 = df1->df_nextinscope;
+ }
+ }
+}
+
+Export(ids, qualified, moddef)
register struct node *ids;
+ struct def *moddef;
{
/* From the current scope, the list of identifiers "ids" is
exported. Note this fact. If the export is not qualified, make
in this scope as "imported".
*/
register struct def *df, *df1;
- struct node *nd = ids;
+ register struct def *impmod;
- while (ids) {
+ for (;ids; ids = ids->next) {
df = lookup(ids->nd_IDF, CurrentScope);
- if (df && (df->df_flags & (D_EXPORTED|D_QEXPORTED))) {
+
+ if (!df) {
+ /* undefined item in export list
+ */
+node_error(ids, "identifier \"%s\" not defined", ids->nd_IDF->id_text);
+ continue;
+ }
+
+ if (df->df_flags & (D_EXPORTED|D_QEXPORTED)) {
node_error(ids, "Identifier \"%s\" occurs more than once in export list",
df->df_idf->id_text);
}
- else if (!df) {
- df = define(ids->nd_IDF, CurrentScope, D_FORWARD);
- df->for_node = MkNode(Name,NULLNODE,NULLNODE,
- &(ids->nd_token));
- }
+
if (qualified) {
df->df_flags |= D_QEXPORTED;
}
else {
+ /* Export, but not qualified.
+ Find all imports of the module in which this export
+ occurs, and export the current definition to it
+ */
+ impmod = moddef->df_idf->id_def;
+ while (impmod) {
+ if (impmod->df_kind == D_IMPORT &&
+ impmod->imp_def == moddef) {
+ DoImport(df, impmod->df_scope);
+ }
+ impmod = impmod->next;
+ }
+
df->df_flags |= D_EXPORTED;
- df1 = lookup(ids->nd_IDF, enclosing(CurrentScope));
- if (! df1 || !(df1->df_kind & (D_PROCHEAD|D_HIDDEN))) {
- df1 = define(ids->nd_IDF,
- enclosing(CurrentScope),
- D_IMPORT);
+ df1 = lookup(ids->nd_IDF, enclosing(CurrVis)->sc_scope);
+ if (df1 && df1->df_kind == D_PROCHEAD) {
+ if (df->df_kind == D_PROCEDURE) {
+ df1->df_kind = D_IMPORT;
+ df1->imp_def = df;
+ continue;
+ }
}
- else {
- /* A hidden type or a procedure of which only
- the head is seen. Apparently, they are
- exported from a local module!
- */
- df->df_kind = df1->df_kind;
- df->df_value.df_forward = df1->df_value.df_forward;
- df1->df_kind = D_IMPORT;
+ else if (df1 && df1->df_kind == D_HIDDEN) {
+ if (df->df_kind == D_TYPE) {
+ if (df->df_type->tp_fund != T_POINTER) {
+error("Opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
+ }
+ df->df_kind = D_HTYPE;
+ df1->df_kind = D_IMPORT;
+ df1->imp_def = df;
+ continue;
+ }
}
+
+ df1 = define(ids->nd_IDF,
+ enclosing(CurrVis)->sc_scope,
+ D_IMPORT);
df1->imp_def = df;
+ DoImport(df, enclosing(CurrVis)->sc_scope);
}
- ids = ids->next;
}
- FreeNode(nd);
}
-static struct scope *
+static struct scopelist *
ForwModule(df, idn)
register struct def *df;
struct node *idn;
/* An import is done from a not yet defined module "idn".
Create a declaration and a scope for this module.
*/
- struct scope *scope;
+ struct scopelist *vis;
- df->df_scope = enclosing(CurrentScope);
+ df->df_scope = enclosing(CurrVis)->sc_scope;
df->df_kind = D_FORWMODULE;
open_scope(CLOSEDSCOPE);
- scope = CurrentScope; /* The new scope, but watch out, it's "next"
+ vis = CurrVis; /* The new scope, but watch out, it's "sc_encl"
field is not set right. It must indicate the
enclosing scope, but this must be done AFTER
closing this one
*/
- df->for_scope = scope;
+ df->for_vis = vis;
df->for_node = MkNode(Name, NULLNODE, NULLNODE, &(idn->nd_token));
close_scope(0);
- scope->next = df->df_scope;
+ vis->sc_encl = enclosing(CurrVis);
/* Here ! */
- return scope;
+ return vis;
}
static struct def *
identifiers defined in this module.
*/
register struct def *df;
- struct scope *scope = enclosing(CurrentScope);
- int kind = D_IMPORT;
+ struct scopelist *vis = enclosing(CurrVis);
int forwflag = 0;
#define FROM_MODULE 0
#define FROM_ENCLOSING 1
if (idn) {
imp_kind = FROM_MODULE;
if (local) {
- df = lookfor(idn, scope, 0);
+ df = lookfor(idn, vis, 0);
switch(df->df_kind) {
case D_ERROR:
/* The module from which the import was done
accept this, but for the time being I will.
???
*/
- scope = ForwModule(df, idn);
+ vis = ForwModule(df, idn);
forwflag = 1;
break;
case D_FORWMODULE:
- scope = df->for_scope;
+ vis = df->for_vis;
break;
case D_MODULE:
- scope = df->mod_scope;
+ vis = df->mod_vis;
break;
default:
- kind = D_ERROR;
node_error(idn, "identifier \"%s\" does not represent a module",
idn->nd_IDF->id_text);
break;
}
}
- else scope = GetDefinitionModule(idn->nd_IDF)->mod_scope;
+ else vis = GetDefinitionModule(idn->nd_IDF)->mod_vis;
FreeNode(idn);
}
while (ids) {
if (imp_kind == FROM_MODULE) {
if (forwflag) {
- df = ForwDef(ids, scope);
+ df = ForwDef(ids, vis->sc_scope);
}
- else if (!(df = lookup(ids->nd_IDF, scope))) {
+ else if (!(df = lookup(ids->nd_IDF, vis->sc_scope))) {
node_error(ids, "identifier \"%s\" not declared in qualifying module",
ids->nd_IDF->id_text);
df = ill_df;
}
}
else {
- if (local) df = ForwDef(ids, scope);
+ if (local) df = ForwDef(ids, vis->sc_scope);
else df = GetDefinitionModule(ids->nd_IDF);
}
DO_DEBUG(2, debug("importing \"%s\", kind %d", ids->nd_IDF->id_text,
df->df_kind));
- define(ids->nd_IDF, CurrentScope, kind)->imp_def = df;
- if (df->df_kind == D_TYPE &&
- df->df_type->tp_fund == T_ENUMERATION) {
- /* Also import all enumeration literals
- */
- exprt_literals(df->df_type->enm_enums, CurrentScope);
- }
+ define(df->df_idf, CurrentScope, D_IMPORT)->imp_def = df;
+ DoImport(df, CurrentScope);
ids = ids->next;
}
FreeNode(idn);
}
-exprt_literals(df, toscope)
- register struct def *df;
- struct scope *toscope;
-{
- /* A list of enumeration literals is exported. This is implemented
- as an import from the scope "toscope".
- */
- DO_DEBUG(3, debug("enumeration import:"));
- while (df) {
- DO_DEBUG(3, debug(df->df_idf->id_text));
- define(df->df_idf, toscope, D_IMPORT)->imp_def = df;
- df = df->enm_next;
- }
-}
-
RemImports(pdf)
struct def **pdf;
{
df->df_kind = D_PROCEDURE;
open_scope(OPENSCOPE);
CurrentScope->sc_name = df->for_name;
- df->prc_scope = CurrentScope;
+ df->prc_vis = CurrVis;
}
else {
df = define(dot.TOK_IDF, CurrentScope, type);
- if (CurrentScope != Defined->mod_scope) {
+ if (CurrVis != Defined->mod_vis) {
sprint(buf, "_%d_%s", ++nmcount,
df->df_idf->id_text);
}
- else (sprint(buf, "%s_%s",df->df_scope->sc_name,
+ else (sprint(buf, "%s_%s",CurrentScope->sc_name,
df->df_idf->id_text));
open_scope(OPENSCOPE);
- df->prc_scope = CurrentScope;
+ df->prc_vis = CurrVis;
CurrentScope->sc_name = Malloc((unsigned)(strlen(buf)+1));
strcpy(CurrentScope->sc_name, buf);
C_inp(buf);
procedure
*/
register struct def *df;
- register struct scope *scope;
+ register struct scopelist *sc;
char buf[256];
extern char *sprint(), *Malloc(), *strcpy();
- scope = CurrentScope;
+ sc = CurrVis;
if (local) {
/* Find the closest enclosing open scope. This
is the procedure that we are dealing with
*/
- while (scope->sc_scopeclosed) scope = scope->next;
+ while (sc->sc_scope->sc_scopeclosed) sc = enclosing(sc);
}
while (IdList) {
as the variable list exists only local to a
procedure
*/
- scope->sc_off = -align(type->tp_size - scope->sc_off,
+ sc->sc_scope->sc_off =
+ -align(type->tp_size - sc->sc_scope->sc_off,
type->tp_align);
- df->var_off = scope->sc_off;
+ df->var_off = sc->sc_scope->sc_off;
}
else if (!DefinitionModule &&
- CurrentScope != Defined->mod_scope) {
+ CurrVis != Defined->mod_vis) {
/* variable list belongs to an internal global
module. Align offset and add size
*/
- scope->sc_off = align(scope->sc_off, type->tp_align);
- df->var_off = scope->sc_off;
- scope->sc_off += type->tp_size;
+ sc->sc_scope->sc_off =
+ align(sc->sc_scope->sc_off, type->tp_align);
+ df->var_off = sc->sc_scope->sc_off;
+ sc->sc_scope->sc_off += type->tp_size;
}
else {
/* Global name, possibly external
*/
- sprint(buf,"%s_%s", df->df_scope->sc_name,
+ sprint(buf,"%s_%s", sc->sc_scope->sc_name,
df->df_idf->id_text);
df->var_name = Malloc((unsigned)(strlen(buf)+1));
strcpy(df->var_name, buf);
}
struct def *
-lookfor(id, scope, give_error)
+lookfor(id, vis, give_error)
struct node *id;
- struct scope *scope;
+ struct scopelist *vis;
{
/* Look for an identifier in the visibility range started by
- "scope".
+ "vis".
If it is not defined, maybe give an error message, and
create a dummy definition.
*/
struct def *df;
- register struct scope *sc = scope;
+ register struct scopelist *sc = vis;
struct def *MkDef();
while (sc) {
- df = lookup(id->nd_IDF, sc);
+ df = lookup(id->nd_IDF, sc->sc_scope);
if (df) return df;
sc = nextvisible(sc);
}
if (give_error) id_not_declared(id);
- return MkDef(id->nd_IDF, scope, D_ERROR);
+ return MkDef(id->nd_IDF, vis->sc_scope, D_ERROR);
}
#include "LLlex.h"
#include "idf.h"
#include "def.h"
-#include "scope.h"
#include "node.h"
#include "const.h"
#include "type.h"
{
struct def *df;
struct node *nd;
+ register struct type *tp;
} :
qualident(0, &df, (char *) 0, p)
[
| %default
number(p)
|
- STRING {
- *p = MkNode(Value, NULLNODE, NULLNODE, &dot);
- if (dot.TOK_SLE == 1) {
- int i;
+ STRING {
+ *p = MkNode(Value, NULLNODE, NULLNODE, &dot);
+ if (dot.TOK_SLE == 1) {
+ int i;
- i = *(dot.TOK_STR) & 0377;
- (*p)->nd_type = charc_type;
- free(dot.TOK_STR);
- dot.TOK_INT = i;
- }
- else (*p)->nd_type = string_type;
- }
+ tp = charc_type;
+ i = *(dot.TOK_STR) & 0377;
+ free(dot.TOK_STR);
+ free((char *) dot.tk_data.tk_str);
+ dot.TOK_INT = i;
+ }
+ else tp = standard_type(T_STRING, 1, dot.TOK_SLE);
+ (*p)->nd_type = tp;
+ }
|
'(' expression(p) ')'
|
static int modulecount = 0;
char buf[256];
struct node *nd;
+ struct node *exportlist = 0;
+ int qualified;
extern char *sprint(), *Malloc(), *strcpy();
} :
MODULE IDENT {
df = define(id, CurrentScope, D_MODULE);
currentdef = df;
- if (!df->mod_scope) {
+ if (!df->mod_vis) {
open_scope(CLOSEDSCOPE);
- df->mod_scope = CurrentScope;
+ df->mod_vis = CurrVis;
}
- else CurrentScope = df->mod_scope;
+ else CurrVis = df->mod_vis;
df->df_type = standard_type(T_RECORD, 0, (arith) 0);
- df->df_type->rec_scope = df->mod_scope;
+ df->df_type->rec_scope = df->mod_vis->sc_scope;
df->mod_number = ++modulecount;
sprint(buf, "__%d%s", df->mod_number, id->id_text);
CurrentScope->sc_name =
priority(&(df->mod_priority))?
';'
import(1)*
- export(0)?
+ export(&qualified, &exportlist, 0)?
block(&nd)
IDENT { InitProc(nd, df);
+ if (exportlist) {
+ Export(exportlist, qualified, df);
+ FreeNode(exportlist);
+ }
close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
match_id(id, dot.TOK_IDF);
currentdef = savecurr;
}
;
-export(int def;)
+export(int *QUALflag; struct node **ExportList; int def;)
{
- struct node *ExportList;
- int QUALflag = 0;
} :
EXPORT
[
QUALIFIED
- { QUALflag = 1; }
- ]?
- IdentList(&ExportList) ';'
+ { *QUALflag = 1; }
+ |
+ { *QUALflag = 0; }
+ ]
+ IdentList(ExportList) ';'
{
- if (!def) {
- Export(ExportList, QUALflag);
- }
- else {
-node_warning(ExportList, "export list in definition module ignored");
- FreeNode(ExportList);
+ if (def) {
+node_warning(*ExportList, "export list in definition module ignored");
+ FreeNode(*ExportList);
}
}
;
{
register struct def *df;
struct idf *id;
+ struct node *exportlist;
+ int dummy;
} :
DEFINITION
MODULE IDENT {
df = define(id, GlobalScope, D_MODULE);
if (!SYSTEMModule) open_scope(CLOSEDSCOPE);
if (!Defined) Defined = df;
- df->mod_scope = CurrentScope;
+ df->mod_vis = CurrVis;
df->mod_number = 0;
CurrentScope->sc_name = id->id_text;
df->df_type = standard_type(T_RECORD, 0, (arith) 0);
- df->df_type->rec_scope = df->mod_scope;
+ df->df_type->rec_scope = df->mod_vis->sc_scope;
DefinitionModule++;
DO_DEBUG(1, debug("Definition module \"%s\" %d",
id->id_text, DefinitionModule));
}
';'
import(0)*
- export(1)?
+ export(&dummy, &exportlist, 1)?
/* New Modula-2 does not have export lists in definition modules.
For the time being, we ignore export lists here, and a
warning is issued.
DEFofIMPL = 1;
df = GetDefinitionModule(id);
currentdef = df;
- CurrentScope = df->mod_scope;
+ CurrVis = df->mod_vis;
+ CurrentScope = CurrVis->sc_scope;
DEFofIMPL = 0;
}
else {
df = define(id, CurrentScope, D_MODULE);
Defined = df;
open_scope(CLOSEDSCOPE);
- df->mod_scope = CurrentScope;
+ df->mod_vis = CurrVis;
df->mod_number = 0;
CurrentScope->sc_name = id->id_text;
}
#include "debug.h"
-struct scope *CurrentScope, *PervasiveScope, *GlobalScope;
+struct scope *PervasiveScope, *GlobalScope;
+struct scopelist *CurrVis;
static int scp_level;
+static struct scopelist *PervVis;
/* STATICALLOCDEF "scope" */
+/* STATICALLOCDEF "scopelist" */
+
open_scope(scopetype)
{
/* Open a scope that is either open (automatic imports) or closed.
*/
register struct scope *sc = new_scope();
+ register struct scopelist *ls = new_scopelist();
assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
sc->sc_scopeclosed = scopetype == CLOSEDSCOPE;
sc->sc_forw = 0;
sc->sc_def = 0;
sc->sc_off = 0;
- sc->next = 0;
- DO_DEBUG(1, debug("Opening a %s scope",
- scopetype == OPENSCOPE ? "open" : "closed"));
- if (CurrentScope != PervasiveScope) {
- sc->next = CurrentScope;
+ if (scopetype == OPENSCOPE) {
+ ls->next = CurrVis;
}
- CurrentScope = sc;
+ else ls->next = PervVis;
+ ls->sc_scope = sc;
+ ls->sc_encl = CurrVis;
+ CurrVis = ls;
}
init_scope()
{
register struct scope *sc = new_scope();
+ register struct scopelist *ls = new_scopelist();
sc->sc_scopeclosed = 0;
sc->sc_forw = 0;
sc->sc_def = 0;
sc->sc_level = scp_level++;
- sc->next = 0;
PervasiveScope = sc;
- CurrentScope = sc;
+ ls->next = 0;
+ ls->sc_encl = 0;
+ ls->sc_scope = PervasiveScope;
+ PervVis = ls;
+ CurrVis = ls;
}
struct forwards {
Maybe the definitions are in the
enclosing scope?
*/
- struct scope *sc;
+ struct scopelist *ls;
- sc = enclosing(CurrentScope);
+ ls = nextvisible(CurrVis);
if ((*pdf)->df_kind == D_FORWMODULE) {
- (*pdf)->for_scope->next = sc;
+ (*pdf)->for_vis->next = ls;
}
- (*pdf)->df_nextinscope = sc->sc_def;
- sc->sc_def = *pdf;
- (*pdf)->df_scope = sc;
+ (*pdf)->df_nextinscope = ls->sc_scope->sc_def;
+ ls->sc_scope->sc_def = *pdf;
+ (*pdf)->df_scope = ls->sc_scope;
*pdf = df1;
}
}
struct def *lookfor();
while (f = fo) {
- df = lookfor(&(f->fo_tok), CurrentScope, 1);
+ df = lookfor(&(f->fo_tok), CurrVis, 1);
if (!(df->df_kind & (D_TYPE|D_HTYPE|D_ERROR))) {
node_error(&(f->fo_tok), "identifier \"%s\" not a type",
df->df_idf->id_text);
if (flag & SC_CHKFORW) chk_forw(&(sc->sc_def));
if (flag & SC_REVERSE) Reverse(&(sc->sc_def));
}
- CurrentScope = sc->next;
+ CurrVis = enclosing(CurrVis);
scp_level = CurrentScope->sc_level;
}
int sc_level; /* level of this scope */
};
+struct scopelist {
+ struct scopelist *next;
+ struct scopelist *sc_encl;
+ struct scope *sc_scope;
+};
+
extern struct scope
- *CurrentScope,
*PervasiveScope,
*GlobalScope;
-#define enclosing(x) ((x)->next)
+extern struct scopelist
+ *CurrVis;
+
+#define CurrentScope (CurrVis->sc_scope)
+#define enclosing(x) ((x)->sc_encl)
#define scopeclosed(x) ((x)->sc_scopeclosed)
-#define nextvisible(x) (scopeclosed(x) ? PervasiveScope : enclosing(x))
+#define nextvisible(x) ((x)->next) /* use with scopelists */
#include <em_arith.h>
#include <em_label.h>
+
#include "idf.h"
#include "LLlex.h"
#include "scope.h"
*word_type,
*address_type,
*intorcard_type,
- *string_type,
*bitset_type,
*std_type,
*error_type; /* All from type.c */
*subr_type(); /* All from type.c */
#define NULLTYPE ((struct type *) 0)
+
+#define IsConformantArray(tpx) ((tpx)->tp_fund == T_ARRAY && (tpx)->next == 0)
*word_type,
*address_type,
*intorcard_type,
- *string_type,
*bitset_type,
*std_type,
*error_type;
char_type = standard_type(T_CHAR, 1, (arith) 1);
char_type->enm_ncst = 256;
- /* character constant, different from char because of compatibility
- with ARRAY OF CHAR
+ /* character constant type, different from character type because
+ of compatibility with character array's
*/
charc_type = standard_type(T_CHAR, 1, (arith) 1);
charc_type->enm_ncst = 256;
real_type = standard_type(T_REAL, float_align, float_size);
longreal_type = standard_type(T_REAL, double_align, double_size);
- /* string constant type
- */
- string_type = standard_type(T_STRING, 1, (arith) -1);
-
/* SYSTEM types
*/
word_type = standard_type(T_WORD, word_align, word_size);
TstTypeEquiv(tp1, tp2)
||
(
- tp1->tp_fund == T_ARRAY
+ IsConformantArray(tp1)
&&
- tp1->next == 0
- &&
- tp2->tp_fund == T_ARRAY
- &&
- tp2->next == 0
+ IsConformantArray(tp2)
&&
TstTypeEquiv(tp1->arr_elem, tp2->arr_elem)
);
*/
register struct paramlist *p1, *p2;
- if (!TstTypeEquiv(tp1->next, tp2->next)) return 0;
+ /* First check if the result types are equivalent
+ */
+ if (! TstTypeEquiv(tp1->next, tp2->next)) return 0;
p1 = tp1->prc_params;
p2 = tp2->prc_params;
+ /* Now check the parameters
+ */
while (p1 && p2) {
if (p1->par_var != p2->par_var ||
!TstParEquiv(p1->par_type, p2->par_type)) return 0;
;
}
-int TstAssCompat(tp1, tp2)
+int
+TstAssCompat(tp1, tp2)
struct type *tp1, *tp2;
{
/* Test if two types are assignment compatible.
+ See Def 9.1.
*/
if (TstCompat(tp1, tp2)) return 1;
(tp2->tp_fund & T_INTORCARD)) return 1;
if (tp1 == char_type && tp2 == charc_type) return 1;
- if (tp1->tp_fund == T_ARRAY &&
- (tp2 == charc_type || tp2 == string_type)) {
- /* Unfortunately the length of the string is not
- available here, so this must be tested somewhere else (???)
- */
+
+ if (tp1->tp_fund == T_ARRAY) {
+ arith size;
+
+ if (! tp1->next) return 0;
+
+ size = tp1->arr_ub - tp1->arr_lb + 1;
tp1 = tp1->arr_elem;
if (tp1->tp_fund == T_SUBRANGE) tp1 = tp1->next;
- return tp1 == char_type;
+ return
+ tp1 == char_type
+ &&
+ (
+ tp2 == charc_type
+ ||
+ (tp2->tp_fund == T_STRING && size >= tp2->tp_size)
+ );
}
return 0;
}
-int TstParCompat(formaltype, actualtype, VARflag)
+int
+TstParCompat(formaltype, actualtype, VARflag)
struct type *formaltype, *actualtype;
{
/* Check type compatibility for a parameter in a procedure
- call
+ call. Ordinary type compatibility is sufficient in any case.
+ Assignment compatibility may do if the parameter is
+ a value parameter.
+ Otherwise, a conformant array may do, or an ARRAY OF WORD
+ may do too.
+ Or: a WORD may do.
*/
return
||
( !VARflag && TstAssCompat(formaltype, actualtype))
||
- ( formaltype->tp_fund == T_ARRAY
- && formaltype->next == 0
- && actualtype->tp_fund == T_ARRAY
- && TstTypeEquiv(formaltype->arr_elem, actualtype->arr_elem));
+ ( formaltype == word_type && actualtype->tp_size == word_size)
+ ||
+ ( IsConformantArray(formaltype)
+ &&
+ ( formaltype->arr_elem == word_type
+ ||
+ ( actualtype->tp_fund == T_ARRAY
+ && TstTypeEquiv(formaltype->arr_elem,actualtype->arr_elem)
+ )
+ ||
+ ( actualtype->tp_fund == T_STRING
+ && TstTypeEquiv(formaltype->arr_elem, char_type)
+ )
+ )
+ );
}
/* Walk through a module, and all its local definitions.
Also generate code for its body.
*/
- register struct def *df = module->mod_scope->sc_def;
- struct scope *scope;
+ register struct def *df = module->mod_vis->sc_scope->sc_def;
+ struct scopelist *vis;
- scope = CurrentScope;
- CurrentScope = module->mod_scope;
+ vis = CurrVis;
+ CurrVis = module->mod_vis;
if (!prclev && module->mod_number) {
/* This module is a local module, but not within a
variables. This is done by generating a "bss",
with label "_<modulenumber><modulename>".
*/
- arith size = align(CurrentScope->sc_off, word_size);
+ arith size = align(CurrentScope->sc_off, word_align);
if (size == 0) size = word_size;
C_df_dnam(&(CurrentScope->sc_name[1]));
C_bss_cst(size, (arith) 0, 0);
}
- else if (CurrentScope == Defined->mod_scope) {
+ else if (CurrVis == Defined->mod_vis) {
/* This module is the module currently being compiled.
Again, generate code to allocate storage for its
variables, which all have an explicit name.
WalkNode(module->mod_body, (label) 0);
C_df_ilb(return_label);
C_ret((label) 0);
- C_end(align(-CurrentScope->sc_off, word_size));
+ C_end(align(-CurrentScope->sc_off, word_align));
- CurrentScope = scope;
+ CurrVis = vis;
}
WalkProcedure(procedure)
/* Walk through the definition of a procedure and all its
local definitions
*/
- struct scope *scope = CurrentScope;
- register struct def *df;
+ struct scopelist *vis = CurrVis;
prclev++;
- CurrentScope = procedure->prc_scope;
+ CurrVis = procedure->prc_vis;
WalkDef(CurrentScope->sc_def);
if (func_type) C_ret((arith) align(func_type->tp_size, word_align));
else C_ret((arith) 0);
C_end(align(-CurrentScope->sc_off, word_size));
- CurrentScope = scope;
+ CurrVis = vis;
prclev--;
}
{
/* Walk through a list of definitions
*/
+
while (df) {
if (df->df_kind == D_MODULE) {
WalkModule(df);
{
/* Generate calls to initialization routines of modules
*/
+
while (df) {
if (df->df_kind == D_MODULE) {
C_lxl((arith) 0);
- C_cal(df->mod_scope->sc_name);
+ C_cal(df->mod_vis->sc_scope->sc_name);
}
df = df->df_nextinscope;
}
"lab" represents the label that must be jumped to on
encountering an EXIT statement.
*/
-
+
while (nd->nd_class == Link) { /* statement list */
WalkStat(nd->nd_left, lab);
nd = nd->nd_right;
switch(nd->nd_symb) {
case BECOMES:
- WalkExpr(nd->nd_right);
- WalkDesignator(nd->nd_left);
+ WalkDesignator(left);
+ WalkExpr(right);
+
+ if (! TstAssCompat(left->nd_type, right->nd_type)) {
+ node_error(nd, "type incompatibility in assignment");
+ break;
+ }
/* ??? */
break;
}
case CASE:
- /* ??? */
- break;
+ {
+ WalkExpr(left);
+
+ while (right) {
+ if (right->nd_class == Link && right->nd_symb == '|') {
+ WalkNode(right->nd_left->nd_right, lab);
+ right = right->nd_right;
+ }
+ else {
+ WalkNode(right, lab);
+ right = 0;
+ }
+ }
+
+ /* ??? */
+ break;
+ }
case WHILE:
{ label l1, l2;
case FOR:
/* ??? */
+ WalkNode(right, lab);
break;
case WITH:
- /* ??? */
- break;
+ {
+ struct scopelist link;
+
+ WalkDesignator(left);
+ if (left->nd_type->tp_fund != T_RECORD) {
+ node_error(left, "record variable expected");
+ break;
+ }
+
+ link.sc_scope = left->nd_type->rec_scope;
+ link.next = CurrVis;
+ CurrVis = &link;
+ WalkNode(right, lab);
+ CurrVis = link.next;
+ /* ??? */
+ break;
+ }
case EXIT:
assert(lab != 0);
case RETURN:
if (right) {
WalkExpr(right);
- if (!TstCompat(right->nd_type, func_type)) {
+ /* What kind of compatibility do we need here ???
+ assignment compatibility?
+ */
+ if (!TstAssCompat(func_type, right->nd_type)) {
node_error(right, "type incompatibility in RETURN statement");
}
}
public / ack.git / commitdiff