symbol2str.o tokenname.o idf.o input.o type.o def.o \
scope.o misc.o enter.o defmodule.o typequiv.o node.o \
cstoper.o chk_expr.o options.o walk.o casestat.o desig.o \
- code.o tmpvar.o
+ code.o tmpvar.o lookup.o
OBJ = $(COBJ) $(LOBJ) Lpars.o
GENFILES= tokenfile.c \
program.c declar.c expression.c statement.c \
assert(pnode->nd_class == Stat && pnode->nd_symb == CASE);
clear((char *) sh, sizeof(*sh));
- WalkExpr(pnode->nd_left, NO_LABEL, NO_LABEL);
+ WalkExpr(pnode->nd_left);
sh->sh_type = pnode->nd_left->nd_type;
sh->sh_break = text_label();
else {
/* Else part
*/
- pnode = 0;
+
sh->sh_default = text_label();
+ pnode = 0;
}
}
tablabel = data_label(); /* the rom must have a label */
C_df_dlb(tablabel);
if (sh->sh_default) C_rom_ilb(sh->sh_default);
- else C_rom_ucon("0", pointer_size);
+ else C_rom_ilb(sh->sh_break);
if (compact(sh->sh_nrofentries, sh->sh_lowerbd, sh->sh_upperbd)) {
/* CSA */
ce = ce->next;
}
else if (sh->sh_default) C_rom_ilb(sh->sh_default);
- else C_rom_ucon("0", pointer_size);
+ else C_rom_ilb(sh->sh_break);
}
C_lae_dlb(tablabel, (arith)0); /* perform the switch */
C_csa(word_size);
*/
switch(expp->nd_class) {
+ case Arrsel:
+ return chk_designator(expp, DESIGNATOR|VARIABLE, D_USED);
+
case Oper:
- if (expp->nd_symb == '[') {
- return chk_designator(expp, DESIGNATOR|VARIABLE, D_NOREG|D_USED);
- }
+ return chk_oper(expp);
- return chk_expr(expp->nd_left) &&
- chk_expr(expp->nd_right) &&
- chk_oper(expp);
+ case Arrow:
+ return chk_designator(expp, DESIGNATOR|VARIABLE, D_USED);
case Uoper:
- if (expp->nd_symb == '^') {
- return chk_designator(expp, DESIGNATOR|VARIABLE, D_USED);
- }
-
- return chk_expr(expp->nd_right) &&
- chk_uoper(expp);
+ return chk_uoper(expp);
case Value:
switch(expp->nd_symb) {
return 0;
}
- if (expp->nd_class == Oper) {
+ if (expp->nd_class == Arrsel) {
struct type *tpl, *tpr;
assert(expp->nd_symb == '[');
return 1;
}
- if (expp->nd_class == Uoper) {
+ if (expp->nd_class == Arrow) {
assert(expp->nd_symb == '^');
if (! chk_designator(expp->nd_right, DESIGNATOR|VARIABLE, dflags)) {
{
/* Check a binary operation.
*/
- register struct node *left = expp->nd_left;
- register struct node *right = expp->nd_right;
- struct type *tpl = left->nd_type;
- struct type *tpr = right->nd_type;
+ register struct node *left, *right;
+ struct type *tpl, *tpr;
int allowed;
+ left = expp->nd_left;
+ right = expp->nd_right;
+
+ if (!chk_expr(left) || !chk_expr(right)) return 0;
+
+ tpl = left->nd_type;
+ tpr = right->nd_type;
+
if (tpl->tp_fund == T_SUBRANGE) tpl = tpl->next;
if (tpr->tp_fund == T_SUBRANGE) tpr = tpr->next;
/* Check an unary operation.
*/
register struct node *right = expp->nd_right;
- register struct type *tpr = right->nd_type;
+ register struct type *tpr;
+
+ if (! chk_expr(right)) return 0;
+ tpr = right->nd_type;
if (tpr->tp_fund == T_SUBRANGE) tpr = tpr->next;
expp->nd_type = tpr;
left = arg->nd_left;
if (! chk_designator(left, DESIGNATOR, D_REFERRED)) return 0;
- if (left->nd_class == Oper || left->nd_class == Uoper) {
+ if (left->nd_class == Arrsel || left->nd_class == Arrow) {
*argp = arg;
return left;
}
}
else {
C_df_dlb(lab = data_label());
- C_rom_scon(nd->nd_STR, align(nd->nd_SLE + 1, (int) word_size));
+ C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1));
C_lae_dlb(lab, (arith) 0);
}
}
/* Generate code to push the string indicated by "nd".
Make it null-padded to "sz" bytes
*/
- register arith sizearg = align(nd->nd_type->tp_size, word_align);
+ register arith sizearg = WA(nd->nd_type->tp_size);
assert(nd->nd_type->tp_fund == T_STRING);
/* Fall through */
case Link:
+ case Arrsel:
+ case Arrow:
CodeDesig(nd, ds);
break;
case Oper:
- if (nd->nd_symb == '[') {
- CodeDesig(nd, ds);
- break;
- }
CodeOper(nd, true_label, false_label);
if (true_label == 0) ds->dsg_kind = DSG_LOADED;
- else ds->dsg_kind = DSG_INIT;
- true_label = 0;
+ else {
+ ds->dsg_kind = DSG_INIT;
+ true_label = 0;
+ }
break;
case Uoper:
- if (nd->nd_symb == '^') {
- CodeDesig(nd, ds);
- break;
- }
CodePExpr(nd->nd_right);
CodeUoper(nd);
ds->dsg_kind = DSG_LOADED;
register struct node *arg = nd;
register struct paramlist *param;
struct type *tp;
- arith pushed = 0;
if (left->nd_type == std_type) {
CodeStd(nd);
else if (tp->arr_elem == word_type) {
C_loc(left->nd_type->tp_size / word_size - 1);
}
- else C_loc(left->nd_type->tp_size /
- tp->arr_elsize - 1);
+ else {
+ tp = left->nd_type->next;
+ if (tp->tp_fund == T_SUBRANGE) {
+ C_loc(tp->sub_ub - tp->sub_lb);
+ }
+ else C_loc((arith) (tp->enm_ncst - 1));
+ }
C_loc((arith) 0);
if (left->nd_symb == STRING) {
CodeString(left);
}
else CodeDAddress(left);
- pushed += pointer_size + 3 * word_size;
}
else if (IsVarParam(param)) {
CodeDAddress(left);
- pushed += pointer_size;
}
else {
if (left->nd_type->tp_fund == T_STRING) {
- CodePadString(left,
- align(tp->tp_size, word_align));
+ CodePadString(left, tp->tp_size);
}
else CodePExpr(left);
CheckAssign(left->nd_type, tp);
- pushed += align(tp->tp_size, word_align);
}
}
if (left->nd_class == Def && left->nd_def->df_kind == D_PROCEDURE) {
if (left->nd_def->df_scope->sc_level > 0) {
C_lxl((arith) proclevel - left->nd_def->df_scope->sc_level);
- pushed += pointer_size;
}
C_cal(NameOfProc(left->nd_def));
}
CodePExpr(left);
C_cai();
}
- if (pushed) C_asp(pushed);
+ if (left->nd_type->prc_nbpar) C_asp(left->nd_type->prc_nbpar);
if (left->nd_type->next) {
- C_lfr(align(left->nd_type->next->tp_size, word_align));
+ C_lfr(WA(left->nd_type->next->tp_size));
}
}
compatibility and the like is already done.
*/
register struct type *tp = nd->nd_right->nd_type;
- extern arith align();
if (dss->dsg_kind == DSG_LOADED) {
if (tp->tp_fund == T_STRING) {
Operands(rightop, leftop);
CodeCoercion(leftop->nd_type, word_type);
C_inn(rightop->nd_type->tp_size);
+ if (true_label != 0) {
+ C_zne(true_label);
+ C_bra(false_label);
+ }
break;
case AND:
case '&':
highoff = df->var_off + pointer_size + word_size;
if (df->df_scope->sc_level < proclevel) {
- C_lxa(proclevel - df->df_scope->sc_level);
+ C_lxa((arith) (proclevel - df->df_scope->sc_level));
C_lof(highoff);
}
else C_lol(highoff);
CutSize(expp);
break;
case S_SIZE:
- expp->nd_INT = align(expr->nd_type->tp_size, (int) word_size) /
- word_size;
+ expp->nd_INT = WA(expr->nd_type->tp_size) / word_size;
break;
case S_VAL:
expp->nd_INT = expr->nd_INT;
VAR { VARp = D_VARPAR; }
]?
IdentList(&FPList) ':' FormalType(&tp)
- {
- ParamList(ppr, FPList, tp, VARp, parmaddr);
- FreeNode(FPList);
- }
+ { EnterParamList(ppr, FPList, tp, VARp, parmaddr); }
;
FormalType(struct type **ptp;)
'(' IdentList(&EnumList) ')'
{
*ptp = tp = standard_type(T_ENUMERATION, 1, (arith) 1);
- EnterIdList(EnumList, D_ENUM, 0, tp,
- CurrentScope, (arith *) 0);
- FreeNode(EnumList);
- if (tp->enm_ncst > 256) {
- /* ??? is this reasonable ??? */
+ EnterEnumList(EnumList, tp);
+ if (tp->enm_ncst > 256) { /* ??? is this reasonable ??? */
error("Too many enumeration literals");
}
}
}
FieldListSequence(scope, &count, &xalign)
{
- *ptp = standard_type(T_RECORD, xalign, count);
+ *ptp = standard_type(T_RECORD, xalign, WA(count));
(*ptp)->rec_scope = scope;
}
END
[
IdentList(&FldList) ':' type(&tp)
{ *palign = lcm(*palign, tp->tp_align);
- EnterIdList(FldList, D_FIELD, D_QEXPORTED,
- tp, scope, cnt);
- FreeNode(FldList);
+ EnterFieldList(FldList, tp, scope, cnt);
}
|
CASE
{ nd = nd->nd_right; }
]*
':' type(&tp)
- { EnterVarList(VarList, tp, proclevel > 0);
- FreeNode(VarList);
- }
+ { EnterVarList(VarList, tp, proclevel > 0); }
;
IdentAddr(struct node **pnd;) :
return MkDef(id, scope, kind);
}
-struct def *
-lookup(id, scope)
- register struct idf *id;
- struct scope *scope;
-{
- /* Look up a definition of an identifier in scope "scope".
- Make the "def" list self-organizing.
- Return a pointer to its "def" structure if it exists,
- otherwise return 0.
- */
- register struct def *df, *df1;
- struct def *retval;
-
- df1 = 0;
- df = id->id_def;
- while (df) {
- if (df->df_scope == scope) {
- retval = df;
- if (df->df_kind == D_IMPORT) {
- retval = df->imp_def;
- assert(retval != 0);
- }
- if (df1) {
- /* Put the definition now found in front
- */
- df1->next = df->next;
- df->next = id->id_def;
- id->id_def = df;
- }
- return retval;
- }
- df1 = df;
- df = df->next;
- }
- return 0;
-}
-
-DoImport(df, scope)
- register struct def *df;
- struct scope *scope;
-{
- /* Definition "df" is imported to scope "scope".
- Handle the case that it is an enumeration type or a module.
- */
-
- define(df->df_idf, scope, D_IMPORT)->imp_def = df;
-
- if (df->df_kind == D_TYPE && df->df_type->tp_fund == T_ENUMERATION) {
- /* Also import all enumeration literals
- */
- df = df->df_type->enm_enums;
- while (df) {
- define(df->df_idf, scope, D_IMPORT)->imp_def = df;
- df = df->enm_next;
- }
- }
- else if (df->df_kind == D_MODULE) {
- /* Also import all definitions that are exported from this
- module
- */
- df = df->mod_vis->sc_scope->sc_def;
- while (df) {
- if (df->df_flags & D_EXPORTED) {
- define(df->df_idf,scope,D_IMPORT)->imp_def = df;
- }
- df = df->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
- all the "ids" visible in the enclosing scope by defining them
- in this scope as "imported".
- */
- register struct def *df, *df1;
- register struct def *impmod;
-
- for (;ids; ids = ids->next) {
- df = lookup(ids->nd_IDF, CurrentScope);
-
- 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);
- }
-
- 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
- */
- df->df_flags |= D_EXPORTED;
-
- 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;
- }
-
- 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 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_TYPE;
- df1->df_kind = D_IMPORT;
- df1->imp_def = df;
- continue;
- }
- }
-
- DoImport(df, enclosing(CurrVis)->sc_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 scopelist *vis;
-
- df->df_scope = enclosing(CurrVis)->sc_scope;
- df->df_kind = D_FORWMODULE;
- open_scope(CLOSEDSCOPE);
- 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_vis = vis;
- df->for_node = MkLeaf(Name, &(idn->nd_token));
- close_scope(0);
- vis->sc_encl = enclosing(CurrVis);
- /* Here ! */
- return vis;
-}
-
-static struct def *
-ForwDef(ids, scope)
- register struct node *ids;
- struct scope *scope;
-{
- /* Enter a forward definition of "ids" in scope "scope",
- if it is not already defined.
- */
- register struct def *df;
-
- if (!(df = lookup(ids->nd_IDF, scope))) {
- df = define(ids->nd_IDF, scope, D_FORWARD);
- df->for_node = MkLeaf(Name, &(ids->nd_token));
- }
- return df;
-}
-
-Import(ids, idn, local)
- register struct node *ids;
- struct node *idn;
-{
- /* "ids" is a list of imported identifiers.
- If "idn" is a null-pointer, the identifiers are imported from
- the enclosing scope. Otherwise they are imported from the module
- indicated by "idn", which 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 "idn" is a null pointer, the "ids" identifiers
- are all module identifiers. Their Definition Modules must be
- read. Otherwise "idn" is a module identifier whose Definition
- Module must be read. "ids" then represents a list of
- identifiers defined in this module.
- */
- register struct def *df;
- struct scopelist *vis = enclosing(CurrVis);
- int forwflag = 0;
-#define FROM_MODULE 0
-#define FROM_ENCLOSING 1
- int imp_kind = FROM_ENCLOSING;
- struct def *lookfor(), *GetDefinitionModule();
-
- if (idn) {
- imp_kind = FROM_MODULE;
- if (local) {
- df = lookfor(idn, vis, 0);
- switch(df->df_kind) {
- case D_ERROR:
- /* The module from which the import was done
- is not yet declared. I'm not sure if I must
- accept this, but for the time being I will.
- ???
- */
- vis = ForwModule(df, idn);
- forwflag = 1;
- break;
- case D_FORWMODULE:
- vis = df->for_vis;
- break;
- case D_MODULE:
- vis = df->mod_vis;
- break;
- default:
-node_error(idn, "identifier \"%s\" does not represent a module",
-idn->nd_IDF->id_text);
- break;
- }
- }
- else vis = GetDefinitionModule(idn->nd_IDF)->mod_vis;
-
- FreeNode(idn);
- }
-
- idn = ids;
- while (ids) {
- if (imp_kind == FROM_MODULE) {
- if (forwflag) {
- df = ForwDef(ids, vis->sc_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 = define(ids->nd_IDF,vis->sc_scope,D_ERROR);
- }
- else if (!(df->df_flags&(D_EXPORTED|D_QEXPORTED))) {
-node_error(ids,"identifier \"%s\" not exported from qualifying module",
-ids->nd_IDF->id_text);
- df->df_flags |= D_QEXPORTED;
- }
- }
- else {
- if (local) df = ForwDef(ids, vis->sc_scope);
- else df = GetDefinitionModule(ids->nd_IDF);
- }
-
- DoImport(df, CurrentScope);
-
- ids = ids->next;
- }
-
- FreeNode(idn);
-}
-
RemoveImports(pdf)
struct def **pdf;
{
CodeFieldDesig(nd->nd_def, ds);
break;
- case Oper:
+ case Arrsel:
assert(nd->nd_symb == '[');
CodeDesig(nd->nd_left, ds);
ds->dsg_kind = DSG_INDEXED;
break;
- case Uoper:
+ case Arrow:
assert(nd->nd_symb == '^');
CodeDesig(nd->nd_right, ds);
-/* H I G H L E V E L S Y M B O L E N T R Y A N D L O O K U P */
+/* H I G H L E V E L S Y M B O L E N T R Y */
#ifndef NORCSID
static char *RcsId = "$Header$";
"type" in the Current Scope. If it is a standard name, also
put its number in the definition structure.
*/
- struct idf *id;
- struct def *df;
+ register struct def *df;
- id = str2idf(name, 0);
- if (!id) fatal("Out of core");
- df = define(id, CurrentScope, kind);
+ df = define(str2idf(name, 0), CurrentScope, kind);
df->df_type = type;
- if (type = std_type) {
- df->df_value.df_stdname = pnam;
- }
+ if (pnam) df->df_value.df_stdname = pnam;
return df;
}
-EnterIdList(idlist, kind, flags, type, scope, addr)
- register struct node *idlist;
- struct type *type;
- struct scope *scope;
- arith *addr;
+EnterEnumList(Idlist, type)
+ struct node *Idlist;
+ register struct type *type;
{
- /* Put a list of identifiers in the symbol table.
- They all have kind "kind", and type "type", and are put
- in scope "scope". "flags" initializes the "df_flags" field
- of the definition structure.
- Also assign numbers to enumeration literals, and link
- them together.
+ /* Put a list of enumeration literals in the symbol table.
+ They all have type "type".
+ Also assign numbers to them, and link them together.
+ We must link them together because an enumeration type may
+ be exported, in which case its literals must also be exported.
+ Thus, we need an easy way to get to them.
*/
register struct def *df;
- struct def *first = 0, *last = 0;
- int assval = 0;
- arith off;
+ register struct node *idlist = Idlist;
- while (idlist) {
- df = define(idlist->nd_IDF, scope, kind);
+ type->enm_ncst = 0;
+ for (; idlist; idlist = idlist->next) {
+ df = define(idlist->nd_IDF, CurrentScope, D_ENUM);
df->df_type = type;
- df->df_flags |= flags;
- if (addr) {
- int xalign = type->tp_align;
-
- if (xalign < word_align && kind != D_FIELD) {
- /* variables are at least word aligned
- */
- xalign = word_align;
- }
+ df->enm_val = (type->enm_ncst)++;
+ df->enm_next = type->enm_enums;
+ type->enm_enums = df;
+ }
+ FreeNode(Idlist);
+}
- if (*addr >= 0) {
- off = align(*addr, xalign);
- *addr = off + type->tp_size;
- }
- else {
- off = -align(-*addr-type->tp_size, xalign);
- *addr = off;
- }
- if (kind == D_VARIABLE) {
- df->var_off = off;
- }
- else {
- assert(kind == D_FIELD);
+EnterFieldList(Idlist, type, scope, addr)
+ struct node *Idlist;
+ register struct type *type;
+ struct scope *scope;
+ arith *addr;
+{
+ /* Put a list of fields in the symbol table.
+ They all have type "type", and are put in scope "scope".
+ Mark them as QUALIFIED EXPORT, because that's exactly what
+ fields are, you can get to them by qualifying them.
+ */
+ register struct def *df;
+ register struct node *idlist = Idlist;
- df->fld_off = off;
- }
- }
- if (kind == D_ENUM) {
- if (!first) first = df;
- df->enm_val = assval++;
- if (last) last->enm_next = df;
- last = df;
- }
- idlist = idlist->next;
- }
- if (last) {
- /* Also meaning : kind == D_ENUM */
- assert(kind == D_ENUM);
- last->enm_next = 0;
- type->enm_enums = first;
- type->enm_ncst = assval;
+ for (; idlist; idlist = idlist->next) {
+ df = define(idlist->nd_IDF, scope, D_FIELD);
+ df->df_type = type;
+ df->df_flags |= D_QEXPORTED;
+ df->fld_off = align(*addr, type->tp_align);
+ *addr = df->fld_off + type->tp_size;
}
+ FreeNode(Idlist);
}
-EnterVarList(IdList, type, local)
- register struct node *IdList;
+EnterVarList(Idlist, type, local)
+ struct node *Idlist;
struct type *type;
{
/* Enter a list of identifiers representing variables into the
procedure.
*/
register struct def *df;
+ register struct node *idlist = Idlist;
register struct scopelist *sc;
char buf[256];
extern char *sprint();
while (sc->sc_scope->sc_scopeclosed) sc = enclosing(sc);
}
- while (IdList) {
- df = define(IdList->nd_IDF, CurrentScope, D_VARIABLE);
+ for (; idlist; idlist = idlist->nd_right) {
+ df = define(idlist->nd_IDF, CurrentScope, D_VARIABLE);
df->df_type = type;
- if (IdList->nd_left) {
+ if (idlist->nd_left) {
/* An address was supplied
*/
df->var_addrgiven = 1;
- if (IdList->nd_left->nd_type != card_type) {
-node_error(IdList->nd_left,"Illegal type for address");
+ if (idlist->nd_left->nd_type != card_type) {
+node_error(idlist->nd_left,"Illegal type for address");
}
- df->var_off = IdList->nd_left->nd_INT;
+ df->var_off = idlist->nd_left->nd_INT;
}
else if (local) {
/* subtract aligned size of variable to the offset,
procedure
*/
sc->sc_scope->sc_off =
- -align(type->tp_size - sc->sc_scope->sc_off,
- type->tp_align);
+ -WA(align(type->tp_size - sc->sc_scope->sc_off,
+ type->tp_align));
df->var_off = sc->sc_scope->sc_off;
}
else {
C_ina_dnam(df->var_name);
}
}
+ }
+ FreeNode(Idlist);
+}
+
+EnterParamList(ppr, Idlist, type, VARp, off)
+ struct node *Idlist;
+ struct paramlist **ppr;
+ struct type *type;
+ int VARp;
+ arith *off;
+{
+ /* Create (part of) a parameterlist of a procedure.
+ "ids" indicates the list of identifiers, "tp" their type, and
+ "VARp" indicates D_VARPAR or D_VALPAR.
+ */
+ register struct paramlist *pr;
+ register struct def *df;
+ register struct node *idlist = Idlist;
+
+ for ( ; idlist; idlist = idlist->next) {
+ pr = new_paramlist();
+ pr->next = *ppr;
+ *ppr = pr;
+ df = define(idlist->nd_IDF, CurrentScope, D_VARIABLE);
+ pr->par_def = df;
+ df->df_type = type;
+ df->var_off = *off;
+ df->df_flags = VARp;
+ if (IsConformantArray(type)) {
+ /* we need room for the base address and a descriptor
+ */
+ *off += pointer_size + 3 * word_size;
+ }
+ else if (VARp == D_VARPAR) {
+ *off += pointer_size;
+ }
+ else {
+ *off += WA(type->tp_size);
+ }
+ }
+ FreeNode(Idlist);
+}
- IdList = IdList->nd_right;
+static
+DoImport(df, scope)
+ register struct def *df;
+ struct scope *scope;
+{
+ /* Definition "df" is imported to scope "scope".
+ Handle the case that it is an enumeration type or a module.
+ */
+
+ define(df->df_idf, scope, D_IMPORT)->imp_def = df;
+
+ if (df->df_kind == D_TYPE && df->df_type->tp_fund == T_ENUMERATION) {
+ /* Also import all enumeration literals
+ */
+ df = df->df_type->enm_enums;
+ while (df) {
+ define(df->df_idf, scope, D_IMPORT)->imp_def = df;
+ df = df->enm_next;
+ }
+ }
+ else if (df->df_kind == D_MODULE) {
+ /* Also import all definitions that are exported from this
+ module
+ */
+ df = df->mod_vis->sc_scope->sc_def;
+ while (df) {
+ if (df->df_flags & D_EXPORTED) {
+ define(df->df_idf,scope,D_IMPORT)->imp_def = df;
+ }
+ df = df->df_nextinscope;
+ }
}
}
-struct def *
-lookfor(id, vis, give_error)
- struct node *id;
+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 scopelist *vis;
+
+ df->df_scope = enclosing(CurrVis)->sc_scope;
+ df->df_kind = D_FORWMODULE;
+ open_scope(CLOSEDSCOPE);
+ 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_vis = vis;
+ df->for_node = MkLeaf(Name, &(idn->nd_token));
+ close_scope(0);
+ vis->sc_encl = enclosing(CurrVis);
+ /* Here ! */
+ return vis;
+}
+
+static struct def *
+ForwDef(ids, scope)
+ register struct node *ids;
+ struct scope *scope;
{
- /* Look for an identifier in the visibility range started by
- "vis".
- If it is not defined, maybe give an error message, and
- create a dummy definition.
+ /* Enter a forward definition of "ids" in scope "scope",
+ if it is not already defined.
*/
- struct def *df;
- register struct scopelist *sc = vis;
- struct def *MkDef();
-
- while (sc) {
- df = lookup(id->nd_IDF, sc->sc_scope);
- if (df) return df;
- sc = nextvisible(sc);
+ register struct def *df;
+
+ if (!(df = lookup(ids->nd_IDF, scope))) {
+ df = define(ids->nd_IDF, scope, D_FORWARD);
+ df->for_node = MkLeaf(Name, &(ids->nd_token));
}
+ return df;
+}
- if (give_error) id_not_declared(id);
+EnterExportList(Idlist, qualified)
+ struct node *Idlist;
+{
+ /* 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".
+ */
+ register struct node *idlist = Idlist;
+ register struct def *df, *df1;
+ register struct def *impmod;
+
+ for (;idlist; idlist = idlist->next) {
+ df = lookup(idlist->nd_IDF, CurrentScope);
+
+ if (!df) {
+ /* undefined item in export list
+ */
+node_error(idlist, "identifier \"%s\" not defined", idlist->nd_IDF->id_text);
+ continue;
+ }
+
+ if (df->df_flags & (D_EXPORTED|D_QEXPORTED)) {
+node_error(idlist, "identifier \"%s\" occurs more than once in export list",
+idlist->nd_IDF->id_text);
+ }
+
+ df->df_flags |= qualified;
+ if (qualified == D_EXPORTED) {
+ /* Export, but not qualified.
+ Find all imports of the module in which this export
+ occurs, and export the current definition to it
+ */
+ impmod = CurrentScope->sc_definedby->df_idf->id_def;
+ while (impmod) {
+ if (impmod->df_kind == D_IMPORT &&
+ impmod->imp_def == CurrentScope->sc_definedby) {
+ DoImport(df, impmod->df_scope);
+ }
+ impmod = impmod->next;
+ }
+
+ /* Also handle the definition as if the enclosing
+ scope imports it.
+ */
+ df1 = lookup(idlist->nd_IDF,
+ enclosing(CurrVis)->sc_scope);
+ if (df1) {
+ /* It was already defined in the enclosing
+ scope. There are two legal possibilities,
+ which are examined below.
+ */
+ if ((df1->df_kind == D_PROCHEAD &&
+ df->df_kind == D_PROCEDURE) ||
+ (df1->df_kind == D_HIDDEN &&
+ df->df_kind == D_TYPE)) {
+ if (df->df_kind == D_TYPE &&
+ df->df_type->tp_fund != T_POINTER) {
+node_error(idlist, "opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
+ }
+ df1->df_kind = D_IMPORT;
+ df1->imp_def = df;
+ continue;
+ }
+ }
- return MkDef(id->nd_IDF, vis->sc_scope, D_ERROR);
+ DoImport(df, enclosing(CurrVis)->sc_scope);
+ }
+ }
+ FreeNode(Idlist);
+}
+
+EnterFromImportList(Idlist, Fromid, local)
+ struct node *Idlist;
+ register struct node *Fromid;
+{
+ /* Import the list Idlist from the module indicated by Fromid.
+ An exception must be made for imports of the Compilation Unit,
+ because in this case the definition module for Fromid must
+ be read.
+ This case is indicated by the value 0 of the flag "local".
+ */
+ register struct node *idlist = Idlist;
+ register struct def *df;
+ struct scopelist *vis = enclosing(CurrVis);
+ int forwflag = 0;
+ extern struct def *lookfor(), *GetDefinitionModule();
+
+ if (local) {
+ df = lookfor(Fromid, vis, 0);
+ switch(df->df_kind) {
+ case D_ERROR:
+ /* The module from which the import was done
+ is not yet declared. I'm not sure if I must
+ accept this, but for the time being I will.
+ ???
+ */
+ vis = ForwModule(df, Fromid);
+ forwflag = 1;
+ break;
+ case D_FORWMODULE:
+ vis = df->for_vis;
+ break;
+ case D_MODULE:
+ vis = df->mod_vis;
+ break;
+ default:
+node_error(Fromid, "identifier \"%s\" does not represent a module",
+Fromid->nd_IDF->id_text);
+ break;
+ }
+ }
+ else vis = GetDefinitionModule(Fromid->nd_IDF)->mod_vis;
+
+ FreeNode(Fromid);
+
+ for (; idlist; idlist = idlist->next) {
+ if (forwflag) {
+ df = ForwDef(idlist, vis->sc_scope);
+ }
+ else if (!(df = lookup(idlist->nd_IDF, vis->sc_scope))) {
+node_error(idlist, "identifier \"%s\" not declared in qualifying module",
+idlist->nd_IDF->id_text);
+ df = define(idlist->nd_IDF,vis->sc_scope,D_ERROR);
+ }
+ else if (!(df->df_flags&(D_EXPORTED|D_QEXPORTED))) {
+node_error(idlist,"identifier \"%s\" not exported from qualifying module",
+idlist->nd_IDF->id_text);
+ df->df_flags |= D_QEXPORTED;
+ }
+ DoImport(df, CurrentScope);
+ }
+
+ FreeNode(Idlist);
+}
+
+EnterImportList(Idlist, local)
+ struct node *Idlist;
+{
+ /* Import "Idlist" from the enclosing scope.
+ An exception must be made for imports of the compilation unit.
+ In this case, definition modules must be read for "Idlist".
+ This case is indicated by the value 0 of the "local" flag.
+ */
+ register struct node *idlist = Idlist;
+ register struct def *df;
+ struct scopelist *vis = enclosing(CurrVis);
+ extern struct def *lookfor(), *GetDefinitionModule();
+
+ for (; idlist; idlist = idlist->next) {
+ if (local) df = ForwDef(idlist, vis->sc_scope);
+ else df = GetDefinitionModule(idlist->nd_IDF);
+ DoImport(df, CurrentScope);
+ }
+ FreeNode(Idlist);
}
;
visible_designator_tail(struct node **pnd;):
- '[' { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
+ '[' { *pnd = MkNode(Arrsel, *pnd, NULLNODE, &dot); }
expression(&((*pnd)->nd_right))
[
','
- { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot);
+ { *pnd = MkNode(Arrsel, *pnd, NULLNODE, &dot);
(*pnd)->nd_symb = '[';
}
expression(&((*pnd)->nd_right))
]*
']'
|
- '^' { *pnd = MkNode(Uoper, NULLNODE, *pnd, &dot); }
+ '^' { *pnd = MkNode(Arrow, NULLNODE, *pnd, &dot); }
;
--- /dev/null
+/* L O O K U P R O U T I N E S */
+
+#ifndef NORCSID
+static char *RcsId = "$Header$";
+#endif
+
+#include "debug.h"
+
+#include <em_arith.h>
+#include <em_label.h>
+#include <assert.h>
+
+#include "def.h"
+#include "idf.h"
+#include "scope.h"
+#include "LLlex.h"
+#include "node.h"
+
+extern struct def *MkDef();
+
+struct def *
+lookup(id, scope)
+ register struct idf *id;
+ struct scope *scope;
+{
+ /* Look up a definition of an identifier in scope "scope".
+ Make the "def" list self-organizing.
+ Return a pointer to its "def" structure if it exists,
+ otherwise return 0.
+ */
+ register struct def *df;
+ struct def *df1;
+
+ for (df = id->id_def, df1 = 0; df; df1 = df, df = df->next) {
+ if (df->df_scope == scope) {
+ if (df1) {
+ /* Put the definition in front
+ */
+ df1->next = df->next;
+ df->next = id->id_def;
+ id->id_def = df;
+ }
+ if (df->df_kind == D_IMPORT) {
+ assert(df->imp_def != 0);
+ return df->imp_def;
+ }
+ return df;
+ }
+ }
+ return 0;
+}
+
+struct def *
+lookfor(id, vis, give_error)
+ register struct node *id;
+ struct scopelist *vis;
+{
+ /* Look for an identifier in the visibility range started by "vis".
+ If it is not defined create a dummy definition and,
+ if "give_error" is set, give an error message.
+ */
+ struct def *df;
+ register struct scopelist *sc = vis;
+
+ while (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, vis->sc_scope, D_ERROR);
+}
AddStandards()
{
register struct def *df;
- struct def *Enter();
+ extern struct def *Enter();
static struct node nilnode = { 0, 0, Value, 0, { INTEGER, 0}};
(void) Enter("ABS", D_PROCEDURE, std_type, S_ABS);
construct_type(T_PROCEDURE, NULLTYPE),
0);
df = Enter("BITSET", D_TYPE, bitset_type, 0);
- df = Enter("FALSE", D_ENUM, bool_type, 0);
- df->enm_val = 0;
- df->enm_next = Enter("TRUE", D_ENUM, bool_type, 0);
- df = df->enm_next;
+ df = Enter("TRUE", D_ENUM, bool_type, 0);
df->enm_val = 1;
+ df->enm_next = Enter("FALSE", D_ENUM, bool_type, 0);
+ df = df->enm_next;
+ df->enm_val = 0;
df->enm_next = 0;
}
#define nd_left next
struct node *nd_right;
int nd_class; /* kind of node */
-#define Value 1 /* constant */
+#define Value 0 /* constant */
+#define Arrsel 1 /* array selection */
#define Oper 2 /* binary operator */
#define Uoper 3 /* unary operator */
-#define Call 4 /* cast or procedure - or function call */
-#define Name 5 /* an identifier */
-#define Set 6 /* a set constant */
-#define Xset 7 /* a set */
-#define Def 8 /* an identified name */
-#define Stat 9 /* a statement */
+#define Arrow 4 /* ^ construction */
+#define Call 5 /* cast or procedure - or function call */
+#define Name 6 /* an identifier */
+#define Set 7 /* a set constant */
+#define Xset 8 /* a set */
+#define Def 9 /* an identified name */
+#define Stat 10 /* a statement */
#define Link 11
struct type *nd_type; /* type of this node */
struct token nd_token;
switch(*text++) {
default:
- options[text[-1]] = 1; /* flags, debug options etc. */
+ options[text[-1]]++; /* flags, debug options etc. */
break;
case 'L' : /* don't generate fil/lin */
priority(&(df->mod_priority))?
';'
import(1)*
- export(&qualified, &exportlist, 0)?
+ export(&qualified, &exportlist)?
block(&nd)
IDENT { InitProc(nd, df);
if (exportlist) {
- Export(exportlist, qualified, df);
- FreeNode(exportlist);
+ EnterExportList(exportlist, qualified);
}
close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
match_id(id, dot.TOK_IDF);
}
;
-export(int *QUALflag; struct node **ExportList; int def;)
+export(int *QUALflag; struct node **ExportList;)
{
} :
EXPORT
[
QUALIFIED
- { *QUALflag = 1; }
+ { *QUALflag = D_QEXPORTED; }
|
- { *QUALflag = 0; }
+ { *QUALflag = D_EXPORTED; }
]
IdentList(ExportList) ';'
- {
- if (def) {
-node_warning(*ExportList, "export list in definition module ignored");
- FreeNode(*ExportList);
- }
- }
;
import(int local;)
If the FROM clause is present, the identifier in it is a module
name, otherwise the names in the import list are module names.
*/
- {
- Import(ImportList, id, local);
+ { if (id) EnterFromImportList(ImportList, id, local);
+ else EnterImportList(ImportList, local);
}
;
{
register struct def *df;
struct idf *id;
- struct node *exportlist;
+ struct node *exportlist = 0;
int dummy;
} :
DEFINITION
}
';'
import(0)*
- export(&dummy, &exportlist, 1)?
+ export(&dummy, &exportlist)?
/* 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.
*/
+ { if (exportlist) {
+node_warning(exportlist, "export list in definition module ignored");
+ FreeNode(exportlist);
+ }
+ }
definition* END IDENT
{
df = CurrentScope->sc_def;
/* Code for the allocation and de-allocation of temporary variables,
allowing re-use.
+ The routines use "ProcScope" instead of "CurrentScope", because
+ "CurrentScope" also reflects WITH statements, and these scopes do not
+ have local variabes.
*/
#include "debug.h"
static struct tmpvar *TmpInts, /* for integer temporaries */
*TmpPtrs; /* for pointer temporaries */
-
-extern arith align();
+extern struct scope *ProcScope; /* scope of procedure in which the
+ temporaries are allocated
+ */
arith
NewInt()
register struct tmpvar *tmp;
if (!TmpInts) {
- offset = - align(int_size - CurrentScope->sc_off, int_align);
- CurrentScope->sc_off = offset;
+ offset = - WA(align(int_size - ProcScope->sc_off, int_align));
+ ProcScope->sc_off = offset;
C_ms_reg(offset, int_size, reg_any, 0);
}
else {
register struct tmpvar *tmp;
if (!TmpPtrs) {
- offset = - align(pointer_size - CurrentScope->sc_off, pointer_align);
- CurrentScope->sc_off = offset;
+ offset = - WA(align(pointer_size - ProcScope->sc_off, pointer_align));
+ ProcScope->sc_off = offset;
C_ms_reg(offset, pointer_size, reg_pointer, 0);
}
else {
#define complex(tpx) ((tpx)->tp_fund & (T_RECORD|T_ARRAY))
#define returntype(tpx) (((tpx)->tp_fund & T_PRCRESULT) ||\
((tpx)->tp_fund == T_SET && (tpx)->tp_size <= dword_size))
+#define WA(sz) (align(sz, (int) word_size))
error_type = standard_type(T_CHAR, 1, (arith) 1);
}
-ParamList(ppr, ids, tp, VARp, off)
- register struct node *ids;
- struct paramlist **ppr;
- struct type *tp;
- int VARp;
- arith *off;
-{
- /* Create (part of) a parameterlist of a procedure.
- "ids" indicates the list of identifiers, "tp" their type, and
- "VARp" indicates D_VARPAR or D_VALPAR.
- */
- register struct paramlist *pr;
- register struct def *df;
-
- for ( ; ids; ids = ids->next) {
- pr = new_paramlist();
- pr->next = *ppr;
- *ppr = pr;
- df = define(ids->nd_IDF, CurrentScope, D_VARIABLE);
- pr->par_def = df;
- df->df_type = tp;
- df->var_off = align(*off, word_align);
- df->df_flags = VARp;
- if (IsConformantArray(tp)) {
- /* we need room for the base address and a descriptor
- */
- *off = df->var_off + pointer_size + 3 * word_size;
- }
- else if (VARp == D_VARPAR) {
- *off = df->var_off + pointer_size;
- }
- else {
- *off = df->var_off + tp->tp_size;
- }
- }
-}
-
chk_basesubrange(tp, base)
register struct type *tp, *base;
{
}
tp = construct_type(T_SET, tp);
- tp->tp_size = align(((ub - lb) + 7)/8, word_align);
+ tp->tp_size = WA(((ub - lb) + 7)/8);
return tp;
}
if (tp->tp_fund == T_ARRAY) ArraySizes(tp);
algn = align(tp->tp_size, tp->tp_align);
- if (!(algn % word_size == 0 || word_size % algn == 0)) {
- algn = align(algn, (int) word_size);
+ if (word_size % algn != 0) {
+ /* algn is not a dividor of the word size, so make sure it
+ is a multiple
+ */
+ algn = WA(algn);
}
return algn;
}
default:
crash("Funny index type");
}
-
+
C_rom_cst(tp->arr_elsize);
+ tp->tp_size = WA(tp->tp_size);
/* ??? overflow checking ???
*/
static struct type *func_type;
struct withdesig *WithDesigs;
struct node *Modules;
+struct scope *ProcScope;
label
text_label()
if (df->df_kind == D_VARIABLE) {
C_df_dnam(df->var_name);
C_bss_cst(
- align(df->df_type->tp_size, word_align),
+ WA(df->df_type->tp_size),
(arith) 0, 0);
}
df = df->df_nextinscope;
sc->sc_off = 0;
instructionlabel = 2;
func_type = 0;
+ ProcScope = CurrentScope;
C_pro_narg(state == PROGRAM ? "main" : sc->sc_name);
DoProfil();
if (CurrVis == Defined->mod_vis) {
proclevel++;
CurrVis = procedure->prc_vis;
- sc = CurrentScope;
+ ProcScope = sc = CurrentScope;
WalkDef(sc->sc_def);
if (! return_expr_occurred) {
node_error(procedure->prc_body,"function procedure does not return a value");
}
- C_ret(align(res_type->tp_size, word_align));
+ C_ret(WA(res_type->tp_size));
}
else C_ret((arith) 0);
C_end(-sc->sc_off);
l1 = instructionlabel++;
l2 = instructionlabel++;
C_df_ilb(l1);
- WalkNode(left, l2);
+ WalkNode(right, l2);
C_bra(l1);
C_df_ilb(l2);
break;
case RETURN:
if (right) {
- WalkExpr(right, NO_LABEL, NO_LABEL);
+ WalkExpr(right);
/* Assignment compatibility? Yes, see Rep. 9.11
*/
if (!TstAssCompat(func_type, right->nd_type)) {
generate code to evaluate the expression.
*/
- WalkExpr(nd, true_label, false_label);
+ if (!chk_expr(nd)) return;
if (nd->nd_type != bool_type && nd->nd_type != error_type) {
node_error(nd, "boolean expression expected");
}
+
+ Desig = InitDesig;
+ CodeExpr(nd, &Desig, true_label, false_label);
}
-WalkExpr(nd, true_label, false_label)
+WalkExpr(nd)
struct node *nd;
- label true_label, false_label;
{
/* Check an expression and generate code for it
*/
if (! chk_expr(nd)) return;
- Desig = InitDesig;
- CodeExpr(nd, &Desig, true_label, false_label);
+ CodePExpr(nd);
}
WalkDesignator(nd)
switch(nd->nd_class) {
case Def: s = "Def"; break;
case Oper: s = "Oper"; break;
+ case Arrsel: s = "Arrsel"; break;
+ case Arrow: s = "Arrow"; break;
case Uoper: s = "Uoper"; break;
case Name: s = "Name"; break;
case Set: s = "Set"; break;
public / ack.git / commitdiff