Rev 2 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed
/*
Crown Copyright (c) 1997
This TenDRA(r) Computer Program is subject to Copyright
owned by the United Kingdom Secretary of State for Defence
acting through the Defence Evaluation and Research Agency
(DERA). It is made available to Recipients with a
royalty-free licence for its use, reproduction, transfer
to other parties and amendment for any purpose not excluding
product development provided that any such use et cetera
shall be deemed to be acceptance of the following conditions:-
(1) Its Recipients shall ensure that this Notice is
reproduced upon any copies or amended versions of it;
(2) Any amended version of it shall be clearly marked to
show both the nature of and the organisation responsible
for the relevant amendment or amendments;
(3) Its onward transfer from a recipient to another
party shall be deemed to be that party's acceptance of
these conditions;
(4) DERA gives no warranty or assurance as to its
quality or suitability for any purpose and DERA accepts
no liability whatsoever in relation to any use to which
it may be put.
*/
/**********************************************************************
$Author: release $
$Date: 1998/01/17 15:56:06 $
$Revision: 1.1.1.1 $
$Log: new_code.c,v $
* Revision 1.1.1.1 1998/01/17 15:56:06 release
* First version to be checked into rolling release.
*
* Revision 1.39 1996/11/12 10:37:36 currie
* cases with big unsigned
*
Revision 1.38 1996/03/28 11:36:27 currie
minus unsigned with et
* Revision 1.37 1996/03/14 17:09:02 currie
* empty callers with postlude
*
* Revision 1.36 1996/01/30 12:36:31 currie
* leaf vcallees with current_env
*
* Revision 1.35 1996/01/17 10:25:02 currie
* tidy transformed idents of idents
*
* Revision 1.34 1996/01/10 17:59:28 currie
* postlude uses in callees
*
* Revision 1.33 1996/01/09 12:00:48 currie
* var callee par in reg
*
* Revision 1.32 1996/01/08 17:05:27 currie
* current_env in depends_on
*
* Revision 1.31 1996/01/02 15:00:57 currie
* return 64-bit const
*
* Revision 1.30 1995/12/08 11:20:06 currie
* Constant offsets + allocaerr_lab
*
* Revision 1.29 1995/11/23 13:17:25 currie
* Cache real consts + get text file name right in diags
*
* Revision 1.28 1995/10/31 17:46:10 currie
* max-min register error
*
* Revision 1.27 1995/10/31 15:04:55 currie
* div1 error
*
* Revision 1.26 1995/10/25 13:48:23 currie
* change to position of .glob
*
* Revision 1.25 1995/10/23 11:18:25 currie
* put in gpword for switches in PIC-code
*
* Revision 1.24 1995/10/20 10:48:01 currie
* avs -slow + attempts to cheat buggy scheduler
*
* Revision 1.23 1995/10/06 14:46:26 currie
* nops in round
*
* Revision 1.22 1995/09/26 09:00:54 currie
* tail call errors in sieve
*
* Revision 1.21 1995/09/21 15:42:51 currie
* silly reordering by as again
*
* Revision 1.20 1995/09/20 14:23:02 currie
* callee-list blunder + fix for silliness in ultrix assembler
*
* Revision 1.19 1995/09/12 10:59:39 currie
* gcc pedanttry
*
* Revision 1.18 1995/08/21 16:13:23 currie
* var pars
*
* Revision 1.17 1995/08/16 16:06:58 currie
* Shortened some .h names
*
* Revision 1.16 1995/08/15 12:20:24 currie
* Dynamic callees!??
*
* Revision 1.15 1995/08/15 10:47:29 currie
* Dynamic callees - protect parregs & link
*
* Revision 1.14 1995/08/15 09:19:29 currie
* Dynamic callees + trap_tag
*
* Revision 1.13 1995/08/10 08:49:40 currie
* var callee tail call
*
* Revision 1.12 1995/08/09 10:53:42 currie
* apply_general bug
*
* Revision 1.11 1995/07/06 17:12:28 currie
* tail call again
*
* Revision 1.10 1995/07/05 11:44:32 currie
* Postlude names in bits!
*
* Revision 1.9 1995/07/05 08:42:40 currie
* Various tail call bugs
*
* Revision 1.7 1995/07/03 15:31:55 currie
* untidy call
*
* Revision 1.6 1995/07/03 10:09:32 currie
* untidy return
*
* Revision 1.5 1995/06/29 16:30:19 currie
* Tail call errors
*
* Revision 1.4 1995/06/28 12:15:24 currie
* New make_stack_limit etc
*
* Revision 1.3 1995/05/05 08:13:01 currie
* initial_value + signtures
*
* Revision 1.2 1995/04/19 16:10:37 currie
* Unset variables - purify
*
* Revision 1.1 1995/04/13 09:08:06 currie
* Initial revision
*
***********************************************************************/
/* new_code.c
This is the principal code producing module
****************************************************************/
#include "config.h"
#include "common_types.h"
#include "addrtypes.h"
#include "tags.h"
#include "expmacs.h"
#include "exp.h"
#include "exptypes.h"
#include "externs.h"
#include "loc_signal.h"
#include "maxminmacs.h"
#include "shapemacs.h"
#include "basicread.h"
#include "procrectypes.h"
#include "eval.h"
#include "move.h"
#include "operators.h"
#include "psu_ops.h"
#include "getregs.h"
#include "guard.h"
#include "locate.h"
#include "code_here.h"
#include "inst_fmt.h"
#include "mips_ins.h"
#include "handle_sregs.h"
#include "bitsmacs.h"
#include "labels.h"
#include "regexps.h"
#include "special.h"
#include "new_tags.h"
#include "out_ba.h"
#include "ibinasm.h"
#include "syms.h"
#include "flags.h"
#include "main.h"
#include "dump_distr.h"
#include "extratags.h"
#include "mipsdiags.h"
#include "frames.h"
#include "f64.h"
#include "regable.h"
#include "diag_fns.h"
#include "flpt.h"
#include "new_code.h"
extern FILE * as_file;
extern int current_symno;
extern procrec * procrecs;
long fscopefile;
ans procans;
int rscope_level;
int rscope_label;
int result_label = 0;
int currentnop;
long max_args;
where nowhere;
static exp crt_proc;
bool NONEGSHIFTS = 1;
long aritherr_lab = 0;
long stackerr_lab = 0;
long allocaerr_lab = 0;
extern exp find_named_tg PROTO_S ((char *, shape));
extern shape f_pointer PROTO_S ((alignment));
extern alignment f_alignment PROTO_S ((shape));
extern shape f_proc;
typedef struct{int dble; r2l r; instore ad;} rcache;
static rcache rca[16];
static int nca = 0;
void do_exception
PROTO_N ( (e) )
PROTO_T ( int e )
{
baseoff b;
b.base = 0; b.offset = e;
ls_ins(i_li, 4, b);
b = boff(find_named_tg("__TDFhandler", f_pointer(f_alignment(f_proc))));
ls_ins(i_lw, 25, b);
br_ins(i_j, 25);
}
long trap_label
PROTO_N ( (e) )
PROTO_T ( exp e )
{
if ((errhandle(e)&3)==3) {
if (aritherr_lab==0) aritherr_lab = new_label();
return aritherr_lab;
}
else return no (son (pt (e)));
}
void dump_gp
PROTO_Z ()
{
baseoff b;
b.base = 29; b.offset = locals_offset>>3;
ls_ins(i_sw, 28, b);
}
void reset_gp
PROTO_Z ()
{
baseoff b;
if (Has_vcallees) {
b.base = local_reg;
b.offset = (locals_offset - frame_size)>>3;
}
else
if (Has_fp) {
b.base = 30;
b.offset = (locals_offset - frame_size - callee_size)>>3;
}
else {
b.base = 29;
b.offset = locals_offset>>3;
}
ls_ins(i_lw, 28, b);
}
bool unsafe
PROTO_N ( (e) )
PROTO_T ( exp e )
{ /* usages of parameters which might be
vararg */
/*
if (last (e))
return (name (bro (e)) != cont_tag && name (bro (e)) != par_tag);
if (last (bro (e)) && name (bro (bro (e))) == ass_tag)
return 0;
if (name (father (e)) == par_tag)
return 0;
if (last (bro (e)) && name (bro (bro (e))) == ident_tag) {
exp u;
if (isvar (bro (bro (e))))
return 1;
for (u = pt (bro (bro (e))); u != nilexp; u = pt (u)) {
if (unsafe (u))
return 1;
}
return 0;
}
return 1;
*/ failer("unsafe");
return 1;
}
void checknan
PROTO_N ( (e, sp) )
PROTO_T ( exp e X space sp )
{
long trap = trap_label(e);
int r1 = getreg(sp.fixed);
int r2 = getreg(guardreg(r1, sp).fixed);
cop_ins(i_cfc1, r1, 31);
rri_ins(i_and, r2, r1, 0x70); /* not including underflo - my choice */
rrr_ins(i_xor, r1, r1, r2);
cop_ins(i_ctc1, r1, 31);
condri_ins(i_bne, r2, 0, trap);
}
/*
char *usbranches (i)
int i;
{
switch (i) {
case 1:
return i_bleu;
case 2:
return i_bltu;
case 3:
return i_bgeu;
case 4:
return i_bgtu;
case 5:
return i_bne;
case 6:
return i_beq;
}
}
*/
void testsigned
PROTO_N ( (r, lower, upper, lab) )
PROTO_T ( int r X long lower X long upper X long lab )
{
condri_ins(i_blt, r, lower, lab);
condri_ins(i_bgt, r, upper, lab);
}
void testusigned
PROTO_N ( (r, maxval, lab) )
PROTO_T ( int r X long maxval X long lab )
{
condri_ins(i_bgtu, r, maxval, lab);
}
/*
char *sbranches(i)
int i;
{
switch (i) {
case 1:
return i_ble;
case 2:
return i_blt;
case 3:
return i_bge;
case 4:
return i_bgt;
case 5:
return i_bne;
case 6:
return i_beq;
}
}
*/
char * branches
PROTO_N ( (s, i) )
PROTO_T ( shape s X int i )
{
int n = name(s);
if (n == scharhd || n == swordhd || n == slonghd
|| n == offsethd) {
switch (i) {
case 1:
return i_ble;
case 2:
return i_blt;
case 3:
return i_bge;
case 4:
return i_bgt;
case 5:
return i_bne;
case 6:
return i_beq;
}
}
else {
switch (i) {
case 1:
return i_bleu;
case 2:
return i_bltu;
case 3:
return i_bgeu;
case 4:
return i_bgtu;
case 5:
return i_bne;
case 6:
return i_beq;
}
}
return i_beq;
}
/*
char *ussets
PROTO_N ( (i) )
PROTO_T ( int i )
{
switch (i) {
case 1:
return i_sgtu;
case 2:
return i_sgeu;
case 3:
return i_sltu;
case 4:
return i_sleu;
case 5:
return i_seq;
case 6:
return i_sne;
}
}
char *ssets
PROTO_N ( (i) )
PROTO_T ( int i )
{
switch (i) {
case 1:
return i_sgt;
case 2:
return i_sge;
case 3:
return i_slt;
case 4:
return i_sle;
case 5:
return i_seq;
case 6:
return i_sne;
}
}
*/
char * sets
PROTO_N ( (s, i) )
PROTO_T ( shape s X int i )
{
int n = name(s);
if (n == scharhd || n == swordhd || n == slonghd
|| n == offsethd) {
switch (i) {
case 1:
return i_sgt;
case 2:
return i_sge;
case 3:
return i_slt;
case 4:
return i_sle;
case 5:
return i_seq;
case 6:
return i_sne;
}
}
else {
switch (i) {
case 1:
return i_sgtu;
case 2:
return i_sgeu;
case 3:
return i_sltu;
case 4:
return i_sleu;
case 5:
return i_seq;
case 6:
return i_sne;
}
}
return i_seq;
}
char *fbranches
PROTO_N ( (i) )
PROTO_T ( int i )
{
switch (i) {
case 1:
return i_c_le_s;
case 2:
return i_c_lt_s;
case 3:
return i_c_lt_s;
case 4:
return i_c_le_s;
case 5:
return i_c_eq_s;
case 6:
return i_c_eq_s;
}
return i_c_eq_s;
}
char *fdbranches
PROTO_N ( (i) )
PROTO_T ( int i )
{
switch (i) {
case 1:
return i_c_le_d;
case 2:
return i_c_lt_d;
case 3:
return i_c_lt_d;
case 4:
return i_c_le_d;
case 5:
return i_c_eq_d;
case 6:
return i_c_eq_d;
}
return i_c_eq_d;
}
long notbranch[6] = {
4, 3, 2, 1, 6, 5
};
/* used to invert TDF tests */
int bitsin
PROTO_N ( (b) )
PROTO_T ( long b )
{ /* counts the bits in b */
int n = 0;
long mask = 1;
for (; b != 0;) {
n += ((b & mask) != 0) ? 1 : 0;
b &= ~mask;
mask = mask << 1;
}
return n;
}
void move_dlts
PROTO_N ( (dr, sr, szr, mr, bytemove) )
PROTO_T ( int dr X int sr X int szr X int mr X int bytemove )
{
/* move szr bytes to dr from sr (use mr)- either nooverlap or dr<=sr */
baseoff b;
int lin = new_label();
b.offset =0;
set_label(lin);
b.base = sr;
ls_ins((bytemove)?i_lb:i_lw, mr, b);
rri_ins(i_addu, sr, sr, (bytemove)?1:4);
b.base = dr;
ls_ins((bytemove)?i_sb:i_sw, mr, b);
rri_ins(i_addu, dr, dr, (bytemove)?1:4);
rri_ins(i_subu, szr, szr, (bytemove)?1:4);
condrr_ins(i_bne, szr, 0, lin);
}
void move_dgts
PROTO_N ( (dr, sr, szr, mr, bytemove) )
PROTO_T ( int dr X int sr X int szr X int mr X int bytemove )
{
/* move szr bytes to dr from sr (use mr) with overlap and dr>sr */
baseoff b;
int lin = new_label();
b.offset = (bytemove)?-1:-4;
rrr_ins(i_addu, dr,dr, szr);
rrr_ins(i_addu, sr,sr, szr);
set_label(lin);
b.base = sr;
ls_ins((bytemove)?i_lb:i_lw, mr, b);
rri_ins(i_subu, sr, sr, (bytemove)?1:4);
b.base = dr;
ls_ins((bytemove)?i_sb:i_sw, mr, b);
rri_ins(i_subu, dr, dr, (bytemove)?1:4);
rri_ins(i_subu, szr, szr, (bytemove)?1:4);
condrr_ins(i_bne, szr, 0, lin);
}
void reset_tos
PROTO_Z ()
{
if (Has_tos) {
baseoff b;
b.base = 30;
b.offset = -8;
ls_ins(i_sw, 29, b);
}
}
exp testlast
PROTO_N ( (e, second) )
PROTO_T ( exp e X exp second )
{
/* finds the last test in sequence e which is a branch to second, if
any, otherwise nil */
if (name (e) == test_tag && pt (e) == second) {
return (e);
}
if (name (e) == seq_tag) {
if (name (bro (son (e))) == test_tag && pt (bro (son (e))) == second) {
return bro (son (e));
}
else
if (name (bro (son (e))) == top_tag) {
exp list = son (son (e));
for (;;) {
if (last (list)) {
if (name (list) == test_tag && pt (list) == second) {
return list;
}
else {
return 0;
}
}
else {
list = bro (list);
}
}
}
}
return 0;
}
bool last_param
PROTO_N ( (e) )
PROTO_T ( exp e )
{
if (!isparam(e)) return 0;
e = bro(son(e));
aa: if (name(e)==ident_tag && isparam(e)
&& name(son(e)) != formal_callee_tag
) return 0;
if (name(e) == diagnose_tag) {
e = son(e); goto aa;
}
return 1;
}
int regfrmdest
PROTO_N ( (dest, sp) )
PROTO_T ( where * dest X space sp )
{
switch (dest->answhere.discrim) {
case inreg:
{
int r = regalt (dest->answhere);
if (r!=0) return r;
}
default:
{
return getreg (sp.fixed);
}
}
}
space do_callers
PROTO_N ( (list,sp) )
PROTO_T ( exp list X space sp )
{ int disp =0;
int spar = 4;
int fpar = 6;
bool hadfixed = 0;
for (;;) { /* evaluate parameters in turn */
int hd = name (sh (list));
instore is;
where w;
ash ap;
int paral;
int parsize;
exp par;
par = (name(list)==caller_tag)?son(list):list;
ap = ashof (sh (list));
paral = (ap.ashalign < 32)?32:ap.ashalign;
parsize = ap.ashsize;
w.ashwhere = ap;
disp = rounder(disp,paral);
spar = 4+ (disp>>5);
is.b.base = 29;
is.b.offset = disp >> 3;
is.adval = 1;
if (disp>96) {spar =8; fpar = 8; }
if (is_floating(hd) && disp+parsize <= 128) {
freg frg;
ans ansfr;
frg.fr = fpar++;
frg.dble = (hd != shrealhd) ? 1 : 0;
setfregalt (ansfr, frg);
w.answhere = ansfr;
code_here (par, sp, w);
/* eval parameter into floating parameter register */
sp = guardfreg(frg.fr, sp);
if (hadfixed) {
setregalt (w.answhere, spar);
move (ansfr, w, sp, 1);
sp = guardreg(spar, sp);
if (hd != shrealhd) { sp = guardreg(spar+1, sp); }
}
}
else
if (valregable (sh (list)) && disp+parsize <=128) {
ans ansr;
setregalt (ansr, spar);
w.answhere = ansr;
hadfixed = 1;
code_here (par, sp, w);
/* eval parameter into fixed parameter register */
sp = guardreg (spar, sp);
}
else {
setinsalt (w.answhere, is);
code_here (par, sp, w);
hadfixed = 1;
/* eval parameter into argument space on stack */
while (spar <= 7 && ap.ashsize >0) {
/* copy (parts of) any struct results into parregs */
ls_ins(i_lw, spar, is.b);
sp =guardreg(spar++, sp);
is.b.offset +=4;
ap.ashsize-=32;
}
}
if(name(list)== caller_tag) { no(list) = disp; }
disp+=parsize;
disp = rounder(disp, 32);
if (last (list)) return sp;
list = bro (list);
} /* end for */
}
void load_reg
PROTO_N ( (e, r, sp) )
PROTO_T ( exp e X int r X space sp )
{
where w;
w.ashwhere = ashof(sh(e));
setregalt(w.answhere, r);
code_here(e, sp, w);
}
static int diagPIClab;
typedef struct postl_ {exp pl; struct postl_ * outer; } postl_chain;
static postl_chain * old_pls;
void update_plc
PROTO_N ( (ch, ma) )
PROTO_T ( postl_chain * ch X int ma )
{
while (ch != (postl_chain*)0) {
exp pl= ch->pl;
while (name(pl)==ident_tag && name(son(pl))==caller_name_tag) {
no(pl)+= (ma<<1);
pl = bro(son(pl));
}
ch = ch->outer;
}
}
void do_callee_list
PROTO_N ( (e, sp) )
PROTO_T ( exp e X space sp )
{
long x = ((no(e)>>3)+23) & ~7;
exp list = son(e);
instore is;
where w;
baseoff b;
long disp;
ash ap;
disp = 0;
rri_ins(i_subu, 29, 29, x);
b.base = 29; b.offset = x-4;
ls_ins(i_sw, 30, b);
update_plc(old_pls, x<<3);
if (no(e)!= 0) {
for(;;) {
ap = ashof(sh(list));
disp = rounder(disp, ap.ashalign);
is.b.offset = disp>>3;
is.b.base = 29; is.adval = 1;
w.ashwhere = ap;
setinsalt(w.answhere, is);
code_here(list, sp, w);
disp = rounder(disp+ap.ashsize, 32);
if (last(list)) break;
list = bro(list);
}
}
update_plc(old_pls, -(x<<3));
}
exp find_ote
PROTO_N ( (e, n) )
PROTO_T ( exp e X int n )
{
exp d = father(e);
while (name(d)!=apply_general_tag) d = father(d);
d = son(bro(son(d))); /* list otagexps */
while(n !=0) { d = bro(d); n--;}
Assert(name(d)==caller_tag);
return d;
}
makeans make_code
PROTO_N ( (e, sp, dest, exitlab) )
PROTO_T ( exp e X space sp X where dest X int exitlab )
{
/* produce code for expression e, putting its result in dest using
t-regs given by sp. If non-zero, exitlab is the label of where the
code is to continue */
long constval;
makeans mka;
tailrecurse:
mka.lab = exitlab;
mka.regmove = NOREG;
switch (name (e)) {
case ident_tag:
{
where placew;
int r = NOREG;
bool remember = 0;
if (props (e) & defer_bit) {/* the tag of this declaration is
transparently identified with its
definition, without reserving more
space */
e = bro (son (e));
goto tailrecurse;
}
if (son (e) == nilexp) {/* I think this is historical - unused
tags are now removed cleanly */
placew = nowhere;
}
else
if (name(son(e)) == caller_name_tag) {
exp ote = find_ote(e,no(son(e)));
long disp = no(ote);
no(e) = (disp<<1)+29;
placew = nowhere;
}
else {
ash a;
int n = no (e);
a = ashof (sh (son (e)));
if ((props (e) & inreg_bits) != 0) {
/* tag in some fixed pt reg */
if (n == 0) { /* if it hasn't been already allocated
into a s-reg (or r2) allocate tag into
fixed t-reg ... */
int s = sp.fixed;
if (props (e) & notparreg)/* ... but not a parameter reg */
s |= 0xf0;
n = getreg (s);
no (e) = n;
}
setregalt (placew.answhere, n);
}
else
if ((props (e) & infreg_bits) != 0) {
/* tag in some float reg */
freg frg;
if (n == 0) { /* if it hasn't been already allocated
into a s-reg (or r0) allocate tag into
float-reg ... */
int s = sp.flt;
if (props (e) & notparreg)
s |= 0xc0;
n = getfreg (s);
no (e) = n;
}
else
if (n == 16) { /* result reg */
n = 0;
no (e) = 0;
}
frg.fr = n;
frg.dble = (a.ashsize == 64) ? 1 : 0;
setfregalt (placew.answhere, frg);
}
else
if (isparam(e) ) {
if(name(son(e))!=formal_callee_tag) {
long n = (no(son(e)) + frame_size +callee_size)>>3 ; /* byte disp of params */
instore is;
is.adval =1;
no(e) = ((no(son(e))+frame_size+callee_size-locals_offset)<<1)+29+Has_fp;
if ((!Has_no_vcallers ||
(isvis(e) && props(son(e)) != 0)) && last_param(e) ){
/* vararg in reg ? */
int r = rounder(no(son(e))+shape_size(sh(son(e))), 32);
while(r<=96) {
is.b.offset = (r+((Has_fp)?0
:frame_size+callee_size))>>3;
is.b.base = 29+Has_fp;
ls_ins(i_sw, 4+(r>>5), is.b);
r+=32;
}
}
if (shape_size(sh(son(e)))==0) {
/* vararg ... param */
e = bro(son(e));
goto tailrecurse;
}
is.b.offset = (Has_fp)? (no(son(e))>>3):n;
is.b.base = 29 + Has_fp;
if (BIGEND && props(son(e)) != 0 && shape_size(sh(son(e)))<32) {
is.b.offset += (shape_size(sh(son(e)))==8)?3:2;
/* short promotions */
}
setinsalt(placew.answhere, is);
remember =1;
}
else {
no(e) = ( ( no(son(e)) +frame_size - locals_offset)<<1)
+ ((Has_vcallees)?local_reg:30);
placew = nowhere;
}
}
else { /* allocate on stack */
int base = n & 0x3f;
instore is;
is.b.base = base;
is.b.offset = (n - base) >> 4;
is.adval = 1;
if (base == 29 ) {
is.b.offset += locals_offset >> 3;
}
else
if ((base==30 && Has_fp) ) {
is.b.offset += ((locals_offset-frame_size-callee_size) >> 3);
}
else
if ( (base == local_reg && Has_vcallees)) {
is.b.offset += ((locals_offset -frame_size) >> 3);
}
setinsalt (placew.answhere, is);
remember = 1;
}
placew.ashwhere = a;
}
if (isparam(e)
&& name(son(e))!=formal_callee_tag) {
exp se = son(e);
exp d = e;
/* parameter fiddles */
if (props(se) == 0 && (props(d) & inanyreg) !=0) {
/* not originally in required reg */
ans a;
instore is;
is.b.base = 29 + Has_fp;
is.b.offset = (no(se) +
((Has_fp)?0:(frame_size+callee_size)))>>3;
is.adval = 0;
if (BIGEND && shape_size(sh(son(e)))<32) {
is.b.offset += (shape_size(sh(son(e)))==8)?3:2;
/* short promotions */
}
setinsalt(a, is);
IGNORE move(a, placew, sp, is_signed(sh(se)));
}
else
if (props(se) !=0 && (props(d) & inanyreg) ==0) {
/* originally in reg and required in store */
ans a;
if (is_floating(name(sh(se))) ) {
freg fr;
fr.fr = props(se);
fr.dble = (name(sh(se)) != shrealhd);
setfregalt(a, fr);
}
else { setregalt(a, props(se)); }
r = move(a, placew, sp, 0);
}
else
if (props(se) !=0 && props(se) != no(d) ) {
/* in wrong register */
int sr = no(d);
int tr = props(se);
if (is_floating(name(sh(se))) ) {
if ((fltdone & (3<<(sr<<1))) != 0) {
rrfp_ins( (name(sh(se)) != shrealhd) ? i_mov_d: i_mov_s,
no(d)<<1, props(se)<<1 );
}
else {
props(se) = sr; no(d)= tr;
sp = guardfreg(tr, sp);
/* !? swopped and moved in dump_tag !? */
}
}
else {
if ( (fixdone & (1<<sr)) !=0 ) {
mon_ins(i_move, no(d), props(se) );
}
else {
props(se) = sr; no(d)= tr;
sp = guardreg(tr,sp);
/* !? swopped for dump_tag !? */
}
}
}
/* maybe more about promotions */
}
else
if (isparam(e) && name(son(e))==formal_callee_tag) {
exp se = son(e);
exp d = e;
if ((props(d) & inanyreg) != 0) {
/* callee parameter assigned to reg */
ans a;
instore is;
if (Has_vcallees) {
is.b.base = local_reg;
is.b.offset = (no(se))>>3;
}
else {
is.b.base = 30;
is.b.offset = (no(se) - callee_size)>>3;
}
is.adval = 0;
setinsalt(a, is);
IGNORE move(a, placew, sp, is_signed(sh(se)));
}
}
else
r = code_here (son (e), sp, placew);
/* evaluate the initialisation of tag, putting it into place
allocated ... */
if (remember && r != NOREG && pt (e) != nilexp && no(pt(e))==0
&& eq_sze (sh (son (e)), sh (pt (e)))) {
/* ...if it was temporarily in a register, remember it */
if (isvar (e)) {
keepcont (pt (e), r);
}
else {
keepreg (pt (e), r);
}
}
sp = guard (placew, sp);
e = bro (son (e));
goto tailrecurse;
/* and evaluate the body of the declaration */
} /* end ident */
case clear_tag: {
return mka;
}
case seq_tag:
{
exp t = son (son (e));
for (;;) {
exp next = (last (t)) ? (bro (son (e))) : bro (t);
if (name (next) == goto_tag) {/* gotos end sequences */
make_code (t, sp, nowhere, no (son (pt (next))));
}
else {
code_here (t, sp, nowhere);
}
if (last (t)) {
e = bro (son (e));
goto tailrecurse;
}
t = bro (t);
}
} /* end seq */
case cond_tag:
{
exp first = son (e);
exp second = bro (son (e));
exp test;
if (dest.answhere.discrim == insomereg) {
/* must make choice of register to contain answer to cond */
int *sr = someregalt (dest.answhere);
if (*sr != -1) {
failer ("Somereg *2");
}
*sr = getreg (sp.fixed);
setregalt (dest.answhere, *sr);
}
else
if (dest.answhere.discrim == insomefreg) {
somefreg sfr;
freg fr;
sfr = somefregalt(dest.answhere);
if (*sfr.fr != -1) { failer ("Somefreg *2"); }
*sfr.fr = getfreg(sp.flt);
fr.fr = *sfr.fr;
fr.dble = sfr.dble;
setfregalt(dest.answhere, fr);
}
if (name (first) == goto_tag && pt (first) == second) {
/* first is goto second */
no (son (second)) = 0;
return make_code (second, sp, dest, exitlab);
}
else
if (name (second) == labst_tag &&
name (bro (son (second))) == top_tag) {
/* second is empty */
int endl = (exitlab == 0) ? new_label () : exitlab;
no (son (second)) = endl;
make_code (first, sp, dest, endl);
mka.lab = endl;
return mka;
}
else
if (name (second) == labst_tag &&
name (bro (son (second))) == goto_tag) {
/* second is goto */
exp g = bro (son (second));
no (son (second)) = no (son (pt (g)));
return make_code (first, sp, dest, exitlab);
}
if (test = testlast (first, second) /* I mean it */ ) {
/* effectively an empty then part */
int l = (exitlab != 0) ? exitlab : new_label ();
bool rev = IsRev(test);
ptno(test) = -l; /* make test jump to exitlab - see
test_tag: */
props (test) = notbranch[(props (test)&127) - 1];
if (rev) { SetRev(test); }
/* ... with inverse test */
no (son (second)) = new_label ();
make_code (first, sp, dest, l);
make_code (second, sp, dest, l);
mka.lab = l;
return mka;
}
else {
int fl;
no (son (second)) = new_label ();
fl = make_code (first, sp, dest, exitlab).lab;
{
int l = (fl != 0) ? fl : ((exitlab != 0) ? exitlab : new_label ());
/* Alteration 4 */
if (name(sh(first))!= bothd || l == rscope_label) uncond_ins (i_b, l);
make_code (second, sp, dest, l);
clear_all ();
mka.lab = l;
return mka;
}
}
} /* end cond */
case labst_tag:
{
if (no (son (e)) != 0) {
set_label (no (son (e)));
}
if (is_loaded_lv(e) && No_S) { /* can be target of long_jump; reset sp */
baseoff b;
b.base = 30;
if (Has_vcallees) {
b.offset = -12;
ls_ins(i_lw, local_reg, b);
}
if (Has_tos) {
b.offset = -8;
ls_ins(i_lw, 29, b);
}
else {
rri_ins(i_subu, 29, 30, (frame_size+callee_size)>>3);
}
}
e = bro (son (e));
goto tailrecurse;
} /* end labst */
case rep_tag:
{
exp first = son (e);
exp second = bro (first);
/* Alteration 1: adds this line :- */
code_here(first, sp, nowhere);
no (son (second)) = new_label ();
e = second;
goto tailrecurse;
} /* end rep */
case goto_tag:
{
exp gotodest = pt(e);
int lab = no (son (gotodest));
clear_all ();
if (!last(e) || name(bro(e))!=seq_tag || !last(bro(e)) ||
last(bro(bro(e))) || bro(bro(bro(e))) != gotodest) {
uncond_ins (i_b, lab);
} /* dest is next in sequence */
return mka;
} /* end goto */
case make_lv_tag: {
int r = regfrmdest(&dest,sp);
ans aa;
condr_ins(i_la, r, no(son(pt(e))) ); /*???? */
setregalt(aa,r);
move(aa,dest, guardreg(r,sp), 0);
mka.regmove = r;
return mka;
}
case long_jump_tag: {
int fp = reg_operand(son(e), sp);
int labval = reg_operand(bro(son(e)), sp);
mon_ins(i_move, 30, fp);
br_ins(i_j, labval);
return mka;
}
case max_tag: case min_tag: case offset_max_tag:
{
exp l = son (e);
exp r = bro (l);
shape shl = sh(l);
int a1, a2, d;
ans aa;
space nsp;
char * setins = sets(shl,3);
int lab = new_label();
a1 = reg_operand(l, nsp);
nsp = guardreg(a1, sp);
d = regfrmdest(&dest, nsp);
if (d==a1) d = getreg(nsp.fixed);
nsp = guardreg(d, nsp);
if (name(r)== val_tag) {
rri_ins (setins, d, a1, no (r));
}
else {
a2 = reg_operand (r, nsp);
if (d==a2) d = getreg(guardreg(a2,nsp).fixed);
rrr_ins (setins, d, a1, a2);
}
setnoreorder();
condri_ins((name(e)!=min_tag)?i_beq:i_bne, d, 0, lab);
rrr_ins(i_addu, d, a1, 0);
if (name(r)==val_tag) {
baseoff b;
b.base = 0;
b.offset = no(r);
ls_ins(i_li, d, b);
}
else rrr_ins(i_addu,d,a2, 0);
set_label_no_clear(lab);
setreorder();
setregalt (aa, d);
move (aa, dest, guardreg (d, sp), 0);
mka.regmove = d;
return mka;
}
case absbool_tag: case maxlike_tag: case minlike_tag: case abslike_tag:
{
exp l = son (son (e));
exp r = bro (l);
shape shl = sh (l);
char *setins;
int n = props (son (e));
int d;
int a1;
int a2;
bool xlike = (name(e) != absbool_tag);
ans aa;
if (!xlike && name (l) == val_tag) {/* put literal operand on right */
exp temp = l;
l = r;
r = temp;
if (n <= 2) {
n += 2;
}
else
if (n <= 4) {
n -= 2;
}
}
setins = sets(shl, n);
/* chose set instruction from test and shape */
d = regfrmdest(&dest, sp);
/* reg d will contain result of set (eventually) */
a1 = reg_operand (l, sp);
if (xlike && a1==d) {
sp = guardreg(a1, sp);
d = getreg(sp.fixed);
}
if (name (r) == val_tag) {
rri_ins (setins, d, a1, no (r));
}
else {
space nsp;
nsp = guardreg (a1, sp);
a2 = reg_operand (r, nsp);
if (xlike && a2==d) {
nsp = guardreg(a2, nsp);
d = getreg(nsp.fixed);
}
rrr_ins (setins, d, a1, a2);
}
if (name(e)==maxlike_tag || name(e)==minlike_tag) {
int l = new_label();
setnoreorder();
condri_ins((name(e)==maxlike_tag)?i_bne:i_beq, d, 0, l);
rrr_ins(i_addu, d, a1, 0);
if (name(r)==val_tag) {
baseoff b;
b.base = 0;
b.offset = no(r);
ls_ins(i_li, d, b);
}
else rrr_ins(i_addu,d,a2, 0);
set_label_no_clear(l);
setreorder();
}
else
if (name(e)==abslike_tag) {
int l = new_label();
setnoreorder();
condri_ins(i_bne, d, 0, l);
rrr_ins(i_addu, d, a1, 0);
rrr_ins(i_subu, d, 0, a1);
set_label_no_clear(l);
setreorder();
}
setregalt (aa, d);
move (aa, dest, guardreg (d, sp), 0);
mka.regmove = d;
return mka;
} /* end absbool */
case test_tag:
{
exp l = son (e);
exp r = bro (l);
int lab = (ptno (e) < 0) ? -ptno (e) : no (son (pt (e)));
/* see frig in cond_tag */
shape shl = sh (l);
char *branch;
int n = (props (e)) & 127; /* could have Rev bit in props*/
if (is_floating (name (sh (l)))) {
bool dble = (name (shl) != shrealhd) ? 1 : 0;
int a1;
char *branch = (n <= 2 || n == 6) ? i_bc1t : i_bc1f;
char *compare = (dble) ? fdbranches (n) : fbranches (n);
/* choose branch and compare instructions */
int a2;
space nsp;
if (IsRev(e)) {
a2 = freg_operand(r, sp);
nsp = guardfreg(a2, sp);
a1 = freg_operand(l, nsp);
}
else {
a1 = freg_operand(l, sp);
nsp = guardfreg(a1, sp);
a2 = freg_operand(r, nsp);
}
rrfpcond_ins (compare, a1 << 1, a2 << 1);
br_ins (branch, lab);
return mka;
} /* end float test */
else {
int a1;
int a2;
if (name (l) == val_tag) {/* put literal operand on right */
exp temp = l;
l = r;
r = temp;
if (n <= 2) {
n += 2;
}
else
if (n <= 4) {
n -= 2;
}
}
branch = branches(shl, n);
/* choose branch instruction */
a1 = reg_operand (l, sp);
if (name (r) == val_tag) {
condri_ins (branch, a1, no (r), lab);
}
else {
space nsp;
nsp = guardreg (a1, sp);
a2 = reg_operand (r, nsp);
condrr_ins (branch, a1, a2, lab);
}
return mka;
} /* end int test */
} /* end test */
case ass_tag:
case assvol_tag:
{
exp lhs = son (e);
exp rhs = bro (lhs);
where assdest;
space nsp;
ash arhs;
int contreg = NOREG;
if (name (e) == assvol_tag) {
clear_all ();
setvolatile ();
}
arhs = ashof (sh (rhs));
if (name (e) == ass_tag && name (rhs) == apply_tag &&
(is_floating (name (sh (rhs))) || valregable (sh (rhs)))) {
/* if source is simple proc call, evaluate it first and do
assignment */
ans aa;
code_here (rhs, sp, nowhere);
if (is_floating (name (sh (rhs)))) {
freg frg;
frg.fr = 0;
frg.dble = (arhs.ashsize == 64) ? 1 : 0;
setfregalt (aa, frg);
}
else {
setregalt (aa, 2);
sp = guardreg(2,sp);
}
assdest = locate (lhs, sp, sh (rhs), 0);
move (aa, assdest, sp, 1);
clear_dep_reg (lhs);
return mka;
}
assdest = locate (lhs, sp, sh (rhs), 0);
nsp = guard (assdest, sp);
/* evaluate 'address' of destination */
if (name (e) == ass_tag
&& assdest.answhere.discrim == notinreg) {
instore is;
is = insalt (assdest.answhere);
if (!is.adval) { /* this is an indirect assignment, so make
it direct by loading pointer into reg
(and remember it) */
int r = getreg (sp.fixed);
ls_ins (i_lw, r, is.b);
nsp = guardreg (r, sp);
is.adval = 1;
is.b.base = r;
is.b.offset = 0;
setinsalt (assdest.answhere, is);
keepexp (lhs, assdest.answhere);
}
}
contreg = code_here (rhs, nsp, assdest);
/* evaluate source into assignment destination .... */
switch (assdest.answhere.discrim) {
case inreg:
{
int a = regalt (assdest.answhere);
keepreg (rhs, a);
/* remember that source has been evaluated into a */
clear_dep_reg (lhs);
/* forget register dependencies on destination */
break;
}
case infreg:
{
freg frg;
int r;
frg = fregalt (assdest.answhere);
r = frg.fr + 32;
if (frg.dble) {
r = -r;
};
keepreg (rhs, r);
/* remember that source has been evaluated into a */
clear_dep_reg (lhs);
/* forget register dependencies on destination */
break;
}
case notinreg:
{
if (contreg != NOREG && name (e) == ass_tag) {
clear_dep_reg (lhs);
/* forget register dependencies on destination */
if (name(lhs) == name_tag) {
exp dc = son(lhs);
exp u = pt(dc);
while (u != nilexp) {
/* loook through uses to find cont(name) */
if ( last(u) && no(u)==no(lhs) && bro(u)!=nilexp &&
name(bro(u))==cont_tag &&
shape_size(sh(bro(u))) == shape_size(sh(rhs)) ) {
keepreg (bro(u), contreg);
break;
}
u = pt(u);
}
/* remember cont of name as in contreg */
}
else
if (!dependson (lhs, 0, lhs) ){
/* remember that dest contains source, provided that it
is not dependent on it */
keepcont (lhs, contreg);
}
return mka;
}
clear_dep_reg (lhs);
/* forget register dependencies on destination */
break;
}
case insomereg: case insomefreg:
{
clear_dep_reg (lhs);
/* forget register dependencies on destination */
}
} /* end sw on answhere */
if (name (e) == assvol_tag)
setnovolatile ();
return mka;
} /* end ass */
case compound_tag:
{
exp t = son (e);
space nsp;
instore str;
int r;
nsp = sp;
switch(dest.answhere.discrim) {
case notinreg: {
str = insalt (dest.answhere);/* it should be !! */
if (!str.adval) {
int r = getreg (sp.fixed);
nsp = guardreg (r, sp);
ls_ins (i_lw, r, str.b);
str.adval = 1;
str.b.base = r;
str.b.offset = 0;
}
for (;;) {
where newdest;
instore newis;
newis = str;
newis.b.offset += no(t);
Assert(name(t)==val_tag && al2(sh(t)) >= 8);
setinsalt (newdest.answhere, newis);
newdest.ashwhere = ashof (sh(bro(t)));
code_here (bro(t), nsp, newdest);
if (last (bro(t))) {
return mka;
}
t = bro (bro(t));
}
}
case insomereg: {
int * sr = someregalt(dest.answhere);
if (*sr != -1) {
failer ("Somereg *2");
}
*sr = getreg (sp.fixed);
setregalt (dest.answhere, *sr);
/* ,... */
}
case inreg: {
code_here(bro(t), sp, dest);
r = regalt(dest.answhere);
Assert(name(t)==val_tag);
if (no(t) !=0) {
rri_ins(i_sll, r, r, (al2(sh(t)) >= 8)? (no(t)<<3):no(t));
}
nsp = guardreg(r, sp);
while(!last(bro(t))) {
int z;
t = bro(bro(t));
Assert(name(t)==val_tag);
z = reg_operand(bro(t), nsp);
if (no(t) !=0) {
rri_ins(i_sll, z,z, (al2(sh(t)) >= 8)? (no(t)<<3):no(t) );
}
rrr_ins(i_or, r, r, z);
}
return mka;
}
case insomefreg: {
somefreg sfr;
freg fr;
sfr = somefregalt(dest.answhere);
if (*sfr.fr != -1) { failer ("Somefreg *2"); }
*sfr.fr = getfreg(sp.flt);
fr.fr = *sfr.fr;
fr.dble = sfr.dble;
setfregalt(dest.answhere, fr);
}
case infreg:{
code_here(bro(t), sp, dest);
if (!last(bro(t)) || name(t)!=val_tag || no(t) !=0) {
failer("No Tuples in freg");
}
return mka;
}
}
} /* end tup */
case nof_tag: case concatnof_tag:
{
exp t = son (e);
space nsp;
instore str;
int r, disp = 0;
if (t == nilexp) return mka;
nsp = sp;
switch(dest.answhere.discrim) {
case notinreg: {
str = insalt (dest.answhere);/* it should be !! */
if (!str.adval) {
int r = getreg (sp.fixed);
nsp = guardreg (r, sp);
ls_ins (i_lw, r, str.b);
str.adval = 1;
str.b.base = r;
str.b.offset = 0;
}
for (;;) {
where newdest;
instore newis;
newis = str;
newis.b.offset += disp;
setinsalt (newdest.answhere, newis);
newdest.ashwhere = ashof (sh(t));
code_here (t, nsp, newdest);
if (last (t)) {
return mka;
}
disp+=(rounder(shape_size(sh(t)), shape_align(sh(bro(t))))>>3);
t =bro(t);
}
}
case insomereg: {
int * sr = someregalt(dest.answhere);
if (*sr != -1) {
failer ("Somereg *2");
}
*sr = getreg (sp.fixed);
setregalt (dest.answhere, *sr);
/* ,... */
}
case inreg: {
code_here(t, sp, dest);
r = regalt(dest.answhere);
nsp = guardreg(r, sp);
while(!last(t)) {
int z;
disp+=rounder(shape_size(sh(t)), shape_align(sh(bro(t))));
t =bro(t);
z = reg_operand(t, nsp);
rri_ins(i_sll, z,z, disp );
rrr_ins(i_or, r, r, z);
}
return mka;
}
default: failer("No Tuples in freg");
}
}
case ncopies_tag:
{
exp t = son (e);
space nsp;
instore str;
int i, r, disp = 0;
nsp = sp;
switch(dest.answhere.discrim) {
case notinreg: {
str = insalt (dest.answhere);/* it should be !! */
if (!str.adval) {
int r = getreg (sp.fixed);
nsp = guardreg (r, sp);
ls_ins (i_lw, r, str.b);
str.adval = 1;
str.b.base = r;
str.b.offset = 0;
}
for (i=1;i<=no(e); i++) {
where newdest;
instore newis;
newis = str;
newis.b.offset += disp;
setinsalt (newdest.answhere, newis);
newdest.ashwhere = ashof (sh(t));
code_here (t, nsp, newdest);
disp+=(rounder(shape_size(sh(t)), shape_align(sh(t)))>>3);
}
return mka;
}
case insomereg: {
int * sr = someregalt(dest.answhere);
if (*sr != -1) {
failer ("Somereg *2");
}
*sr = getreg (sp.fixed);
setregalt (dest.answhere, *sr);
/* ,... */
}
case inreg: {
code_here(t, sp, dest);
r = regalt(dest.answhere);
nsp = guardreg(r, sp);
for(i=1; i<=no(e); i++) {
int z;
disp+=rounder(shape_size(sh(t)), shape_align(sh(t)));
z = reg_operand(t, nsp);
rri_ins(i_sll, z,z, disp );
rrr_ins(i_or, r, r, z);
}
return mka;
}
default: failer("No Tuples in freg");
}
}
case caller_tag: {
e = son(e); goto tailrecurse;
}
case apply_general_tag:
{
exp fn = son(e);
exp cers = bro(fn);
exp cees = bro(cers);
exp pl = bro(cees);
space nsp;
if (no(cers) !=0) { nsp = do_callers(son(cers),sp); }
else { nsp = sp; }
IGNORE make_code(cees, nsp, nowhere, 0);
if (name (fn) == name_tag && name (son (fn)) == ident_tag
&& (son (son (fn)) == nilexp ||
name (son (son (fn))) == proc_tag ||
name (son (son (fn))) == general_proc_tag)) {
/* the procedure can be entered directly */
extj_ins (i_jal, boff (son (fn)));
}
else
if (PIC_code) {
/* have to get address of proc into r25 */
where w;
setregalt(w.answhere, 25);
w.ashwhere = ashof(sh(fn));
code_here(fn,sp,w);
br_ins(i_jal, 25);
}
else { /* the address of the proc is evaluated
and entered indirectly */
clear_reg(31); /* can't use 31 as temp reg for jal */
br_ins (i_jal, reg_operand (fn, guardreg(31,sp)));
}
if (PIC_code) reset_gp();
clear_all (); /* forget all register memories */
{ int hda = name(sh(e));
ans aa;
if (is_floating (hda)) {
freg frg;
frg.fr = 0;
frg.dble = (hda != shrealhd);
setfregalt (aa, frg);
move (aa, dest, sp, 1);
/* move floating point result of application to destination */
}
else {
setregalt (aa, 2);
mka.regmove = 2;
move (aa, dest, sp, 1);
/* move floating point result of application to destination */
}
/* else struct results are moved by body of proc */
}
if (call_is_untidy(cees)) {
rri_ins(i_subu, 29, 29, max_args>>3);
reset_tos();
Assert(name(pl)==top_tag);
}
else
if(postlude_has_call(e)) {
exp x = son(cers);
postl_chain p;
for(;x != nilexp ;) {
if (name(x)==caller_tag) {
no(x) += max_args;
}
if (last(x)) break;
x = bro(x);
}
mka.regmove = NOREG;
update_plc(old_pls, max_args);
p.pl = pl;
p.outer = old_pls;
old_pls = &p;
rri_ins(i_subu, 29, 29, max_args>>3);
IGNORE make_code(pl, sp, nowhere, 0);
rri_ins(i_addu, 29, 29, max_args>>3);
old_pls = p.outer;
update_plc(old_pls, -max_args);
}
else
IGNORE make_code(pl, sp, nowhere, 0);
return mka;
}
case caller_name_tag: {
return mka;
}
case make_callee_list_tag: {
long x = ((no(e)>>3)+23) & ~7;
do_callee_list(e, sp);
if (call_has_vcallees(e)) { rri_ins(i_addu, 30, 29, x);}
return mka;
/*
| 1st callee par | = sf on entry
| 2nd "" |
.....
-16 | callers loc reg 23 | Has_vcallees }
-12 | callees loc reg 23 | Has_vcallees } 4 overhd wds
-8 | callees tos | Has_tos }
-4 | caller's fp = $30 | }
-----------------------
| caller pars | = top of callers env
| | also $30 if var callees
*/
}
case same_callees_tag: {
baseoff b;
bool vc = call_has_vcallees(e);
space nsp;
exp bdy = son(crt_proc);
while(name(bdy)==dump_tag || name(bdy)==diagnose_tag) bdy = son(bdy);
while (name(bdy)==ident_tag && isparam(bdy)) {
/* make sure that current callees are in right place */
exp sbdy = son(bdy);
if (name(sbdy)==formal_callee_tag &&(props(bdy) &inanyreg)!=0
&& isvar(bdy) ) {
baseoff b;
if (Has_fp) {
b.base = 30;
b.offset = (no(sbdy)-callee_size)>>3;
}
else {
b.base = 29;
b.offset = (no(sbdy)+frame_size)>>3;
}
if(is_floating(name(sh(sbdy)))) {
lsfp_ins((name(sh(sbdy))!=shrealhd)?i_s_d:i_s_s,
no(bdy)<<1, b);
}
else ls_ins(i_sw, no(bdy), b);
}
bdy = bro(sbdy);
}
if (Has_vcallees) {
/* move [fp+16..local_reg] -> top of stack */
int rsize = getreg(sp.fixed);
int rsrce; int rdest;
int t30;
int le = new_label(); int lb = new_label();
nsp = guardreg(rsize, sp);
t30 = getreg(nsp.fixed); nsp = guardreg(t30, nsp);
rsrce = getreg(nsp.fixed); nsp = guardreg(rsrce, nsp);
rdest = getreg(nsp.fixed); nsp = guardreg(rdest, nsp);
mon_ins(i_move, t30, 29);
rrr_ins(i_subu, rsize, 30, local_reg);
rrr_ins(i_subu, 29,29, rsize);
b.base = t30; b.offset = -4;
ls_ins(i_sw, 30, b);
rri_ins(i_subu, rsrce, 30, 16);
rri_ins(i_subu, rdest, t30, 16);
condrr_ins(i_beq, rdest, 29, le);
set_label(lb);
b.base = rsrce; b.offset = -4;
ls_ins(i_lw, rsize, b);
b.base = rdest;
ls_ins(i_sw, rsize, b);
rri_ins(i_subu, rsrce, rsrce, 4);
rri_ins(i_subu, rdest, rdest, 4);
condrr_ins(i_bne, rdest, 29, lb);
set_label(le);
if (vc) { mon_ins(i_move, 30, t30); }
}
else {
int cs = (callee_size>>3);
int i;
int tr = getreg(sp.fixed);
rri_ins(i_subu, 29,29, cs);
b.base = 29; b.offset = cs-4;
ls_ins(i_sw, 30, b);
for(i = cs-16; i>0; i-=4) {
b.base = 30; b.offset = i-cs-4;
ls_ins(i_lw, tr, b);
b.base = 29; b.offset = i-4;
ls_ins(i_sw, tr, b);
}
if (vc) { rri_ins(i_addu, 30, 29, cs); }
}
return mka;
}
case make_dynamic_callee_tag: {
bool vc = call_has_vcallees(e);
int rptr;
int rsize;
int rdest;
int tempreg;
space nsp;
baseoff b;
int ls,le;
rptr = getreg(sp.fixed);
load_reg(son(e), rptr, sp);
nsp = guardreg(rptr, sp);
rsize = getreg(nsp.fixed);
load_reg(bro(son(e)), rsize, sp);
nsp = guardreg(rsize,nsp);
rdest = getreg(nsp.fixed);
nsp = guardreg(rdest,nsp);
tempreg = getreg(nsp.fixed);
rri_ins(i_addu, rdest, rsize, 7+16);
rri_ins(i_and, rdest,rdest, ~7);
b.base= 29; b.offset = -4;
ls_ins(i_sw, 30, b);
if (vc) mon_ins(i_move, 30, 29);
rrr_ins(i_subu, 29, 29, rdest);
rri_ins(i_addu, rdest, 29, 0);
ls = new_label();
le = new_label();
condrr_ins(i_ble, rsize, 0, le);
b.offset = 0;
set_label(ls);
b.base = rptr;
ls_ins(i_lw, tempreg, b);
b.base = rdest;
ls_ins(i_sw, tempreg, b);
rri_ins(i_addu, rdest, rdest, 4);
rri_ins(i_addu, rptr, rptr, 4);
rri_ins(i_subu, rsize, rsize, 4);
condrr_ins(i_bgt, rsize, 0, ls);
set_label(le);
return mka;
}
case tail_call_tag: {
exp fn = son(e);
exp cees = bro(fn);
bool glob = (name (fn) == name_tag && name (son (fn)) == ident_tag
&& (son (son (fn)) == nilexp ||
name (son (son (fn))) == proc_tag ||
name (son (son (fn))) ==
general_proc_tag));
exp bdy = son(crt_proc);
int rptr; int rsz;
space nsp;
space xsp;
int temp_fn_reg;
nsp=sp;
xsp=sp;
if (name(cees)==make_callee_list_tag) {
do_callee_list(cees, sp);
}
xsp.fixed = 0x800000f0;
nsp.fixed |= 0x800000f0; /* don't use parregs or linkreg */
if (name(cees)==make_dynamic_callee_tag) {
rptr = getreg(nsp.fixed);
load_reg(son(cees),rptr,nsp);
nsp = guardreg(rptr, nsp);
xsp = guardreg(rptr, xsp);
rsz = getreg(nsp.fixed);
load_reg(bro(son(cees)),rsz,nsp);
nsp = guardreg(rsz, nsp);
xsp = guardreg(rsz,nsp);
}
if (PIC_code) {
temp_fn_reg = 25;
load_reg(fn,temp_fn_reg,nsp);
}
else
if(!glob) {
temp_fn_reg = getreg(nsp.fixed);
load_reg(fn,temp_fn_reg,nsp);
nsp = guardreg(temp_fn_reg,nsp);
xsp = guardreg(temp_fn_reg,xsp);
}
while(name(bdy)==dump_tag || name(bdy)==diagnose_tag) bdy = son(bdy);
while (name(bdy)==ident_tag && isparam(bdy)) {
/* make sure that current callers and callees are in right place */
exp sbdy = son(bdy);
baseoff b;
if (Has_fp) {
b.base = 30;
b.offset = no(sbdy)>>3;
}
else {
b.base = 29;
b.offset = (no(sbdy)+frame_size+callee_size)>>3;
}
if (name(sbdy)==formal_callee_tag
&& name(cees)== same_callees_tag) {
if ((props(bdy) &inanyreg)!=0) {
b.offset -= (callee_size>>3);
if(isvar(bdy)) {
if(is_floating(name(sh(sbdy)))) {
lsfp_ins((name(sh(sbdy))!=shrealhd)?i_s_d:i_s_s,
no(bdy)<<1, b);
}
else ls_ins(i_sw, no(bdy), b);
}
}
}
else
if (props(sbdy) == 0 && (props(bdy) &inanyreg)!=0) {
/* should be instore; is in reg */
if(isvar(bdy)) {
if(is_floating(name(sh(sbdy)))) {
lsfp_ins((name(sh(sbdy))!=shrealhd)?i_s_d:i_s_s,
no(bdy)<<1, b);
}
else ls_ins(i_sw, no(bdy), b);
}
}
else
if (props(sbdy) !=0 && (props(bdy) & inanyreg) ==0) {
/* should be in reg; is in store */
if (!Has_no_vcallers && isvis(bdy) && last_param(bdy) ) {
int i = no(sbdy)>>5;
for(; i<4; i++) {
ls_ins(i_lw, i+4, b);
b.offset +=4;
}
}
else
if(is_floating(name(sh(sbdy)))) {
lsfp_ins((name(sh(sbdy))!=shrealhd)?i_l_d:i_l_s,
props(sbdy)<<1, b);
}
else ls_ins(i_lw, props(sbdy), b);
}
else
if (props(sbdy) !=0 && props(sbdy) != no(bdy) ) {
/* in wrong register */
if(is_floating(name(sh(sbdy)))) {
rrfp_ins((name(sh(sbdy))!=shrealhd)?i_mov_d:i_mov_s,
props(sbdy)<<1, no(bdy)<<1);
}
else mon_ins(i_move, props(sbdy), no(bdy));
}
bdy = bro(sbdy);
}
restore_sregs(fixdone, fltdone);
if (name(cees)==make_callee_list_tag) {
/* copy from top of stack */
int x = ((no(cees)>>3)+23) & ~7;
int r = getreg(xsp.fixed);
int r1 = getreg(guardreg(r,xsp).fixed);
int i;
baseoff b;
int ncees = no(cees)>>3;
int rnc = (ncees+7)&~7;
for(i= ncees; i > 0; i-=4) {
int x = r;
b.base = 29; b.offset = i-4;
ls_ins(i_lw, r, b);
b.base = 30; b.offset = i-rnc-20;
ls_ins(i_sw, r, b);
r = r1; r1 = x;
}
/*
sp + 0: p1 -> fp - 20: p1
sp + 4: p2 fp - 24: p2
sp + 8: p3 fp - 28: p3
....
*/
rri_ins(i_subu, 29, 30, x);
}
else
if (name(cees)==make_dynamic_callee_tag) {
/* rdest = fp-16;
rsize = (rsize+23)&~7
rsource = rptr + rsize
while rsize>0
[rdest-4] = [rsource-4];
rdest-=4; rsource-=4; rsize-=4;
sp = rdest;
*/
int rdest; int rsize = rsz;
int rsource = rptr; int tempr;
int le, ls;
baseoff b;
rdest = getreg(xsp.fixed);
nsp = guardreg(rdest, nsp);
tempr = getreg(xsp.fixed);
rri_ins(i_subu, rdest, 30, 16);
rri_ins(i_addu, rsize, rsize, 7);
rri_ins(i_and, rsize, rsize, ~7);
rrr_ins(i_addu, rsource, rsource, rsize);
le = new_label(); ls = new_label();
condrr_ins(i_ble, rsize, 0, le);
set_label(ls);
b.base = rsource; b.offset = -4;
ls_ins(i_lw, tempr, b);
b.base = rdest;
ls_ins(i_sw, tempr, b);
rri_ins(i_subu, rdest, rdest, 4);
rri_ins(i_subu, rsource, rsource, 4);
rri_ins(i_subu, rsize, rsize, 4);
condrr_ins(i_bgt, rsize, 0, ls);
set_label(le);
mon_ins(i_move, 29, rdest);
}
else {
if (Has_vcallees) {
mon_ins(i_move, 29, local_reg);
}
else
if (Has_fp) {
rri_ins(i_subu, 29, 30, callee_size>>3);
}
else { /* this should only occur in initialisation procs */
rri_ins(i_addu, 29, 29, (frame_size+callee_size)>>3);
}
}
if (Has_vcallees) {
baseoff b;
b.base = 30;
b.offset = -16;
ls_ins(i_lw, local_reg, b); /* old l-reg in -16(30) */
}
if (glob && !PIC_code) {
extj_ins(i_j, boff(son(fn)) );
}
else {
br_ins(i_j, temp_fn_reg);
}
clear_all();
return mka;
}
case apply_tag:
{
exp fn = son (e);
exp par = bro (fn);
exp list = par;
exp dad = father (e);
bool tlrecurse = rscope_level == 0 && (name(dad)== res_tag) && props(dad);
int hda = name (sh (e));
int disp;
ash ansash;
if ((disp = specialfn (fn)) > 0) {/* eg function is strlen */
mka.lab = specialmake (disp, list, sp, dest, exitlab);
return mka;
}
ansash = ashof (sh (e));
if (!last(fn)) {
sp = do_callers(list, sp);
}
if (name (fn) == name_tag && name (son (fn)) == ident_tag
&& (son (son (fn)) == nilexp || name (son (son (fn))) == proc_tag)) {
/* the procedure can be entered directly */
if (! tlrecurse) {
extj_ins (i_jal, boff (son (fn)));
if (PIC_code) reset_gp();
}
else {
if (Has_fp) {
baseoff b;
b.base = 30;
b.offset = -4;
restore_sregs(fixdone, fltdone);
mon_ins(i_move, 29, 30);
ls_ins(i_lw, 30, b);
}
else {
restore_sregs(fixdone, fltdone);
rri_ins(i_addu, 29, 29, (frame_size+callee_size)>>3);
}
extj_ins(i_j, boff(son(fn)) );
if (as_file) fprintf(as_file," # Tail recursion\n");
}
}
else
if (PIC_code) {
/* have to get address of proc into r25 */
where w;
setregalt(w.answhere, 25);
w.ashwhere = ashof(sh(fn));
code_here(fn,sp,w);
br_ins(i_jal, 25);
reset_gp();
}
else { /* the address of the proc is evaluated
and entered indirectly */
clear_reg(31); /* can't use 31 as temp reg for jal */
br_ins (i_jal, reg_operand (fn, guardreg(31,sp)));
}
clear_all (); /* forget all register memories */
{
ans aa;
if (is_floating (hda)) {
freg frg;
frg.fr = 0;
frg.dble = (hda != shrealhd);
setfregalt (aa, frg);
move (aa, dest, sp, 1);
/* move floating point result of application to destination */
}
else {
setregalt (aa, 2);
mka.regmove = 2;
move (aa, dest, guardreg(2,sp), 1);
/* move fixed point result of application to destination */
}
/* else struct results are moved by body of proc */
}
return mka;
} /* end apply */
case return_to_label_tag: {
int r = getreg(sp.fixed);
where w;
setregalt(w.answhere, r);
w.ashwhere = ashof (sh(son (e)));
code_here (son (e), sp, w);
clear_all();
if (Has_fp) {
baseoff b;
b.base = 30;
restore_sregs (fixdone, fltdone);
if (Has_vcallees) {
b.offset = -16;
ls_ins(i_lw, local_reg, b);
}
b.offset = -4;
mon_ins(i_move, 29, 30);
ls_ins(i_lw, 30, b);
}
else
if (frame_size !=0) {
restore_sregs (fixdone, fltdone);
/* restore dumped value of s-regs on entry */
rri_ins (i_addu, 29, 29, frame_size >> 3);
/* reset stack ptr */
}
uncond_ins(i_j, r);
return mka;
}
case res_tag: case untidy_return_tag:
{
where w;
w.answhere = procans;
w.ashwhere = ashof (sh (son (e)));
code_here (son (e), sp, w);
/* evaluate result value */
clear_all (); /* clear all register memories */
if (rscope_level == 0) {/* normal proc body */
if (name(son(e)) == apply_tag && props(e)) return mka;
/* was a tail recursion */
if (frame_size == 0
&& !Has_fp) {
uncond_ins (i_j, 31);
}
else
if (result_label != 0 && name(e)==res_tag) {
uncond_ins(i_b, result_label);
if (as_file) fprintf(as_file, " # Return\n");
}
else{
if ((fixdone|fltdone)==0) {
result_label = new_label();
set_label(result_label);
}
if (Has_fp) {
baseoff b;
b.base = 30;
restore_sregs (fixdone, fltdone);
if (Has_vcallees) {
b.offset = -16;
ls_ins(i_lw, local_reg, b);
}
b.offset = -4;
if (name(e)==res_tag) mon_ins(i_move, 29, 30);
ls_ins(i_lw, 30, b);
}
else {
restore_sregs (fixdone, fltdone);
/* restore dumped value of s-regs on entry */
if (frame_size != 0 && name(e) == res_tag) {
rri_ins (i_addu, 29, 29, frame_size >> 3);
}
/* reset stack ptr */
}
if (diagPIClab != 0) {
uncond_ins(i_b, diagPIClab);
}
else { uncond_ins (i_j, 31); }
}
}
else { /* inlined result */
if (rscope_label == 0) rscope_label = new_label();
if (rscope_label != exitlab) {
uncond_ins (i_b, rscope_label);
}
}
return mka;
} /* end result */
case diagnose_tag: {
output_diag(dno(e), 0,e);
mka = make_code (son (e), sp, dest, exitlab);
output_end_scope(dno(e),e);
return mka;
}
/*
removed in version 3.0
case rscope_tag:
{
ans old_procans;
int old_rscope_label = rscope_label;
if (dest.answhere.discrim == insomereg) {
int *sr = someregalt (dest.answhere);
if (*sr != -1) {
failer ("Somereg *2");
}
*sr = getreg (sp.fixed);
setregalt (dest.answhere, *sr);
}
else
if (dest.answhere.discrim == insomefreg) {
somefreg sfr;
freg fr;
sfr = somefregalt(dest.answhere);
if (*sfr.fr != -1) { failer ("Somefreg *2"); }
*sfr.fr = getfreg(sp.flt);
fr.fr = *sfr.fr;
fr.dble = sfr.dble;
setfregalt(dest.answhere, fr);
}
rscope_level++;
old_procans = procans;
procans = dest.answhere;
rscope_label = exitlab;
if (as_file) fprintf(as_file, " # start inlined proc\n");
mka = make_code (son (e), sp, dest, rscope_label);
if (as_file) fprintf(as_file, " # end inlined proc\n");
if (mka.lab != 0 && mka.lab != rscope_label) {
set_label(mka.lab);
}
mka.lab = rscope_label;
mka.regmove = NOREG;
rscope_level--;
procans = old_procans;
rscope_label = old_rscope_label;
return mka;
}
*/
case solve_tag:
{
exp m = bro (son (e));
int l = exitlab;
if (dest.answhere.discrim == insomereg) {
/* choose register for result */
int *sr = someregalt (dest.answhere);
if (*sr != -1) {
failer ("Somereg *2");
}
*sr = getreg (sp.fixed);
setregalt (dest.answhere, *sr);
}
else
if (dest.answhere.discrim == insomefreg ){
somefreg sfr;
freg fr;
sfr = somefregalt(dest.answhere);
if (*sfr.fr != -1) { failer ("Somefreg *2"); }
*sfr.fr = getfreg(sp.flt);
fr.fr = *sfr.fr;
fr.dble = sfr.dble;
setfregalt(dest.answhere, fr);
}
for (;;) { /* set up all the labels in the component
labst_tags */
no (son (m)) = new_label ();
if (last (m))
break;
m = bro (m);
}
m = son (e);
for (;;) { /* evaluate all the component statements
*/
int fl = make_code (m, sp, dest, l).lab;
clear_all ();
if (fl != 0)
l = fl;
if (!last (m)) { /* jump to end of solve */
if (l == 0)
l = new_label ();
if (name (sh (m)) != bothd) {
uncond_ins (i_b, l);
}
}
if (last (m)) {
mka.lab = l;
return mka;
};
m = bro (m);
}
} /* end solve */
case case_tag:
{
int r = reg_operand (son (e), sp);
/* evaluate controlling integer into reg r */
mm lims;
exp z = bro (son (e));
exp zt = z;
long n;
long l;
long u = 0x80000000;
sp = guardreg(r,sp);
l = no (zt);
for (n = 1;; n++) { /* calculate crude criterion for using
jump vector or branches */
if (u + 1 != no (zt) && son (zt) != nilexp) {
n++;
}
if (last (zt)) {
u = (son (zt) != nilexp) ? no (son (zt)) : no (zt);
break;
}
if (son (zt) != nilexp) {
u = no (son (zt));
}
else {
if (u + 1 == no (zt))
u += 1;
}
zt = bro (zt);
}
/* now l is lowest controlling value and u is highest */
if (is_signed(sh(son(e))) ) { u = u/2 - l/2; }
else { u = ((unsigned)u)/2 - ((unsigned)l)/2; }
if ( u <= n * n / 4 -3 /* ware overflow! */) {
/* space-time product criterion for jump vector instead of tests
and branches *//* use jump vector */
int endlab = new_label ();
int veclab = next_dlab_sym ();
baseoff zeroveclab;
baseoff zero3;
int mr = getreg (sp.fixed);
int r3 = getreg(guardreg(mr,sp).fixed);
zero3.base = r3;
zero3.offset = 0;
zeroveclab.offset = 0;
zeroveclab.base = veclab;
n = l;
if (as_file)
fprintf (as_file, "\t.rdata\n$$%d:\n", veclab);
out_common (0, irdata);
out_common (tempsnos[veclab - 32], ilabel);
for (;;) {
for (; no (z) > n; n++) {/* o/p jump vector */
if (as_file)
fprintf (as_file,
(PIC_code)?"\t.gpword\t$%d\n":"\t.word\t$%d\n", endlab);
out_value (-endlab, (PIC_code)?igpword:iword, 0, 1);
}
u = (son (z) == nilexp) ? n : no (son (z));
for (; n <= u; n++) {
props(son(pt(z))) = 1; /* as bug - see labst_tag */
if (as_file)
fprintf (as_file,
(PIC_code)?"\t.gpword\t$%d\n":"\t.word\t$%d\n", no (son (pt (z))));
out_value (-no (son (pt (z))), (PIC_code)?igpword:iword, 0, 1);
}
if (last (z))
break;
z = bro (z);
}
if (as_file)
fprintf (as_file, "\t.text\n");
out_common (0, itext);
ls_ins (i_la, r3, zeroveclab);
if (l != 0) {
rri_ins (i_addu, mr, r, -l);
condri_ins (i_bgeu, mr, u - l + 1, endlab);
rri_ins (i_mul, mr, mr, 4);
}
else {
condri_ins (i_bgeu, r, u + 1, endlab);
rri_ins (i_mul, mr, r, 4);
}
rrr_ins (i_addu, r3, r3, mr);
ls_ins (i_lw, r3, zero3);
if (PIC_code) { rrr_ins(i_addu, r3, r3, 28); }
uncond_ins (i_j, r3);
set_label (endlab);
return mka;
}
else
if (is_signed(sh(son(e)))) {
int over = 0; /* use branches - tests are already
ordered */
bool usw;
lims = maxmin (sh (son (e)));
for (;;) {
int lab = no (son (pt (z)));
long l = no (z);
if (son (z) == nilexp) {/* only single test required */
condri_ins (i_beq, r, l, lab);
if (l == lims.maxi)
lims.maxi -= 1;
else
if (l == lims.mini)
lims.mini += 1;
}
else
if (u = no (son (z)), l > lims.mini) {
if ( u >= lims.maxi)
{/* have already tested lower */
condri_ins (i_bge, r, l, lab);
lims.maxi = l - 1;
}
else {
if (over == 0) {
over = new_label ();
}
condri_ins (i_blt, r, l, over);
condri_ins (i_ble, r, u, lab);
lims.mini = u + 1;
}
}
else /* lower is <= lower limit of shape */
if (u < lims.maxi) {
condri_ins (i_ble, r, u, lab);
lims.mini = u + 1;
}
else { /* upper is >= upper limit of shape */
uncond_ins (i_b, lab);
}
if (last (z)) {
if (over != 0) {
set_label (over);
} return mka;
}
z = bro (z);
}
}
else {
int over = 0; /* use branches - tests are already
ordered */
unsigned long maxi;
unsigned long mini;
lims = maxmin (sh (son (e)));
maxi = (unsigned)lims.maxi;
mini = (unsigned)lims.mini;
for (;;) {
int lab = no (son (pt (z)));
unsigned long l = no (z);
if (son (z) == nilexp) {/* only single test required */
condri_ins (i_beq, r, l, lab);
if (l == maxi)
maxi -= 1;
else
if (l == mini)
mini += 1;
}
else
if (u = no (son (z)), l > mini) {
if ( u >= maxi)
{/* have already tested lower */
condri_ins (i_bgeu, r, l, lab);
maxi = l - 1;
}
else {
if (over == 0) {
over = new_label ();
}
condri_ins (i_bltu, r, l, over);
condri_ins (i_bleu, r, u, lab);
mini = u + 1;
}
}
else /* lower is <= lower limit of shape */
if (u < maxi) {
condri_ins (i_bleu, r, u, lab);
mini = u + 1;
}
else { /* upper is >= upper limit of shape */
uncond_ins (i_b, lab);
}
if (last (z)) {
if (over != 0) {
set_label (over);
} return mka;
}
z = bro (z);
}
}
} /* end case */
case offset_add_tag: { /* byte offset + bit offset - see needs scan */
exp l = son(e);
exp r = bro(l);
int r1 = reg_operand(l, sp);
int tmp, d, r2;
space nsp;
ans aa;
tmp = getreg(sp.fixed);
rri_ins(i_sll, tmp, r1, 3);
d = regfrmdest(&dest, sp);
if (name(r)==val_tag) {
rri_ins(i_addu, d, tmp, no(r));
}
else {
nsp = guardreg(tmp, sp);
r2 = reg_operand(r, nsp);
rrr_ins(i_addu, d, tmp, r2);
}
setregalt(aa, d);
mka.regmove = move(aa, dest, guardreg(d, sp), 0);
return mka;
}
case offset_subtract_tag: { /* bit offset - byte offset - see needs scan */
exp l = son(e);
exp r = bro(l);
int r2 = reg_operand(r, sp);
int tmp, d, r1;
space nsp;
ans aa;
tmp = getreg(sp.fixed);
rri_ins(i_sll, tmp, r2, 3);
d = regfrmdest(&dest, sp);
nsp = guardreg(tmp, sp);
r1 = reg_operand(l, nsp);
rrr_ins(i_subu, d, r1, tmp);
setregalt(aa, d);
mka.regmove = move(aa, dest, guardreg(d, sp), 0);
return mka;
}
case plus_tag:
{
if (optop(e) ) {
mka.regmove =
comm_op (e, sp, dest, i_addu);
return mka;
}
if ((errhandle(e)&3)==3 && is_signed(sh(e)) && shape_size(sh(e))==32 ) {
mka.regmove =
comm_op (e, sp, dest, i_add);
return mka;
}
else {
/* possible overflow - can optimised a bit fot lit. operand*/
int r1 = reg_operand(son(e), sp);
int r2, r3, r0;
long over = new_label();
long trap = trap_label(e);
space nsp;
ans aa;
nsp = guardreg(r1, sp);
r2 = reg_operand(bro(son(e)), nsp);
nsp = guardreg(r2, nsp);
r0 = getreg(nsp.fixed);
nsp = guardreg(r0, nsp);
rrr_ins(i_addu, r0, r1, r2);
switch(name(sh(e)) ) {
case slonghd: {
r3 = getreg(nsp.fixed);
rrr_ins(i_xor, r3, r1, r2);
condr_ins(i_bltz, r3, over);
rrr_ins(i_xor, r3, r0, r1);
condr_ins(i_bltz, r3, trap);
set_label(over);
break;
}
case ulonghd: {
r3 = getreg(nsp.fixed);
mon_ins(i_not, r3, r1);
rrr_ins(i_sltu, r3, r3, r2);
condrr_ins(i_bne, r3, 0, trap);
break;
}
case scharhd: {
testsigned(r0, -128, 127, trap);
break;
}
case ucharhd: {
testusigned(r0, 255, trap);
break;
}
case swordhd: {
testsigned(r0, -0x8000, 0x7fff, trap);
break;
}
case uwordhd: {
testusigned(r0, 0xffff, trap);
break;
}
default: failer("NOT integer in plus with o/f");
}
setregalt(aa, r0);
mka.regmove = move(aa, dest, nsp, 0);
return mka;
}
} /* end plus */
case chvar_tag:
{
int a;
int d;
ans aa;
int nsh = name (sh (e));
if (!BIGEND && dest.answhere.discrim == inreg
&& regalt(dest.answhere) != 0) {
ash arga;
arga = ashof (sh (son (e)));
if (arga.ashsize <= dest.ashwhere.ashsize) {
dest.ashwhere = arga;
}
a = regalt (dest.answhere);
code_here (son (e), sp, dest);
/* evaluate arguement into reg */
}
else {
a = reg_operand (son (e), sp);
/* evaluate arguement into a */
}
setregalt (aa, a);
if (!optop(e)) {
long trap = trap_label(e);
bool sg = is_signed(sh(son(e)));
switch(nsh) {
case scharhd:
if (sg) { testsigned(a, -128, 127, trap);}
else { testusigned(a, 127, trap); }
break;
case ucharhd: testusigned(a, 255, trap); break;
case swordhd:
if (sg){ testsigned(a, -0x8000, 0x7fff, trap); }
else { testusigned(a, 0x7fff, trap); }
break;
case uwordhd: testusigned(a, 0xffff, trap); break;
case slonghd:
if (!sg) { testusigned(a, 0x7fffffff, trap); }
break;
case ulonghd:
if (sg) { testusigned(a, 0x7fffffff, trap); }
break;
}
mka.regmove = move (aa, dest, sp, 1);
return mka;
}
if (sh (son (e)) == sh (e) || nsh >= slonghd) {
/* no changes required, so just move */
mka.regmove = move (aa, dest, sp, 1);
return mka;
}
switch (dest.answhere.discrim) {
case insomereg:
{
int *dr = someregalt (dest.answhere);
d = getreg (sp.fixed);
*dr = d;
goto out;
}
case inreg:
{
d = regalt (dest.answhere);
goto out;
}
default:
/* representation in store will be same so just move */
{
move (aa, dest, sp, 1);
return mka;
}
}
out: /* d is destination register - do
appropriate ands etc */
if (d==0) return mka;
if (nsh == ucharhd) {
rri_ins (i_and, d, a, 255);
}
else
if (nsh == uwordhd) {
rri_ins (i_and, d, a, (1 << 16) - 1);
}
else
if (nsh == scharhd) {
rri_ins (i_sll, d, a, 24);
rri_ins (i_sra, d, d, 24);
}
else
if (nsh == swordhd) {
rri_ins (i_sll, d, a, 16);
rri_ins (i_sra, d, d, 16);
}
mka.regmove = d;
return mka;
} /* end chvar */
case minus_tag:
{
if (optop(e)) {
mka.regmove =
non_comm_op (e, sp, dest, i_subu);
return mka;
}
else
if ((errhandle(e)&3)==3 && is_signed(sh(e)) && shape_size(sh(e))==32 ) {
mka.regmove =
non_comm_op (e, sp, dest, i_sub);
return mka;
}
else {
/* possible overflow - can optimised a bit for lit. operand*/
int r1 = reg_operand(son(e), sp);
int r2, r3, r0;
long over = new_label();
long trap = trap_label(e);
space nsp;
ans aa;
nsp = guardreg(r1, sp);
r2 = reg_operand(bro(son(e)), nsp);
nsp = guardreg(r2, nsp);
r0 = getreg(nsp.fixed);
nsp = guardreg(r0,nsp);
rrr_ins(i_subu, r0, r1, r2);
switch(name(sh(e))) {
case slonghd: {
r3 = getreg(nsp.fixed);
rrr_ins(i_xor, r3, r1, r2);
condr_ins(i_bgez, r3, over);
rrr_ins(i_xor, r3, r0, r1);
condr_ins(i_bltz, r3, trap);
set_label(over);
/* Alteration 2 also in plus_tag */
break;
}
case ulonghd: {
r3 = getreg(nsp.fixed);
/* Alteration 3 */
rrr_ins(i_sltu, r3, r1, r2);
condrr_ins(i_bne, r3, 0, trap);
break;
}
case scharhd: {
testsigned(r0, -128, 127, trap);
break;
}
case ucharhd: {
testusigned(r0, 255, trap);
break;
}
case swordhd: {
testsigned(r0, -0x8000, 0x7fff, trap);
break;
}
case uwordhd: {
testusigned(r0, 0xffff, trap);
break;
}
default: failer("NOT integer in minus with o/f");
}
setregalt(aa, r0);
mka.regmove = move(aa, dest, nsp, 0);
return mka;
}
} /* end minus */
case mult_tag: case offset_mult_tag:
{
exp rop = bro (son (e));
if (!optop(e)) { /* test for overflo */
int r1 = reg_operand(son(e), sp);
int r2, r3, r0;
long trap = trap_label(e);
space nsp;
ans aa;
nsp = guardreg(r1, sp);
r2 = reg_operand(bro(son(e)), nsp);
nsp = guardreg(r2, nsp);
r0 = getreg(nsp.fixed);
nsp = guardreg(r0, nsp);
r3 = getreg(nsp.fixed);
switch(name(sh(e))) {
case slonghd: {
int r4;
mon_ins(i_mult, r1, r2);
hilo_ins(i_mflo, r0);
hilo_ins(i_mfhi, r3);
r4 = getreg(guardreg(r3, nsp).fixed);
rri_ins(i_sra, r4, r0, 31);
condrr_ins(i_bne, r4, r3, trap);
break;
}
case ulonghd: {
mon_ins(i_multu, r1, r2);
hilo_ins(i_mflo, r0);
hilo_ins(i_mfhi, r3);
condrr_ins(i_bne, r3, 0, trap);
break;
}
case scharhd: {
rrr_ins(i_mul, r0, r1, r2);
testsigned(r0, -128, 127, trap);
break;
}
case ucharhd: {
rrr_ins(i_mul, r0, r1, r2);
testusigned(r0, 255, trap);
break;
}
case swordhd: {
rrr_ins(i_mul, r0, r1, r2);
testsigned(r0, -0x8000, 0x7fff, trap);
break;
}
case uwordhd: {
rrr_ins(i_mul, r0, r1, r2);
testusigned(r0, 0xffff, trap);
break;
}
default: failer("NOT integer in mult with o/f");
}
setregalt(aa, r0);
mka.regmove = move(aa, dest, nsp, 0);
return mka;
}
if (last (rop) && name (rop) == val_tag) {
/* multiplication by constant m */
int m = no (rop);
int p2;
if (m > 1 && (
((p2 = m) & (m - 1)) == 0 ||
(m & (p2 = m + 1)) == 0 ||
((p2 = m - 1) & (m - 2)) == 0
)
) { /* m = 2^shleng or m = 2^(shleng +/- 1)
*/
int r = reg_operand (son (e), sp);
/* evaluate first arguement */
int rr;
space nsp;
int shleng;
ans aa;
for (shleng = 0; p2 != 1; shleng++)
p2 >>= 1;
switch (dest.answhere.discrim) {
case inreg:
{
rr = regalt (dest.answhere);
if (rr != r || (m & (m - 1)) == 0) {
nsp = sp;
break;
}
/* else continue to next case */
}
default:
{
if ((m &(m-1))==0) {
rr = getreg(sp.fixed);
nsp = sp;
}
else {
nsp = guardreg (r, sp);
rr = getreg (nsp.fixed);
}
}
}
rri_ins (i_sll, rr, r, shleng);
if ((m & (m - 1)) != 0)
rrr_ins (((m & (m + 1)) == 0) ? i_subu : i_addu, rr, rr, r);
setregalt (aa, rr);
mka.regmove = move (aa, dest, guardreg (rr, sp), 1);
return mka;
}
} /* else do straightforward mult */
mka.regmove = comm_op (e, sp, dest, i_mul);
return mka;
} /* end mult */
case div0_tag:case div2_tag: case offset_div_by_int_tag: case offset_div_tag:
{
exp rop = bro (son (e));
exp lop = son(e);
bool uns = !(is_signed(sh (e)));
int trap;
space nsp;
int r0, r1, r2;
ans aa;
if ( name (rop) == val_tag ) {
/* division by constant */
int m = no (rop);
if (m==1) {
e = lop;
goto tailrecurse;
}
if ((name(e) == div0_tag || uns) && m > 1 && (m & (m - 1)) == 0) {
int r = reg_operand (son (e), sp);
/* replace div by 2^shleng by sh right shleng */
int shleng;
int rr;
for (shleng = 0; m != 1; shleng++)
m >>= 1;
rr = regfrmdest(&dest, sp);
rri_ins ( (uns)?i_srl:i_sra, rr, r, shleng);
setregalt (aa, rr);
mka.regmove = move (aa, dest, guardreg (rr, sp), 1);
return mka;
}
}
r1 = reg_operand(lop, sp);
nsp = guardreg(r1, sp);
r2 = reg_operand(rop, nsp);
if (!optop(e)|| (errhandle(e)&3)==2) { /* test for (-inf)/-1 and /0 */
long over = new_label();
trap = ((errhandle(e)&3)==2)?new_label():trap_label(e);
condri_ins(i_beq, r2, 0, trap);
if (!uns) {
condri_ins(i_bne, r2, -1, over);
condri_ins(i_beq, r1, maxmin(sh(e)).mini, trap);
set_label(over);
}
}
r0 = regfrmdest(&dest,sp);
rrr_ins((uns)?i_divu:i_div, r0, r1, r2);
if ((errhandle(e)&3)==2) set_label(trap);
setregalt(aa, r0);
mka.regmove = move(aa, dest, guardreg(r0,sp), 0);
return mka;
}
case div1_tag:
{ /* only applies to signed operands */
exp rop = bro (son (e));
exp lop = son(e);
space nsp;
int r0, r1, r2;
int lab, treg, trap;
ans aa;
if (name (rop) == val_tag ) {/* division by constant */
int m = no (rop);
if (m > 1 && (m & (m - 1)) == 0) {
int r = reg_operand (son (e), sp);
/* replace div by 2^shleng by arith sh right shleng */
int shleng;
int rr;
for (shleng = 0; m != 1; shleng++)
m >>= 1;
rr = regfrmdest(&dest, sp);
rri_ins ( i_sra, rr, r, shleng);
setregalt (aa, rr);
mka.regmove = move (aa, dest, guardreg (rr, sp), 1);
return mka;
}
}
r1 = reg_operand(lop, sp);
nsp = guardreg(r1, sp);
r2 = reg_operand(rop, nsp);
nsp = guardreg(r2, sp);
if (!optop(e)|| (errhandle(e)&3)==2) { /* test for (-inf)/-1 and /0 */
long over = new_label();
trap = ((errhandle(e)&3)==2)?new_label():trap_label(e);
condri_ins(i_beq, r2, 0, trap);
condri_ins(i_bne, r2, -1, over);
condri_ins(i_beq, r1, maxmin(sh(e)).mini, trap);
set_label(over);
}
r0 = regfrmdest(&dest,nsp);
rrr_ins((is_signed(sh(e)))?i_div:i_divu, r0, r1, r2);
treg = getreg(guardreg(r0,nsp).fixed);
lab = new_label();
hilo_ins(i_mfhi, treg);
condri_ins(i_beq, treg, 0, lab);
rrr_ins(i_xor, treg, treg, r2);
rri_ins(i_sra, treg, treg, 31);
rrr_ins(i_addu, r0, r0, treg);
set_label(lab);
if ((errhandle(e)&3)==2) set_label(trap);
setregalt(aa, r0);
mka.regmove = move(aa, dest, guardreg(r0,sp), 0);
return mka;
}
case abs_tag: {
int r = reg_operand(son(e), sp);
int d = regfrmdest(&dest, guardreg(r, sp));
int l = new_label();
ans aa;
setnoreorder();
condri_ins(i_bge,r, 0, l);
rri_ins(i_addu, d, r, 0);
rrr_ins(i_subu, d, 0, r);
setreorder();
if (!optop(e)) {
condri_ins (i_ble, r, maxmin(sh(e)).mini, trap_label(e));
}
set_label_no_clear(l);
setregalt(aa, d);
mka.regmove = move(aa, dest, guardreg(d, sp), 0);
return mka;
}
case neg_tag: case offset_negate_tag:
{
if (optop(e) ) {
mka.regmove = monop (e, sp, dest, i_negu);
return mka;
}
if ((errhandle(e)&3)==3 && shape_size(sh(e)) == 32) {
mka.regmove = monop (e, sp, dest, i_neg);
return mka;
}
else {
int r1 = reg_operand(son(e), sp);
long trap = trap_label(e);
int r2;
ans aa;
condri_ins((is_signed(sh(e)))?i_ble:i_bne, r1, maxmin(sh(e)).mini, trap);
r2 = getreg(sp.fixed);
mon_ins(i_neg, r2, r1);
if (is_signed(sh(e)))condri_ins(i_ble, r2, maxmin(sh(e)).mini, trap);
setregalt(aa, r2);
mka.regmove = move(aa, dest, guardreg(r2, sp), 0);
return mka;
}
} /* end neg */
case goto_lv_tag: {
int r = reg_operand(son(e),sp);
uncond_ins(i_j, r);
clear_all();
return mka;
}
case shl_tag:
case shr_tag:
{
exp s = son (e);
exp b = bro (s);
int a;
int d;
int sz = shape_size(sh(s));
bool lded = ((name (s) == name_tag && regofval (s) >= 100)
|| (name (s) == cont_tag &&
(name (son (s)) != name_tag || regofval (son (s)) > 0)
)
);
bool signok = (sz == 32 || name(s)== chvar_tag || lded );
ans aa;
space nsp;
bool sgned = is_signed(sh (e));
char *shnat;
char *shun;
int norms = 0;
if (lded && name (b) == val_tag && (no (b) == 16 || no (b) == 24)
&& name (e) == shr_tag ) {
/* can use short loads instead of shifts */
where w;
instore is;
w = locate (s, sp, sh (s), 0);
/* 'address' of first operand with shape of result */
switch (w.answhere.discrim) {
/* if w is a register we still have to do shifts */
case inreg: {
a = regalt (w.answhere);
goto alreadythere;
}
case notinreg:
{
is = insalt (w.answhere);
if (!is.adval)
break;
if (is.b.offset == 0 && (a = is.b.base) >= 0 && a <= 31) {
goto alreadythere;
}
}
default: { /* this shoudn't happen - shift of address or
perhaps float in reg */
where temp;
a = -1;
setsomeregalt(temp.answhere, &a);
temp.ashwhere = dest.ashwhere;
move(w.answhere, temp, sp, 1);
goto alreadythere;
}
}
d = regfrmdest(&dest,sp);
/* d is destination register */
if (!BIGEND) {
if (no (b) == 16) {
is.b.offset += 2;
}
else {
is.b.offset += 3;
}
}
ls_ins ((no (b) == 16) ? ((sgned) ? i_lh : i_lhu) : ((sgned) ? i_lb : i_lbu),
d, is.b);
setregalt (aa, d);
move (aa, dest, guardreg (d, sp), 0);
mka.regmove = d;
return mka;
}
a = reg_operand (s, sp);
alreadythere:
/* choose which shift instruction */
if (name (e) == shr_tag) {
shnat = (sgned) ? i_sra : i_srl;
shun = i_sll;
if (!signok) {
rri_ins(i_sll, a, a, norms = 32-sz);
}
}
else {
shnat = i_sll;
shun = (sgned) ? i_sra : i_srl;
}
nsp = guardreg (a, sp);
d = regfrmdest(&dest, nsp);
if (name (b) == val_tag) {
/* if its a constant shift we dont have to choose shift
dynamically ... */
if (no (b) >= 0) {
rri_ins (shnat, d, a, no (b)+norms);
}
else {
rri_ins (shun, d, a, -no (b));
}
}
else {
int sr = getreg (nsp.fixed);
int ar = reg_operand (b, nsp);
if (norms != 0) {
rri_ins(shnat, a, a, norms);
}
if (NONEGSHIFTS || !is_signed(sh(e))
|| (name (b) == and_tag && name (bro (son (b))) == val_tag
&& no (bro (son (b))) > 0 && no (bro (son (b))) <= 31)
) { /* ... similarly in these cases */
rrr_ins (shnat, d, a, ar);
}
else { /* choose shift dynamically - is this
necessary for C? */
int l = new_label ();
int endl = new_label ();
condri_ins (i_bge, ar, 0, l);
mon_ins (i_neg, sr, ar);
rrr_ins (shun, d, a, sr);
uncond_ins (i_b, endl);
set_label (l);
rrr_ins (shnat, d, a, ar);
set_label (endl);
}
}
setregalt (aa, d);
move (aa, dest, nsp, 1);
mka.regmove = d;
return mka;
} /* end shl */
case mod_tag:
{ /* only applies to signed operands */
exp rop = bro (son (e));
exp lop = son(e);
space nsp;
int r0, r1, r2;
int lab, treg;
ans aa;
if (name (rop) == val_tag) {/* mod by constant */
int m = no (rop);
if (m > 1 && (m & (m - 1)) == 0) {
/* mod by power of 2 replaced by and */
int r = reg_operand (son (e), sp);
ans aa;
int rr = regfrmdest(&dest,sp);
rri_ins (i_and, rr, r, no (rop) - 1);
setregalt (aa, rr);
mka.regmove = move (aa, dest, guardreg (rr, sp), 1);
return mka;
}
}
r1 = reg_operand(lop, sp);
nsp = guardreg(r1, sp);
r2 = reg_operand(rop, nsp);
if (!optop(e)) { /* test for (-inf)/-1 and /0 */
long over = new_label();
long trap = trap_label(e);
condri_ins(i_beq, r2, 0, trap);
condri_ins(i_bne, r2, -1, over);
condri_ins(i_beq, r1, maxmin(sh(e)).mini, trap);
set_label(over);
}
r0 = regfrmdest(&dest, nsp);
rrr_ins(i_rem, r0, r1, r2);
treg= getreg(guardreg(r0, nsp).fixed);
lab = new_label();
condri_ins(i_beq, r0, 0, lab);
rrr_ins(i_xor, treg, r0, r2);
condri_ins(i_bge, treg, 0, lab);
rrr_ins(i_addu, r0, r0, r2);
set_label(lab);
setregalt(aa, r0);
mka.regmove = move(aa, dest, guardreg(r0,sp), 0);
return mka;
}
case rem2_tag: case rem0_tag:
{
exp rop = bro (son (e));
exp lop = son(e);
bool uns = !is_signed(sh (e));
space nsp;
int r0, r1, r2;
ans aa;
if ((uns || name(e)==rem0_tag) && name (rop) == val_tag) {
/* mod by constant */
int m = no (rop);
if (m > 1 && (m & (m - 1)) == 0) {
/* mod by power of 2 replaced by and */
int r = reg_operand (son (e), sp);
ans aa;
int rr = regfrmdest(&dest,sp);
rri_ins (i_and, rr, r, no (rop) - 1);
setregalt (aa, rr);
mka.regmove = move (aa, dest, guardreg (rr, sp), 1);
return mka;
}
if( m != 0 && (m!=-1 || uns)) {
r1 = reg_operand(lop, sp);
r0 = regfrmdest(&dest, sp);
rri_ins((uns)?i_remu:i_rem, r0, r1, m);
setregalt(aa, r0);
mka.regmove = move(aa, dest, guardreg(r0,nsp), 0);
return mka;
}
}
r1 = reg_operand(lop, sp);
nsp = guardreg(r1, sp);
r2 = reg_operand(rop, nsp);
if (!optop(e)) { /* test for (-inf)/-1 and /0 */
long over = new_label();
long trap = trap_label(e);
condri_ins(i_beq, r2, 0, trap);
if (!uns) {
condri_ins(i_bne, r2, -1, over);
condri_ins(i_beq, r1, maxmin(sh(e)).mini, trap);
set_label(over);
}
}
r0 = regfrmdest(&dest, sp);
rrr_ins((uns)?i_remu:i_rem, r0, r1, r2);
setregalt(aa, r0);
mka.regmove = move(aa, dest, guardreg(r0,nsp), 0);
return mka;
} /* end mod */
case minptr_tag: case make_stack_limit_tag:
{
mka.regmove = non_comm_op (e, sp, dest, i_subu);
return mka;
}
case fplus_tag:
{
mka.regmove =
fop (e, sp, dest, (name (sh (e)) != shrealhd) ? i_add_d : i_add_s);
if (!optop(e)) checknan(e, sp);
return mka;
}
case fminus_tag:
{
mka.regmove =
fop (e, sp, dest, (name (sh (e)) != shrealhd) ? i_sub_d : i_sub_s);
if (!optop(e)) checknan(e, sp);
return mka;
}
case fmult_tag:
{
mka.regmove =
fop (e, sp, dest, (name (sh (e)) != shrealhd) ? i_mul_d : i_mul_s);
if (!optop(e)) checknan(e, sp);
return mka;
}
case fdiv_tag:
{
mka.regmove =
fop (e, sp, dest, (name (sh (e)) != shrealhd) ? i_div_d : i_div_s);
if (!optop(e)) checknan(e, sp);
return mka;
}
case fneg_tag:
{
mka.regmove =
fmop (e, sp, dest, (name (sh (e)) != shrealhd) ? i_neg_d : i_neg_s);
if (!optop(e)) checknan(e, sp);
return mka;
}
case fabs_tag:
{
mka.regmove =
fmop (e, sp, dest, (name (sh (e)) != shrealhd) ? i_abs_d : i_abs_s);
if (!optop(e)) checknan(e, sp);
return mka;
}
case float_tag:
{
exp in = son (e);
where w;
int r;
int f
= (dest.answhere.discrim == infreg) ? regalt (dest.answhere)
/* cheat */
: getfreg (sp.flt);
freg frg;
ans aa;
ash ain;
ain = ashof (sh (in));
frg.fr = f;
frg.dble = 0;
if (ain.ashsize == 32 && name(sh(in)) != ulonghd) {
setfregalt (w.answhere, frg);
w.ashwhere = ashof (sh (in));
code_here (in, sp, w);
/* evaluate fix pt arguement into float pt reg f */
}
else { /* bytes and halfs must go through fixpt
regs */
r = reg_operand (in, sp);
cop_ins (i_mtc1, r, f << 1);
}
rrfp_ins ((name (sh (e)) != shrealhd) ? i_cvt_d_w : i_cvt_s_w,
f << 1, f << 1);
if (name (sh (e)) != shrealhd) {
frg.dble = 1;
}
if( name(sh(in))==ulonghd) {
int tmp = getreg(sp.fixed);
int constf = getfreg(guardfreg(f,sp).flt);
rri_ins(i_and, tmp,r, 0x80000000);
cop_ins (i_mtc1, tmp, constf << 1);
rrfp_ins ((frg.dble) ? i_cvt_d_w : i_cvt_s_w,
constf << 1, constf << 1);
rrrfp_ins((frg.dble) ? i_sub_d: i_sub_s, f<<1, f<<1, constf<<1);
rrrfp_ins((frg.dble) ? i_sub_d: i_sub_s, f<<1, f<<1, constf<<1);
}
setfregalt (aa, frg);
move (aa, dest, sp, 1);
mka.regmove = (frg.dble) ? -(f + 32) : (f + 32);
return mka;
}
case chfl_tag:
{
int to = name (sh (e));
int from = name (sh (son (e)));
bool dto = (to != shrealhd) ? 1 : 0;
bool dfrom = (from != shrealhd) ? 1 : 0;
if (dto == dfrom) { /* no change in representation */
return make_code (son (e), sp, dest, exitlab);
}
else {
freg frg;
ans aa;
where w;
if (dest.answhere.discrim == infreg) {
frg = fregalt (dest.answhere);
}
else {
frg.fr = getfreg (sp.flt);
}
frg.dble = dfrom;
setfregalt (aa, frg);
w.answhere = aa;
w.ashwhere = ashof (sh (son (e)));
code_here (son (e), sp, w);
if (!optop(e) && !dto) setnoreorder();
rrfp_ins ((dfrom) ? i_cvt_s_d : i_cvt_d_s, frg.fr << 1, frg.fr << 1);
frg.dble = dto;
setfregalt (aa, frg);
move (aa, dest, sp, 1);
mka.regmove = (frg.dble) ? -(frg.fr + 32) : (frg.fr + 32);
if (!optop(e) && !dto) {
setreorder();
checknan(e, sp);
}
return mka;
}
}
case and_tag:
{
exp r = son (e);
exp l = bro (son (e));
ans aa;
space nsp;
where d1;
if (last (l) && name (l) == val_tag && (no (l) == 255 || no (l) == 0xffff)
&& ((name (r) == name_tag && regofval (r) == 100)
|| (name (r) == cont_tag &&
(name (son (r)) != name_tag
|| regofval (son (r)) > 0
)
)
)
&& (aa = iskept (r), (aa.discrim == inreg && regalt (aa) == 0))
) { /* can use load short instructions */
where w;
int dsize = dest.ashwhere.ashsize;
int asize = (no (l) == 255) ? 8 : 16;
w = locate (r, sp, sh (r), 0);
if (w.answhere.discrim == notinreg
&& dest.answhere.discrim == notinreg && no (l) == 0xffff) {
instore isw;
instore isd;
isw = insalt (w.answhere);
isd = insalt (dest.answhere);
if (!isw.adval && isd.adval && isw.b.base == isd.b.base &&
isd.b.offset == isw.b.offset) {
if (dsize > 16) {
if (!BIGEND) isd.b.offset += 2;
/* just clear out top bits */
ls_ins (i_sh, 0, isd.b);
}
return mka;
} /* else drop through to load short case */
}
if (!BIGEND) {
nsp = guard(w,sp);
setregalt(aa,getreg(nsp.fixed));
d1.answhere = aa;
d1.ashwhere.ashsize = d1.ashwhere.ashalign = asize;
move(w.answhere, d1, nsp, 0);
mka.regmove
= move (aa, dest, guard(d1,nsp), 0 /* unsigned */ );
return mka;
}
}
mka.regmove = comm_op (e, sp, dest, i_and);
return mka;
}
case or_tag:
{
mka.regmove = comm_op (e, sp, dest, i_or);
return mka;
}
case xor_tag:
{
mka.regmove = comm_op (e, sp, dest, i_xor);
return mka;
}
case not_tag:
{
if (name(son(e)) == or_tag) {
mka.regmove = comm_op(son(e), sp, dest, i_nor);
}
else {
mka.regmove = monop (e, sp, dest, i_not);
}
return mka;
}
case offset_pad_tag: {
int r, v;
ans aa;
if (al2(sh(son(e))) >= al2(sh(e))) {
if (al2(sh(e)) != 1 || al2(sh(son(e))) == 1) {
/* is already aligned correctly, whether as bit or byte-offset*/
e = son(e); goto tailrecurse;
}
r = regfrmdest(&dest, sp);
v = reg_operand(son(e), sp);
rri_ins(i_sll, r, v, 3);
}
else {
int al = (al2(sh(son(e)))==1)?al2(sh(e)):(al2(sh(e))/8);
r = regfrmdest(&dest, sp);
v = reg_operand(son(e), sp);
rri_ins(i_addu, r, v, al-1);
rri_ins(i_and, r, r, -al);
if (al2(sh(son(e)))==1) { /* operand is bit-offset,
byte-offset required */
rri_ins(i_sra, r, r, 3);
}
}
setregalt(aa,r);
mka.regmove = move(aa, dest, guardreg(r,sp), 0);
return mka;
}
case locptr_tag: {
int pr = reg_operand(son(e), sp);
int ansr = regfrmdest(&dest, sp);
baseoff b;
ans aa;
b.base = pr; b.offset = -12;
ls_ins(i_lw, ansr, b);
setregalt(aa,ansr);
mka.regmove = move(aa, dest, guardreg(ansr,sp), 0);
return mka;
}
case cont_tag:
case name_tag:
case field_tag:
case reff_tag:
case addptr_tag:
case subptr_tag:
case contvol_tag:
{
where w;
bool sgned;
ash desper;
int dr = (dest.answhere.discrim == inreg) ? dest.answhere.val.regans : 0;
desper = ashof (sh (e));
if (name (e) == contvol_tag) {
clear_all ();
setvolatile ();
}
w = locate (e, sp, sh (e), dr);
/* 'address of arguement */
sgned = ((w.ashwhere.ashsize >= 32) || is_signed(sh (e)) )? 1 : 0;
mka.regmove = move (w.answhere, dest, (guard (w, sp)), sgned);
if (name (e) == contvol_tag) {
mka.regmove = NOREG;
setnovolatile ();
}
return mka;
} /* end cont */
case real_tag: {
int dble = shape_size(sh(e))>32;
r2l x;
int i;
ans aa;
instore isa;
int n = (nca<16)?nca:16;
x = real2longs_IEEE(&flptnos[no (e)], dble);
for(i=0; i< n; i++) {
rcache *r = &rca[i];
if (r->dble == dble && r->r.i1 == x.i1 && r-> r.i2 == x.i2)
{isa = r->ad; goto found;}
}
isa = evaluated(e, 0,(dec*)0);
rca[nca & 15].dble = dble; rca[nca & 15].r = x; rca[nca & 15].ad = isa;
nca++;
settext();
found:setinsalt (aa, isa);
mka.regmove = move (aa, dest, sp, 0);
return mka;
}
case string_tag:
{
instore isa;
ans aa;
bool sgned = ((ashof (sh (e)).ashsize >= 32) || is_signed(sh (e)))? 1 : 0;
isa = evaluated (e, 0, (dec*)0);
/* place constant in appropriate data segment */
settext ();
setinsalt (aa, isa);
mka.regmove = move (aa, dest, sp, sgned);
return mka;
} /* end eval */
case val_tag:
{
if( shape_size(sh(e))>32) {
flt64 temp;
int ov;
int r = getreg(sp.fixed);
space nsp;
baseoff bc;
ans aa;
if (dest.answhere.discrim!=notinreg) return mka;
if (isbigval(e)) {
temp = flt_to_f64(no(e), 0, &ov);
}
else {
temp.big = (is_signed(sh(e)) && no(e)<0)?-1:0;
temp.small = no(e);
}
nsp = guardreg(r, sp);
bc.base =0;
bc.offset = temp.small;
ls_ins(i_li, r, bc);
setregalt(aa,r);
dest.ashwhere.ashsize = 32;
dest.ashwhere.ashalign = 32;
move(aa,dest,nsp,1);
bc.offset = temp.big;
ls_ins(i_li, r, bc);
dest.answhere.val.instoreans.b.offset+=4;
move(aa,dest,nsp,1);
return mka;
}
if (no (e) == 0) {
goto null_tag_case;
}
else {
ash a;
a = ashof (sh (e));
if (a.ashsize == 32 || !is_signed(sh (e))) {
constval = no (e);
}
else
if (a.ashsize == 8) {
constval = no (e) & 255;
constval -= (constval & 128) << 1;
}
else {
constval = no (e) & 65535;
constval -= (constval & 32768) << 1;
}
goto moveconst;
}
}
case top_tag: {
return mka;
}
case dump_tag: {
long fxd = no(e);
long fld = no(pt(e));
long old_fixdone = fixdone;
long old_fltdone = fltdone;
long old_result_label = result_label;
exp l;
result_label =0;
dump_sregs(fxd, fld);
if ((fxd &(1<<31))) sp.fixed &= ~(1<<31); /*release link reg */
for(l=son(crt_proc); name(l)==ident_tag && isparam(l); ){
/* move any pars still in registers which go into dump regs */
int sr = props(son(l));
int tr = no(l);
if ((props(l) & inanyreg)!=0 && (tr !=sr) && sr != 0) {
if ((props(l) & infreg_bits)!=0 &&
(fld &(3<<(sr<<1))) !=0 ) {
if (name(sh(son(l))) != shrealhd) {
rrfp_ins(i_mov_d, sr<<1, tr<<1);
}
else {
rrfp_ins(i_mov_s, sr<<1, tr<<1);
}
sp.flt &= ~(1<<tr); /* release fpar reg */
no(l) = sr; props(son(l)) = tr;
}
else
if ((fxd & (1<<sr)) !=0 ) {
mon_ins(i_move, sr, tr);
sp.fixed &= ~(1<<tr); /* release par reg */
no(l)=sr; props(son(l)) = tr;
}
}
l = bro(son(l));
if (name(l)==dump_tag) l = son(l);
}
code_here(son(e), sp, dest);
for(l=son(crt_proc); name(l)==ident_tag && isparam(l); ){
/* restore structure of moved pars */
int sr = props(son(l));
int tr = no(l);
if ((props(l) & inanyreg)!=0 && (tr !=sr) && sr != 0) {
if ((props(l) & infreg_bits)!=0 &&
(fld &(3<<(tr<<1))) !=0 ) {
no(l) = sr; props(son(l)) = tr;
}
else
if ((fxd & (1<<tr)) !=0 ) {
no(l)=sr; props(son(l)) = tr;
}
}
l = bro(son(l));
if (name(l)==dump_tag) l = son(l);
}
if (name(sh(e)) != bothd) {
restore_sregs(fxd, fld);
}
fixdone = old_fixdone;
fltdone = old_fltdone;
result_label = old_result_label;
return mka;
}
case env_size_tag: {
exp tg = son(son(e));
procrec * pr = &procrecs[no(son(tg))];
constval = (pr->frame_size+pr->callee_size) >> 3;
goto moveconst;
}
case proc_tag: case general_proc_tag:
{ /*
set up locals_offset, fixdump, floatdump, frame_size, dumpstart
dec stack ; output frame and mask
code here;
*/
procrec * pr = & procrecs[no(e)];
needs * ndpr = & pr->needsproc;
long pprops = (ndpr->propsneeds);
bool leaf = (pprops & anyproccall) == 0;
space tbd;
space pars;
long st;
exp l;
crt_proc = e;
old_pls = (postl_chain*)0;
frame_size = pr->frame_size;
locals_offset = pr->locals_offset;
max_args = pr->max_args;
fixdump = pr->fixdump;
floatdump = pr->floatdump;
dumpstart = pr->dumpstart;
fldumpstart = pr->fldumpstart;
callee_size = pr->callee_size;
setframe_flags(e, leaf);
st = (frame_size+callee_size) >> 3;
fixdone = fltdone = 0; /* no s-regs have been dumped yet */
tbd.fixed = fixdump;
tbd.flt = floatdump;
pars.fixed = (leaf)?0:(1<<31);
pars.flt = 0;
for (l = son(e);
name(l) == ident_tag && isparam(l)
&& name(son(l)) != formal_callee_tag;
l = bro(son(l))) {
if ((props(l) & infreg_bits)!= 0) {
int n = props(son(l));
if (n != no(l) && n != 0) {
pars.flt |= (3<<(no(l)<<1));
}
}
else
if ((props(l) & inreg_bits)!=0) {
int n = props(son(l));
if (n != no(l) && n != 0) {
pars.fixed |= (1<<no(l));
}
}
}
dump_opt(e, &tbd, &pars);
if (PIC_code) {
setnoreorder();
out_cpload(current_symno, 25);
if (as_file) {
fprintf(as_file, "\t.cpload\t$25\n");
}
setreorder();
}
if (name(e)==general_proc_tag) {
if (Has_vcallees) {
baseoff b;
b.base = 30;
b.offset = -16;
ls_ins(i_sw, local_reg, b); /* old l-reg in -16(30) */
mon_ins(i_move, local_reg, 29);
/* if(!leaf) */ {
b.offset = -12; /* new l_reg in -12(30); */
ls_ins(i_sw, local_reg, b);
}
}
else
if (Has_fp && name(e)==general_proc_tag) {
rri_ins(i_addu, 30, 29, callee_size>>3);
}
if (frame_size !=0) {
rri_ins (i_subu, 29, 29, frame_size>>3);
}
}
else {
if (st !=0) {
rri_ins (i_subu, 29, 29, st);
}
if (Has_fp) {
baseoff b;
b.base = 29;
b.offset = st-4;
ls_ins(i_sw, 30, b);
rri_ins(i_addu, 30, 29, st);
}
}
if (Has_tos ) {
baseoff b;
b.base = 30;
b.offset = -8;
ls_ins(i_sw, 29, b);
}
diagPIClab = 0;
if (PIC_code && !leaf) {
dump_gp();
if (diagnose && frame_size != 0) {
diagPIClab = new_label();
}
}
allocaerr_lab = 0;
if (proc_has_checkstack(e)) {
baseoff b;
exp stl = find_named_tg("__TDFstacklim",
f_pointer(f_alignment(f_proc)));
setvar(stl);
b = boff(stl);
stackerr_lab = new_label();
ls_ins(i_lw, 2, b);
condrr_ins(i_bgt, 2, 29, stackerr_lab);
}
else stackerr_lab = 0;
setframe (st);
/* I'm not sure that this is the right order for these -
diagnostics ? */
if (fixdump != 0) {
setmask (fixdump, dumpstart - st - 4);
}
if (floatdump != 0) {
setfmask (floatdump, fldumpstart - st - 4 );
}
if ((pprops & realresult_bit) != 0) {
/* proc has real result */
freg frg;
frg.fr = 0;
frg.dble = (pprops & longrealresult_bit) ? 1 : 0;
setfregalt (procans, frg);
}
else
if ((pprops & has_result_bit) != 0) {
/* proc has fixed pt result */
setregalt (procans, 2);
}
else { /* proc has no result */
setregalt (procans, 0);
}
rscope_level = 0;
result_label = 0;
aritherr_lab = 0;
code_here (son(e), guardreg(31,sp), nowhere);
/* evaluate body of proc */
if (stackerr_lab != 0 || allocaerr_lab != 0) {
if (stackerr_lab != 0) {
set_label(stackerr_lab);
rri_ins (i_addu, 29, 29, frame_size>>3);
}
if (allocaerr_lab != 0) { set_label(allocaerr_lab); }
do_exception(MIPS_SIGUSR1);
}
if (aritherr_lab != 0) {
set_label(aritherr_lab);
do_exception(MIPS_SIGFPE);
}
if (diagPIClab != 0) {
set_label(diagPIClab);
uncond_ins (i_j, 31);
}
return mka;
} /* end proc */
case alloca_tag: {
exp s = son(e);
int r = regfrmdest(&dest, sp);
ans aa;
if (checkalloc(e)) {
int tmp = getreg(guardreg(r,sp).fixed);
exp stl = find_named_tg("__TDFstacklim",
f_pointer(f_alignment(f_proc)) );
baseoff b;
setvar(stl);
if (name(s)==val_tag) {
rri_ins(i_subu, r, 29, (no(s)+7 )&~7);
}
else {
int rr = reg_operand(s, sp);
rri_ins(i_addu, tmp, rr, 7 );
rri_ins(i_and, tmp,tmp, ~7);
rrr_ins(i_subu, r, 29, tmp);
}
b = boff(stl);
if (allocaerr_lab == 0) allocaerr_lab = new_label();
ls_ins(i_lw, tmp, b);
condrr_ins(i_bgt, tmp, r, allocaerr_lab);
rri_ins(i_addu, 29, r, 0);
}
else {
if (name(s)==val_tag) {
rri_ins(i_subu, 29, 29, (no(s)+7 )&~7);
}
else { int tmp = getreg(sp.fixed);
int rr = reg_operand(s, sp);
rri_ins(i_addu, tmp, rr, 7 );
rri_ins(i_and, tmp,tmp, ~7);
rrr_ins(i_subu, 29, 29, tmp);
}
}
reset_tos();
rri_ins(i_addu, r, 29, (max_args>>3) );
setregalt(aa, r);
mka.regmove = move(aa, dest, sp, 1);
return mka;
}
case last_local_tag: {
int r = regfrmdest(&dest, sp);
ans aa;
rri_ins(i_addu, r, 29, max_args>>3);
setregalt(aa, r);
mka.regmove = move(aa, dest, sp, 1);
return mka;
}
case local_free_tag: {
exp p = son(e);
int r = reg_operand(p, sp);
exp off = bro(p);
if (name(off)==val_tag) {
rri_ins(i_addu, r, r,(no(off)+7 )&~7);
}
else {
int tmp = reg_operand(off, guardreg(r, sp));
rri_ins(i_addu, tmp, tmp, 7 );
rri_ins(i_and, tmp,tmp, ~7);
rrr_ins(i_addu, r, r, tmp);
}
if (Has_fp) {
rri_ins(i_subu, 29, r, max_args>>3);
reset_tos();
}
return mka;
}
case local_free_all_tag: {
if (Has_fp) {
rri_ins(i_subu, 29, 30 , (frame_size+callee_size)>>3);
reset_tos();
}
return mka;
}
case current_env_tag: {
int r = regfrmdest(&dest, sp);
ans aa;
if (Has_fp) {
mon_ins(i_move, r, 30);
}
else {
rri_ins(i_addu, r, 29, (frame_size+callee_size)>>3);
}
setregalt(aa, r);
mka.regmove = move(aa, dest, sp, 1);
return mka;
}
case env_offset_tag: case general_env_offset_tag:{
constval = frame_offset(son(e));
goto moveconst;
}
case null_tag:
null_tag_case:
{
ans aa;
setregalt (aa, 0);
mka.regmove = move (aa, dest, sp, 1);
return mka;
}
case round_tag:
/* case trunc_tag: */
{
int r = (dest.answhere.discrim == inreg) ? regalt (dest.answhere)
: getreg (sp.fixed);
int sfr = freg_operand (son (e), sp);
int dfr = getfreg (guardfreg (sfr, sp).flt);
ans aa;
int s = shape_size(sh(son(e)));
int mr = (round_number(e)== f_to_nearest)? 3:
(round_number(e)== f_toward_zero)? 2:
(round_number(e)== f_toward_larger)? 1:
(round_number(e)== f_toward_smaller)? 0:3;
int r1;
if (r==0) r = getreg(sp.fixed);
sp = guardreg(r, sp);
r1 = getreg(sp.fixed);
if (!optop(e)) setnoreorder();
cop_ins(i_cfc1, r, 31);
rrr_ins(i_or, 0, 0, 0); /* nop */
rri_ins(i_or, r1, r , 3);
rri_ins(i_xor, r1, r1, mr);
cop_ins(i_ctc1, r1, 31);
rrr_ins(i_or, 0, 0, 0); /* nop */
rrfp_ins((s==32)?i_cvt_w_s:i_cvt_w_d, dfr<<1, sfr<<1);
if (!optop(e)) {
setreorder();
checknan(e, guardreg(r, sp));
}
cop_ins(i_ctc1, r, 31);
cop_ins (i_mfc1, r, dfr << 1);
/* cfc1 r,$31
cfc1 r,$31
ori r1,dfr,0x3
xori r1,r1, to_n = 3, to_z = 2, to+i = 1, to-i = 0
ctc1 r1,$31
srl r0,r0,0
cvt.w.s $f6,$f0
check
ctc1 r,$31
expansion of i_round_w_s etc
*/
setregalt (aa, r);
mka.regmove = move (aa, dest, sp, 1);
return mka;
}
case int_to_bitf_tag:
{
int r;
where w;
ash a;
ash ai;
ans aa;
space nsp;
a = ashof (sh (e));
ai = ashof (sh (son (e)));
r = regfrmdest(&dest, sp);
setregalt (w.answhere, r);
w.ashwhere = a;
code_here (son (e), sp, w);
if (a.ashsize != ai.ashsize) {
rri_ins (i_and, r, r, (1 << a.ashsize) - 1);
}
nsp = guardreg (r, sp);
setregalt (aa, r);
move (aa, dest, nsp, 0);
return mka;
}
case bitf_to_int_tag:
{
ash a;
int r;
where w;
a = ashof (sh (son (e)));
r = regfrmdest(&dest, sp);
setregalt (w.answhere, r);
w.ashwhere = a;
code_here (son (e), sp, w);
if (a.ashsize != 32) {
if ( is_signed(sh (e)) ) {
rri_ins (i_sll, r, r, 32 - a.ashsize);
rri_ins (i_sra, r, r, 32 - a.ashsize);
}
else {
rri_ins (i_and, r, r, ((1 << a.ashsize) - 1));
}
}
move (w.answhere, dest, guardreg (r, sp), 0);
keepreg (e, r);
return mka;
}
case movecont_tag: {
exp szarg = bro(bro(son(e)));
int dr, sr, szr, mr;
int lout = new_label();
space nsp;
int bytemove;
where w;
sr = getreg(sp.fixed);
setregalt(w.answhere, sr);
w.ashwhere = ashof(sh(son(e)));
IGNORE make_code(son(e), sp, w , 0);
nsp = guardreg(sr, sp);
dr = getreg(nsp.fixed);
setregalt(w.answhere, dr);
IGNORE make_code(bro(son(e)), nsp, w, 0);
nsp = guardreg(dr, nsp);
w.ashwhere = ashof(sh(bro(bro(son(e)))));
szr = getreg(nsp.fixed);
setregalt(w.answhere, szr);
IGNORE make_code(szarg, nsp, w, 0);
nsp = guardreg(szr, nsp);
mr = getreg(nsp.fixed);
bytemove = (al2(sh(szarg)) <= 8);
if(name(szarg) != val_tag || no(szarg) == 0) {
condrr_ins(i_beq, szr, 0, lout);
}
if (isnooverlap(e)) {
move_dlts(dr,sr,szr,mr, bytemove);
}
else {
int gtlab = new_label();
condrr_ins(i_bgt, dr, sr,gtlab);
move_dlts(dr,sr,szr, mr, bytemove);
uncond_ins(i_b, lout);
set_label(gtlab);
move_dgts(dr,sr,szr, mr, bytemove);
}
set_label(lout);
return mka;
}
case set_stack_limit_tag: {
baseoff b ;
int r = reg_operand(son(e), sp);
exp stl = find_named_tg("__TDFstacklim",
f_pointer(f_alignment(f_proc)));
setvar(stl);
b = boff(stl);
ls_ins(i_sw, r, b);
return mka;
}
case give_stack_limit_tag: {
baseoff b;
ans aa;
int r = regfrmdest(&dest, sp);
exp stl = find_named_tg("__TDFstacklim",
f_pointer(f_alignment(f_proc)));
setvar(stl);
b = boff(stl);
ls_ins(i_lw, r, b);
setregalt (aa, r);
move (aa, dest, guardreg (r, sp), 1);
return mka;
}
case trap_tag: {
if (no(e) == f_overflow) {
do_exception(MIPS_SIGFPE);
}
else
if (no(e) == f_nil_access) {
do_exception(MIPS_SIGSEGV);
}
else do_exception(MIPS_SIGUSR1);
return mka;
}
default:
failer ("not done yet");
} /* end outer switch */
moveconst:
{
int r = regfrmdest(&dest, sp);
baseoff b;
ans aa;
if (r != 0) { /* somewhere! */
b.base = 0;
b.offset = constval;
ls_ins (i_li, r, b);
setregalt (aa, r);
move (aa, dest, guardreg (r, sp), 1);
}
mka.regmove = r;
return mka;
}
} /* end make_code */