123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705 |
- /*
- * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
- * See the copyright notice in the ACK home directory, in the file "Copyright".
- *
- * Author: Ceriel J.H. Jacobs
- */
- /* D E S I G N A T O R E V A L U A T I O N */
- /* $Id$ */
- /* Code generation for designators.
- This file contains some routines that generate code common to address
- as well as value computations, and leave a description in a "desig"
- structure. It also contains routines to load an address, load a value
- or perform a store.
- */
- #include "debug.h"
- #include <em_arith.h>
- #include <em_label.h>
- #include <em_code.h>
- #include <assert.h>
- #include <alloc.h>
- #include "type.h"
- #include "LLlex.h"
- #include "def.h"
- #include "scope.h"
- #include "desig.h"
- #include "node.h"
- #include "warning.h"
- #include "walk.h"
- #include "squeeze.h"
- extern int proclevel;
- extern arith NewPtr();
- extern char options[];
- int
- WordOrDouble(ds, size)
- t_desig *ds;
- arith size;
- {
- /* Check if designator is suitable for word or double-word
- operation
- */
- if ((int) (ds->dsg_offset) % word_align == 0) {
- if (size == word_size) return 1;
- if (size == dword_size) return 2;
- }
- return 0;
- }
- LOL(offset, size)
- arith offset, size;
- {
- if (size == word_size) {
- C_lol(offset);
- }
- else if (size == dword_size) {
- C_ldl(offset);
- }
- else {
- C_lal(offset);
- C_loi(size);
- }
- }
- STL(offset, size)
- arith offset, size;
- {
- if (size == word_size) {
- C_stl(offset);
- }
- else if (size == dword_size) {
- C_sdl(offset);
- }
- else {
- C_lal(offset);
- C_sti(size);
- }
- }
- int
- DoLoad(ds, size)
- register t_desig *ds;
- arith size;
- {
- /* Try to load designator with word or double-word operation.
- Return 0 if not done
- */
- switch (WordOrDouble(ds, size)) {
- default:
- return 0;
- case 1:
- if (ds->dsg_name) {
- C_loe_dnam(ds->dsg_name, ds->dsg_offset);
- }
- else C_lol(ds->dsg_offset);
- break;
- case 2:
- if (ds->dsg_name) {
- C_lde_dnam(ds->dsg_name, ds->dsg_offset);
- }
- else C_ldl(ds->dsg_offset);
- break;
- }
- return 1;
- }
- int
- DoStore(ds, size)
- register t_desig *ds;
- arith size;
- {
- /* Try to store designator with word or double-word operation.
- Return 0 if not done
- */
- switch (WordOrDouble(ds, size)) {
- default:
- return 0;
- case 1:
- if (ds->dsg_name) {
- C_ste_dnam(ds->dsg_name, ds->dsg_offset);
- }
- else C_stl(ds->dsg_offset);
- break;
- case 2:
- if (ds->dsg_name) {
- C_sde_dnam(ds->dsg_name, ds->dsg_offset);
- }
- else C_sdl(ds->dsg_offset);
- break;
- }
- return 1;
- }
- /* Return 1 if the type indicated by tp has a size that is a
- multiple of the word_size and is also word_aligned
- */
- #define word_multiple(tp) \
- ( (int)(tp->tp_size) % (int)word_size == 0 && \
- tp->tp_align >= word_align)
- /* Return 1 if the type indicated by tp has a size that is a proper
- dividor of the word_size, and has alignment >= size or
- alignment >= word_align
- */
- #define word_dividor(tp) \
- ( tp->tp_size < word_size && \
- (int)word_size % (int)(tp->tp_size) == 0 && \
- (tp->tp_align >= word_align || \
- tp->tp_align >= (int)(tp->tp_size)))
- #define USE_LOI_STI 0
- #define USE_LOS_STS 1
- #define USE_LOAD_STORE 2
- #define USE_BLM 3 /* like USE_LOI_STI, but more restricted:
- multiple of word_size only
- */
- STATIC int
- suitable_move(tp)
- register t_type *tp;
- {
- /* Find out how to load or store the value indicated by "ds".
- There are four ways:
- - suitable for BLM/LOI/STI
- - suitable for LOI/STI
- - suitable for LOS/STS/BLS
- - suitable for calls to load/store/blockmove
- */
- if (! word_multiple(tp)) {
- if (word_dividor(tp)) return USE_LOI_STI;
- return USE_LOAD_STORE;
- }
- if (! fit(tp->tp_size, (int) word_size)) return USE_LOS_STS;
- return USE_BLM;
- }
- CodeValue(ds, tp)
- register t_desig *ds;
- register t_type *tp;
- {
- /* Generate code to load the value of the designator described
- in "ds".
- */
- arith sz;
- switch(ds->dsg_kind) {
- case DSG_LOADED:
- break;
- case DSG_FIXED:
- if (DoLoad(ds, tp->tp_size)) break;
- /* Fall through */
- case DSG_PLOADED:
- case DSG_PFIXED:
- switch (suitable_move(tp)) {
- case USE_BLM:
- case USE_LOI_STI:
- #ifndef SQUEEZE
- CodeAddress(ds);
- C_loi(tp->tp_size);
- break;
- #endif
- case USE_LOS_STS:
- CodeAddress(ds);
- CodeConst(tp->tp_size, (int)pointer_size);
- C_los(pointer_size);
- break;
- case USE_LOAD_STORE:
- sz = WA(tp->tp_size);
- if (ds->dsg_kind != DSG_PFIXED) {
- arith tmp = NewPtr();
- CodeAddress(ds);
- STL(tmp, pointer_size);
- CodeConst(-sz, (int) pointer_size);
- C_ass(pointer_size);
- LOL(tmp, pointer_size);
- FreePtr(tmp);
- }
- else {
- CodeConst(-sz, (int) pointer_size);
- C_ass(pointer_size);
- CodeAddress(ds);
- }
- CodeConst(tp->tp_size, (int) pointer_size);
- CAL("load", (int)pointer_size + (int)pointer_size);
- break;
- }
- break;
- case DSG_INDEXED:
- C_lar(word_size);
- break;
- default:
- crash("(CodeValue)");
- }
- ds->dsg_kind = DSG_LOADED;
- }
- ChkForFOR(nd)
- register t_node *nd;
- {
- /* Check for an assignment to a FOR-loop control variable
- */
- if (nd->nd_class == Def) {
- register t_def *df = nd->nd_def;
- if (df->df_flags & D_FORLOOP) {
- node_warning(nd,
- W_ORDINARY,
- "assignment to FOR-loop control variable");
- df->df_flags &= ~D_FORLOOP;
- /* only procude warning once */
- }
- }
- }
- CodeStore(ds, tp)
- register t_desig *ds;
- register t_type *tp;
- {
- /* Generate code to store the value on the stack in the designator
- described in "ds"
- */
- switch(ds->dsg_kind) {
- case DSG_FIXED:
- if (DoStore(ds, tp->tp_size)) break;
- /* Fall through */
- case DSG_PLOADED:
- case DSG_PFIXED:
- CodeAddress(ds);
- switch (suitable_move(tp)) {
- case USE_BLM:
- case USE_LOI_STI:
- #ifndef SQUEEZE
- C_sti(tp->tp_size);
- break;
- #endif
- case USE_LOS_STS:
- CodeConst(tp->tp_size, (int) pointer_size);
- C_sts(pointer_size);
- break;
- case USE_LOAD_STORE:
- CodeConst(tp->tp_size, (int) pointer_size);
- C_cal("store");
- CodeConst(pointer_size + pointer_size + WA(tp->tp_size),
- (int) pointer_size);
- C_ass(pointer_size);
- break;
- }
- break;
- case DSG_INDEXED:
- C_sar(word_size);
- break;
- default:
- crash("(CodeStore)");
- }
- ds->dsg_kind = DSG_INIT;
- }
- CodeCopy(lhs, rhs, sz, psize)
- register t_desig *lhs, *rhs;
- arith sz, *psize;
- {
- /* Do part of a copy, which is assumed to be "reasonable",
- so that it can be done with LOI/STI or BLM.
- */
- t_desig l, r;
- l = *lhs; r = *rhs;
- *psize -= sz;
- lhs->dsg_offset += sz;
- rhs->dsg_offset += sz;
- CodeAddress(&r);
- if (sz <= dword_size) {
- C_loi(sz);
- CodeAddress(&l);
- C_sti(sz);
- }
- else {
- CodeAddress(&l);
- C_blm(sz);
- }
- }
- t_desig null_desig;
- CodeMove(rhs, left, rtp)
- register t_desig *rhs;
- register t_node *left;
- t_type *rtp;
- {
- /* Generate code for an assignment. Testing of type
- compatibility and the like is already done.
- Go through some (considerable) trouble to see if a BLM can be
- generated.
- */
- t_desig lhs;
- register t_type *tp = left->nd_type;
- int loadedflag = 0;
- lhs = null_desig;
- ChkForFOR(left);
- switch(rhs->dsg_kind) {
- case DSG_LOADED:
- CodeDesig(left, &lhs);
- if (rtp->tp_fund == T_STRING) {
- /* size of a string literal fits in an
- int of size word_size
- */
- CodeAddress(&lhs);
- C_loc(rtp->tp_size);
- C_loc(tp->tp_size);
- CAL("StringAssign", (int)pointer_size + (int)pointer_size + (int)dword_size);
- break;
- }
- CodeStore(&lhs, tp);
- break;
- case DSG_FIXED:
- CodeDesig(left, &lhs);
- if (lhs.dsg_kind == DSG_FIXED &&
- fit(tp->tp_size, (int) word_size) &&
- (int) (lhs.dsg_offset) % word_align ==
- (int) (rhs->dsg_offset) % word_align) {
- register int sz = 1;
- arith size = tp->tp_size;
- while (size && sz < word_align) {
- /* First copy up to word-aligned
- boundaries
- */
- if (!((int)(lhs.dsg_offset)%(sz+sz))) {
- sz += sz;
- }
- else CodeCopy(&lhs, rhs, (arith) sz, &size);
- }
- /* Now copy the bulk
- */
- sz = (int) size % (int) word_size;
- size -= sz;
- CodeCopy(&lhs, rhs, size, &size);
- size = sz;
- sz = word_size;
- while (size) {
- /* And then copy remaining parts
- */
- sz >>= 1;
- if (size >= sz) {
- CodeCopy(&lhs, rhs, (arith) sz, &size);
- }
- }
- break;
- }
- CodeAddress(&lhs);
- loadedflag = 1;
- /* Fall through */
- case DSG_PLOADED:
- case DSG_PFIXED:
- assert(! loadedflag || rhs->dsg_kind == DSG_FIXED);
- CodeAddress(rhs);
- if (loadedflag) {
- C_exg(pointer_size);
- }
- else {
- CodeDesig(left, &lhs);
- CodeAddress(&lhs);
- }
- switch (suitable_move(tp)) {
- case USE_BLM:
- #ifndef SQUEEZE
- C_blm(tp->tp_size);
- break;
- #endif
- case USE_LOS_STS:
- CodeConst(tp->tp_size, (int) pointer_size);
- C_bls(pointer_size);
- break;
- case USE_LOAD_STORE:
- case USE_LOI_STI:
- CodeConst(tp->tp_size, (int) pointer_size);
- CAL("blockmove", 3 * (int)pointer_size);
- break;
- }
- break;
- default:
- crash("CodeMove");
- }
- }
- CodeAddress(ds)
- register t_desig *ds;
- {
- /* Generate code to load the address of the designator described
- in "ds"
- */
- switch(ds->dsg_kind) {
- case DSG_PLOADED:
- if (ds->dsg_offset) {
- C_adp(ds->dsg_offset);
- }
- break;
- case DSG_FIXED:
- if (ds->dsg_name) {
- C_lae_dnam(ds->dsg_name, ds->dsg_offset);
- break;
- }
- C_lal(ds->dsg_offset);
- if (ds->dsg_def) ds->dsg_def->df_flags |= D_NOREG;
- break;
-
- case DSG_PFIXED:
- if (! DoLoad(ds, pointer_size)) {
- assert(0);
- }
- break;
- case DSG_INDEXED:
- C_aar(word_size);
- break;
- default:
- crash("(CodeAddress)");
- }
- ds->dsg_offset = 0;
- ds->dsg_kind = DSG_PLOADED;
- }
- CodeFieldDesig(df, ds)
- register t_def *df;
- register t_desig *ds;
- {
- /* Generate code for a field designator. Only the code common for
- address as well as value computation is generated, and the
- resulting information on where to find the designator is placed
- in "ds". "df" indicates the definition of the field.
- */
- if (ds->dsg_kind == DSG_INIT) {
- /* In a WITH statement. We must find the designator in the
- WITH statement, and act as if the field is a selection
- of this designator.
- So, first find the right WITH statement, which is the
- first one of the proper record type, which is
- recognized by its scope indication.
- */
- register struct withdesig *wds = WithDesigs;
- assert(wds != 0);
- while (wds->w_scope != df->df_scope) {
- wds = wds->w_next;
- assert(wds != 0);
- }
- /* Found it. Now, act like it was a selection.
- */
- *ds = wds->w_desig;
- wds->w_flags |= df->df_flags;
- assert(ds->dsg_kind == DSG_PFIXED);
- }
- switch(ds->dsg_kind) {
- case DSG_PLOADED:
- case DSG_FIXED:
- ds->dsg_offset += df->fld_off;
- break;
- case DSG_PFIXED:
- case DSG_INDEXED:
- CodeAddress(ds);
- ds->dsg_kind = DSG_PLOADED;
- ds->dsg_offset = df->fld_off;
- break;
- default:
- crash("(CodeFieldDesig)");
- }
- }
- CodeVarDesig(df, ds)
- register t_def *df;
- register t_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 t_scope *sc = df->df_scope;
- int difflevel;
- /* Selections from a module are handled earlier, when identifying
- the variable, so ...
- */
- assert(ds->dsg_kind == DSG_INIT);
- if (df->df_flags & D_ADDRGIVEN) {
- /* the programmer specified an address in the declaration of
- the variable. Generate code to push the address.
- */
- CodeConst(df->var_off, (int) 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 ((difflevel = proclevel - sc->sc_level) != 0) {
- /* the variable is local to a statically enclosing procedure.
- */
- assert(difflevel > 0);
- df->df_flags |= D_NOREG;
- if (df->df_flags & (D_VARPAR|D_VALPAR)) {
- /* value or var parameter
- */
- C_lxa((arith) difflevel);
- if ((df->df_flags & D_VARPAR) ||
- IsConformantArray(df->df_type)) {
- /* var parameter or conformant array.
- The address is passed.
- */
- C_adp(df->var_off);
- C_loi(pointer_size);
- ds->dsg_offset = 0;
- ds->dsg_kind = DSG_PLOADED;
- return;
- }
- }
- else C_lxl((arith) difflevel);
- 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) ||
- IsConformantArray(df->df_type)) {
- /* a var parameter; address directly accessible.
- */
- ds->dsg_kind = DSG_PFIXED;
- }
- else ds->dsg_kind = DSG_FIXED;
- ds->dsg_offset = df->var_off;
- ds->dsg_def = df;
- }
- CodeDesig(nd, ds)
- register t_node *nd;
- register t_desig *ds;
- {
- /* Generate code for a designator. Use divide and conquer
- principle
- */
- register t_def *df;
- switch(nd->nd_class) { /* Divide */
- case Def:
- df = nd->nd_def;
- if (nd->nd_NEXT) CodeDesig(nd->nd_NEXT, ds);
- switch(df->df_kind) {
- case D_FIELD:
- CodeFieldDesig(df, ds);
- break;
- case D_VARIABLE:
- CodeVarDesig(df, ds);
- break;
- default:
- crash("(CodeDesig) Def");
- }
- break;
- case Arrsel:
- assert(nd->nd_symb == '[' || nd->nd_symb == ',');
- CodeDesig(nd->nd_LEFT, ds);
- CodeAddress(ds);
- CodePExpr(nd->nd_RIGHT);
- nd = nd->nd_LEFT;
- /* Now load address of descriptor
- */
- if (IsConformantArray(nd->nd_type)) {
- arith off;
- assert(nd->nd_class == Def);
- df = nd->nd_def;
- off = df->var_off + pointer_size;
- if (proclevel > df->df_scope->sc_level) {
- C_lxa((arith) (proclevel - df->df_scope->sc_level));
- C_adp(off);
- }
- else C_lal(off);
- }
- else {
- C_loc(nd->nd_type->arr_low);
- C_sbu(int_size);
- c_lae_dlb(nd->nd_type->arr_descr);
- }
- if (options['A']) {
- C_cal("rcka");
- }
- ds->dsg_kind = DSG_INDEXED;
- break;
- case Arrow:
- assert(nd->nd_symb == '^');
- nd = nd->nd_RIGHT;
- CodeDesig(nd, 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, nd->nd_type);
- 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");
- }
- }
|