diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile index 3f233ffe1..ee5c819f5 100644 --- a/lang/m2/comp/Makefile +++ b/lang/m2/comp/Makefile @@ -18,7 +18,7 @@ LOBJ = tokenfile.o program.o declar.o expression.o statement.o 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 \ diff --git a/lang/m2/comp/casestat.C b/lang/m2/comp/casestat.C index b3ef54b3f..9ba52fb2e 100644 --- a/lang/m2/comp/casestat.C +++ b/lang/m2/comp/casestat.C @@ -15,6 +15,7 @@ static char *RcsId = "$Header$"; #include "type.h" #include "LLlex.h" #include "node.h" +#include "desig.h" #include "density.h" @@ -64,7 +65,7 @@ CaseCode(nd, exitlabel) 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; diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index a4f55fd00..5934c4061 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -371,6 +371,12 @@ node_error(arg->nd_left, "type incompatibility in parameter"); 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; } @@ -445,14 +451,20 @@ chk_designator(expp, flag) 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); @@ -472,7 +484,8 @@ df->df_idf->id_text); } } - 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); @@ -628,7 +641,7 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R symbol2str(expp->nd_symb)); return 0; } - + switch(expp->nd_symb) { case '+': case '-': diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c new file mode 100644 index 000000000..f47349e1e --- /dev/null +++ b/lang/m2/comp/code.c @@ -0,0 +1,584 @@ +/* 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 +#include +#include + +#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"); + } +} diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 36c160b34..05acf8948 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -56,16 +56,16 @@ ProcedureHeading(struct def **pdf; int type;) { 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 diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H index 82a5cda77..95037b6fa 100644 --- a/lang/m2/comp/def.H +++ b/lang/m2/comp/def.H @@ -45,10 +45,8 @@ struct field { 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 }; diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c index e52b69f22..7f09be6c2 100644 --- a/lang/m2/comp/desig.c +++ b/lang/m2/comp/desig.c @@ -24,6 +24,10 @@ static char *RcsId = "$Header$"; #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; { @@ -44,7 +48,7 @@ CodeValue(ds, size) break; } - if (size == dwird_size) { + if (size == dword_size) { if (ds->dsg_name) { C_lde_dnam(ds->dsg_name, ds->dsg_offset); } @@ -63,7 +67,7 @@ CodeValue(ds, size) break; default: - assert(0); + crash("(CodeValue)"); } ds->dsg_kind = DSG_LOADED; @@ -101,8 +105,7 @@ CodeAddress(ds) break; default: - assert(0); - break; + crash("(CodeAddress)"); } ds->dsg_offset = 0; @@ -152,13 +155,176 @@ CodeFieldDesig(df, ds) 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"); + } +} diff --git a/lang/m2/comp/desig.h b/lang/m2/comp/desig.h index ffbbb65b3..ac2f37608 100644 --- a/lang/m2/comp/desig.h +++ b/lang/m2/comp/desig.h @@ -44,10 +44,12 @@ struct withdesig { 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) diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c index 17fe39c5c..782ad9b14 100644 --- a/lang/m2/comp/enter.c +++ b/lang/m2/comp/enter.c @@ -64,13 +64,34 @@ EnterIdList(idlist, kind, flags, type, scope, addr) 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; diff --git a/lang/m2/comp/error.c b/lang/m2/comp/error.c index 815888688..38a29fff9 100644 --- a/lang/m2/comp/error.c +++ b/lang/m2/comp/error.c @@ -111,6 +111,20 @@ fatal(fmt, args) 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; diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H index ef74b9932..b9c0eaf0a 100644 --- a/lang/m2/comp/type.H +++ b/lang/m2/comp/type.H @@ -45,7 +45,9 @@ struct record { 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 { diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index a15405cfa..5898569b1 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -149,6 +149,20 @@ init_types() */ 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); diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index 9c4ba1cfd..1ea53dd6e 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -217,8 +217,11 @@ WalkStat(nd, lab) 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)) { @@ -226,18 +229,19 @@ WalkStat(nd, lab) 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 */ @@ -255,13 +259,14 @@ WalkStat(nd, lab) 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); @@ -269,13 +274,14 @@ WalkStat(nd, lab) } 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; } @@ -314,10 +320,9 @@ WalkStat(nd, lab) 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; @@ -335,7 +340,7 @@ WalkStat(nd, lab) case RETURN: if (right) { - WalkExpr(right); + WalkExpr(right, NO_LABEL, NO_LABEL); /* What kind of compatibility do we need here ??? assignment compatibility? */ @@ -352,22 +357,24 @@ node_error(right, "type incompatibility in RETURN statement"); } } -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 */ @@ -376,7 +383,8 @@ WalkExpr(nd) if (! chk_expr(nd)) return; - /* ??? */ + Desig = InitDesig; + CodeExpr(nd, &Desig, true_label, false_label); } WalkDesignator(nd) @@ -389,25 +397,8 @@ 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