CC = cc
GEN = /usr/em/util/LLgen/src/LLgen
GENOPTIONS = -d
-PROFILE = -p
+PROFILE =
CFLAGS = $(PROFILE) $(INCLUDES) -DSTATIC=
LINTFLAGS = -DSTATIC= -DNORCSID
LFLAGS = $(PROFILE)
cstoper.o chk_expr.o options.o walk.o casestat.o desig.o \
code.o tmpvar.o lookup.o
OBJ = $(COBJ) $(LOBJ) Lpars.o
-GENFILES= tokenfile.c \
- program.c declar.c expression.c statement.c \
- tokenfile.g symbol2str.c char.c Lpars.c Lpars.h
+# Keep the next three entries up to date!
+GENCFILES= tokenfile.c \
+ program.c declar.c expression.c statement.c \
+ symbol2str.c char.c Lpars.c casestat.c tmpvar.c scope.c
+GENGFILES= tokenfile.g
+GENHFILES= errout.h\
+ idfsize.h numsize.h strsize.h target_sizes.h debug.h\
+ inputtype.h maxset.h ndir.h density.h
+#
+GENFILES = $(GENGFILES) $(GENCFILES) $(GENHFILES)
all:
make hfiles
make LLfiles
size main
clean:
- rm -f $(OBJ) $(GENFILES) LLfiles
+ rm -f $(OBJ) $(GENFILES) LLfiles hfiles
lint: LLfiles hfiles
lint $(INCLUDES) $(LINTFLAGS) `sources $(OBJ)`
cstoper.o: LLlex.h Lpars.h debug.h idf.h node.h standards.h target_sizes.h type.h
chk_expr.o: LLlex.h Lpars.h chk_expr.h const.h debug.h def.h idf.h node.h scope.h standards.h type.h
options.o: idfsize.h main.h ndir.h type.h
-walk.o: LLlex.h Lpars.h chk_expr.h debug.h def.h desig.h f_info.h idf.h main.h node.h scope.h type.h
+walk.o: LLlex.h Lpars.h chk_expr.h debug.h def.h desig.h f_info.h idf.h main.h node.h scope.h type.h walk.h
casestat.o: LLlex.h Lpars.h debug.h density.h desig.h node.h type.h
desig.o: LLlex.h debug.h def.h desig.h node.h scope.h type.h
code.o: LLlex.h Lpars.h debug.h def.h desig.h node.h scope.h standards.h type.h
#include "LLlex.h"
#include "node.h"
#include "desig.h"
+#include "walk.h"
#include "density.h"
*/
#define compact(nr, low, up) (nr != 0 && (up - low) / nr <= DENSITY)
-extern label text_label(), data_label();
-
CaseCode(nd, exitlabel)
struct node *nd;
label exitlabel;
clear((char *) sh, sizeof(*sh));
WalkExpr(pnode->nd_left);
sh->sh_type = pnode->nd_left->nd_type;
- sh->sh_break = text_label();
+ sh->sh_break = ++text_label;
/* Now, create case label list
*/
pnode = pnode->nd_right;
if (pnode->nd_class == Link && pnode->nd_symb == '|') {
if (pnode->nd_left) {
- pnode->nd_lab = text_label();
+ pnode->nd_lab = ++text_label;
if (! AddCases(sh,
pnode->nd_left->nd_left,
pnode->nd_lab)) {
/* Else part
*/
- sh->sh_default = text_label();
+ sh->sh_default = ++text_label;
pnode = 0;
}
}
/* Now generate code for the switch itself
*/
- tablabel = data_label(); /* the rom must have a label */
+ 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_ilb(sh->sh_break);
+ else C_rom_ucon("0", pointer_size);
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_ilb(sh->sh_break);
+ else C_rom_ucon("0", pointer_size);
}
C_lae_dlb(tablabel, (arith)0); /* perform the switch */
C_csa(word_size);
chk_arr(expp)
struct node *expp;
{
- return chk_designator(expp, DESIGNATOR|VARIABLE, D_USED);
+ return chk_designator(expp, VARIABLE, D_USED);
}
STATIC int
chk_linkorname(expp)
register struct node *expp;
{
- if (chk_designator(expp, VALUE|DESIGNATOR, D_USED)) {
+ if (chk_designator(expp, VALUE, D_USED)) {
if (expp->nd_class == Def &&
expp->nd_def->df_kind == D_PROCEDURE) {
/* Check that this procedure is one that we
if ((!designator && !chk_expr(left)) ||
(designator &&
- !chk_designator(left, DESIGNATOR|VARIABLE, D_USED|D_NOREG))) {
+ !chk_designator(left, VARIABLE, D_USED|D_NOREG))) {
return 0;
}
arg = arg->nd_right;
if (! chk_designator(arg->nd_left, 0, D_REFERRED)) return 0;
- if (arg->nd_left->nd_class != Def);
+ if (arg->nd_left->nd_class != Def && arg->nd_left->nd_class != LinkDef) {
+ node_error(arg, "identifier expected");
+ return 0;
+ }
if (!(arg->nd_left->nd_def->df_kind & kinds)) {
node_error(arg, "unexpected type");
arg = expp;
expp->nd_type = left->nd_type->next;
- for (param = left->nd_type->prc_params; param; param = param->next) {
+ for (param = ParamList(left->nd_type); param; param = param->next) {
if (!(left = getarg(&arg, 0, IsVarParam(param)))) return 0;
if (left->nd_symb == STRING) {
TryToString(left, TypeOfParam(param));
be something that can be assigned to.
It may also contain the flag VALUE, indicating that a
value is expected. In this case, VARIABLE may not be set.
- It also contains the flag DESIGNATOR, indicating that '['
- and '^' are allowed for this designator.
Also contained may be the flag HASSELECTORS, indicating that
the result must have selectors.
"dflags" contains some flags that must be set at the definition
register struct def *df;
register struct type *tp;
+ if (expp->nd_class == Def || expp->nd_class == LinkDef) {
+ expp->nd_def->df_flags |= dflags;
+ return 1;
+ }
+
expp->nd_type = error_type;
if (expp->nd_class == Name) {
assert(expp->nd_symb == '.');
if (! chk_designator(left,
- (flag&DESIGNATOR)|HASSELECTORS,
+ HASSELECTORS,
dflags)) return 0;
tp = left->nd_type;
else {
expp->nd_def = df;
expp->nd_type = df->df_type;
+ expp->nd_class = LinkDef;
if (!(df->df_flags & (D_EXPORTED|D_QEXPORTED))) {
/* Fields of a record are always D_QEXPORTED,
so ...
return 1;
}
- if (! (flag & DESIGNATOR)) {
- node_error(expp, "identifier expected");
- return 0;
- }
-
if (expp->nd_class == Arrsel) {
struct type *tpl, *tpr;
assert(expp->nd_symb == '[');
if (
- !chk_designator(expp->nd_left, DESIGNATOR|VARIABLE, dflags)
+ !chk_designator(expp->nd_left, VARIABLE, dflags)
||
!chk_expr(expp->nd_right)
||
if (expp->nd_class == Arrow) {
assert(expp->nd_symb == '^');
- if (! chk_designator(expp->nd_right, DESIGNATOR|VARIABLE, dflags)) {
+ if (! chk_designator(expp->nd_right, VARIABLE, dflags)) {
return 0;
}
break;
default:
- assert(0);
+ crash("chk_uoper");
}
node_error(expp, "illegal operand for unary operator \"%s\"",
symbol2str(expp->nd_symb));
left = arg->nd_left;
- if (! chk_designator(left, DESIGNATOR, D_REFERRED)) return 0;
+ if (! chk_designator(left, 0, D_REFERRED)) return 0;
if (left->nd_class == Arrsel || left->nd_class == Arrow) {
*argp = arg;
return left;
}
df = 0;
- if (left->nd_class == Link || left->nd_class == Def) {
+ if (left->nd_class == LinkDef || left->nd_class == Def) {
df = left->nd_def;
}
if (left->nd_class == Value) cstcall(expp, S_ORD);
break;
+ case S_NEW:
+ case S_DISPOSE:
+ {
+ static int warning_given = 0;
+
+ if (!warning_given) {
+ warning_given = 1;
+ node_warning(expp, "NEW and DISPOSE are old-fashioned");
+ }
+ }
+ if (! (left = getvariable(&arg))) return 0;
+ if (! (left->nd_type->tp_fund == T_POINTER)) {
+ node_error(left, "pointer variable expected");
+ return 0;
+ }
+ if (left->nd_class == Def) {
+ left->nd_def->df_flags |= D_NOREG;
+ }
+ /* Now, make it look like a call to ALLOCATE or DEALLOCATE */
+ {
+ struct token dt;
+ struct node *nd;
+
+ dt.TOK_INT = left->nd_type->next->tp_size;
+ dt.tk_symb = INTEGER;
+ dt.tk_lineno = left->nd_lineno;
+ nd = MkLeaf(Value, &dt);
+ nd->nd_type = card_type;
+ dt.tk_symb = ',';
+ arg->nd_right = MkNode(Link, nd, NULLNODE, &dt);
+ /* Ignore other arguments to NEW and/or DISPOSE ??? */
+
+ FreeNode(expp->nd_left);
+ dt.tk_symb = IDENT;
+ dt.tk_lineno = expp->nd_left->nd_lineno;
+ dt.TOK_IDF = str2idf(std == S_NEW ?
+ "ALLOCATE" : "DEALLOCATE", 0);
+ expp->nd_left = MkLeaf(Name, &dt);
+ }
+ return chk_call(expp);
+
case S_TSIZE: /* ??? */
case S_SIZE:
expp->nd_type = intorcard_type;
chk_set,
NodeCrash,
NodeCrash,
- chk_linkorname
+ chk_linkorname,
+ NodeCrash
};
#include "node.h"
#include "Lpars.h"
#include "standards.h"
+#include "walk.h"
-extern label data_label();
-extern label text_label();
extern char *long2str();
extern char *symbol2str();
extern int proclevel;
C_ldc(cst);
}
else {
- C_df_dlb(dlab = data_label());
+ C_df_dlb(dlab = ++data_label);
C_rom_icon(long2str((long) cst), size);
C_lae_dlb(dlab, (arith) 0);
C_loi(size);
C_loc(nd->nd_INT);
}
else {
- C_df_dlb(lab = data_label());
+ C_df_dlb(lab = ++data_label);
C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1));
C_lae_dlb(lab, (arith) 0);
}
CodeReal(nd)
register struct node *nd;
{
- label lab = data_label();
+ label lab = ++data_label;
C_df_dlb(lab);
C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size);
/* Fall through */
case Link:
+ case LinkDef:
case Arrsel:
case Arrow:
CodeDesig(nd, ds);
and result is already done.
*/
register struct node *left = nd->nd_left;
+ register struct type *result_tp;
if (left->nd_type == std_type) {
CodeStd(nd);
assert(IsProcCall(left));
if (nd->nd_right) {
- CodeParameters(left->nd_type->prc_params, nd->nd_right);
+ CodeParameters(ParamList(left->nd_type), nd->nd_right);
}
if (left->nd_class == Def && left->nd_def->df_kind == D_PROCEDURE) {
C_cai();
}
if (left->nd_type->prc_nbpar) C_asp(left->nd_type->prc_nbpar);
- if (left->nd_type->next) {
- C_lfr(WA(left->nd_type->next->tp_size));
+ if (result_tp = ResultType(left->nd_type)) {
+ if (IsConstructed(result_tp)) {
+ C_lfr(pointer_size);
+ C_loi(result_tp->tp_size);
+ }
+ else C_lfr(WA(result_tp->tp_size));
}
}
C_com(tp->tp_size);
C_and(tp->tp_size);
C_ior(tp->tp_size);
+ C_zer(tp->tp_size);
}
C_cms(tp->tp_size);
break;
case AND:
case '&':
if (true_label == 0) {
- label l_true = text_label();
- label l_false = text_label();
- label l_maybe = text_label();
- label l_end = text_label();
+ label l_true = ++text_label;
+ label l_false = ++text_label;
+ label l_maybe = ++text_label;
+ label l_end = ++text_label;
struct desig Des;
Des = InitDesig;
C_df_ilb(l_end);
}
else {
- label l_maybe = text_label();
+ label l_maybe = ++text_label;
struct desig Des;
Des = InitDesig;
break;
case OR:
if (true_label == 0) {
- label l_true = text_label();
- label l_false = text_label();
- label l_maybe = text_label();
- label l_end = text_label();
+ label l_true = ++text_label;
+ label l_false = ++text_label;
+ label l_maybe = ++text_label;
+ label l_end = ++text_label;
struct desig Des;
Des = InitDesig;
C_df_ilb(l_end);
}
else {
- label l_maybe = text_label();
+ label l_maybe = ++text_label;
struct desig Des;
Des = InitDesig;
DoHIGH(nd)
struct node *nd;
{
- register struct def *df;
- arith highoff;
+ register struct def *df = nd->nd_def;
+ register arith highoff;
assert(nd->nd_class == Def);
-
- df = nd->nd_def;
-
assert(df->df_kind == D_VARIABLE);
highoff = df->var_off + pointer_size + word_size;
#include "misc.h"
#include "main.h"
-int proclevel = 0; /* nesting level of procedures */
+int proclevel = 0; /* nesting level of procedures */
+int return_occurred; /* set if a return occurred in a
+ procedure or function
+ */
}
ProcedureDeclaration
{
- struct def *df;
+ register struct def *df;
+ struct def *df1;
} :
{ proclevel++; }
- ProcedureHeading(&df, D_PROCEDURE)
+ ProcedureHeading(&df1, D_PROCEDURE)
{
- CurrentScope->sc_definedby = df;
+ CurrentScope->sc_definedby = df = df1;
df->prc_vis = CurrVis;
+ return_occurred = 0;
}
';' block(&(df->prc_body)) IDENT
{
match_id(dot.TOK_IDF, df->df_idf);
close_scope(SC_CHKFORW|SC_REVERSE);
+ if (! return_occurred && ResultType(df->df_type)) {
+error("function procedure does not return a value", df->df_idf->id_text);
+ }
proclevel--;
}
;
}
break;
- case Link:
+ case LinkDef:
assert(nd->nd_symb == '.');
CodeDesig(nd->nd_left, ds);
Return a pointer to its "def" structure if it exists,
otherwise return 0.
*/
- register struct def *df;
- struct def *df1;
+ register struct def *df, *df1;
+
+ /* Look in the chain of definitions of this "id" for one with scope
+ "scope".
+ */
+ for (df = id->id_def, df1 = 0;
+ df && df->df_scope != scope;
+ df1 = df, df = df->next) { /* nothing */ }
- 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;
+ if (df) {
+ /* Found it
+ */
+ 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 0;
+ return df;
}
struct def *
If it is not defined create a dummy definition and,
if "give_error" is set, give an error message.
*/
- struct def *df;
+ register struct def *df;
register struct scopelist *sc = vis;
while (sc) {
(void) Enter("DEC", D_PROCEDURE, std_type, S_DEC);
(void) Enter("INC", D_PROCEDURE, std_type, S_INC);
(void) Enter("VAL", D_PROCEDURE, std_type, S_VAL);
+ (void) Enter("NEW", D_PROCEDURE, std_type, S_NEW);
+ (void) Enter("DISPOSE", D_PROCEDURE, std_type, S_DISPOSE);
(void) Enter("TRUNC", D_PROCEDURE, std_type, S_TRUNC);
(void) Enter("SIZE", D_PROCEDURE, std_type, S_SIZE);
(void) Enter("ORD", D_PROCEDURE, std_type, S_ORD);
#define Def 9 /* an identified name */
#define Stat 10 /* a statement */
#define Link 11
+#define LinkDef 12
/* do NOT change the order or the numbers!!! */
struct type *nd_type; /* type of this node */
struct token nd_token;
#define NULLNODE ((struct node *) 0)
-#define DESIGNATOR 1
-#define HASSELECTORS 2
-#define VARIABLE 4
-#define VALUE 8
+#define HASSELECTORS 002
+#define VARIABLE 004
+#define VALUE 010
-#define IsCast(lnd) ((lnd)->nd_class == Def && is_type((lnd)->nd_def))
+#define IsCast(lnd) (((lnd)->nd_class == Def || (lnd)->nd_class == LinkDef) && is_type((lnd)->nd_def))
#define IsProcCall(lnd) ((lnd)->nd_type->tp_fund == T_PROCEDURE)
#define S_SIZE 15
#define S_TRUNC 16
#define S_VAL 17
+#define S_NEW 18
+#define S_DISPOSE 19
/* Standard procedures and functions defined in the SYSTEM module ... */
{
register struct def *df = CurrentScope->sc_definedby;
register struct node *nd;
+ extern int return_occurred;
} :
- RETURN { *pnd = nd = MkLeaf(Stat, &dot); }
+ RETURN { *pnd = nd = MkLeaf(Stat, &dot);
+ return_occurred = 1;
+ }
[
expression(&(nd->nd_right))
{ if (scopeclosed(CurrentScope)) {
#define T_NUMERIC (T_INTORCARD|T_REAL)
#define T_INDEX (T_ENUMERATION|T_CHAR|T_SUBRANGE)
#define T_DISCRETE (T_INDEX|T_INTORCARD)
-#define T_PRCRESULT (T_DISCRETE|T_REAL|T_POINTER|T_WORD)
+#define T_CONSTRUCTED (T_ARRAY|T_SET|T_RECORD)
int tp_align; /* alignment requirement of this type */
arith tp_size; /* size of this type */
union {
#define IsConformantArray(tpx) ((tpx)->tp_fund==T_ARRAY && (tpx)->next==0)
#define bounded(tpx) ((tpx)->tp_fund & T_INDEX)
#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))
+#define ResultType(tpx) (assert((tpx)->tp_fund == T_PROCEDURE), (tpx)->next)
+#define ParamList(tpx) (assert((tpx)->tp_fund == T_PROCEDURE),\
+ (tpx)->prc_params)
+#define IsConstructed(tpx) ((tpx)->tp_fund & T_CONSTRUCTED)
#include "node.h"
#include "const.h"
#include "scope.h"
+#include "walk.h"
int
word_align = AL_WORD,
int cnt_type;
#endif
-extern label data_label();
-
struct type *
create_type(fund)
int fund;
switch (fund) {
case T_PROCEDURE:
- if (tp && !returntype(tp)) {
- error("illegal procedure result type");
- }
- /* Fall through */
case T_POINTER:
case T_HIDDEN:
dtp->tp_align = pointer_align;
if (tp->tp_fund == T_SUBRANGE) {
if (!(ol = tp->sub_rck)) {
- tp->sub_rck = l = data_label();
+ tp->sub_rck = l = ++data_label;
}
}
else if (!(ol = tp->enm_rck)) {
- tp->enm_rck = l = data_label();
+ tp->enm_rck = l = ++data_label;
}
if (!ol) {
ol = l;
/* generate descriptor and remember label.
*/
- tp->arr_descr = data_label();
+ tp->arr_descr = ++data_label;
C_df_dlb(tp->arr_descr);
C_rom_cst(lo);
C_rom_cst(hi - lo);
assert(tp->tp_fund == T_PROCEDURE);
- pr = tp->prc_params;
+ pr = ParamList(tp);
while (pr) {
pr1 = pr;
pr = pr->next;
break;
case T_PROCEDURE:
{
- register struct paramlist *par = tp->prc_params;
+ register struct paramlist *par = ParamList(tp);
print("PROCEDURE");
if (par) {
case T_INTORCARD:
print("INTORCARD"); break;
default:
- assert(0);
+ crash("DumpType");
}
print(";");
}
/* Routines for testing type equivalence, type compatibility, and
assignment compatibility
*/
+#include "debug.h"
+
#include <em_arith.h>
#include <em_label.h>
+#include <assert.h>
#include "type.h"
#include "def.h"
*/
if (! TstTypeEquiv(tp1->next, tp2->next)) return 0;
- p1 = tp1->prc_params;
- p2 = tp2->prc_params;
+ p1 = ParamList(tp1);
+ p2 = ParamList(tp2);
/* Now check the parameters
*/
TstTypeEquiv(formaltype, actualtype)
||
( !VARflag && TstAssCompat(formaltype, actualtype))
+ ||
+ ( formaltype == address_type
+ && actualtype->tp_fund == T_POINTER
+ )
||
( formaltype == word_type
&&
#include "f_info.h"
#include "idf.h"
#include "chk_expr.h"
+#include "walk.h"
extern arith NewPtr();
extern arith NewInt();
extern int proclevel;
-static label instructionlabel;
-static char return_expr_occurred;
+label text_label;
+label data_label;
static struct type *func_type;
struct withdesig *WithDesigs;
struct node *Modules;
struct scope *ProcScope;
-label
-text_label()
-{
- return instructionlabel++;
-}
-
-label
-data_label()
-{
- static label datalabel = 0;
-
- return ++datalabel;
-}
-
STATIC
DoProfil()
{
if (! options['L']) {
if (!filename_label) {
- filename_label = data_label();
+ filename_label = ++data_label;
C_df_dlb(filename_label);
C_rom_scon(FileName, (arith) (strlen(FileName) + 1));
}
/* Walk through a module, and all its local definitions.
Also generate code for its body.
*/
- register struct def *df = module->mod_vis->sc_scope->sc_def;
register struct scope *sc;
struct scopelist *vis;
CurrVis = module->mod_vis;
sc = CurrentScope;
- if (!proclevel) {
- /* This module is a glocal module.
- Generate code to allocate storage for its variables.
- They all have an explicit name.
+ if (!proclevel && module == Defined) {
+ /* This module is a global module. Export the name of its
+ initialization routine
*/
- while (df) {
- if (df->df_kind == D_VARIABLE) {
- C_df_dnam(df->var_name);
- C_bss_cst(
- WA(df->df_type->tp_size),
- (arith) 0, 0);
- }
- df = df->df_nextinscope;
- }
if (state == PROGRAM) C_exp("main");
else C_exp(sc->sc_name);
}
this module.
*/
sc->sc_off = 0;
- instructionlabel = 2;
- func_type = 0;
+ text_label = 1;
ProcScope = CurrentScope;
- C_pro_narg(state == PROGRAM ? "main" : sc->sc_name);
+ C_pro_narg(state==PROGRAM && module==Defined ? "main" : sc->sc_name);
DoProfil();
- if (CurrVis == Defined->mod_vis) {
+ if (module == Defined) {
/* Body of implementation or program module.
Call initialization routines of imported modules.
Also prevent recursive calls of this one.
struct node *nd;
if (state == IMPLEMENTATION) {
- label l1 = data_label();
+ label l1 = ++data_label;
/* we don't actually prevent recursive calls,
but do nothing if called recursively
*/
/* Walk through the definition of a procedure and all its
local definitions
*/
- struct scopelist *vis = CurrVis;
+ struct scopelist *savevis = CurrVis;
register struct scope *sc;
register struct type *tp;
register struct paramlist *param;
+ label func_res_label = 0;
proclevel++;
CurrVis = procedure->prc_vis;
ProcScope = sc = CurrentScope;
+ /* Generate code for all local modules and procedures
+ */
WalkDef(sc->sc_def);
/* Generate code for this procedure
*/
C_pro_narg(sc->sc_name);
DoProfil();
- /* generate calls to initialization routines of modules defined within
+
+ /* Generate calls to initialization routines of modules defined within
this procedure
*/
MkCalls(sc->sc_def);
- return_expr_occurred = 0;
- instructionlabel = 2;
- func_type = tp = procedure->df_type->next;
- if (! returntype(tp)) {
- node_error(procedure->prc_body, "illegal result type");
+
+ /* Make sure that arguments of size < word_size are on a
+ fixed place.
+ */
+ for (param = ParamList(procedure->df_type);
+ param;
+ param = param->next) {
+ if (! IsVarParam(param)) {
+ tp = TypeOfParam(param);
+
+ if (!IsConformantArray(tp) && tp->tp_size < word_size) {
+ C_lol(param->par_def->var_off);
+ C_lal(param->par_def->var_off);
+ C_sti(tp->tp_size);
+ }
+ }
}
+
+ text_label = 1;
+ func_type = tp = ResultType(procedure->df_type);
+
+ if (IsConstructed(tp)) {
+ func_res_label = ++data_label;
+ C_df_dlb(func_res_label);
+ C_bss_cst(tp->tp_size, (arith) 0, 0);
+ }
+
WalkNode(procedure->prc_body, (label) 0);
- C_df_ilb((label) 1);
+ C_ret((arith) 0);
if (tp) {
- if (! return_expr_occurred) {
-node_error(procedure->prc_body,"function procedure does not return a value");
+ C_df_ilb((label) 1);
+ if (func_res_label) {
+ C_lae_dlb(func_res_label, (arith) 0);
+ C_sti(tp->tp_size);
+ C_lae_dlb(func_res_label, (arith) 0);
+ C_ret(pointer_size);
}
- C_ret(WA(tp->tp_size));
+ else C_ret(WA(tp->tp_size));
}
- else C_ret((arith) 0);
+
RegisterMessages(sc->sc_def);
C_end(-sc->sc_off);
TmpClose();
- CurrVis = vis;
+ CurrVis = savevis;
proclevel--;
}
else if (df->df_kind == D_PROCEDURE) {
WalkProcedure(df);
}
+ else if (!proclevel && df->df_kind == D_VARIABLE) {
+ C_df_dnam(df->var_name);
+ C_bss_cst(
+ WA(df->df_type->tp_size),
+ (arith) 0, 0);
+ }
df = df->df_nextinscope;
}
}
}
}
-WalkNode(nd, lab)
+WalkLink(nd, lab)
register struct node *nd;
label lab;
{
- /* Node "nd" represents either a statement or a statement list.
- Walk through it.
+ /* Walk node "nd", which is a link.
"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);
+ while (nd && nd->nd_class == Link) { /* statement list */
+ WalkNode(nd->nd_left, lab);
nd = nd->nd_right;
}
- WalkStat(nd, lab);
+ WalkNode(nd, lab);
+}
+
+WalkCall(nd)
+ register struct node *nd;
+{
+ assert(nd->nd_class == Call);
+
+ if (! options['L']) C_lin((arith) nd->nd_lineno);
+ if (chk_call(nd)) {
+ if (nd->nd_type != 0) {
+ node_error(nd, "procedure call expected");
+ return;
+ }
+ CodeCall(nd);
+ }
}
WalkStat(nd, lab)
register struct node *left = nd->nd_left;
register struct node *right = nd->nd_right;
- if (!nd) {
- /* Empty statement
- */
- return;
- }
-
- if (! options['L']) C_lin((arith) nd->nd_lineno);
-
- if (nd->nd_class == Call) {
- if (chk_call(nd)) {
- if (nd->nd_type != 0) {
- node_error(nd, "procedure call expected");
- return;
- }
- CodeCall(nd);
- }
- return;
- }
-
assert(nd->nd_class == Stat);
+ if (! options['L']) C_lin((arith) nd->nd_lineno);
switch(nd->nd_symb) {
case BECOMES:
DoAssign(nd, left, right);
case IF:
{ label l1, l2, l3;
- l1 = instructionlabel++;
- l2 = instructionlabel++;
- l3 = instructionlabel++;
+ l1 = ++text_label;
+ l2 = ++text_label;
+ l3 = ++text_label;
ExpectBool(left, l3, l1);
assert(right->nd_symb == THEN);
C_df_ilb(l3);
case WHILE:
{ label l1, l2, l3;
- l1 = instructionlabel++;
- l2 = instructionlabel++;
- l3 = instructionlabel++;
+ l1 = ++text_label;
+ l2 = ++text_label;
+ l3 = ++text_label;
C_df_ilb(l1);
ExpectBool(left, l3, l2);
C_df_ilb(l3);
case REPEAT:
{ label l1, l2;
- l1 = instructionlabel++;
- l2 = instructionlabel++;
+ l1 = ++text_label;
+ l2 = ++text_label;
C_df_ilb(l1);
WalkNode(left, lab);
ExpectBool(right, l2, l1);
case LOOP:
{ label l1, l2;
- l1 = instructionlabel++;
- l2 = instructionlabel++;
+ l1 = ++text_label;
+ l2 = ++text_label;
C_df_ilb(l1);
WalkNode(right, l2);
C_bra(l1);
{
arith tmp = 0;
struct node *fnd;
- label l1 = instructionlabel++;
- label l2 = instructionlabel++;
+ label l1 = ++text_label;
+ label l2 = ++text_label;
if (! DoForInit(nd, left)) break;
fnd = left->nd_right;
case RETURN:
if (right) {
WalkExpr(right);
- /* Assignment compatibility? Yes, see Rep. 9.11
+ /* The type of the return-expression must be
+ assignment compatible with the result type of the
+ function procedure (See Rep. 9.11).
*/
if (!TstAssCompat(func_type, right->nd_type)) {
node_error(right, "type incompatibility in RETURN statement");
}
- return_expr_occurred = 1;
+ C_bra((label) 1);
}
- C_bra((label) 1);
+ else C_ret((arith) 0);
break;
default:
}
}
+extern int NodeCrash();
+
+int (*WalkTable[])() = {
+ NodeCrash,
+ NodeCrash,
+ NodeCrash,
+ NodeCrash,
+ NodeCrash,
+ WalkCall,
+ NodeCrash,
+ NodeCrash,
+ NodeCrash,
+ NodeCrash,
+ WalkStat,
+ WalkLink,
+ NodeCrash
+};
+
ExpectBool(nd, true_label, false_label)
register struct node *nd;
label true_label, false_label;
DO_DEBUG(1, (DumpTree(nd), print("\n")));
- if (! chk_designator(nd, DESIGNATOR|VARIABLE, D_DEFINED)) return;
+ if (! chk_designator(nd, VARIABLE, D_DEFINED)) return;
*ds = InitDesig;
CodeDesig(nd, ds);
DoForInit(nd, left)
register struct node *nd, *left;
{
+ register struct def *df;
nd->nd_left = nd->nd_right = 0;
nd->nd_class = Name;
! chk_expr(left->nd_left) ||
! chk_expr(left->nd_right)) return 0;
+ df = nd->nd_def;
+ if (df->df_kind == D_FIELD) {
+ node_error(nd, "FOR-loop variable may not be a field of a record");
+ return 0;
+ }
+
+ if (!df->var_name && df->var_off >= 0) {
+ node_error(nd, "FOR-loop variable may not be a parameter");
+ return 0;
+ }
+
+ if (df->df_scope != CurrentScope) {
+ register struct scopelist *sc = CurrVis;
+
+ while (sc && sc->sc_scope != df->df_scope) {
+ sc = nextvisible(sc);
+ }
+
+ if (!sc) {
+ node_error(nd, "FOR-loop variable may not be imported");
+ return 0;
+ }
+ }
+
if (nd->nd_type->tp_size > word_size ||
!(nd->nd_type->tp_fund & T_DISCRETE)) {
node_error(nd, "illegal type of FOR loop variable");
struct desig dsl, dsr;
if (!chk_expr(right)) return;
- if (! chk_designator(left, DESIGNATOR|VARIABLE, D_DEFINED)) return;
+ if (! chk_designator(left, VARIABLE, D_DEFINED)) return;
TryToString(right, left->nd_type);
dsr = InitDesig;
CodeExpr(right, &dsr, NO_LABEL, NO_LABEL);
--- /dev/null
+/* P A R S E T R E E W A L K E R */
+
+/* $Header$ */
+
+/* Definition of WalkNode macro
+*/
+
+extern int (*WalkTable[])();
+
+#define WalkNode(xnd, xlab) ((xnd) && (*WalkTable[(xnd)->nd_class])((xnd), (xlab)))
+
+extern label text_label;
+extern label data_label;
public / ack.git / commitdiff