COBJ = LLlex.o LLmessage.o char.o error.o main.o \
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
+ cstoper.o chk_expr.o options.o walk.o casestat.o desig.o code.o
OBJ = $(COBJ) $(LOBJ) Lpars.o
GENFILES= tokenfile.c \
program.c declar.c expression.c statement.c \
#include "type.h"
#include "LLlex.h"
#include "node.h"
+#include "desig.h"
#include "density.h"
assert(nd->nd_class == Stat && nd->nd_symb == CASE);
- WalkExpr(nd->nd_left);
+ WalkExpr(nd->nd_left, NO_LABEL, NO_LABEL);
sh->sh_type = nd->nd_left->nd_type;
sh->sh_break = text_label();
sh->sh_default = 0;
return 0;
}
+ if (param->par_var &&
+ !chk_designator(arg->nd_left, VARIABLE|DESIGNATOR)) {
+ node_error(arg->nd_left,"VAR parameter expected");
+ return 0;
+ }
+
param = param->next;
}
if (expp->nd_class == Link) {
assert(expp->nd_symb == '.');
- assert(expp->nd_right->nd_class == Name);
if (! chk_designator(expp->nd_left,
(flag|HASSELECTORS))) return 0;
tp = expp->nd_left->nd_type;
+ if (expp->nd_right->nd_class == Def) {
+ /* We were here already!
+ */
+ return 1;
+ }
+
assert(tp->tp_fund == T_RECORD);
+ assert(expp->nd_right->nd_class == Name);
df = lookup(expp->nd_right->nd_IDF, tp->rec_scope);
}
}
- if (expp->nd_left->nd_class == Def) {
+ if (expp->nd_left->nd_class == Def &&
+ expp->nd_left->nd_def->df_kind == D_MODULE) {
expp->nd_class = Def;
expp->nd_def = df;
FreeNode(expp->nd_left);
symbol2str(expp->nd_symb));
return 0;
}
-
+
switch(expp->nd_symb) {
case '+':
case '-':
--- /dev/null
+/* C O D E G E N E R A T I O N R O U T I N E S */
+
+#ifndef NORCSID
+static char *RcsId = "$Header$";
+#endif
+
+/* Code generation for expressions and coercions
+*/
+
+#include "debug.h"
+
+#include <em_arith.h>
+#include <em_label.h>
+#include <assert.h>
+
+#include "type.h"
+#include "def.h"
+#include "scope.h"
+#include "desig.h"
+#include "LLlex.h"
+#include "node.h"
+#include "Lpars.h"
+
+extern label data_label();
+extern char *long2str();
+extern char *symbol2str();
+extern int proclevel;
+
+CodeConst(cst, size)
+ arith cst, size;
+{
+ /* Generate code to push constant "cst" with size "size"
+ */
+ label dlab;
+
+ if (size <= word_size) {
+ C_loc(cst);
+ }
+ else if (size == dword_size) {
+ C_ldc(cst);
+ }
+ else {
+ C_df_dlb(dlab = data_label());
+ C_rom_icon(long2str((long) cst), 10);
+ C_lae_dlb(dlab);
+ C_loi(size);
+ }
+}
+
+CodeString(nd)
+ struct node *nd;
+{
+
+ label lab;
+
+ C_df_dlb(lab = data_label());
+ C_rom_scon(nd->nd_STR, nd->nd_SLE);
+ C_lae_dlb(lab);
+}
+
+CodeReal(nd)
+ struct node *nd;
+{
+ label lab;
+
+ C_df_dlb(lab = data_label());
+ C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size);
+ C_lae_dlb(lab);
+ C_loi(nd->nd_type->tp_size);
+}
+
+CodeExpr(nd, ds, true_label, false_label)
+ struct node *nd;
+ struct desig *ds;
+ label true_label, false_label;
+{
+ struct desig ds1, ds2;
+
+ switch(nd->nd_class) {
+ case Def:
+ 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 = InitDesig;
+ true_label = 0;
+ }
+ break;
+
+ case Uoper:
+ if (nd->nd_symb == '^') {
+ CodeDesig(nd, ds);
+ break;
+ }
+ CodeExpr(nd->nd_right, ds, NO_LABEL, NO_LABEL);
+ CodeValue(ds, nd->nd_right->nd_type->tp_size);
+ CodeUoper(nd);
+ ds->dsg_kind = DSG_LOADED;
+ break;
+
+ case Value:
+ switch(nd->nd_symb) {
+ case REAL:
+ CodeReal(nd);
+ break;
+ case STRING:
+ CodeString(nd);
+ break;
+ case INTEGER:
+ CodeConst(nd->nd_INT, nd->nd_type->tp_size);
+ break;
+ default:
+ crash("Value error");
+ }
+ ds->dsg_kind = DSG_LOADED;
+ break;
+
+ case Link:
+ CodeDesig(nd, ds);
+ break;
+
+ case Call:
+ CodeCall(nd);
+ ds->dsg_kind = DSG_LOADED;
+ break;
+
+ case Xset:
+ case Set:
+ /* ??? */
+ ds->dsg_kind = DSG_LOADED;
+ break;
+
+ default:
+ crash("(CodeExpr) bad node type");
+ }
+
+ if (true_label != 0) {
+ CodeValue(ds, nd->nd_type->tp_size);
+ *ds = InitDesig;
+ C_zne(true_label);
+ C_bra(false_label);
+ }
+}
+
+CodeCoercion(t1, t2)
+ struct type *t1, *t2;
+{
+ /* ??? */
+}
+
+CodeCall(nd)
+ struct node *nd;
+{
+ /* Generate code for a procedure call. Checking of parameters
+ and result is already done.
+ */
+ register struct node *left = nd->nd_left;
+ register struct node *arg = nd;
+ register struct paramlist *param;
+ struct type *tp;
+ arith pushed = 0;
+ struct desig Des;
+
+ if (left->nd_type == std_type) {
+ CodeStd(nd);
+ return;
+ }
+ tp = left->nd_type;
+
+ assert(tp->tp_fund == T_PROCEDURE);
+
+ for (param = left->nd_type->prc_params; param; param = param->next) {
+ Des = InitDesig;
+ arg = arg->nd_right;
+ assert(arg != 0);
+ if (param->par_var) {
+ CodeDesig(arg->nd_left, &Des);
+ CodeAddress(&Des);
+ pushed += pointer_size;
+ }
+ else {
+ CodeExpr(arg->nd_left, &Des, NO_LABEL, NO_LABEL);
+ CodeValue(&Des, arg->nd_left->nd_type->tp_size);
+ pushed += align(arg->nd_left->nd_type->tp_size, word_align);
+ }
+ /* ??? Conformant arrays */
+ }
+
+ 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(left->nd_def->prc_vis->sc_scope->sc_name);
+ }
+ else if (left->nd_class == Def && left->nd_def->df_kind == D_PROCHEAD) {
+ C_cal(left->nd_def->for_name);
+ }
+ else {
+ Des = InitDesig;
+ CodeDesig(left, &Des);
+ CodeAddress(&Des);
+ C_cai();
+ }
+ C_asp(pushed);
+ if (tp->next) {
+ C_lfr(align(tp->next->tp_size, word_align));
+ }
+}
+
+CodeStd(nd)
+ struct node *nd;
+{
+ /* ??? */
+}
+
+CodeAssign(nd, dst, dss)
+ struct node *nd;
+ struct desig *dst, dss;
+{
+ /* Generate code for an assignment. Testing of type
+ compatibility and the like is already done.
+ */
+
+ CodeCoercion(nd->nd_right->nd_type, nd->nd_left->nd_type);
+ /* ??? */
+}
+
+Operands(leftop, rightop)
+ struct node *leftop, *rightop;
+{
+ struct desig Des;
+
+ Des = InitDesig;
+ CodeExpr(leftop, &Des, NO_LABEL, NO_LABEL);
+ CodeValue(&Des, leftop->nd_type->tp_size);
+ Des = InitDesig;
+
+ if (rightop->nd_type->tp_fund == T_POINTER &&
+ leftop->nd_type->tp_size != pointer_size) {
+ CodeCoercion(leftop->nd_type, rightop->nd_type);
+ leftop->nd_type = rightop->nd_type;
+ }
+
+ CodeExpr(rightop, &Des, NO_LABEL, NO_LABEL);
+ CodeValue(&Des, rightop->nd_type->tp_size);
+}
+
+CodeOper(expr, true_label, false_label)
+ struct node *expr; /* the expression tree itself */
+ label true_label;
+ label false_label; /* labels to jump to in logical expr's */
+{
+ register int oper = expr->nd_symb;
+ register struct node *leftop = expr->nd_left;
+ register struct node *rightop = expr->nd_right;
+ register struct type *tp = expr->nd_type;
+ struct desig Des;
+ register struct desig *ds = &Des;
+
+ switch (oper) {
+ case '+':
+ Operands(leftop, rightop);
+ switch (tp->tp_fund) {
+ case T_INTEGER:
+ C_adi(tp->tp_size);
+ break;
+ case T_POINTER:
+ C_ads(rightop->nd_type->tp_size);
+ break;
+ case T_REAL:
+ C_adf(tp->tp_size);
+ break;
+ case T_CARDINAL:
+ C_adu(tp->tp_size);
+ break;
+ case T_SET:
+ C_ior(tp->tp_size);
+ break;
+ default:
+ crash("bad type +");
+ }
+ break;
+ case '-':
+ Operands(leftop, rightop);
+ switch (tp->tp_fund) {
+ case T_INTEGER:
+ C_sbi(tp->tp_size);
+ break;
+ case T_POINTER:
+ if (rightop->nd_type->tp_fund == T_POINTER) {
+ C_sbs(pointer_size);
+ }
+ else {
+ C_ngi(rightop->nd_type->tp_size);
+ C_ads(rightop->nd_type->tp_size);
+ }
+ break;
+ case T_REAL:
+ C_sbf(tp->tp_size);
+ break;
+ case T_CARDINAL:
+ C_sbu(tp->tp_size);
+ break;
+ case T_SET:
+ C_com(tp->tp_size);
+ C_and(tp->tp_size);
+ break;
+ default:
+ crash("bad type -");
+ }
+ break;
+ case '*':
+ Operands(leftop, rightop);
+ switch (tp->tp_fund) {
+ case T_INTEGER:
+ C_mli(tp->tp_size);
+ break;
+ case T_POINTER:
+ CodeCoercion(rightop->nd_type, tp);
+ /* Fall through */
+ case T_CARDINAL:
+ C_mlu(tp->tp_size);
+ break;
+ case T_REAL:
+ C_mlf(tp->tp_size);
+ break;
+ case T_SET:
+ C_and(tp->tp_size);
+ break;
+ default:
+ crash("bad type *");
+ }
+ break;
+ case '/':
+ Operands(leftop, rightop);
+ switch (tp->tp_fund) {
+ case T_REAL:
+ C_dvf(tp->tp_size);
+ break;
+ case T_SET:
+ C_xor(tp->tp_size);
+ break;
+ default:
+ crash("bad type /");
+ }
+ break;
+ case DIV:
+ Operands(leftop, rightop);
+ switch(tp->tp_fund) {
+ case T_INTEGER:
+ C_dvi(tp->tp_size);
+ break;
+ case T_POINTER:
+ CodeCoercion(rightop->nd_type, tp);
+ /* Fall through */
+ case T_CARDINAL:
+ C_dvu(tp->tp_size);
+ break;
+ default:
+ crash("bad type DIV");
+ }
+ break;
+ case MOD:
+ Operands(leftop, rightop);
+ switch(tp->tp_fund) {
+ case T_INTEGER:
+ C_rmi(tp->tp_size);
+ break;
+ case T_POINTER:
+ CodeCoercion(rightop->nd_type, tp);
+ /* Fall through */
+ case T_CARDINAL:
+ C_rmu(tp->tp_size);
+ break;
+ default:
+ crash("bad type MOD");
+ }
+ break;
+ case '<':
+ case LESSEQUAL:
+ case '>':
+ case GREATEREQUAL:
+ case '=':
+ case UNEQUAL:
+ case '#':
+ Operands(leftop, rightop);
+ CodeCoercion(rightop->nd_type, leftop->nd_type);
+ switch (tp->tp_fund) {
+ case T_INTEGER:
+ C_cmi(leftop->nd_type->tp_size);
+ break;
+ case T_POINTER:
+ C_cmp();
+ break;
+ case T_CARDINAL:
+ C_cmu(leftop->nd_type->tp_size);
+ break;
+ case T_ENUMERATION:
+ case T_CHAR:
+ C_cmu(word_size);
+ break;
+ case T_REAL:
+ C_cmf(leftop->nd_type->tp_size);
+ break;
+ case T_SET:
+ C_cms(leftop->nd_type->tp_size);
+ break;
+ default:
+ crash("bad type COMPARE");
+ }
+ if (true_label != 0) {
+ compare(oper, true_label);
+ C_bra(false_label);
+ }
+ else {
+ truthvalue(oper);
+ }
+ break;
+ case IN:
+ Operands(leftop, rightop);
+ CodeCoercion(rightop->nd_type, word_type);
+ C_inn(leftop->nd_type->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();
+ struct desig Des;
+
+ Des = InitDesig;
+ CodeExpr(leftop, &Des, l_maybe, l_false);
+ C_df_ilb(l_maybe);
+ Des = InitDesig;
+ CodeExpr(rightop, &Des, l_true, l_false);
+ C_df_ilb(l_true);
+ C_loc((arith)1);
+ C_bra(l_end);
+ C_df_ilb(l_false);
+ C_loc((arith)0);
+ C_df_ilb(l_end);
+ }
+ else {
+ label l_maybe = text_label();
+ struct desig Des;
+
+ Des = InitDesig;
+ CodeExpr(leftop, &Des, l_maybe, false_label);
+ Des = InitDesig;
+ C_df_ilb(l_maybe);
+ CodeExpr(rightop, &Des, true_label, false_label);
+ }
+ 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();
+ struct desig Des;
+
+ Des = InitDesig;
+ CodeExpr(leftop, &Des, l_true, l_maybe);
+ C_df_ilb(l_maybe);
+ Des = InitDesig;
+ CodeExpr(rightop, &Des, l_true, l_false);
+ C_df_ilb(l_false);
+ C_loc((arith)0);
+ C_bra(l_end);
+ C_df_ilb(l_true);
+ C_loc((arith)1);
+ C_df_ilb(l_end);
+ }
+ else {
+ label l_maybe = text_label();
+ struct desig Des;
+
+ Des = InitDesig;
+ CodeExpr(leftop, &Des, true_label, l_maybe);
+ C_df_ilb(l_maybe);
+ Des = InitDesig;
+ CodeExpr(rightop, &Des, true_label, false_label);
+ }
+ break;
+ default:
+ crash("(CodeOper) Bad operator %s\n", symbol2str(oper));
+ }
+}
+
+/* compare() serves as an auxiliary function of CodeOper */
+compare(relop, lbl)
+ int relop;
+ label lbl;
+{
+ switch (relop) {
+ case '<':
+ C_zlt(lbl);
+ break;
+ case LESSEQUAL:
+ C_zle(lbl);
+ break;
+ case '>':
+ C_zgt(lbl);
+ break;
+ case GREATEREQUAL:
+ C_zge(lbl);
+ break;
+ case '=':
+ C_zeq(lbl);
+ break;
+ case UNEQUAL:
+ case '#':
+ C_zne(lbl);
+ break;
+ default:
+ crash("(compare)");
+ }
+}
+
+/* truthvalue() serves as an auxiliary function of CodeOper */
+truthvalue(relop)
+ int relop;
+{
+ switch (relop) {
+ case '<':
+ C_tlt();
+ break;
+ case LESSEQUAL:
+ C_tle();
+ break;
+ case '>':
+ C_tgt();
+ break;
+ case GREATEREQUAL:
+ C_tge();
+ break;
+ case '=':
+ C_teq();
+ break;
+ case UNEQUAL:
+ case '#':
+ C_tne();
+ break;
+ default:
+ crash("(truthvalue)");
+ }
+}
+
+CodeUoper(nd)
+ register struct node *nd;
+{
+ register struct type *tp = nd->nd_type;
+
+ switch(nd->nd_symb) {
+ case '~':
+ case NOT:
+ C_teq();
+ break;
+ case '-':
+ switch(tp->tp_fund) {
+ case T_INTEGER:
+ C_ngi(tp->tp_size);
+ break;
+ case T_REAL:
+ C_ngf(tp->tp_size);
+ break;
+ default:
+ crash("Bad operand to unary -");
+ }
+ break;
+ default:
+ crash("Bad unary operator");
+ }
+}
{
if (type == D_PROCEDURE) proclevel++;
df = DeclProc(type);
+ tp = construct_type(T_PROCEDURE, tp);
if (proclevel > 1) {
/* Room for static link
*/
- df->prc_nbpar = pointer_size;
+ tp->prc_nbpar = pointer_size;
}
- else df->prc_nbpar = 0;
+ else tp->prc_nbpar = 0;
}
- FormalParameters(type == D_PROCEDURE, ¶ms, &tp, &(df->prc_nbpar))?
+ FormalParameters(type == D_PROCEDURE, ¶ms, &(tp->next), &(tp->prc_nbpar))?
{
- tp = construct_type(T_PROCEDURE, tp);
tp->prc_params = params;
if (df->df_type) {
/* We already saw a definition of this type
struct dfproc {
struct scopelist *pr_vis; /* scope of procedure */
- arith pr_nbpar; /* number of bytes parameters */
struct node *pr_body; /* body of this procedure */
#define prc_vis df_value.df_proc.pr_vis
-#define prc_nbpar df_value.df_proc.pr_nbpar
#define prc_body df_value.df_proc.pr_body
};
#include "LLlex.h"
#include "node.h"
+extern int proclevel;
+struct desig Desig;
+struct desig InitDesig = {DSG_INIT, 0, 0};
+
CodeValue(ds, size)
register struct desig *ds;
{
break;
}
- if (size == dwird_size) {
+ if (size == dword_size) {
if (ds->dsg_name) {
C_lde_dnam(ds->dsg_name, ds->dsg_offset);
}
break;
default:
- assert(0);
+ crash("(CodeValue)");
}
ds->dsg_kind = DSG_LOADED;
break;
default:
- assert(0);
- break;
+ crash("(CodeAddress)");
}
ds->dsg_offset = 0;
case DSG_PFIXED:
case DSG_INDEXED:
CodeAddress(ds);
- ds->dsg_kind = PLOADED;
+ ds->dsg_kind = DSG_PLOADED;
ds->dsg_offset = df->fld_off;
break;
default:
- assert(0);
- break;
+ crash("(CodeFieldDesig)");
}
}
+CodeVarDesig(df, ds)
+ register struct def *df;
+ register struct desig *ds;
+{
+ /* Generate code for a variable represented by a "def" structure.
+ Of course, there are numerous cases: the variable is local,
+ it is a value parameter, it is a var parameter, it is one of
+ those of an enclosing procedure, or it is global.
+ */
+ register struct scope *sc = df->df_scope;
+
+ /* Selections from a module are handled earlier, when identifying
+ the variable, so ...
+ */
+ assert(ds->dsg_kind == DSG_INIT);
+
+ if (df->var_addrgiven) {
+ /* the programmer specified an address in the declaration of
+ the variable. Generate code to push the address.
+ */
+ CodeConst(df->var_off, pointer_size);
+ ds->dsg_kind = DSG_PLOADED;
+ ds->dsg_offset = 0;
+ return;
+ }
+
+ if (df->var_name) {
+ /* this variable has been given a name, so it is global.
+ It is directly accessible.
+ */
+ ds->dsg_name = df->var_name;
+ ds->dsg_offset = 0;
+ ds->dsg_kind = DSG_FIXED;
+ return;
+ }
+
+ if (sc->sc_level == 0) {
+ /* the variable is global, but declared in a module local
+ to the implementation or program module.
+ Such variables can be accessed through an offset from
+ the name of the module.
+ */
+ ds->dsg_name = &(sc->sc_name[1]);
+ ds->dsg_offset = df->var_off;
+ ds->dsg_kind = DSG_FIXED;
+ return;
+ }
+
+ if (sc->sc_level != proclevel) {
+ /* the variable is local to a statically enclosing procedure.
+ */
+ assert(proclevel > sc->sc_level);
+ if (df->df_flags & (D_VARPAR|D_VALPAR)) {
+ /* value or var parameter
+ */
+ C_lxa((arith) (proclevel - sc->sc_level));
+ if (df->df_flags & D_VARPAR) {
+ /* var parameter
+ */
+ C_adp(df->var_off);
+ C_loi(pointer_size);
+ ds->dsg_offset = 0;
+ ds->dsg_kind = DSG_PLOADED;
+ return;
+ }
+ }
+ else C_lxl((arith) (proclevel - sc->sc_level));
+ ds->dsg_kind = DSG_PLOADED;
+ ds->dsg_offset = df->var_off;
+ return;
+ }
+
+ /* Now, finally, we have a local variable or a local parameter
+ */
+ if (df->df_flags & D_VARPAR) {
+ /* a var parameter; address directly accessible.
+ */
+ ds->dsg_kind = DSG_PFIXED;
+ }
+ else ds->dsg_kind = DSG_FIXED;
+ ds->dsg_offset =df->var_off;
+}
+
+CodeDesig(nd, ds)
+ register struct node *nd;
+ register struct desig *ds;
+{
+ /* Generate code for a designator. Use divide and conquer
+ principle
+ */
+
+ switch(nd->nd_class) { /* Divide */
+ case Def: {
+ register struct def *df = nd->nd_def;
+
+ switch(df->df_kind) {
+ case D_FIELD:
+ CodeFieldDesig(df, ds);
+ break;
+
+ case D_VARIABLE:
+ CodeVarDesig(df, ds);
+ break;
+
+ default:
+ crash("(CodeDesig) Def");
+ }
+ }
+ break;
+
+ case Link:
+ assert(nd->nd_symb == '.');
+ assert(nd->nd_right->nd_class == Def);
+ CodeDesig(nd->nd_left, ds);
+ CodeFieldDesig(nd->nd_right->nd_def, ds);
+ break;
+
+ case Oper:
+ assert(nd->nd_symb == '[');
+ CodeDesig(nd->nd_left, ds);
+ CodeAddress(ds);
+ *ds = InitDesig;
+ CodeExpr(nd->nd_right, ds, NO_LABEL, NO_LABEL);
+ CodeValue(ds, nd->nd_right->nd_type->tp_size);
+ CodeCoercion(nd->nd_right->nd_type, int_type);
+ if (IsConformantArray(nd->nd_left->nd_type)) {
+ /* ??? */
+ }
+ else {
+ /* load address of descriptor
+ */
+ /* ??? */
+ }
+ break;
+
+ case Uoper:
+ assert(nd->nd_symb == '^');
+ CodeDesig(nd->nd_right, ds);
+ switch(ds->dsg_kind) {
+ case DSG_LOADED:
+ ds->dsg_kind = DSG_PLOADED;
+ break;
+
+ case DSG_INDEXED:
+ case DSG_PLOADED:
+ case DSG_PFIXED:
+ CodeValue(ds, pointer_size);
+ ds->dsg_kind = DSG_PLOADED;
+ ds->dsg_offset = 0;
+ break;
+
+ case DSG_FIXED:
+ ds->dsg_kind = DSG_PFIXED;
+ break;
+
+ default:
+ crash("(CodeDesig) Uoper");
+ }
+ break;
+
+ default:
+ crash("(CodeDesig) class");
+ }
+}
struct scope *w_scope; /* scope in which fields of this record
reside
*/
- struct desig *w_desig; /* a desig structure for this particular
+ struct desig w_desig; /* a desig structure for this particular
designator
*/
};
extern struct withdesig *WithDesigs;
-extern struct desig Desig;
+extern struct desig Desig, InitDesig;
+
+#define NO_LABEL ((label) 0)
df->df_type = type;
df->df_flags |= flags;
if (addr) {
+ int xalign = type->tp_align;
+
+ if (xalign < word_align && kind != D_FIELD) {
+ xalign = word_align;
+ }
+
if (*addr >= 0) {
- off = align(*addr, type->tp_align);
- *addr = off + type->tp_size;
+ if (scope->sc_level) {
+ /* alignment of parameters is on
+ word boundaries. We cannot do any
+ better, because we don't know the
+ alignment of the stack pointer when
+ starting to push parameters
+ */
+ off = *addr;
+ *addr = align(off, word_align);
+ }
+ else {
+ /* for global variables we can honour
+ the alignment requirements totally.
+ */
+ off = align(*addr, xalign);
+ *addr = off + type->tp_size;
+ }
}
else {
- off = -align(-*addr, type->tp_align);
- *addr = off - type->tp_size;
+ off = -align(-*addr-type->tp_size, xalign);
+ *addr = off;
}
if (kind == D_VARIABLE) {
df->var_off = off;
sys_stop(S_EXIT);
}
+/*VARARGS1*/
+crash(fmt, args)
+ char *fmt;
+ int args;
+{
+
+ _error(CRASH, NULLNODE, fmt, &args);
+#ifdef DEBUG
+ sys_stop(S_ABORT);
+#else
+ sys_stop(S_EXIT);
+#endif
+}
+
_error(class, node, fmt, argv)
int class;
struct node *node;
struct proc {
struct paramlist *pr_params;
+ arith pr_nbpar;
#define prc_params tp_value.tp_proc.pr_params
+#define prc_nbpar tp_value.tp_proc.pr_nbpar
};
struct type {
*/
register struct type *tp;
+ /* first, do some checking
+ */
+ if (int_size != word_size) {
+ fatal("Integer size not equal to word size");
+ }
+
+ if (long_size < int_size) {
+ fatal("Long integer size smaller than integer size");
+ }
+
+ if (double_size < float_size) {
+ fatal("Long real size smaller than real size");
+ }
+
/* character type
*/
char_type = standard_type(T_CHAR, 1, (arith) 1);
assert(nd->nd_class == Stat);
switch(nd->nd_symb) {
- case BECOMES:
- WalkExpr(right);
+ case BECOMES: {
+ struct desig ds;
+
+ WalkExpr(right, NO_LABEL, NO_LABEL);
+ ds = Desig;
WalkDesignator(left); /* May we do it in this order??? */
if (! TstAssCompat(left->nd_type, right->nd_type)) {
break;
}
- CodeAssign(nd);
-
+ CodeAssign(nd, &ds, &Desig);
+ }
break;
case IF:
- { label l1, l2;
+ { label l1, l2, l3;
l1 = instructionlabel++;
l2 = instructionlabel++;
- ExpectBool(left);
+ l3 = instructionlabel++;
+ ExpectBool(left, l3, l1);
assert(right->nd_symb == THEN);
- C_zeq(l1);
+ C_df_ilb(l3);
WalkNode(right->nd_left, lab);
if (right->nd_right) { /* ELSE part */
break;
case WHILE:
- { label l1, l2;
+ { label l1, l2, l3;
l1 = instructionlabel++;
l2 = instructionlabel++;
+ l3 = instructionlabel++;
C_df_ilb(l1);
- ExpectBool(left);
- C_zeq(l2);
+ ExpectBool(left, l3, l2);
+ C_df_ilb(l3);
WalkNode(right, lab);
C_bra(l1);
C_df_ilb(l2);
}
case REPEAT:
- { label l1;
+ { label l1, l2;
l1 = instructionlabel++;
+ l2 = instructionlabel++;
C_df_ilb(l1);
WalkNode(left, lab);
- ExpectBool(right);
- C_zeq(l1);
+ ExpectBool(right, l2, l1);
+ C_df_ilb(l2);
break;
}
Decide here wether to use a temporary variable or
not, depending on the value of Desig.
Suggestion: temporary if Desig != DSG_FIXED
-
- And then:
- wds.w_desig = Desig; ???
+ ???
*/
+ wds.w_desig = Desig;
link.sc_scope = wds.w_scope;
link.next = CurrVis;
CurrVis = &link;
case RETURN:
if (right) {
- WalkExpr(right);
+ WalkExpr(right, NO_LABEL, NO_LABEL);
/* What kind of compatibility do we need here ???
assignment compatibility?
*/
}
}
-ExpectBool(nd)
+ExpectBool(nd, true_label, false_label)
struct node *nd;
+ label true_label, false_label;
{
/* "nd" must indicate a boolean expression. Check this and
generate code to evaluate the expression.
*/
- WalkExpr(nd);
+ WalkExpr(nd, true_label, false_label);
if (nd->nd_type != bool_type && nd->nd_type != error_type) {
node_error(nd, "boolean expression expected");
}
}
-WalkExpr(nd)
+WalkExpr(nd, true_label, false_label)
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);
}
WalkDesignator(nd)
if (! chk_designator(nd, DESIGNATOR|VARIABLE)) return;
- /* ??? */
-}
-
-CodeCall(nd)
- struct node *nd;
-{
- /* Generate code for a procedure call. Checking of parameters
- and result is already done.
- */
- /* ??? */
-}
-
-CodeAssign(nd)
- struct node *nd;
-{
- /* Generate code for an assignment. Testing of type
- compatibility and the like is already done.
- */
- /* ??? */
+ Desig = InitDesig;
+ CodeDesig(nd, &Desig);
}
#ifdef DEBUG
public / ack.git / commitdiff