f6c43b95ef
--HG-- branch : dtrg-buildsystem rename : lang/pc/build.mk => lang/m2/build.mk rename : lang/pc/libpc/build.mk => lang/m2/comp/build.mk rename : lang/pc/libpc/build.mk => lang/m2/libm2/build.mk
705 lines
14 KiB
C
705 lines
14 KiB
C
/*
|
|
* (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 "parameters.h"
|
|
#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"
|
|
|
|
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");
|
|
}
|
|
}
|