Rev 2 | Blame | Compare with Previous | Last modification | View Log | RSS feed
/*
* Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*
* 1. Redistributions of source code must retain the above copyright notice,
* this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright notice,
* this list of conditions and the following disclaimer in the documentation
* and/or other materials provided with the distribution.
* 3. Neither the name of The TenDRA Project nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific, prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
* IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
* CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
* EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
* $Id$
*/
/*
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.
*/
/* $Id$ */
#ifndef lint
static char vcid[] = "$Id$";
#endif /* lint */
/*
$Log: coder.c,v $
* Revision 1.2 1998/02/04 10:43:30 release
* Changes during testing.
*
* Revision 1.1.1.1 1998/01/17 15:55:58 release
* First version to be checked into rolling release.
*
* Revision 1.46 1997/09/05 12:22:14 john
* Changed case behaviour
*
* Revision 1.45 1996/11/27 17:56:27 john
* Changed case behaviour
*
* Revision 1.44 1996/03/18 17:00:17 john
* Fix to rem operation
*
* Revision 1.43 1996/03/15 10:29:39 john
* Fix to char & short ops
*
* Revision 1.42 1996/02/29 17:35:49 john
* Fix to remainder op
*
* Revision 1.41 1996/02/19 09:25:05 john
* change to register
*
* Revision 1.40 1996/02/15 09:49:16 john
* Some changes to general proc handling
*
* Revision 1.39 1996/01/23 16:48:40 john
* Fixed vararg handling for general procs
*
* Revision 1.38 1996/01/17 09:30:14 john
* Various fixes
*
* Revision 1.37 1995/12/04 09:12:17 john
* Fix to varparams & alloca
*
* Revision 1.36 1995/11/14 15:20:53 john
* Fixes to general procs
*
* Revision 1.35 1995/11/13 12:10:15 john
* Fixes to arithmetic
*
* Revision 1.34 1995/10/27 16:17:00 john
* Change to general procs
*
* Revision 1.33 1995/10/27 12:07:40 john
* Fix to same_callees
*
* Revision 1.32 1995/10/24 09:27:53 john
* Fixes to large numbers
*
* Revision 1.31 1995/10/19 16:36:13 john
* Fix to error treatments
*
* Revision 1.30 1995/10/18 09:28:40 john
* Fix to round_tag
*
* Revision 1.29 1995/09/29 15:27:04 john
* Some changes for vcallers
*
* Revision 1.28 1995/09/22 16:02:04 john
* Minor fix
*
* Revision 1.27 1995/09/21 15:40:43 john
* Various improvements to error handling
*
* Revision 1.26 1995/09/15 16:21:15 john
* New exception handling
*
* Revision 1.25 1995/09/13 15:45:29 john
* Cleared out some old code
*
* Revision 1.24 1995/09/13 08:22:10 john
* Addition for exception handling
*
* Revision 1.23 1995/09/07 12:27:46 john
* Changes to general procs
*
* Revision 1.22 1995/09/04 16:13:00 john
* Fix to general procs
*
* Revision 1.21 1995/09/01 09:08:56 john
* Fix to mult_tag
*
* Revision 1.20 1995/08/31 15:41:46 john
* Added fmax_tag & fixed some limits bugs
*
* Revision 1.19 1995/08/30 16:13:14 john
* Various fixes to error treatments
*
* Revision 1.18 1995/08/23 16:05:06 john
* Corrected comment
*
* Revision 1.17 1995/08/21 13:37:28 john
* Changed handling of caller_tag
*
* Revision 1.16 1995/08/21 10:44:11 john
* Added trap_tag
*
* Revision 1.15 1995/08/21 08:43:28 john
* Changed include files
*
* Revision 1.14 1995/08/04 15:49:40 john
* Fixed parameters of tail call and added new error jumps
*
* Revision 1.13 1995/07/27 09:24:39 john
* Changed general procs, repositioned $fp
*
* Revision 1.12 1995/07/04 09:07:43 john
* Fixed tail call
*
* Revision 1.11 1995/06/30 07:58:34 john
* Fixed bug in tail_call, callee parameters were being passed the wrong
* way round.
*
* Revision 1.10 1995/06/28 10:19:37 john
* Fix to shr_tag
*
* Revision 1.9 1995/06/21 14:24:51 john
* Reformatting
*
* Revision 1.8 1995/06/15 09:43:44 john
* Added code for stack error handling
*
* Revision 1.7 1995/06/15 08:34:41 john
* Some reformatting and additions for new error treatment
*
* Revision 1.6 1995/05/25 15:33:02 john
* Cosmetic changes
*
* Revision 1.5 1995/05/23 10:53:53 john
* Reformatting + additions for spec 3.1
*
* Revision 1.4 1995/04/10 14:14:50 john
* Added new division code. Not fully tested in this version
*
* Revision 1.3 1995/03/29 14:01:08 john
* Changes to keep tcheck happy
*
* Revision 1.2 1995/03/29 10:29:33 john
* Added code to detect and handle IEEE denormals
*
* Revision 1.1.1.1 1995/03/23 10:39:03 john
* Entered into CVS
*
* Revision 1.51 1995/03/23 10:00:47 john
* Various changes for AVS test suite
*
* Revision 1.50 1995/03/16 09:43:41 john
* Removed bitfield operations, fixed local_free_tag and changed
* chvar_tag
*
* Revision 1.49 1995/03/09 14:08:55 john
* Introduced code to use the scheduler, and fixed a bug in test_tag
*
* Revision 1.48 1995/02/09 17:17:29 john
* Fix to rep_tag and local_free_tag
*
* Revision 1.47 1995/02/06 16:45:11 john
* Fix to case_tag
*
* Revision 1.46 1995/01/26 13:30:54 john
* Modified error jump handling, and did some reformating
*
* Revision 1.45 1995/01/23 09:18:45 john
* First attempt at implementing error jumps
*
* Revision 1.44 1995/01/18 11:49:03 john
* Fixed errors in abslike_tag and case_tag, and added overflow check to
* div_tag
*
* Revision 1.43 1995/01/17 10:30:44 john
* Changed implementation of absbool_tag
*
* Revision 1.42 1995/01/10 09:42:23 john
* Minor reformating and removal of dead code.
*
*/
/*
coder.c
This is the principal code producing module
*/
#include "config.h"
#include "coder.h"
#include "common_types.h"
#include "addresstypes.h"
#include "tags.h"
#include "expmacs.h"
#include "exp.h"
#include "exptypes.h"
#include "externs.h"
#include "maxminmacs.h"
#include "shapemacs.h"
#include "basicread.h"
#include "procrectypes.h"
#include "eval.h"
#include "move.h"
#include "operators.h"
#include "pseudo.h"
#include "getregs.h"
#include "guard.h"
#include "locate.h"
#include "code_here.h"
#include "inst_fmt.h"
#include "alpha_ins.h"
#include "handle_sregs.h"
#include "bitsmacs.h"
#include "labels.h"
#include "regexps.h"
#include "special.h"
#include "new_tags.h"
#include "syms.h"
#include "flags.h"
#include "main.h"
#include "dump_distr.h"
#include "extratags.h"
#include "frames.h"
#include "reg_defs.h"
#include "cross.h"
#include "flpttypes.h"
#include "flpt.h"
#include "f64.h"
#include "fail.h"
#include "bool.h"
#include "regable.h"
#include "symdiags.h"
#include "f64.h"
#include "install_fns.h"
#include "outofline.h"
#include "diag_fns.h"
#include "out_ba.h"
#include "float.h"
#include "szs_als.h"
#include "translate.h"
extern FILE * as_file;
int fscopefile; /* file of current proc */
/*extern void add_odd_bits PROTO_S ((outofline*));*/
ans procans;
int rscope_level;
int rscope_label;
int result_label = 0;
int currentnop;
long max_args;
baseoff procbase=
{
RA,0L
};
flt alpha_word_max = {{32768,0,0,0,0,0,0,0},1,0};
flt alpha_long_max = {{1,0,0,0,0,0,0,0},1,2};
flt alpha_quad_max = {{1,0,0,0,0,0,0,0},1,4};
where nowhere;
int stack_top;
int paramsdumpstart;
int gpdumpstart;
int arg_stack_space=0;
static exp crt_proc;
int use_andcomp = 0;
int in_general_proc = 0;
int in_vcallers_apply = 0;
int aritherr_lab = 0;
int stackerr_lab = 0;
int testrev[] = {
4,3,2,1,6,5
};
/*
outofline *odd_bits;
int doing_odd_bits;
*/
/* put register number 'Reg' back into the current space. */
#define replace_reg(Reg,Space)((Space) & ~(1<< (Reg)))
#define fix_parameter_size(X,Y) if (Y==32) {\
operate_fmt_immediate(i_addl,X,0,X);\
}
#define error_treatment_is_trap(e)((errhandle(e) &3) ==3)
/*
Return TRUE if the floating point number is zero and FALSE
otherwise.
*/
static bool is_fzero
(flt fnum)
{
int i;
for (i=0;(i<MANT_SIZE) && (fnum.mant[i] ==0);++i);
return(i==MANT_SIZE);
}
/*
Functions to handle the 'trap' exception handling mechanism
*/
static int trap_label
(exp e)
{
if (error_treatment_is_trap(e)) {
if (aritherr_lab == 0)aritherr_lab = new_label();
return aritherr_lab;
}
else return no(son(pt(e)));
}
static void do_exception
(int ex)
{
baseoff b;
load_store_immediate(i_ldiq, FIRST_INT_ARG, ex);
setnoat();
/* b = find_tag("__TDFhandler");*/
b = find_tag("__alpha_errhandler");
load_store(i_ldq,AT,b);
operate_fmt(i_bis,AT,AT,PV);
b.base = AT;
b.offset = 0;
integer_jump(i_jmp,31,AT,0);
setat();
return;
}
/*
check that the floating point register contains a non-negative
value and,if it does, convert to signed by adding the
appropriate constant.
*/
static void fix_unsigned
(freg fr, space sp, int name)
{
space nsp;
int ftmp;
freg newfr;
ans aa;
flpt fltval;
exp float_exp;
instore isa;
where dest;
flt constval;
nsp = guardfreg(fr.fr,sp);
ftmp = getfreg(nsp.flt);
fltval = new_flpt();
switch (name) {
case uwordhd:
constval = alpha_word_max;
break;
case ulonghd:
constval = alpha_long_max;
break;
case u64hd:
constval = alpha_quad_max;
break;
}
flptnos[fltval] = constval;
comment("BEGIN fix_unsigned");
float_exp = getexp(realsh,nilexp,1,nilexp,nilexp,0,fltval,real_tag);
#if DO_SCHEDULE
start_new_capsule(false);
#endif
isa = evaluated(float_exp,0);
set_text_section();
#if DO_SCHEDULE
close_capsule();
#endif
setinsalt(aa,isa);
dest.ashwhere.ashsize = (fr.type == IEEE_single)?32:64;
dest.ashwhere.ashalign = dest.ashwhere.ashsize;
newfr.fr = ftmp;
newfr.type = fr.type;
setfregalt(dest.answhere,newfr);
(void)move(aa,dest,nsp,0);
float_op((fr.type == IEEE_single)?i_adds:i_addt,fr.fr,ftmp,ftmp);
float_op(i_fcmovlt,fr.fr,ftmp,fr.fr);
comment("END fix_unsigned");
return;
}
INT64 unsigned_rep
(INT64 val, shape dest_shape)
{
switch (name(dest_shape)) {
case ucharhd: return val & 0xff;
case uwordhd: return val & 0xffff;
case ulonghd: return val & 0xffffffff;
case u64hd: return val;
}
return val;
}
/*
Inserts global pointer reference.
*/
static void set_global_pointer
(void)
{
baseoff a;
a.offset = 0;
a.base = PV;
load_store(i_ldgp,GP,a);
return;
}
#if !DO_NEW_DIVISION
/*
This function produces a code sequence to divide the contents of
register 'src' by constant value 'm' and store the result in
register 'target'. The division is performed by calculating
umax64/b and then performing an umulh of this with the source
register.
*/
static void divide_by_constant
(int src, INT64 m, int target, space sp)
{
space newsp;
int rtmp;
int ruse;
INT64 divres;
int use_div_lab,exit_lab;
newsp = guardreg(src,sp);
rtmp=getreg(newsp.fixed);
ruse = getreg(guardreg(rtmp,newsp).fixed);
exit_lab = new_label();
use_div_lab = new_label();
operate_fmt(i_subq,31,src,ruse);
operate_fmt(i_cmovgt,src,src,ruse);
INT64_assign(divres, INT64_increment(INT64_divide(umax,m,0)));
load_store_immediate(i_ldiq,rtmp,divres);
operate_fmt(i_umulh,rtmp,ruse,target);
operate_fmt(i_subq,31,target,ruse);
operate_fmt(i_cmovlt,src,ruse,target);
return;
}
#endif
#if DO_NEW_DIVISION
/*
Output log2(x) rounding up.
*/
int log2
(INT64 val)
{
int res = 0;
int absval = abs(val);
while (!INT64_eq(absval,make_INT64(0,1))) {
/*while (absval != 1){*/
while (!INT64_eq(INT64_mod(absval,make_INT64(0,2),1),make_INT64(0,0))) {
/*while (absval % 2){*/
absval = INT64_increment(absval);
/*++absval;*/
}
while (INT64_eq(INT64_mod(absval,make_INT64(0,2),1),make_INT64(0,0))) {
/*while (absval % 2 == 0){*/
++res;
absval = INT64_divide(absval,make_INT64(0,2),1);
/*absval /=2;*/
}
}
return res;
}
/*
If 1/m can be transformed into the form:
1/m = 1/(2^n) * (2^x/b). Then return the values of n and x
required. If successfull, return TRUE, otherwise, return FALSE.
*/
bool calculate_shift_for_division
(INT64 m, int *n, int *x, bool is_quad)
{
INT64 val = m;
INT64 r;
int shift=0;
int power = 1;
INT64 max32 = make_INT64(0,0xffffffff);
INT64 max16 = make_INT64(0,0xffff);
if (is_quad) {
/*r = (429496729L%m) * 429496729L;*/
r = INT64_mult(max32, INT64_mod(max32,m,1),1);
}
else{
/*r = (65536%m) *65536;*/
r = INT64_mult(max16, INT64_mod(max16,m,1),1);
}
r = INT64_mod(r,val,1);
/*r = r % val; */
while (INT64_eq(INT64_mod(val,make_INT64(0,2),1),make_INT64(0,0))) {
/* while(val%2 == 0){*/
val = INT64_shift_right(val,1,1);
/*val/=2;*/
shift++;
}
if (INT64_eq(val,make_INT64(0,1))) {
failer("Unexpected power of 2 in shift calculation");
exit(EXIT_FAILURE);
}
while ((INT64_lt(make_INT64(0,power),val) &&
INT64_lt(make_INT64(0,power), INT64_subtract(val,r,1)))) {
/*while ((power<val) && (val-r > power)){*/
r = INT64_mult(r,make_INT64(0,2),1);
/*r *= 2;*/
/*r = r % val;*/
r = INT64_mod(r,val,1);
power *=2;
/*power *= 2;*/
}
*n = shift;
*x = power;
return INT64_lt(make_INT64(0,power),val)?TRUE:FALSE;
/*return (power<val)?TRUE:FALSE;*/
}
/*
This function produces a code sequence to divide the contents of
register 'src' by constant value 'm' and store the result in
register 'target'. The division is performed by calculating
umax64/b and then performing an umulh of this with the source
register. The code produced makes use of the AT register.
*/
static void divide_by_constant
(exp div, exp lhs, exp valexp, int r_dest, space nsp)
{
INT64 m = zero_int64;
INT64 divres;
bool simple_div;
INT64 max_val;
INT64 factor;
int shift,power /*,factor*/;
int src = reg_operand(lhs,nsp);
int ruse,rdest,r_frac_value;
space newsp = guardreg(src,nsp);
int is_quad = !is32(sh(lhs));
newsp = guardreg(r_dest,newsp);
if (!is_quad) {
m = make_INT64(0,no(valexp));
}
else{
m = flt64_to_INT64(exp_to_f64(valexp));
}
if (!is_signed(sh(lhs)) && INT64_lt(m,make_INT64(0,0))) {
setnoat();
load_store_immediate(i_ldiq,AT,m);
operate_fmt(i_cmpule,AT,src,rdest);
setat();
return;
}
/*max_val = is_quad?0xffffffffffffffffL:0xffffffffL;*/
max_val = is_quad?make_INT64(0xffffffff,0xffffffff):make_INT64(0,0xffffffff);
simple_div = calculate_shift_for_division(m,&shift,&power,is_quad);
r_frac_value = r_dest; /* alias, saves registers */
if (simple_div) {
factor = m/*2<<power*/;
factor = INT64_shift_left(make_INT64(0,2),log2(m) -1,1);
/*factor = 2<<(log2(m)-1);*/
}
else if (is_signed(sh(lhs))) {
factor = (m);
factor = INT64_shift_left(make_INT64(0,2),log2(m) -1,1);
/*factor = 2<<(log2(m)-1);*/
shift = 0 /*factor*/;
}
else{
factor = INT64_subtract(
INT64_shift_left(make_INT64(0,2),log2(m) -1,1),
m,1);
/*factor = (2<<(log2(m)-1))-m;*/
/* factor = power-m;*/
}
divres = INT64_add(INT64_divide(factor,m,1),
INT64_mult(
INT64_divide(max_val,m,1),
factor,
1
),
1
);
/* divres = factor/m + (max_val/m)*factor;*/
if (!is_quad)divres =
INT64_add(
INT64_divide(
INT64_shift_left(
make_INT64(0,1),
32+log2(m) -1,
1
),
m,
1
),
INT64_divide(
INT64_shift_left(
make_INT64(0,1),
log2(m) -1,
1
),
m,
1
),
1
);
#if 0
if (!is_quad)divres = (((long)0x1<< (32+log2(m))) /m) + (1<<log2(m)) /m;
#endif
if (is_signed(sh(lhs))) {
/*ruse = getreg(newsp.fixed);*/
ruse = AT;
setnoat();
operate_fmt(i_subq,31,src,ruse);
operate_fmt(i_cmovgt,src,src,ruse);
}
else{
if (!is_quad) {
/*ruse = getreg(newsp.fixed);*/
ruse = AT;
setnoat();
operate_fmt_immediate(i_zap,src,240,ruse);
}
else {
ruse = src;
}
}
if (is_quad) {
operate_fmt_big_immediate(i_umulh,ruse,divres,r_dest);
}
else{
load_store_immediate(i_ldiq,r_frac_value,divres);
operate_fmt(i_mulq,ruse,r_frac_value,r_dest);
}
if (is_signed(sh(lhs))) {
operate_fmt_immediate(i_sra,r_dest,(is_quad?0:32) +log2(m) -1,r_dest);
}
else{
operate_fmt_immediate(i_srl,r_dest,(is_quad?0:32) + ((!simple_div)?0:
(log2(m) -1)),r_dest);
}
if (is_signed(sh(lhs))) {
operate_fmt(i_subq,31,r_dest,ruse);
operate_fmt(INT64_lt(make_INT64(0,0),m)?i_cmovlt:i_cmovgt,src,ruse,r_dest);
/*operate_fmt((m>0)?i_cmovlt:i_cmovgt,src,ruse,r_dest);*/
}
else if (!simple_div && !is_signed(sh(lhs))) {
operate_fmt(i_addq,r_dest,ruse,r_dest);
operate_fmt_immediate(i_srl,r_dest,log2(m),r_dest);
}
if (ruse == AT)setat();
return;
}
#endif
/*
This function produces a code sequence to convert the value in
register reg from shape src_shape to shape dest_shape.
Returns TRUE if any code is produced and FALSE otherwise.
*/
static bool convert_shapes
(int dest_shape, int src_shape, int reg, int dreg)
{
if (reg<32 && dreg<32) {
switch (dest_shape) {
case s64hd:
case u64hd:
switch (src_shape) {
case ucharhd:
operate_fmt_immediate(i_zapnot,reg,1,dreg);
/* clear all but the bottom byte */
return TRUE;
case uwordhd:
operate_fmt_immediate(i_zapnot,reg,3,dreg);
return TRUE;
case ulonghd:
operate_fmt_immediate(i_zapnot,reg,15,dreg);
return TRUE;
default: return FALSE;
}
case slonghd:
switch (src_shape) {
case ucharhd:
operate_fmt_immediate(i_zapnot,reg,1,dreg);
return TRUE;
case uwordhd:
operate_fmt_immediate(i_zapnot,reg,3,dreg);
return TRUE;
case ulonghd:
/* operate_fmt_immediate(i_addl,reg,0,dreg);
return TRUE;*/
return FALSE;
/* sign extend */
#if 0
case s64hd:
operate_fmt_immediate(i_zapnot,reg,15,dreg);
/*operate_fmt_immediate(i_addl,reg,0,reg);*/
return TRUE;
#endif
default:return FALSE;
}
case ulonghd:
switch (src_shape) {
case scharhd:
operate_fmt_immediate(i_zapnot,reg,1,dreg);
return TRUE;
case swordhd:
operate_fmt_immediate(i_zapnot,reg,3,dreg);
return TRUE;
case slonghd:
/* operate_fmt_immediate(i_zapnot,reg,15,dreg);
return TRUE;*/
return FALSE;
#if 0
case s64hd:
operate_fmt_immediate(i_zapnot,reg,15,dreg);
return TRUE;
#endif
default: return FALSE
;
}
default:return FALSE;
}
}
return FALSE;
}
#define OVERFLOW_VALUE 0x02e0000000000000
/*
Checks for floating point error.
This function outputs code to look at the contents of the
floating point control register (FPCR) and determine whether
or not a floating point error has occured. If an error is
detected a jump is made to the label specified in no(son(pt(e))).
The error status is determined by looking at the summary bit
of the FPCR (bit 63) which is a bitwise OR of all the error bits.
The errors recognised are : integer overflow,inexact result,
underflow,overflow,division by zero, and invalid operation.
*/
#if 0
static void check_exception
(exp e, space sp)
{
long trap;
int r1,r2;
if (!pt(e)) {
alphafail(NO_ERROR_HANDLER);
}
trap = trap_label(e); /* label of handler */
r1 = getfreg(sp.flt);
r2 = getfreg(guardfreg(r1,sp).flt);
no_parameter_instructions(i_trapb);
float_op(i_mf_fpcr,r1,r1,r1);
#if 0
/*float_op(i_mt_fpcr,31,31,31);*/
float_load_store_immediate(i_ldit,r2,"1.0"); /* ?? */
float_op(i_cpys,r1,r2,r2);/* take the sign bit of the fpcr and append 1.0 */
no_parameter_instructions(i_trapb);
float_branch(i_fblt,r2,trap);
#else
{
baseoff b;
int rt = getreg(sp.fixed);
b.base = SP;
b.offset = stack_top;
float_load_store(i_stt,r1,b);
load_store(i_ldq,rt,b);
/* now check for overflow (bits 57/55/54/53) */
operate_fmt_big_immediate(i_and,rt,OVERFLOW_VALUE,rt);
no_parameter_instructions(i_trapb);
integer_branch(i_bne,rt,trap);
}
#endif
}
#endif
#define check_exception(e, sp) ((void)0)
#define PLUS_INFINITY 3
void set_up_rounding_mode
(int val)
{
return;
}
/*
This function returns the appropriate branch instruction
for the test represented by 'i'
*/
static instruction sbranches
(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;
default:
failer("Illegal value for ntest");
}
return i_ble;
}
void testunsigned
(int r, long max, int lab, space sp)
{
int rtmp = getreg(sp.fixed);
operate_fmt_immediate(i_cmpule,r,max,rtmp);
integer_branch(i_bne,rtmp,lab);
return;
}
static bool fdouble_comparisons
(instruction *ins, int i)
{
bool rev = FALSE;
switch (i) {
case 1:
*ins = i_cmptle;
break;
case 2:
*ins = i_cmptlt;
break;
case 3:
*ins = i_cmptlt;
rev = TRUE;
break;
case 4:
*ins = i_cmptle;
rev = TRUE;
break;
case 5:
*ins = i_cmpteq;
rev = TRUE;
break;
case 6:
*ins = i_cmpteq;
break;
default:
failer("illegal branch");
break;
}
return rev;
}
/*
This function selects an appropriate compare instruction for
the test represented by 'i', returning the instruction name in
the 'ins' parameter. As the set of instructions available does
not directly cover all the required tests, some instructions
carry out the inverse of the required test. In these cases, the
return value is TRUE, otherwise it is FALSE.
*/
static bool comparisons
(instruction *ins, shape s, int i)
{
bool rev=FALSE;
if ((is_signed(s))) {
/* treat pointer as signed (even though it isn't) */
switch (i) {
case 1:
*ins=i_cmple;
break;
case 2:
*ins = i_cmplt;
break;
case 3:
*ins = i_cmplt;
rev = TRUE;
break;
case 4:
*ins = i_cmple;
rev = TRUE;
break;
case 5:
*ins = i_cmpeq;
rev = TRUE;
break;
case 6:
*ins = i_cmpeq;
break;
default:
failer("illegal branch");
break;
}
}
else{
switch (i) {
case 1:
*ins=i_cmpule;
break;
case 2:
*ins=i_cmpult;
break;
case 3:
*ins=i_cmpult;
rev=TRUE; /* actually >= */
break;
case 4:
*ins=i_cmpule; /* actually > */
rev=TRUE;
break;
case 5:
*ins = i_cmpeq;
rev = 1;
break;
case 6:
*ins = i_cmpeq;
break;
default:
failer("illegal branch");
}
}
return rev;
}
/*
conditional moves
*/
static instruction condmove
(int i)
{
switch (i) {
case 1:
return i_cmovle;
case 2:
return i_cmovlt;
case 3:
return i_cmovge;
case 4:
return i_cmovgt;
case 5:
return i_cmovne;
case 6:
return i_cmoveq;
default:
failer("Illegal value for ntest");
}
return i_cmovle;
}
/*
static instruction fcondmove
PROTO_N ( ( i ) )
PROTO_T ( int i )
{
switch(i){
case 1:
return i_fcmovle;
case 2:
return i_fcmovlt;
case 3:
return i_fcmovge;
case 4:
return i_fcmovgt;
case 5:
return i_fcmovne;
case 6:
return i_fcmoveq;
default:
failer("Illegal value for ntest");
}
}
*/
static bool compares
(instruction *ins, shape s, int i)
{
bool rev=FALSE;
if (is_signed(s)) {
/* signed comparison */
switch (i) {
case 1:
*ins= i_cmplt;
break;
case 2:
*ins= i_cmple;
break;
case 3:
*ins= i_cmplt;
break;
case 4:
*ins= i_cmple;
break;
case 5:
*ins= i_cmpeq;
break;
case 6:
*ins= i_cmpeq;
break;
}
}
else{
switch (i) {
case 1:
*ins= i_cmpult;
break;
case 2:
*ins= i_cmpule;
break;
case 3:
*ins= i_cmpult;
rev=TRUE;
break;
case 4:
*ins= i_cmpule;
rev=TRUE;
break;
case 5:
*ins= i_cmpeq;
break;
case 6:
*ins= i_cmpeq;
break;
}
}
return rev;
}
/*
static instruction fbranches
PROTO_N ( ( i ) )
PROTO_T ( int i )
{
switch (i) {
case 1:
return i_fble;
case 2:
return i_fblt;
case 3:
return i_fbge;
case 4:
return i_fbgt;
case 5:
return i_fbne;
case 6:
return i_fbeq;
default:
failer("Illegal value for ntest");
}
}
static instruction fdbranches
PROTO_N ( ( i ) )
PROTO_T ( int i )
{
switch (i) {
case 1:
return i_fble;
case 2:
return i_fblt;
case 3:
return i_fbge;
case 4:
return i_fbgt;
case 5:
return i_fbne;
case 6:
return i_fbeq;
default:
failer("Illegal value for ntest");
}
}
*/
long notbranch[6] = {
4, 3, 2, 1, 6, 5
};
/* used to invert TDF tests */
/*
count the number of bits set in b.
*/
int bitsin
(int32 b)
{
int n = 0;
int32 mask = 1;
for (; b != 0;) {
n += ((b & mask)!= 0)? 1 : 0;
b &= ~mask;
mask = mask << 1;
}
return n;
}
/*****************************************************************/
/*
Move sizereg bytes to dest from source using movereg
bytemove is the maximum number of bytes which can be moved
in a single instruction if available.
In order to reduce the time for the operation the function
attempts to use the most appropriate load & store instructions,
which requires that the number of bytes remaining to be copied
and the alignment of the object be taken into account.
As the code sequence required to generate word (16 bit)
load/store is prohibitively long, these cases are treated
as bytes.
*/
/*
Without overlap (destination < source)
*/
void move_dlts
(int dest, int src, int sizereg, int movereg, int bytemove, space sp)
{
int qword_lab,lword_lab,word_lab,byte_lab,endlab;
int rtest = getreg(sp.fixed);
baseoff b;
b.offset = 0;
qword_lab = (bytemove==8)?new_label():-1;
lword_lab = (bytemove>=4)?new_label():-1;
word_lab = (bytemove>=2)?new_label():-1;
byte_lab = new_label();
endlab = new_label();
switch (bytemove) {
case 8:{
set_label(qword_lab);
operate_fmt_immediate(i_cmplt,sizereg,8,rtest);
integer_branch(i_bne,rtest,lword_lab);
b.base = src;
load_store(i_ldq,movereg,b);
b.base = dest;
load_store(i_stq,movereg,b);
operate_fmt_immediate(i_addq,src,8,src);
operate_fmt_immediate(i_addq,dest,8,dest);
operate_fmt_immediate(i_subq,sizereg,8,sizereg);
integer_branch(i_beq,sizereg,endlab);
integer_branch(i_br,31,qword_lab);
}
FALL_THROUGH;
case 4:{
set_label(lword_lab);
operate_fmt_immediate(i_cmplt,sizereg,4,rtest);
integer_branch(i_bne,rtest,byte_lab);
b.base = src;
load_store(i_ldl,movereg,b);
b.base = dest;
load_store(i_stq,movereg,b);
operate_fmt_immediate(i_addq,src,4,src);
operate_fmt_immediate(i_addq,dest,4,dest);
operate_fmt_immediate(i_subq,sizereg,4,sizereg);
integer_branch(i_beq,sizereg,endlab);
integer_branch(i_br,31,lword_lab);
}
FALL_THROUGH;
case 2:
FALL_THROUGH;
case 1:{
int rtmp = getreg(sp.fixed);
int rtmp2 = getreg(sp.fixed);
set_label(byte_lab);
integer_branch(i_beq,sizereg,endlab);
b.base=src;
load_store(i_ldq_u,movereg,b);
setnoat();
load_store(i_lda,AT,b);
operate_fmt(i_extbl,movereg,AT,movereg);
b.base=dest;
load_store(i_lda,AT,b);
load_store(i_ldq_u,rtmp,b);
operate_fmt(i_insbl,movereg,AT,rtmp2);
operate_fmt(i_mskbl,rtmp,AT,rtmp);
setat();
operate_fmt(i_bis,rtmp,rtmp2,rtmp);
load_store(i_stq_u,rtmp,b);
operate_fmt_immediate(i_addq,src,1,src);
operate_fmt_immediate(i_addq,dest,1,dest);
operate_fmt_immediate(i_subq,sizereg,1,sizereg);
integer_branch(i_bne,sizereg,byte_lab);
}
}
set_label(endlab);
return;
}
/*
With overlap (destination > src)
*/
void move_dgts
(int dest, int src, int sizereg, int movereg, int bytemove, space sp)
{
int qword_lab,lword_lab,word_lab,byte_lab,endlab;
int rtest = getreg(sp.fixed);
baseoff b;
b.offset = 0;
qword_lab = (bytemove==8)?new_label():-1;
lword_lab = (bytemove>=4)?new_label():-1;
word_lab = (bytemove>=2)?new_label():-1;
byte_lab = new_label();
endlab = new_label();
operate_fmt(i_addq,dest,sizereg,dest);
operate_fmt(i_addq,src,sizereg,src);
switch (bytemove) {
case 8:{
b.offset = -8;
set_label(qword_lab);
operate_fmt_immediate(i_cmplt,sizereg,8,rtest);
integer_branch(i_bne,rtest,lword_lab);
b.base = src;
load_store(i_ldq,movereg,b);
b.base = dest;
load_store(i_stq,movereg,b);
operate_fmt_immediate(i_subq,src,8,src);
operate_fmt_immediate(i_subq,dest,8,dest);
operate_fmt_immediate(i_subq,sizereg,8,sizereg);
integer_branch(i_beq,sizereg,endlab);
integer_branch(i_br,31,qword_lab);
}
FALL_THROUGH;
case 4:{
b.offset = -4;
set_label(lword_lab);
operate_fmt_immediate(i_cmplt,sizereg,4,rtest);
integer_branch(i_bne,rtest,byte_lab);
b.base = src;
load_store(i_ldl,movereg,b);
b.base = dest;
load_store(i_stq,movereg,b);
operate_fmt_immediate(i_subq,src,4,src);
operate_fmt_immediate(i_subq,dest,4,dest);
operate_fmt_immediate(i_subq,sizereg,4,sizereg);
integer_branch(i_beq,sizereg,endlab);
integer_branch(i_br,31,lword_lab);
}
FALL_THROUGH;
case 2:
FALL_THROUGH;
case 1:{
int rtmp = getreg(sp.fixed);
int rtmp2 = getreg(sp.fixed);
b.offset = -1;
set_label(byte_lab);
integer_branch(i_beq,sizereg,endlab);
b.base=src;
load_store(i_ldq_u,movereg,b);
setnoat();
load_store(i_lda,AT,b);
operate_fmt(i_extbl,movereg,AT,movereg);
b.base=dest;
load_store(i_lda,AT,b);
load_store(i_ldq_u,rtmp,b);
operate_fmt(i_insbl,movereg,AT,rtmp2);
operate_fmt(i_mskbl,rtmp,AT,rtmp);
setat();
operate_fmt(i_bis,rtmp,rtmp2,rtmp);
load_store(i_stq_u,rtmp,b);
operate_fmt_immediate(i_subq,src,1,src);
operate_fmt_immediate(i_subq,dest,1,dest);
operate_fmt_immediate(i_subq,sizereg,1,sizereg);
integer_branch(i_bne,sizereg,byte_lab);
}
}
set_label(endlab);
return;
}
/****************************************************************/
static void reset_tos
(void)
{
if (Has_tos) {
baseoff b;
b.base = FP;
b.offset = - ((PTR_SZ>>3)*2) - arg_stack_space;
load_store(i_stq,SP,b);
}
return;
}
/*
This function finds the last test in the sequence e which is
a branch to second, if any exists, otherwise it returns nil.
*/
static exp testlast
(exp e, exp second)
{
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
(exp e)
{
bool res=0;
if (isparam(e)) {
e = bro(son(e));
while (name(e) == diagnose_tag)
e = son(e);
if ((name(e)!= ident_tag) || !isparam(e) ||
name(son(e)) ==formal_callee_tag)
res=1;
}
return res;
}
void test_unsigned
(int reg, unsigned long upper, unsigned trap)
{
setnoat();
operate_fmt_big_immediate(i_cmpule,reg,upper,AT);
integer_branch(i_beq,AT,trap);
setat();
return;
}
void test_signed
(int reg, long lower, long upper, int trap)
{
setnoat();
operate_fmt_big_immediate(i_cmplt,reg,lower,AT);
integer_branch(i_bne,AT,trap);
operate_fmt_big_immediate(i_cmple,reg,upper,AT);
integer_branch(i_beq,AT,trap);
setat();
return;
}
void test_signed_and_trap
(int reg, long lower, long upper, int except)
{
int ok_lab = new_label();
int jump_label = new_label();
setnoat();
operate_fmt_big_immediate(i_cmplt,reg,lower,AT);
integer_branch(i_bne,AT,jump_label);
operate_fmt_big_immediate(i_cmple,reg,upper,AT);
integer_branch(i_beq,AT,jump_label);
setat();
integer_branch(i_br,31,ok_lab);
set_label(jump_label);
do_exception(except);
set_label(ok_lab);
return;
}
void test_unsigned_and_trap
(int reg, unsigned long upper, unsigned except)
{
int ok_lab = new_label();
setnoat();
operate_fmt_big_immediate(i_cmpule,reg,upper,AT);
integer_branch(i_bne,AT,ok_lab);
setat();
do_exception(except);
set_label(ok_lab);
return;
}
/*
This function returns a register for use as a destination operand.
If the final destination is in a register then that register is
returned, otherwise a new register is selected from the pool.
*/
int regfrmdest
(where *dest, space sp)
{
switch (dest->answhere.discrim) {
case inreg:{
return regalt(dest->answhere);
}
default :{
return getreg(sp.fixed);
}
}
}
freg fregfrmdest
(where *dest, space sp)
{
switch (dest->answhere.discrim) {
case infreg: {
return fregalt(dest->answhere);
}
default : {
freg fr;
fr.fr = getfreg(sp.flt);
fr.type = IEEE_double;
return fr;
}
}
}
/*
Divide dividend by divisor using the divide instructions supplied
by the the assembler. These divide instructions corrupt the t-regs
23,24,25,27(PV), and 28(AT) which have to be protected if in use.
Returns result register.
*/
static int divide_using_div
(exp div, exp dividend, exp divisor, where dest, space sp, instruction div_ins)
{
int r_result;
space newsp;
int r_dividend,r_divisor;
int uns;
newsp = guardreg(AT,sp);
uns = !is_signed(sh(dividend));
r_result = regfrmdest(&dest,newsp);
if (r_result == NO_REG) {
r_result = getreg(newsp.fixed);
}
newsp = guardreg(r_result,newsp);
r_dividend = reg_operand(dividend,newsp);
clear_reg(AT),clear_reg(23),clear_reg(24),clear_reg(25),clear_reg(27);
newsp = guardreg(r_dividend,newsp);
if (r_result == NO_REG)r_result = getreg(newsp.fixed);
if (name(divisor) == val_tag && optop(div)) {
r_divisor = no(divisor);
}
else{
r_divisor = reg_operand(divisor,newsp);
}
if (!optop(div) && !error_treatment_is_trap(div)) {
/* test for (-inf)/-1 and /0 */
int over = new_label();
int trap = trap_label(div);
integer_branch(i_beq,r_divisor,trap);
if (!(is_signed(sh(div)))) {
int rt=getreg(newsp.fixed);
comment(" check unsigned overflow ");
operate_fmt_immediate(i_cmpeq,r_divisor,-1,rt);
integer_branch(i_bne,rt,trap);
set_label(over);
}
}
if (!optop(div) && is_signed(sh(div)) && (is64(sh(div)) || is32(sh(div)))) {
int continue_lab = new_label();
setnoat();
operate_fmt_immediate(i_cmpeq,r_divisor,-1,AT);
integer_branch(i_beq,AT,continue_lab);
operate_fmt_big_immediate(i_cmpeq,r_dividend,maxmin(sh(div)).mini,AT);
integer_branch(i_beq,AT,continue_lab);
if (error_treatment_is_trap(div)) {
do_exception(f_overflow);
}
else{
integer_branch(i_br,31,trap_label(div));
}
set_label(continue_lab);
setat();
}
if ((name(divisor)!= val_tag) || !optop(div)) {
operate_fmt(div_ins,r_dividend,r_divisor,r_result);
}
else{
operate_fmt_immediate(div_ins,r_dividend,r_divisor,r_result);
}
if (name(div) == div1_tag) {
int rem_neg = new_label();
int exitlab = new_label();
int rrem = getreg(newsp.fixed);
if ((name(divisor)!= val_tag) || !optop(div)) {
operate_fmt(((uns)?((is64(sh(div)))?i_remqu:i_remlu):
(is64(sh(div)))?i_remq:i_reml),
r_dividend,r_divisor,rrem);
}
else {
operate_fmt_immediate(((uns)?((is64(sh(div)))?i_remqu:i_remlu):
(is64(sh(div)))?i_remq:i_reml),
r_dividend,r_divisor,rrem);
}
integer_branch(i_beq,rrem,exitlab);
integer_branch(i_blt,rrem,rem_neg);
/*set_label(rem_pos);*/
integer_branch(i_bge,r_divisor,exitlab);
operate_fmt_immediate((is64(sh(div)))?i_addq:i_addl,r_result,-1,r_result);
integer_branch(i_br,31,exitlab);
set_label(rem_neg);
integer_branch(i_ble,r_divisor,exitlab);
operate_fmt_immediate((is64(sh(div)))?i_addq:i_addl,r_result,-1,r_result);
set_label(exitlab);
}
if (!optop(div)) {
switch (name(sh(div))) {
case ucharhd:{
if (error_treatment_is_trap(div)) {
test_unsigned_and_trap(r_result,255,f_overflow);
}
else {
test_unsigned(r_result,255,trap_label(div));
}
break;
}
case scharhd:{
if (error_treatment_is_trap(div)) {
test_signed_and_trap(r_result,-128,127,f_overflow);
}
else{
test_signed(r_result,-128,127,trap_label(div));
}
break;
}
case uwordhd:{
if (error_treatment_is_trap(div)) {
test_unsigned_and_trap(r_result,0xffff,f_overflow);
}
else {
test_unsigned(r_result,0xffff,trap_label(div));
}
break;
}
case swordhd: {
if (error_treatment_is_trap(div)) {
test_signed_and_trap(r_result,-0x8000,0x7fff,f_overflow);
}
else {
test_signed(r_result,-0x8000,0x7fff,trap_label(div));
}
break;
}
case ulonghd:{
if (error_treatment_is_trap(div)) {
test_unsigned_and_trap(r_result,0xffffffff,f_overflow);
}
else{
test_unsigned(r_result,0xffffffff,trap_label(div));
}
break;
}
case slonghd:{
if (error_treatment_is_trap(div)) {
test_signed_and_trap(r_result,-0x80000000L,0x7fffffff,f_overflow);
}
else{
test_signed(r_result,-0x80000000L,0x7fffffff,trap_label(div));
}
break;
}
case s64hd:{
if (error_treatment_is_trap(div)) {
test_signed_and_trap(r_result,-0x8000000000000000L,0x7fffffffffffffffL
,f_overflow);
}
else{
test_signed(r_result,-0x8000000000000000L,0x7fffffffffffffffL
,trap_label(div));
}
break;
}
case u64hd:{
if (error_treatment_is_trap(div)) {
test_unsigned_and_trap(r_result,0xffffffffffffffffL,f_overflow);
}
else{
test_unsigned(r_result,0xffffffffffffffffL,trap_label(div));
}
break;
}
default:failer("Illegal shape in div");
}
}
return r_result;
}
static int proc_has_vararg;
/*
Process a parameter list
*/
space do_callers
(exp list, space sp, int *sizecallers)
{
int disp;
int spar;
int fpar = 16;
ash ansash;
bool hadfixed;
instore is;
is.b.base = SP;
is.b.offset = 0;
is.adval = 1;
#ifdef DO_SPECIAL
if ((disp = specialfn (fn)) > 0) { /* eg function is strlen */
mka.lab = specialmake(disp, list, sp, dest, exitlab);
return mka;
}
#endif
ansash = ashof(sh(list));
disp = 0;
spar = FIRST_INT_ARG;/* register holding 1st integer parameter */
hadfixed = 0;
for (;;) { /* evaluate parameters in turn */
int hd = name(sh(list));
where w;
ash ap;
int paral;
int parsize;
ap = ashof(sh(list));
paral = (ap.ashalign < 32)?32:ap.ashalign;
if (spar>21) {
ap.ashalign=64;
paral = 64;
}
parsize = ap.ashsize;
/* all parameters passed on stack are quadword aligned */
w.ashwhere = ap;
disp = rounder(disp,paral);
spar = FIRST_INT_ARG+ (disp>>6);
fpar = FIRST_FLOAT_ARG+ (disp>>6);
if (disp>448) {spar =22; fpar = 22; }
if (is_floating(hd) && disp+parsize <= 384) {
freg frg;
ans ansfr;
frg.fr = fpar++;
if (hd != shrealhd)
frg.type = IEEE_double;
else
frg.type = IEEE_single;
setfregalt(ansfr, frg);
w.answhere = ansfr;
code_here(list, sp, w);
/* evaluate parameter into floating parameter register */
sp = guardfreg(frg.fr, sp);
}
else if (((valregable(sh(list)) || (name(sh(list)) ==cpdhd)) ||
(name(sh(list)) ==nofhd)) && spar<=21) {
/* compound types are always passed in registers
(given enough space). */
ans ansr;
int par_reg;
int numleft = parsize- ((LAST_INT_ARG-spar+1) <<6);
int pregs_used = min((numleft>>6) +6,6);
hadfixed=1;
setregalt(ansr,spar);
w.answhere=ansr;
for (par_reg=spar;par_reg<spar+pregs_used;++par_reg) {
sp = guardreg(par_reg,sp);
}
sp = guardreg(spar,sp);
code_here(list,sp,w);
if (numleft>0) {
is.b.offset+=(numleft>>3); /* += number of bytes remaining */
}
}
else {
/* pass remaining parameters on the stack.
The parameters are aligned on 8 byte boundaries.
*/
setinsalt(w.answhere, is);
is.b.offset+= (max(ap.ashsize,REG_SIZE) >>3);
/* 'size' was used here */
code_here(list, sp, w);
hadfixed = 1;
/* eval parameter into argument space on stack */
}
if (name(list) == caller_tag) {
no(list) = disp;
}
disp+=parsize;
disp = rounder(disp, REG_SIZE);
*sizecallers = min(disp,NUM_PARAM_REGS*REG_SIZE);
if (last(list)) return sp;
list = bro(list);
} /* end for */
return sp;
}
void load_reg
(exp e, int r, space sp)
{
where w;
w.ashwhere = ashof(sh(e));
setregalt(w.answhere,r);
code_here(e,sp,w);
return;
}
static postlude_chain * old_postludes;
void update_plc
(postlude_chain *chain, int ma)
{
while (chain) {
exp pl = chain->postlude;
while (name(pl) == ident_tag && name(son(pl)) == caller_name_tag) {
no(pl) += (ma<<1);
pl = bro(son(pl));
}
chain = chain->outer;
}
return;
}
/*
This function finds the caller_tag corresponding to a caller_name tag
*/
exp find_ote
(exp name, int n)
{
exp dad = father(name);
while (name(dad)!= apply_general_tag) {
dad = father(dad);
}
dad = son(bro(son(dad)));
while (n) {
dad = bro(dad);
n --;
}
Assert(name(dad) == caller_tag);
return dad;
}
/*
This function produces code for expression e, evaluating
its result into dest.
*/
makeans make_code
(exp e, space sp, where dest, int exitlab)
{
INT64 constval;
makeans mka;
static int param_stack_space;
static int sizecallers = 0;
tailrecurse:
mka.lab = exitlab;
mka.regmove = NOREG;
clear_INT64(constval);
switch (name(e)) {
case ident_tag: {
where placew;
int r = NOREG;
bool remember = 0;
placew = nowhere;
if (name(sh(son(e))) == ptrhd && name(son(e))!= cont_tag) {
/* We should never be identifing a pointer to bits */
if (al1(sh(son(e))) == 1) {
#if 0
failer("Identify REF BITS");
#endif
}
}
if (is_param_reg(no(e)) && is32(sh(son(e))) &&
name(son(e))!=formal_callee_tag) {
operate_fmt_immediate(i_addl,no(e),0,no(e));
}
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) {
placew = nowhere; /* is this needed? */
}
else if (name(son(e)) == caller_name_tag) {
exp ote = find_ote(e,no(son(e)));
int disp = no(ote);
if (in_vcallers_apply) {
/* bit of a hack here */
if (is_floating(name(sh(son(e))))) {
no(e) = (((disp-sizecallers) >>3) <<4) + SP;
}
else {
no(e) = (((disp - 6*PTR_SZ) >>3) <<4) +SP;
}
}
else {
no(e) = (((disp-sizecallers) >>3) <<4) + SP;
}
placew = nowhere;
}
else {
ash a;
int n = no(e);
a = ashof(sh(son(e)));
if (is_param_reg(n) && (props(e) &inreg_bits) && proc_has_vararg) {
props(e) &= (~inreg_bits);
}
if (((props(e) & inreg_bits)!= 0)) {
/* tag in some fixed pt reg */
if (n == NO_REG) {
/* if it hasn't been already allocated
into a s-reg (or r0) allocate tag into
fixed t-reg ... */
int s = sp.fixed;
if (props (e) & notparreg)/* ... but not a parameter reg */
s |= PARAM_REGS;
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 == NO_REG) {
/* 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;
}
frg.fr = n;
if (a.ashsize == 64)
frg.type = IEEE_double;
else
frg.type = IEEE_single;
setfregalt(placew.answhere, frg);
}
else if (isparam(e)) {
if (name(son(e))!= formal_callee_tag) {
instore is;
int this_reg=-1;
int comp_size;
/* floating point registers are to be separated
from fixed point registers when saving to the
stack */
int n;
int offset_adjustment;
if (proc_has_vararg && !is_floating(name(sh(son(e))))) {
offset_adjustment = 6 * PTR_SZ;
}
else {
offset_adjustment = arg_stack_space *8;
}
if (Has_fp) {
n = (no(son(e)) >>3) - (offset_adjustment>>3);
}
else{
n= (((no(son(e)) +frame_size+callee_size-offset_adjustment) >>3));
}
if (props(son(e))) {
this_reg = (props(son(e)) -16) <<6;
}
/* save all parameters in 64 bit chunks */
/* Byte disp of params */
is.b.offset = n;
is.b.base = (Has_fp)?FP:SP;
is.adval =1;
setinsalt(placew.answhere, is);
if (Has_fp) {
if (Has_no_vcallers || is_floating(name(sh(son(e))))) {
no(e) = ((no(son(e)) +frame_size+callee_size-locals_offset-
(offset_adjustment)) <<1) +FP;
}
else{
no(e) = ((no(son(e)) + frame_size + callee_size -locals_offset
- (arg_stack_space<<3)) <<1) +FP;
no(e) = ((no(son(e)) + frame_size + callee_size -locals_offset
- (offset_adjustment)) <<1) +FP;
}
}
else{
no(e) = ((no(son(e)) +frame_size+callee_size-locals_offset -
(offset_adjustment)) <<1) +SP;
}
if ((a.ashsize>64) && (this_reg != -1)) {
for (comp_size=a.ashsize;(comp_size>0) && (this_reg<384);
comp_size -= 64) {
load_store(i_stq,16+ (this_reg>>6),is.b);
this_reg+=64;
is.b.offset+=8;
}
/*props(son(e))=0;*/ /* ensures it wont be saved again */
}
if (proc_has_vararg && last_param(e) && (this_reg>=0)) {
/* attempt to detect vararg */
int r = rounder(no(son(e)) +shape_size(sh(son(e))), REG_SIZE);
setinsalt(placew.answhere,is);
for (r=this_reg;r<=320;r+=64) {
/* no need to save first freg */
is.b.offset = ((r+paramsdumpstart) >>3) -
((is.b.base == FP)?(frame_size>>3):0);
float_load_store(i_stt,16+ (r>>6),is.b);
}
for (r=this_reg;r<=320;r+=64) {
is.b.offset = ((r+gpdumpstart) >>3) -
((is.b.base == FP)?(frame_size>>3):0);;
load_store(i_stq,16+ (r>>6),is.b);
}
is.b.offset = n;
}
else{
if ((name(sh(son(e))) ==cpdhd) && (a.ashsize==64)) {
/* the alignment of a complex shape is the
maximum of the alignments of its components.
This assignment overrides that rule in order
to simplify saving the parameter to the stack.
*/
a.ashalign=a.ashsize;
}
is.b.offset = n;
}
setinsalt(placew.answhere, is);
remember =1;
}
else{
no(e) = ((no(son(e)) + frame_size - locals_offset) <<1) +
((Has_vcallees)?local_reg:FP);
if (!Has_vcallees) {
no(e) -= (arg_stack_space<<4);
}
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 == SP) {
is.b.offset += locals_offset >> 3;
}
else if ((base == FP && Has_fp)) {
#if 1
is.b.offset += (((locals_offset-callee_size-frame_size) >>3)
/*- ((in_general_proc)?0:arg_stack_space)*/);
#else
is.b.offset += (((locals_offset-callee_size-frame_size) >>3)
-arg_stack_space);
#endif
}
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 = (Has_fp)?FP:SP;
is.b.offset = ((no(se) - (arg_stack_space<<3)) +
((Has_fp)?0:((callee_size+frame_size)))) >>3;
is.adval = 0;
setinsalt(a, is);
(void)move(a,placew, sp, name(sh(se)) & 1);
}
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);
if (name(sh(se))!=shrealhd)
fr.type = IEEE_double;
else
fr.type = IEEE_single;
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 & (1<< (sr)))!= 0) {
float_op((name(sh(se))!= shrealhd)? i_cpys: i_cpys,
(int)props(se), (int)(props(se)),no(d));
}
else {
props(se) = sr; no(d) = tr;
sp = guardfreg(tr, sp);
/* !? swopped and moved in dump_tag !? */
}
}
else {
if ((fixdone & (1<<sr))!=0) {
/* operate_fmt(i_bis,no(d),no(d),(int)props(se));*/
operate_fmt(i_bis,(int)props(se), (int)props(se),no(d));
}
else {
props(se) = sr; no(d) = tr;
sp = guardreg(tr,sp);
/* !? swapped 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;
is.b.base = FP;
is.b.offset = (no(se) - callee_size) >>3;
is.adval = 0;
setinsalt(a, is);
(void)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
&& 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;
exp record;
record = getexp(f_bottom,nilexp,0,nilexp,nilexp,0,0,0);
#if DO_SCHEDULE && ENCAPSULATE_LABELS
start_new_capsule(true);
#endif
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.type = sfr.type;
setfregalt(dest.answhere, fr);
}
if (name(first) == goto_tag && pt(first) == second) {
/* first is goto second */
no(son(second)) = 0;
mka = make_code(second, sp, dest, exitlab);
#if DO_SCHEDULE && ENCAPSULATE_LABELS
close_capsule();
#endif
return mka;
}
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;
#if DO_SCHEDULE && ENCAPSULATE_LABELS
close_capsule();
#endif
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)));
mka = make_code(first, sp, dest, exitlab);
#if DO_SCHEDULE && ENCAPSULATE_LABELS
close_capsule();
#endif
return mka;
}
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;
#if DO_SCHEDULE && ENCAPSULATE_LABELS
close_capsule();
#endif
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());
if (name(sh(first))!=bothd)integer_branch(i_br,31,l);
make_code(second, sp, dest, l);
clear_all();
mka.lab = l;
#if DO_SCHEDULE && ENCAPSULATE_LABELS
close_capsule();
#endif
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 = FP;
if (Has_vcallees) {
#if 0
b.offset = -arg_stack_space- (3*(PTR_SZ>>3));
#endif
b.offset = - (3*(PTR_SZ>>3));
load_store(i_ldq,local_reg,b);
}
if (Has_tos) {
b.offset = - (PTR_SZ>>3) - (arg_stack_space);
load_store(i_ldq,SP,b);
}
else {
comment("labst_tag:");
operate_fmt_immediate(i_subq,FP,(frame_size+callee_size) >>3,SP);
}
}
e = bro(son(e));
goto tailrecurse;
} /* end labst */
case rep_tag: {
exp first = son(e);
exp second = bro(first);
#if DO_SCHEDULE && ENCAPSULATE_LABELS
/* start_new_capsule(true);*/
#endif
code_here(first,sp,nowhere);
no(son(second)) = new_label();
/*e = second;*/
mka = make_code(second,sp,dest,exitlab);
#if DO_SCHEDULE && ENCAPSULATE_LABELS
/* close_capsule();*/
#endif
return mka;
/*goto tailrecurse;*/
} /* end rep */
case goto_tag: {
int lab = no(son(pt(e)));
clear_all();
integer_branch(i_br,31,lab);
return mka;
} /* end goto */
case make_lv_tag: {
int r = regfrmdest(&dest,sp);
ans aa;
load_store_label(i_lda,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);
comment("long jump");
operate_fmt(i_bis,fp,fp,FP); /* move fp into FP */
/* load labval into register*/
integer_jump(i_jmp,31,labval,0);
return mka;
}
/*
max(x,y) and min(x,y)
*/
case offset_max_tag:
case max_tag:
case min_tag:{
exp l = son(e);
exp r = bro(l);
int a1= reg_operand(l,sp);
int a2 = reg_operand(r,sp);
int d = regfrmdest(&dest,sp);
int rtmp = getreg(guardreg(d,sp).fixed);
ans aa;
operate_fmt(i_bis,a1,a1,d);
operate_fmt(is_signed(sh(l))?i_cmplt:i_cmpult,a1,a2,rtmp);
if ((name(e) == max_tag) || (name(e) == offset_max_tag)) {
operate_fmt(i_cmovne,rtmp,a2,d);
}
else{
operate_fmt(i_cmoveq,rtmp,a2,d);
}
setregalt(aa,d);
(void)move(aa,dest,guardreg(d,sp),0);
mka.regmove=d;
return mka;
}
case fmax_tag: {
exp l = son(e);
exp r = bro(l);
int a1 = freg_operand(l,sp);
int a2 = freg_operand(r,sp);
freg rd;
int rtmp;
ans aa;
rd = fregfrmdest(&dest,sp);
rtmp = getfreg(guardreg(rd.fr,sp).fixed);
float_op(i_cpys,a1,a1,rd.fr);
float_op(i_cmptlt,a1,a2,rtmp);
float_op(i_fcmovne,rtmp,a2,rd.fr);
setfregalt(aa,rd);
mka.regmove = move(aa,dest,guardfreg(rd.fr,sp),1);
return mka;
}
case abslike_tag:{
/* if (test x) then res = -x, else res = x *
The code produced for this construct is:
move x to res, neg x -> y, cmov(test) x,y,res.
If the test is unsigned then we can optimise certain
cases, i.e. less-than and greater-than-or-equal are
always false and true respectively
*/
exp l = son(son(e));
shape shl = sh(l);
instruction cmove_ins;
space nsp;
int test_num;
int dest_reg;
int uns;
ans aa;
int a1,rtmp;
nsp = sp;
test_num = props(son(e));
dest_reg = regfrmdest(&dest,nsp);
mka.regmove = dest_reg;
setregalt(aa,dest_reg);
uns = !is_signed(shl);
nsp = guardreg(dest_reg,nsp);
a1 = reg_operand(l,nsp);
nsp = guardreg(dest_reg,nsp);
rtmp = getreg(nsp.fixed);
operate_fmt(i_bis,a1,a1,dest_reg);
cmove_ins = condmove(test_num);
operate_fmt(i_subq,31,a1,rtmp);
operate_fmt(cmove_ins,a1,rtmp,dest_reg);
move(aa,dest,guardreg(dest_reg,nsp),0);
return mka;
}
case absbool_tag:
/*case abslike_tag:*/{
/*
need to clear up the distinctions between comparison and
conditional move.
*/
exp l = son(son(e));
exp r = bro(l);
shape shl = sh(l);
instruction compare_ins;
int n = props(son(e));
int d;
int a1;
int a2;
bool xlike = (name(e)!= absbool_tag);
ans aa;
bool uns = (!is_signed(shl));
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;
}
}
(void)compares(&compare_ins,shl,n);
d = regfrmdest(&dest, sp);
/* reg d will contain result of compare */
a1 = reg_operand(l, sp);
sp = guardreg(a1,sp);
if (xlike && a1==d) {
d = getreg(sp.fixed);
}
if (name(r) == val_tag) {
if ((n==1) || (n==2)) {
int rt = getreg(guardreg(d,sp).fixed);
if (no(r)) {
INT64 res;
if (isbigval(r)) {
INT64_assign(res,flt64_to_INT64(exp_to_f64(r)));
/*res=flt64_to_INT64(exp_to_f64(r));*/
}
else{
INT64_assign(res,make_INT64(0,no(r)));
}
load_store_immediate(i_ldiq,rt,res);
}
else
rt=31;
if (name(e)!=absbool_tag) {
int rtmp;
if (uns) {
rtmp = getreg(sp.fixed);
operate_fmt(compare_ins,rt,a1,rtmp);
}
else{
rtmp = rt;
}
compare_ins=condmove(n);
operate_fmt(i_bis,rtmp,rtmp,d);
operate_fmt(compare_ins,a1,a1,d);
}
else
operate_fmt(compare_ins,rt,a1,d);
}
else{
if (isbigval(r)) {
operate_fmt_big_immediate(compare_ins,a1,
flt64_to_INT64(exp_to_f64(r)),d);
}
else{
operate_fmt_immediate(compare_ins,a1,no(r),d);
}
}
if(n==6) /* ? */
operate_fmt(i_cmpeq,d,31,d);
/* invert the result */
}
else {
space nsp;
nsp = guardreg(a1, sp);
a2 = reg_operand(r, nsp);
if (xlike && a2==d) {
nsp = guardreg(a2, nsp);
d = getreg(nsp.fixed);
}
if ((n==1) || (n==2))
operate_fmt(compare_ins,a2,a1,d);
else
operate_fmt(compare_ins,a1,a2,d);
if (n==6)operate_fmt(i_cmpeq,d,31,d);
}
if (name(e) ==maxlike_tag || name(e) ==minlike_tag) {
instruction ins;
int l = new_label();
setnoreorder();
ins= (name(e) ==maxlike_tag)?i_bne:i_beq;
/*operate_fmt(i_addu, d, a1, 0);*/
integer_branch(ins,d,l);
if (name(r) ==val_tag) {
INT64 v;
low_INT64(v) = no(r);
load_store_immediate(i_ldil,d,v);
}
else operate_fmt(i_bis,no(r),no(r),d);
set_label_no_clear(l);
setreorder();
}
else
if (name(e) ==abslike_tag) {
int l1 = new_label();
int l2 = new_label();
setnoreorder();
integer_branch(i_bne,d,l2);
operate_fmt(i_subq, 31, a1, d);
integer_branch(i_br,31,l1);
set_label(l2);
operate_fmt(i_bis,a1,a1,d);
set_label_no_clear(l1);
setreorder();
}
setregalt(aa, d);
move(aa,dest, guardreg(d, sp), 0);
mka.regmove = d;
return mka;
} /* end absbool */
case test_tag: {
/*
Tests are performed by either a comparison or subraction
instruction, followed by a conditional branch. If the
test is unsigned, or if a subtraction could cause an
overflow, then comparisons must be used.
*/
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);
instruction test_ins;
int n = (props (e)) & 127; /* could have Rev bit in props*/
bool rev;
bool is_compare = ((!is_signed(shl)) && ((n-5) <0) &&
(name(shl)!=ptrhd)) || ((is64(shl)));
is_compare = TRUE;
if (is_floating(name(sh(l)))) {
instruction compare_ins;
space nsp;
int rev;
int a1,a2,dest;
a1 = freg_operand(l,sp);
nsp = guardfreg(a1,sp);
a2 = freg_operand(r,nsp);
dest = getfreg(nsp.flt);
rev = fdouble_comparisons(&compare_ins,n);
float_op(compare_ins,a1,a2,dest);
float_branch(rev?i_fbeq:i_fbne,dest,lab);
return mka;
}
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;
}
}
if (is_compare) {
rev = comparisons(&test_ins,shl, n);
}
else{
rev = 0;
test_ins = sbranches(n);
}
a1 = reg_operand(l, sp);
if (name(r) == val_tag) {
space nsp;
int rtemp;
switch (name(sh(r))) {
case ucharhd:{
no(r) = (unsigned char)no(r);
break;
}
case scharhd:{
no(r) = (char)no(r);
break;
}
case swordhd:{
no(r) = (short)no(r);
break;
}
case uwordhd:{
no(r) = (unsigned short)no(r);
break;
}
}
if ((no(r)!=0) || (isbigval(r))) {
nsp=guardreg(a1,sp);
rtemp=getreg(nsp.fixed);
if (is_compare) {
if (isbigval(r)) {
operate_fmt_big_immediate(test_ins,a1,exp_to_INT64(r),rtemp);
}
else{
operate_fmt_immediate(test_ins,a1,no(r),rtemp);
}
integer_branch(rev?i_beq:i_bne,rtemp,lab);
}
else{
if (name(shl) ==ulonghd) {
operate_fmt_immediate(i_addl,a1,0,a1);
}
if (isbigval(r)) {
INT64 res = flt64_to_INT64(exp_to_f64(r));
operate_fmt_big_immediate(i_subq,a1,res,rtemp);
}
else{
operate_fmt_immediate(i_subq,a1,no(r),rtemp);
}
integer_branch(test_ins,rtemp,lab);
}
}
else{
if (is_compare) {
int rtmp=getreg(guardreg(a1,sp).fixed);
if (is_signed(shl)) {
test_ins = sbranches(n);
integer_branch(test_ins,a1,lab);
}
else{
operate_fmt(test_ins,a1,31,rtmp);
integer_branch(rev?i_beq:i_bne,rtmp,lab);
}
}
else{
int dreg=a1;
integer_branch(test_ins,dreg,lab);
}
}
}
else {
space nsp;
int rtemp;
nsp = guardreg(a1, sp);
a2 = reg_operand(r, nsp);
if (a2!=31) {
rtemp=getreg(guardreg(a2,nsp).fixed);
if (is_compare) {
operate_fmt(test_ins,a1,a2,rtemp);
integer_branch(rev?i_beq:i_bne,rtemp,lab);
}
else{
operate_fmt(is64(sh(son(e)))?i_subq:i_subl,a1,a2,
rtemp);
integer_branch(test_ins,rtemp,lab);
}
}
else{
test_ins = sbranches(n);
integer_branch(test_ins,a1,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;
if (arhs.ashsize==64)
frg.type = IEEE_double;
else
frg.type = IEEE_single;
setfregalt(aa, frg);
}
else {
setregalt(aa, RESULT_REG);
}
assdest = locate(lhs, guardreg(RESULT_REG,sp), sh(rhs), NO_REG);
move(aa,assdest, sp, 1);
move(aa,dest, sp, 1);
clear_dep_reg(lhs);
return mka;
}
/* if (al1(sh(lhs)) == 1 || arhs.ashalign == 1)
clear_reg (0);*/
assdest = locate(lhs, sp, sh(rhs), NO_REG);
nsp = guard(assdest, sp);
/* evaluate address of destination */
if (assdest.ashwhere.ashalign == 1) {
/* this is an assignment of a bitfield, so get address
in proper form */
instore is;
switch (assdest.answhere.discrim) {
case inreg: {
is.b.base = regalt(assdest.answhere);
is.b.offset = 0;
is.adval = 1;
break;
}
case notinreg: {
is = insalt(assdest.answhere);
if (!is.adval) {
int r = getreg(nsp.fixed);
load_store(i_ldq,r,is.b);
nsp = guardreg(r, nsp);
is.adval = 1;
is.b.base = r;
is.b.offset = 0;
}
else {
is.b.offset = is.b.offset << 3;
}
break;
}
#if 0
case bitad: {
is = bitadalt(assdest.answhere);
break;
}
#endif
default:
failer("Wrong assbits");
}
/* setbitadalt (assdest.answhere, is);*/
}
else if (name(e) == ass_tag
&& assdest.answhere.discrim == notinreg
&& assdest.ashwhere.ashsize == assdest.ashwhere.ashalign) {
instore is;
is = insalt(assdest.answhere);
if (!is.adval) {
/* this is an indirect assignment, so make
it direct by loading pointer into a register
(and remember it) */
int r = getreg(nsp.fixed);
load_store(i_ldq,r,is.b);
nsp = guardreg(r, nsp);
is.adval = 1;
is.b.base = r;
is.b.offset = 0;
setinsalt(assdest.answhere, is);
keepexp(lhs, assdest.answhere);
}
}
contreg = code_here(rhs, guard(assdest,nsp), assdest);
/*
evaluate source into assignment destination
and move it into dest - could use assignment as value
*/
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 */
move(assdest.answhere,dest, nsp, 1);
break;
}
case infreg:{
freg frg;
int r;
frg = fregalt(assdest.answhere);
r = frg.fr + 32;
if (frg.type==IEEE_double) {
r = -r;
};
keepreg(rhs, r);
/* remember that source has been evaluated into a */
clear_dep_reg(lhs);
/* forget register dependencies on destination */
move(assdest.answhere,dest, nsp, 1);
break;
}
case notinreg : /*case bitad: */{
if (contreg != NOREG && name(e) == ass_tag) {
ans aa;
space nnsp;
if (contreg > 0 && contreg < 31) {
setregalt(aa, contreg);
nnsp = guardreg(contreg, sp);
}
else {
freg frg;
frg.fr = abs(contreg) - 32;
if (contreg<0)
frg.type = IEEE_double;
else
frg.type = IEEE_single;
nnsp = nsp;
setfregalt(aa, frg);
}
move(aa,dest, nnsp, 1);
clear_dep_reg(lhs);
/* forget register dependencies on destination */
if (name(lhs) == name_tag || !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 */
move(assdest.answhere,dest, nsp, 1);
break;
case insomereg: case insomefreg: {
clear_dep_reg(lhs);
/* forget register dependencies on destination */
move(assdest.answhere,dest, guard(assdest, sp), 1);
}
}
} /* 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);
load_store(i_ldq,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);
}
FALL_THROUGH;
case inreg: {
code_here(bro(t), sp, dest);
r = regalt(dest.answhere);
Assert(name(t) ==val_tag);
if (no(t)!=0) {
operate_fmt_immediate(i_sll, r,
(al2(sh(t)) >= 8)?(no(t) <<3):no(t),r);
}
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) {
operate_fmt_immediate
(i_sll, z,(al2(sh(t)) >= 8)?(no(t) <<3):no(t),z);
}
operate_fmt(i_bis, z, z, r);
}
return mka;
}
default: failer("No Tuples in freg");
}
break;
} /* end tup */
case nof_tag:
case concatnof_tag:{
exp t = son(e);
space nsp;
instore str;
int 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);
load_store(i_ldq,r,str.b);
str.adval = 1;
str.b.base = r;
str.b.offset = 0;
}
for (;;) {
where newdest;
instore newis;
if (t == nilexp) return mka;
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);
/* ,... */
}
FALL_THROUGH;
case inreg: {
if (t == nilexp) return mka;
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);
operate_fmt_immediate(i_sll, z,disp,z);
operate_fmt(i_bis, z, z, r);
}
return mka;
}
default: failer("No Tuples in freg");
}
break;
}
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);
load_store(i_ldq,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);
}
FALL_THROUGH;
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);
operate_fmt_immediate(i_sll, z,disp,z);
operate_fmt(i_bis, z, z, r);
}
return mka;
}
default: failer("No Tuples in freg");
}
break;
}
case apply_tag:{
exp fn = son(e);
exp par = bro(fn);
exp list = par;
int hda = name(sh(e));
int disp;
int spar;
int fpar = 16;
ash ansash;
bool hadfixed;
instore is;
is.b.base = SP;
is.b.offset = 0;
is.adval = 1;
#ifdef DO_SPECIAL
if ((disp = specialfn (fn)) > 0) { /* eg function is strlen */
mka.lab = specialmake(disp, list, sp, dest, exitlab);
return mka;
}
#endif
ansash = ashof(sh(e));
disp = 0;
spar = FIRST_INT_ARG;/* register holding 1st integer parameter */
hadfixed = 0;
if (!last(fn)) {
for (;;) { /* evaluate parameters in turn */
int hd = name(sh(list));
where w;
ash ap;
int paral;
int parsize;
ap = ashof(sh(list));
paral = (ap.ashalign < 32)?32:ap.ashalign;
if (spar>21) {
ap.ashalign=64;
paral = 64;
}
parsize = ap.ashsize;
/* all parameters passed on stack are quadword aligned */
w.ashwhere = ap;
disp = rounder(disp,paral);
spar = FIRST_INT_ARG+ (disp>>6);
fpar = FIRST_FLOAT_ARG+ (disp>>6);
if (disp>448) {spar =22; fpar = 22; }
if (is_floating(hd) && disp+parsize <= 384) {
freg frg;
ans ansfr;
frg.fr = fpar++;
if (hd != shrealhd)
frg.type = IEEE_double;
else
frg.type = IEEE_single;
setfregalt(ansfr, frg);
w.answhere = ansfr;
code_here(list, sp, w);
/* eval parameter into floating parameter register */
sp = guardfreg(frg.fr, sp);
}
else if (((valregable(sh(list)) || (name(sh(list)) ==cpdhd)) ||
(name(sh(list)) ==nofhd)) && spar<=21) {
/* compound types are always passed in registers
(given enough space). */
ans ansr;
int par_reg;
int numleft = parsize- ((LAST_INT_ARG-spar+1) <<6);
int pregs_used = min((numleft>>6) +6,6);
hadfixed=1;
setregalt(ansr,spar);
w.answhere=ansr;
for (par_reg=spar;par_reg<spar+pregs_used;++par_reg) {
sp = guardreg(par_reg,sp);
}
sp = guardreg(spar,sp);
code_here(list,sp,w);
if (numleft>0) {
is.b.offset+=(numleft>>3); /* += number of bytes remaining */
}
}
else {
/* pass remaining parameters on the stack.
The parameters are aligned on 8 byte boundaries.
*/
setinsalt(w.answhere, is);
is.b.offset+= (max(ap.ashsize,REG_SIZE) >>3);
/* 'size' was used here */
code_here(list, sp, w);
hadfixed = 1;
/* eval parameter into argument space on stack */
}
if (name(list) == caller_tag) {
no(list) = disp;
}
disp+=parsize;
disp = rounder(disp, REG_SIZE);
if (last(list))break;
list = bro(list);
} /* end for */
} /* end if list */
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*/1) {
baseoff a;
integer_jump_external(i_jsr,26,boff(son(fn)));
a.base = RA;
a.offset=0;
load_store(i_ldgp,GP,a);
}
else {
if (Has_fp) {
baseoff b;
b.base = FP;
b.offset = (frame_size+ callee_size) >>3;
restore_sregs(fixdone, fltdone);
operate_fmt(i_bis,FP,FP,SP);
load_store(i_ldq,FP,b);
}
else {
baseoff b;
b.base=SP;
b.offset= (frame_size+callee_size) >>3;
restore_sregs(fixdone, fltdone);
load_store(i_lda,SP,b);
}
integer_jump_external(i_jmp,31,boff(son(fn)));
if (as_file) {
fprintf(as_file," # Tail recursion\n");
}
}
}
else { /* the address of the proc is evaluated
and entered indirectly */
int destreg=reg_operand(fn,guardreg(26,sp));
operate_fmt(i_bis,destreg,destreg,PV);
integer_jump(i_jsr,RA,destreg,0);
load_store(i_ldgp,GP,procbase);
}
if (in_general_proc) {
/* Temporary */
/* operate_fmt_immediate(i_addq,SP,(callee_size+frame_size)>>3,FP);*/
}
clear_all (); /* forget all register memories */
{
ans aa;
if (is_floating(hda)) {
freg frg;
frg.fr = 0;
if (hda != shrealhd)
frg.type = IEEE_double;
else
frg.type = IEEE_single;
setfregalt(aa, frg);
move(aa,dest, sp, 1);
/* move floating point result of application
to destination */
}
else {
setregalt(aa, RESULT_REG);
mka.regmove = 0;
move(aa,dest, sp, 1);
/* move floating point result of application to
destination */
}
/* else struct results are moved by body of proc */
}
return mka;
} /* end apply */
case caller_tag: {
e = son(e);
goto tailrecurse;
}
case apply_general_tag: {
exp fn = son(e);
exp callers = bro(fn);
exp cllees = bro(callers);
exp postlude = bro(cllees);
space nsp;
int postlude_arg_space;
nsp = sp;
if (no(callers)!= 0) {
nsp = do_callers(son(callers),sp,&sizecallers);
}
else {
sizecallers = 0;
}
if ((in_vcallers_apply = call_has_vcallers(cllees))) {
sizecallers = 12 * REG_SIZE;
}
else {
sizecallers = 6 * REG_SIZE;
}
(void)make_code(cllees,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)) {
baseoff a;
a.base = RA;
a.offset = 0;
integer_jump_external(i_jsr,26,boff(son(fn)));
load_store(i_ldgp,GP,a);
}
else{
if (Has_fp) {
baseoff b;
b.base = FP;
b.offset = (frame_size+callee_size) >>3;
b.offset = -8;
}
else {
baseoff b;
b.base=SP;
}
integer_jump_fn(i_jmp,31,fn,sp);
}
clear_all();
{
int hda = name(sh(e));
ans aa;
if (is_floating(hda)) {
freg frg;
frg.fr = 0;
if (hda != shrealhd)
frg.type = IEEE_double;
else
frg.type = IEEE_single;
setfregalt(aa, frg);
move(aa,dest, sp, 1);
/* move floating point result of application
to destination */
}
else {
setregalt(aa, RESULT_REG);
mka.regmove = RESULT_REG;
move(aa,dest, sp, 1);
/* move floating point result of application to destination */
}
/* else struct results are moved by body of proc */
}
if (in_vcallers_apply) {
postlude_arg_space = max(max_args,sizecallers);
}
else {
postlude_arg_space = max(max_args,6*PTR_SZ);
}
if (call_is_untidy(cllees)) {
operate_fmt_immediate(i_subq,SP,postlude_arg_space>>3,SP);
reset_tos();
Assert(name(bro(cllees)) == top_tag);
}
else if (postlude_has_call(e)) {
exp x = son(callers);
postlude_chain p;
for (;;) {
if (name(x) == caller_tag) {
no(x) += postlude_arg_space;
}
if (last(x))break;
x = bro(x);
}
comment("In postlude, with call");
/* operate_fmt_immediate(i_subq,SP,max_args>>3,SP);*/
mka.regmove = NOREG;
update_plc(old_postludes,postlude_arg_space);
p.postlude = postlude;
p.outer = old_postludes;
old_postludes = &p;
operate_fmt_immediate(i_subq,SP,postlude_arg_space>>3,SP);
(void)make_code(postlude,sp,nowhere,0);
operate_fmt_immediate(i_addq,SP,postlude_arg_space>>3,SP);
old_postludes = p.outer;
update_plc(old_postludes,-postlude_arg_space);
}
else {
(void)make_code(postlude,sp,nowhere,0);
}
in_vcallers_apply = 0;
return mka;
}
case caller_name_tag: {
return mka;
}
case make_callee_list_tag: {
int size = ((no(e) >>3) + 39) & ~7;
int alloc_size;
bool vc = call_has_vcallees(e);
exp list = son(e);
instore is;
where w;
baseoff b;
int disp=0;
ash ap;
exp anc = father(e);
if (call_has_vcallers(e)) {
alloc_size = size + (12 *(PTR_SZ>>3));
sizecallers = (12*(PTR_SZ));
}
else{
alloc_size = size + ((name(anc) ==tail_call_tag)?(6*PTR_SZ>>3):
(sizecallers>>3));
}
b.base = SP;
operate_fmt_immediate(i_subq,SP,alloc_size,SP);
if (name(anc) == tail_call_tag) {
/*b.offset = alloc_size - (PTR_SZ>>3) - arg_stack_space;*/
b.offset = alloc_size - (PTR_SZ>>3);
load_store(i_stq,FP,b);
}
else {
b.offset = alloc_size - (PTR_SZ>>3) - (sizecallers>>3);
load_store(i_stq,FP,b);
}
#if 0
if (!Has_fp)
operate_fmt_immediate(i_addq,SP,size,FP);
#endif
update_plc(old_postludes,alloc_size<<3);
if (no(e)) {
int lastpar = 0;
for (;!lastpar;list = bro(list)) {
ap = ashof(sh(list));
disp = rounder(disp,ap.ashalign);
is.b.offset = disp>>3;
is.b.base = SP;
is.adval = 1;
w.ashwhere = ap;
setinsalt(w.answhere,is);
code_here(list,sp,w);
disp = rounder(disp+ap.ashsize,PTR_SZ);
/* disp = rounder(disp+ap.ashsize,is32(sh(list))?32:64);*/
lastpar = last(list);
}
}
update_plc(old_postludes,-alloc_size<<3);
#if 1
if (vc && (name(anc) == apply_general_tag)) {
operate_fmt_immediate(i_addq,SP,alloc_size,FP);
}
#endif
return mka;
}
case same_callees_tag: {
baseoff b;
bool vc = call_has_vcallees(e);
space nsp;
if (Has_vcallees) {
int rsize = getreg(sp.fixed);
int rsrc,rdest;
int le = new_label();
int lb = new_label();
int tmp;
nsp = guardreg(rsize,sp);
tmp = getreg(nsp.fixed);
nsp = guardreg(tmp,nsp);
rsrc = getreg(nsp.fixed);
nsp = guardreg(rsrc,nsp);
rdest = getreg(nsp.fixed);
nsp = guardreg(rdest,nsp);
operate_fmt(i_bis,SP,SP,tmp);
operate_fmt(i_subq,FP,local_reg,rsize);
if (!Has_no_vcallers && !call_has_vcallers(e)) {
operate_fmt_immediate(i_subq,rsize,6*PTR_SZ>>3,rsize);
}
if ((sizecallers>>3) >arg_stack_space) {
operate_fmt_immediate(i_addq,rsize,
((sizecallers>>3) -arg_stack_space),rsize);
}
operate_fmt(i_subq,SP,rsize,SP);
b.base = tmp;
b.offset = - (PTR_SZ>>3) - (sizecallers>>3);
load_store(i_stq,FP,b);
operate_fmt_immediate(i_subq,FP,4*(PTR_SZ>>3) + (arg_stack_space),
rsrc);
operate_fmt_immediate(i_subq,tmp,(4*(PTR_SZ>>3)) + (sizecallers>>3),
rdest);
setnoat();
operate_fmt(i_cmpeq,rdest,SP,AT);
integer_branch(i_bne,AT,le);
setat();
set_label(lb);
b.base = rsrc;
b.offset = - (PTR_SZ>>3);
load_store(i_ldq,rsize,b);
b.base = rdest;
load_store(i_stq,rsize,b);
operate_fmt_immediate(i_subq,rsrc,PTR_SZ>>3,rsrc);
operate_fmt_immediate(i_subq,rdest,PTR_SZ>>3,rdest);
setnoat();
operate_fmt(i_cmpeq,rdest,SP,AT);
integer_branch(i_beq,AT,lb);
setat();
set_label(le);
if (vc)operate_fmt(i_bis,tmp,tmp,FP);
}
else{
int cs = callee_size>>3;
int i;
int tr = getreg(sp.fixed);
operate_fmt_immediate(i_subq,SP,cs + (sizecallers>>3),SP);
b.base = SP;
b.offset = cs - (PTR_SZ>>3) /*-arg_stack_space*//*-(sizecallers>>3)*/;
load_store(i_stq,FP,b);
for (i=cs - (4*8);i>0;i -= 8) {
b.base = FP;
b.offset = i -cs -8 - (arg_stack_space);
load_store(i_ldq,tr,b);
b.base = SP;
b.offset = i - 8;
load_store(i_stq,tr,b);
}
if (vc)operate_fmt_immediate(i_addq,SP,cs + (sizecallers>>3),FP);
}
return mka;
}
case make_dynamic_callee_tag: {
bool vc = call_has_vcallees(e);
exp anc = father(e);
int extra_space;
int rptr,rsize,rdest,tempreg,ls,le;
space nsp;
baseoff b;
extra_space = (name(anc) == apply_general_tag)?(sizecallers>>3):
arg_stack_space;
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);
operate_fmt_immediate(i_addq,rsize,(4*(PTR_SZ>>3) +extra_space) +7,rdest);
operate_fmt_immediate(i_bic,rdest,7,rdest);
b.base = SP;
b.offset = - (PTR_SZ>>3) - (sizecallers>>3);
load_store(i_stq,FP,b);
if (vc)operate_fmt(i_bis,SP,SP,FP);
operate_fmt(i_subq,SP,rdest,SP);
operate_fmt(i_bis,SP,SP,rdest);
ls = new_label();
le = new_label();
integer_branch(i_ble,rsize,le);
b.offset = 0;
set_label(ls);
b.base = rptr;
load_store(i_ldq,tempreg,b);
b.base = rdest;
load_store(i_stq,tempreg,b);
operate_fmt_immediate(i_addq,rdest,(PTR_SZ>>3),rdest);
operate_fmt_immediate(i_addq,rptr,(PTR_SZ>>3),rptr);
operate_fmt_immediate(i_subq,rsize,(PTR_SZ>>3),rsize);
integer_branch(i_bgt,rsize,ls);
set_label(le);
return mka;
}
case tail_call_tag: {
exp fn = son(e);
exp cllees = bro(fn);
exp bdy = son(crt_proc);
int stack_space;
int rsize = -1;
space nsp;
nsp = sp;
stack_space = max(arg_stack_space,6*(PTR_SZ>>3));
if (name(cllees) == make_callee_list_tag) {
code_here(cllees,sp,nowhere);
}
for (;name(bdy) ==dump_tag || name(bdy) ==diagnose_tag;bdy = son(bdy));
while (name(bdy) == ident_tag && isparam(bdy)) {
/* go throught the current callers, making sure they are
in the right place */
exp sbody = son(bdy);
baseoff b;
if (Has_fp) {
b.base = FP;
b.offset = (no(sbody) >>3) - stack_space;
}
else {
b.base = SP;
b.offset = (no(sbody) + frame_size + callee_size) >>3;
}
#if 0
b.base = FP;
b.offset = (no(sbody)>>3) - (PTR_SZ>>3) ; /* This will work its
way through the
caller param area */
b.offset = no(sbody) >>3;
#endif
if (name(sbody) == formal_callee_tag) {
if ((props(bdy) & inanyreg)) {
b.offset -= callee_size>>3;
if (isvar(bdy)) {
if (is_floating(name(sh(sbody)))) {
float_load_store((name(sh(sbody)) == shrealhd)?i_sts : i_stt,
no(bdy),b);
}
else {
load_store(is64(sh(sbody))?i_stq : i_stl,no(bdy),b);
}
}
}
}
else if (props(sbody) ==0 && (props(bdy) &inanyreg)!=0) {
/* move from reg to store */
if (isvar(bdy)) {
if (is_floating(name(sh(sbody)))) {
float_load_store((name(sh(sbody)) ==shrealhd)?i_sts:i_stt,
no(bdy),b);
}
else{
load_store(is64(sh(sbody))?i_stq:i_stl,props(sbody),b);
}
}
}
else if (props(sbody)!= 0 && (props(bdy) & inanyreg) ==0) {
/* move from store to reg */
if (is_floating(name(sh(sbody)))) {
float_load_store((name(sh(sbody)) ==shrealhd)?i_lds:i_ldt,
props(sbody),b);
}
else{
if (isvis(bdy) && last_param(bdy) && !Has_no_vcallers) {
int this_reg = props(sbody);
int r;
Assert(this_reg>=16);
b.offset = ((this_reg+1-16) <<3) + ((gpdumpstart - frame_size) >>3);
for (r = this_reg+1;r <= LAST_INT_ARG;++r) {
load_store(i_ldq,r,b);
b.offset += (REG_SIZE>>3);
}
b.offset = ((paramsdumpstart-frame_size) >>3);
for (r = FIRST_FLOAT_ARG;r<= LAST_FLOAT_ARG;++r) {
float_load_store(i_ldt,r,b);
b.offset += (REG_SIZE>>3);
}
b.offset = ((this_reg-16) <<3) + ((gpdumpstart-frame_size) >>3);
load_store(is64(sh(sbody))?i_ldq:i_ldl,props(sbody),b);
}
else {
load_store(is64(sh(sbody))?i_ldq:i_ldl,props(sbody),b);
}
}
}
else if (props(sbody)!=0 && (props(sbody)!= no(bdy))) {
/* move from reg to reg */
if (is_floating(name(sh(sbody)))) {
float_op(i_cpys,no(bdy),no(bdy),props(sbody));
}
else{
operate_fmt(i_bis,no(bdy),no(bdy),props(sbody));
}
}
bdy = bro(sbody);
}
restore_sregs(fixdone,fltdone);
/*
Allocate space on the frame for the number of callees used
in the tail call which exceed the number of callees for
this procedure
*/
if (name(cllees) == make_callee_list_tag) {
int x = (((no(cllees) >> 3) + 39) & ~7) + stack_space;
baseoff b;
int i;
int rndcllees = ((no(cllees) >>3) +7) &~7;
setnoat();
for (i=no(cllees) >>3;i>0;i -= (PTR_SZ>>3)) {
b.base = SP;
b.offset = i - (PTR_SZ>>3);
load_store(i_ldq,AT,b);
b.base = FP;
b.offset = i- (4*(PTR_SZ>>3)) - (rndcllees + (PTR_SZ>>3))
- stack_space;
load_store(i_stq,AT,b);
}
setat();
operate_fmt_immediate(i_subq,FP,x,SP);
}
else if (name(cllees) == make_dynamic_callee_tag) {
int rdest,rsource,tempreg,le,ls;
space nsp;
baseoff b;
rdest = getreg(sp.fixed);
nsp = guardreg(rdest,sp);
rsource = getreg(nsp.fixed);
load_reg(son(cllees),rsource,sp);
nsp = guardreg(rsource,nsp);
rsize = getreg(nsp.fixed);
load_reg(bro(son(cllees)),rsize,nsp);
nsp = guardreg(rsize,nsp);
tempreg = getreg(nsp.fixed);
operate_fmt_immediate(i_subq,FP,4*(PTR_SZ>>3) +stack_space,rdest);
operate_fmt_immediate(i_addq,rsize,7,rsize);
operate_fmt_immediate(i_bic,rsize,7,rsize);
operate_fmt(i_addq,rsource,rsize,rsource);
le = new_label();
ls = new_label();
integer_branch(i_ble,rsize,le);
set_label(ls);
b.base = rsource;
b.offset = - (PTR_SZ>>3);
load_store(i_ldq,tempreg,b);
b.base = rdest;
load_store(i_stq,tempreg,b);
operate_fmt_immediate(i_subq,rdest,(PTR_SZ>>3),rdest);
operate_fmt_immediate(i_subq,rsource,(PTR_SZ>>3),rsource);
operate_fmt_immediate(i_subq,rsize,(PTR_SZ>>3),rsize);
integer_branch(i_bgt,rsize,ls);
set_label(le);
operate_fmt(i_bis,rdest,rdest,SP);
}
else{
if (Has_vcallees) {
operate_fmt(i_bis,local_reg,local_reg,SP);
}
else{
operate_fmt_immediate(i_subq,FP,stack_space+ (callee_size>>3),SP);
}
}
if (Has_vcallees) {
baseoff b;
b.base = FP;
b.offset = (-4 *(PTR_SZ>>3)) - stack_space;
load_store(i_ldq,local_reg,b);
}
if (!in_general_proc) {
baseoff b;
b.base = FP;
b.offset = - (PTR_SZ>>3) -arg_stack_space;
setnoat();
load_store(i_ldq,AT,b);
b.base = SP;
if (name(cllees)!=make_dynamic_callee_tag) {
b.offset = (((no(cllees) >> 3) + 39) & ~7) - (PTR_SZ>>3);
}
else {
load_reg(bro(son(cllees)),rsize,sp);
operate_fmt_immediate(i_addq,rsize,7,rsize);
operate_fmt_immediate(i_bic,rsize,7,rsize);
operate_fmt_immediate(i_addq,rsize,(39&~7) - (PTR_SZ>>3),rsize);
operate_fmt(i_addq,rsize,SP,rsize);
b.base = rsize;
b.offset = 0;
}
load_store(i_stq,AT,b);
if (Has_vcallees) {
operate_fmt(i_bis,FP,FP,local_reg);
}
}
{
int rt = getreg(sp.fixed);
rt = reg_operand(fn,guardreg(RA,sp));
operate_fmt(i_bis,rt,rt,PV);
integer_jump(i_jmp,31,rt,0);
/*integer_jump_external(i_jmp,31,boff(son(fn)));*/
}
return mka;
}
#ifdef return_to_label_tag
case return_to_label_tag: {
int r = getreg(sp.fixed);
where w;
w.ashwhere.ashsize = 64;
w.ashwhere.ashalign = 64;
setregalt(w.answhere,r);
code_here(son(e),sp,w);
clear_all();
if (Has_fp) {
baseoff b;
b.base = FP;
restore_sregs(fixdone,fltdone);
if (Has_vcallees) {
b.offset = -4*(PTR_SZ>>3);
load_store(i_ldq,local_reg,b);
}
b.offset = - (PTR_SZ>>3) - arg_stack_space;
operate_fmt(i_bis,FP,FP,SP);
load_store(i_ldq,FP,b);
}
else if (frame_size != 0) {
restore_sregs(fixdone,fltdone);
operate_fmt_immediate(i_addq,SP,frame_size>>3,SP);
}
integer_jump(i_jmp,31,r,0);
clear_all();
return mka;
}
#endif
case untidy_return_tag:
case res_tag: {
where w;
w.answhere = procans;
w.ashwhere = ashof(sh(son(e)));
code_here(son(e), sp, w);
/* evaluate result value */
if (name(e) == untidy_return_tag)comment("untidy return");
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) {
integer_jump(i_ret,31,RA,1);
}
if (result_label != 0) {
integer_branch(i_br,31,result_label);
comment(" Return ");
}
else{
if ((fixdone|fltdone) ==0) {
result_label = new_label();
set_label(result_label);
}
if (Has_fp) {
baseoff b;
b.base = FP;
restore_sregs(fixdone, fltdone);
if (Has_vcallees) {
b.offset = -4 *(PTR_SZ>>3) - arg_stack_space;
load_store(i_ldq,local_reg,b);
}
b.offset = (in_general_proc)?(-PTR_SZ>>3):(-arg_stack_space- (PTR_SZ>>3));;
b.offset = (-arg_stack_space- (PTR_SZ>>3));;
#if 0
if (arg_stack_space && in_general_proc && name(e) == res_tag) {
operate_fmt_immediate(i_addq,FP,arg_stack_space,SP);
}
else
#endif
if (name(e) == res_tag) {
operate_fmt(i_bis,FP,FP,SP);
}
load_store(i_ldq,FP,b);
}
else {
baseoff a;
restore_sregs(fixdone, fltdone);
/* restore dumped value of s-regs on entry */
a.base=SP;
a.offset= (callee_size+frame_size) >>3;
if (a.offset!=0 && name(e) == res_tag)
load_store(i_lda,SP,a);
/* reset stack ptr */
}
integer_jump(i_ret,31,RA,1);
}
}
else { /* inlined result */
if (rscope_label == 0)rscope_label = new_label();
if (rscope_label != exitlab) {
integer_branch(i_br,31,rscope_label);
/*
uncond_ins (i_b, rscope_label);*/
}
}
sizecallers = 0;
return mka;
} /* end result */
case diagnose_tag: {
output_diag(dno(e),0,e);
/* output_symbolic_diagnostic(as_file,dno(e));*/
mka = make_code(son(e), sp, dest, exitlab);
output_end_scope(dno(e),e);
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.type = sfr.type;
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) {
integer_branch(i_br,31,l);
}
}
if (last(m)) {
mka.lab = l;
return mka;
}
m = bro(m);
}
} /* end solve */
/*
case_tag now uses the INT64 type.
*/
case case_tag: {
char * outline = (char*)NULL;
int r = reg_operand(son(e), sp);
/* evaluate controlling integer into reg r */
mm lims;
exp z = bro(son(e));
exp zt = z;
INT64 n;
INT64 l;
INT64 u;
INT64 xt,yt;
int control_sgned = is_signed(sh(son(e)));
u = make_INT64(0x80000000,0x00000000);
/*INT64_assign(u,smin);*/
comment(" begin case ");
INT64_assign(l,exp_to_INT64(zt));
for (n=make_INT64(0,1);;n=INT64_increment(n)) {
/* calculate crude criterion for using
jump vector or branches */
if (!(INT64_eq(INT64_increment(u),exp_to_INT64(zt))) &&
(son(zt)!=nilexp)) {
n = INT64_increment(n);
}
if (last(zt)) {
u = (son(zt)!= nilexp)? exp_to_INT64(son(zt)):exp_to_INT64(zt);
break;
}
if (son(zt)!= nilexp) {
u = exp_to_INT64(son(zt));
}
else {
if (INT64_eq(INT64_increment(u),exp_to_INT64(zt))) {
u = INT64_increment(u);
}
}
zt = bro(zt);
}
/* now l is lowest controlling value and u is highest */
/* The above actually means: */
if (control_sgned) {
xt = (INT64_subtract(INT64_shift_right(u,1,1),
INT64_shift_right(l,1,1),1));
yt = (INT64_subtract(INT64_divide(INT64_mult(n,n,1),
make_INT64(0,4),1),
make_INT64(0,3),1));
}
else {
unsigned long uu = unsigned_rep(u,sh(son(e)));
unsigned long lu = unsigned_rep(l,sh(son(e)));
xt = (INT64_subtract(INT64_shift_right(uu,1,1),
INT64_shift_right(lu,1,1),1));
yt = (INT64_subtract(INT64_divide(INT64_mult(n,n,1),
make_INT64(0,4),1),
make_INT64(0,3),1));
}
if (xt <= yt) {
/* 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 rtmp=getreg(guardreg(r,sp).fixed); /* could use AT */
zero3.base = rtmp;
zero3.offset = 0;
zeroveclab.offset = 0;
zeroveclab.base = veclab;
n = l;
start_new_capsule(false);
if (as_file) {
#if !DO_SCHEDULE
fprintf(as_file, "\t.rdata\n$$%d:\n", veclab);
#else
outline = (char*)xcalloc(30,sizeof(char));
sprintf(outline, "\t.rdata\n$$%d:\n", veclab);
#endif
}
#if DO_SCHEDULE
output_instruction(class_null,outline,out_common(0,irdata));
output_instruction(class_null,(char*)NULL,
out_common(tempsnos[veclab-32],ilabel));
#else
out_common(0, irdata);
out_common(tempsnos[veclab - 32], ilabel);
#endif
for (;;) {
for (; INT64_lt(n,exp_to_INT64(z));
n = INT64_increment(n)) {
/* o/p jump vector */
if (as_file) {
#if !DO_SCHEDULE
fprintf(as_file, "\t.gprel32\t$%d\n", endlab);
#else
outline = (char*)xcalloc(30,sizeof(char));
sprintf(outline, "\t.gprel32\t$%d\n", endlab);
#endif
}
#if DO_SCHEDULE
output_instruction(class_null,outline,
out_value(-endlab,igprel32,0,1));
#else
out_value(-endlab, igprel32, make_INT64(0,0), 1);
#endif
}
u = (son(z) == nilexp)? n : exp_to_INT64(son(z));
for (; INT64_leq(n,u) /*n <= u*/; n=INT64_increment(n)/*n++*/){
if (as_file) {
#if !DO_SCHEDULE
fprintf(as_file, "\t.gprel32\t$%d\n", no(son(pt(z))));
#else
outline = (char*)xcalloc(30,sizeof(char));
sprintf(outline, "\t.gprel32\t$%d\n", no(son(pt(z))));
#endif
}
#if DO_SCHEDULE
output_instruction(class_null,outline,
out_value(-no(son(pt(z))),igprel32,0,1));
#else
out_value(-no(son(pt(z))),igprel32,make_INT64(0,0),1);
#endif
}
if (last(z))
break;
z = bro(z);
}
set_text_section();
setnoat();
load_store(i_lda, AT, zeroveclab);
if (!INT64_eq(l,zero_int64) /*l != 0*/) {
int rtmp2;
INT64 lit;
space newsp;
newsp = guardreg(r,sp);
newsp = guardreg(rtmp,newsp);
rtmp2 = getreg(newsp.fixed);
lit=INT64_subtract(make_INT64(0,0),l,1);
operate_fmt_big_immediate(i_addq, r, lit,rtmp);
lit = INT64_increment(INT64_subtract(u,l,1));
operate_fmt_big_immediate(i_cmpult,rtmp,lit,rtmp2);
integer_branch(i_beq,rtmp2,endlab);
operate_fmt(i_s4addq,rtmp,AT,rtmp);
}
else {
int rtmp2;
space newsp;
newsp = guardreg(r,sp);
newsp = guardreg(rtmp,newsp);
rtmp2 = getreg(newsp.fixed);
load_store_immediate(i_ldiq,rtmp2,INT64_increment(u));
/* operate_fmt(i_subq,r,rtmp2,rtmp);
integer_branch(i_bge,rtmp,endlab); */
operate_fmt(i_cmpule,rtmp2,r,rtmp);
integer_branch(i_bne,rtmp,endlab);
operate_fmt(i_s4addq,r,AT,rtmp);
}
setat();
load_store(i_ldl,rtmp,zero3);
operate_fmt(i_addq,rtmp,GP,rtmp);
integer_jump(i_jmp,31,rtmp,endlab); /* endlab is hint */
set_label(endlab);
close_capsule();
comment(" end case ");
return mka;
}
else {
int over = 0; /* use branches - tests are already
ordered */
int rtmp = getreg(guardreg(r,sp).fixed);
bool usw;
lims = maxmin(sh(son(e)));
usw = !is_signed(sh(son(e)));
for (;;) {
int lab = no(son(pt(z))); /* can this be big */
l = exp_to_INT64(z);
if (isbigval(son(pt(z))))
alphafail(BIG_LABEL);
if (son (z) == nilexp) { /* only single test required */
operate_fmt_big_immediate(i_cmpeq,r,l,rtmp);
integer_branch(i_bne,rtmp,lab);
if (INT64_eq(l,lims.maxi)) {
lims.maxi = INT64_decrement(lims.maxi);
}
else if (INT64_eq(l,lims.mini)) {
lims.mini = INT64_increment(lims.mini);
}
}
else if (u = exp_to_INT64(son(z)),
INT64_leq(lims.mini,l) ||usw) {
/* if (INT64_lt(lims.maxi,INT64_and(INT64_not(usw),u))){ */
if (INT64_leq(lims.maxi,u) && !usw) {
/* have already tested lower */
operate_fmt_big_immediate(i_cmplt,r,l,rtmp);
integer_branch(i_beq,rtmp,lab);
lims.maxi = INT64_decrement(l);
}
else {
if (over == 0) {
over = new_label();
}
operate_fmt_big_immediate(i_cmplt,r,l,rtmp);
integer_branch(i_bne,rtmp,over);
operate_fmt_big_immediate(i_cmple,r,u,rtmp);
integer_branch(i_bne,rtmp,lab);
lims.mini = INT64_increment(u);
}
}
else if (INT64_lt(u,lims.maxi)) {/*lower is <= lower limit
of shape*/
operate_fmt_big_immediate(i_cmple,r,u,rtmp);
integer_branch(i_bne,rtmp,lab);
lims.mini = INT64_increment(u);
}
else { /* upper is >= upper limit of shape */
integer_branch(i_br,31,lab);
}
if (last(z)) {
if (over != 0) {
set_label(over);
}
comment(" end case ");
return mka;
}
z = bro(z);
}
}
} /* end case */
case plus_tag:
case offset_add_tag:{
if (optop(e)) {
mka.regmove = comm_op(e,sp,dest,(dest.ashwhere.ashsize==32)?
i_addl:i_addq);
return mka;
}
#if 0
if(error_treatment_is_trap(e) /*&& is_signed(sh(e))*/){
mka.regmove = comm_op(e,sp,dest,(dest.ashwhere.ashsize==32)?
i_addlv:i_addqv);
return mka;
}
#endif
else{
int r1 = reg_operand(son(e), sp);
int r2,r0;
int over = new_label();
int 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);
operate_fmt(is64(sh(e))?i_addq:i_addl,r1,r2,r0);
switch (name(sh(e))) {
case s64hd:
case slonghd:{
int r3 = getreg(sp.fixed);
operate_fmt(i_xor,r1,r2,r3);
integer_branch(i_blt,r3,over);
operate_fmt(i_xor,r0,r1,r3);
if (error_treatment_is_trap(e)) {
integer_branch(i_bge,r3,over);
do_exception(f_overflow);
}
else{
integer_branch(i_blt,r3,trap);
}
set_label(over);
break;
}
case ulonghd:
case u64hd:{
int r3 = getreg(sp.fixed);
operate_fmt(i_cmpult,r0,r1,r3);
if (error_treatment_is_trap(e)) {
int oklab = new_label();
integer_branch(i_beq,r3,oklab);
do_exception(f_overflow);
set_label(oklab);
}
else{
integer_branch(i_bne,r3,trap);
}
break;
}
case uwordhd:{
if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(r0,0xffff,f_overflow);
}
else{
test_unsigned(r0,0xffff,trap);
}
break;
}
case swordhd:{
if (error_treatment_is_trap(e)) {
test_signed_and_trap(r0,-0x8000L,0x7fff,f_overflow);
}
else{
test_signed(r0,-0x8000L,0x7fff,trap);
}
break;
}
case ucharhd:{
if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(r0,255,f_overflow);
}
else{
test_unsigned(r0,255,trap);
}
break;
}
case scharhd:{
if (error_treatment_is_trap(e)) {
test_signed_and_trap(r0,-128,127,f_overflow);
}
else{
test_signed(r0,-128,127,trap);
}
break;
}
default:failer("illegal shape");
}
setregalt(aa,r0);
mka.regmove = move(aa,dest,nsp,0);
return mka;
}
} /* end plus */
case chvar_tag: {
int a;
int tmpreg;
int d;
ans aa;
int nsh = name(sh(e));
switch (dest.answhere.discrim) {
case inreg: {
ash arga;
arga = ashof(sh(son(e)));
if (arga.ashsize <= dest.ashwhere.ashsize) {
dest.ashwhere = arga;
}
a = regalt(dest.answhere);
if (a == NO_REG) {
a = getreg(sp.fixed);
setregalt(dest.answhere,a);
dest.ashwhere.ashsize = shape_size(sh(son(e)));
dest.ashwhere.ashalign = dest.ashwhere.ashsize;
}
code_here(son(e), sp, dest);
/* evaluate argument into reg */
break;
}
default:
a = reg_operand(son(e), sp);
/* evaluate arguement into a */
}
setregalt(aa, a);
if (sh(son(e)) == sh(e)) {
mka.regmove = move(aa,dest,sp,1);
return mka;
}
if ((dest.answhere.discrim == inreg) &&
(dest.answhere.val.regans == a)) {
tmpreg = a;
}
else{
tmpreg = getreg(sp.fixed);
}
if (nsh >= s64hd) {
/* destination is 64 bits wide, the only thing we have
to worry about is the conversion of unsigned
values to signed, which can be avoided by the
following code */
if (convert_shapes(nsh,name(sh(son(e))),a,tmpreg)) {
setregalt(aa,tmpreg);
}
mka.regmove = move(aa,dest,sp,1);
return mka;
}
if (sh (son (e)) == sh (e) /*|| nsh >= slonghd*/) {
/* no changes required, so just move to dest*/
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==NO_REG) return mka;
/* (void)convert_shapes(nsh,name(sh(son(e))),a,d);*/
switch (nsh) {
case ucharhd:{
if (is_signed(sh(son(e))) && !optop(e)) {
if (error_treatment_is_trap(e)) {
int new_lab = new_label();
integer_branch(i_bge,a,new_lab);
do_exception(f_overflow);
set_label(new_lab);
}
else{
integer_branch(i_blt,a,trap_label(e));
}
}
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(a,255,f_overflow);
}
else{
test_unsigned(a,255,trap_label(e));
}
}
operate_fmt_immediate(i_and,a,255,d);
break;
}
case scharhd:{
if (!is_signed(sh(son(e))) && !optop(e)) {
setnoat();
operate_fmt_immediate(i_cmpule,a,0x7f,AT);
if (!error_treatment_is_trap(e)) {
integer_branch(i_beq,AT,trap_label(e));
}
else{
int new_lab = new_label();
integer_branch(i_bne,AT,new_lab);
do_exception(f_overflow);
set_label(new_lab);
}
setat();
}
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
test_signed_and_trap(a,-128,127,f_overflow);
}
else{
test_signed(a,-128,127,trap_label(e));
}
}
operate_fmt_immediate(i_extqh,a,1,d);
operate_fmt_immediate(i_sra,d,REG_SIZE-8,d);
break;
}
case uwordhd:{
if (is_signed(sh(son(e))) && !optop(e)) {
if (error_treatment_is_trap(e)) {
int new_lab = new_label();
integer_branch(i_bge,a,new_lab);
do_exception(f_overflow);
set_label(new_lab);
}
else{
integer_branch(i_blt,a,trap_label(e));
}
}
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(a,0xffff,f_overflow);
}
else{
test_unsigned(a,0xffff,trap_label(e));
}
}
operate_fmt_immediate(i_and,a,(1<<16) -1,d);
break;
}
case swordhd: {
if (!is_signed(sh(son(e))) && !optop(e)) {
setnoat();
operate_fmt_immediate(i_cmpule,a,0x7fff,AT);
if (error_treatment_is_trap(e)) {
int new_lab = new_label();
integer_branch(i_bne,AT,new_lab);
do_exception(f_overflow);
set_label(new_lab);
}
else{
integer_branch(i_beq,AT,trap_label(e));
}
setat();
}
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
test_signed_and_trap(a,-0x8000L,0x7fff,f_overflow);
}
else{
test_signed(a,-0x8000L,0x7fff,trap_label(e));
}
}
operate_fmt_immediate(i_sll,a,48,d);
operate_fmt_immediate(i_sra,d,48,d);
break;
}
case ulonghd:{
if (is_signed(sh(son(e))) && !optop(e)) {
if (error_treatment_is_trap(e)) {
int new_lab = new_label();
integer_branch(i_bge,a,new_lab);
do_exception(f_overflow);
set_label(new_lab);
}
else{
integer_branch(i_blt,a,trap_label(e));
}
}
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(a,0xffffffff,f_overflow);
}
else{
test_unsigned(a,0xffffffff,trap_label(e));
}
}
operate_fmt_immediate(i_addl,a,0,d);
/*operate_fmt_big_immediate(i_and,a,0xffffffff,d);*/
break;
}
case slonghd:{
if (!is_signed(sh(son(e))) && !optop(e)) {
setnoat();
operate_fmt_big_immediate(i_cmpule,a,0x7fffffff,AT);
if (error_treatment_is_trap(e)) {
int new_lab = new_label();
integer_branch(i_bne,AT,new_lab);
do_exception(f_overflow);
set_label(new_lab);
}
else{
integer_branch(i_beq,AT,trap_label(e));
}
setat();
}
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
test_signed_and_trap(a,-0x80000000L,0x7fffffff,f_overflow);
}
else{
test_signed(a,-0x80000000L,0x7fffffff,trap_label(e));
}
}
operate_fmt_immediate(i_sll,a,32,d);
operate_fmt_immediate(i_sra,d,32,d);
break;
}
case s64hd: {
if (!is_signed(sh(e)) && !optop(e)) {
setnoat();
operate_fmt_big_immediate(i_cmpule,a,0x7fffffffffffffffL,AT);
if (error_treatment_is_trap(e)) {
int new_lab = new_label();
integer_branch(i_bne,AT,new_lab);
do_exception(f_overflow);
set_label(new_lab);
}
else{
integer_branch(i_beq,AT,trap_label(e));
}
setat();
}
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
test_signed_and_trap(a,-0x8000000000000000L,0x7fffffffffffffffL,
f_overflow);
}
else{
test_signed(a,-0x8000000000000000L,0x7fffffffffffffffL,
trap_label(e));
}
}
operate_fmt(i_bis,a,a,d);
break;
}
case u64hd:{
if (is_signed(sh(e)) && !optop(e)) {
if (error_treatment_is_trap(e)) {
int new_lab = new_label();
integer_branch(i_bge,a,new_lab);
do_exception(f_overflow);
set_label(new_lab);
}
else{
integer_branch(i_blt,a,trap_label(e));
}
}
operate_fmt(i_bis,a,a,d);
break;
}
default:failer("Illegal shape in chvar");
}
#if 0
if (nsh == ucharhd) {
operate_fmt_immediate(i_and, a, 255,d);
}
else if (nsh == uwordhd) {
operate_fmt_immediate(i_and,a,(1 << 16) - 1,d);
}
else if (nsh == scharhd) {
/* operate_fmt_immediate (i_sll,a,REG_SIZE-8,d);*/
operate_fmt_immediate(i_extqh,a,1,d);
operate_fmt_immediate(i_sra,d,REG_SIZE-8,d);
}
else if (nsh == swordhd) {
operate_fmt_immediate(i_sll, a, 32,d);
operate_fmt_immediate(i_sra, d, 32,d);
}
#endif
mka.regmove = d;
return mka;
} /* end chvar */
case minus_tag:
case offset_subtract_tag:{
if (optop(e)) {
mka.regmove = non_comm_op(e,sp,dest,is64(sh(e))?i_subq:i_subl);
return mka;
}
#if 0
if (error_treatment_is_trap(e) && is_signed(sh(e))) {
mka.regmove = non_comm_op(e,sp,dest,is64(sh(e))?i_subqv:i_sublv);
return mka;
}
#endif
else{
/* if(!optop(e)) check_exception(e,sp);*/
int r1 = reg_operand(son(e), sp);
int r2, r3, r0;
int over = new_label();
int 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);
operate_fmt((is64(sh(e)))?i_subq:i_subl, r1, r2,r0);
switch (name(sh(e))) {
case s64hd:
case slonghd: {
r3 = getreg(nsp.fixed);
operate_fmt(i_xor,r1, r2,r3);
integer_branch(i_bge,r3,over);
operate_fmt(i_xor,r0,r1,r3);
if (error_treatment_is_trap(e)) {
integer_branch(i_bge,r3,over);
do_exception(f_overflow);
}
else{
integer_branch(i_blt,r3,trap);
}
set_label(over);
break;
}
case u64hd:
case ulonghd: {
r3 = getreg(guardreg(r0, nsp).fixed);
operate_fmt(i_cmpult,r1,r2,r3);
if (error_treatment_is_trap(e)) {
int ok_lab = new_label();
integer_branch(i_beq,r3,ok_lab);
do_exception(f_overflow);
set_label(ok_lab);
}
else{
integer_branch(i_bne,r3,trap);
}
break;
}
case scharhd: {
if (error_treatment_is_trap(e)) {
test_signed_and_trap(r0,-128,127,f_overflow);
}
else{
test_signed(r0, -128, 127, trap);
}
break;
}
case ucharhd: {
if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(r0,255,f_overflow);
}
else{
test_unsigned(r0, 255, trap);
}
break;
}
case swordhd: {
if (error_treatment_is_trap(e)) {
test_signed_and_trap(r0,-0x8000L,0x7fff,f_overflow);
}
else{
test_signed(r0, -0x8000L, 0x7fff, trap);
}
break;
}
case uwordhd: {
if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(r0,0xffff,f_overflow);
}
else{
test_unsigned(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;
}
return mka;
}
/* end minus */
case mult_tag:
case offset_mult_tag:{
exp rop = bro(son(e));
instruction mult_ins;
if (!optop(e) & error_treatment_is_trap(e)) {
mult_ins = is64(sh(e))?i_mulqv : i_mullv;
}
else{
mult_ins = is64(sh(e))?i_mulq : i_mull;
}
if (last(rop) && name(rop) == val_tag && optop(e)) {
/* 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;
}
}
FALL_THROUGH;
default: {
nsp = guardreg(r, sp);
rr = getreg(nsp.fixed);
}
}
operate_fmt_immediate(i_sll,r,shleng,rr);
if ((m & (m - 1))!= 0)
if (optop(e)) {
operate_fmt(((m & (m + 1)) == 0)? i_subq : i_addq, rr, r, rr);
}
else{
operate_fmt(((m& (m+1)) ==0)? i_subqv : i_addqv, rr, r, rr);
}
if (!optop(e) && !error_treatment_is_trap(e)) {
check_exception(e,sp);
}
setregalt(aa, rr);
mka.regmove = move(aa, dest, guardreg(rr, sp), 1);
return mka;
}
} /* else do straightforward mult */
if(optop(e) /*|| error_treatment_is_trap(e)*/) {
mka.regmove = comm_op(e, sp, dest, mult_ins);
}
else /* if (!optop(e) && !error_treatment_is_trap(e)) */{
int r1 = reg_operand(son(e), sp);
int r2,r0;
/*int over = new_label();*/
space nsp;
ans aa;
int contlab = new_label();
int zerolab = new_label();
int mult_end_lab = new_label();
nsp = guardreg(r1, sp);
r2 = reg_operand(bro(son(e)), nsp);
nsp = guardreg(r2, nsp);
r0 = getreg(nsp.fixed);
nsp = guardreg(r0, nsp);
integer_branch(i_beq,r1,zerolab);
integer_branch(i_beq,r2,zerolab);
integer_branch(i_br,31,contlab);
set_label(zerolab);
operate_fmt(i_bis,31,31,r0);
integer_branch(i_br,31,mult_end_lab);
set_label(contlab);
/* operate_fmt(is64(sh(e))?i_mulq:i_mull,r1,r2,r0);*/
if (error_treatment_is_trap(e)) {
operate_fmt(i_mulqv,r1,r2,r0);
}
else{
operate_fmt(i_mulq,r1,r2,r0);
}
switch (name(sh(e))) {
case u64hd:
case s64hd:{
int r3 = getreg(sp.fixed);
int oklab = new_label();
integer_branch(i_beq,r1,oklab);
integer_branch(i_beq,r2,oklab);
if (error_treatment_is_trap(e)) {
int new_lab = new_label();
integer_branch(i_bne,r0,new_lab);
do_exception(f_overflow);
set_label(new_lab);
}
else{
integer_branch(i_beq,r0,trap_label(e));
}
set_label(oklab);
operate_fmt(i_xor,r1,r2,r3);
/*integer_branch(i_blt,r3,over);*/
operate_fmt(i_xor,r3,r0,r3);
if (error_treatment_is_trap(e)) {
int ok_lab = new_label();
integer_branch(i_bge,r3,ok_lab);
do_exception(f_overflow);
set_label(ok_lab);
}
else{
integer_branch(i_blt,r3,trap_label(e));
}
/*set_label(over);*/
break;
}
case slonghd: {
if (!error_treatment_is_trap(e)) {
int r3 = getreg(sp.fixed);
operate_fmt(i_xor,r1,r2,r3);
operate_fmt(i_xor,r3,r0,r3);
integer_branch(i_blt,r3,trap_label(e));
test_signed(r0,-0x80000000L,0x7fffffff,trap_label(e));
}
else{
#if 1
int oklab = new_label();
int r3 = getreg(sp.fixed);
operate_fmt(i_xor,r1,r2,r3);
operate_fmt(i_xor,r3,r0,r3);
integer_branch(i_bge,r3,oklab);
do_exception(f_overflow);
set_label(oklab);
#endif
test_signed_and_trap(r0,-0x80000000L,0x7fffffff,f_overflow);
}
break;
}
case ulonghd: {
if (!error_treatment_is_trap(e)) {
int r3 = getreg(sp.fixed);
operate_fmt(i_xor,r1,r2,r3);
integer_branch(i_blt,r3,trap_label(e));
test_unsigned(r0,0xffffffff,trap_label(e));
}
else{
int r3 = getreg(sp.fixed);
int oklab = new_label();
operate_fmt(i_xor,r1,r2,r3);
integer_branch(i_bge,r3,oklab);
do_exception(f_overflow);
set_label(oklab);
test_unsigned_and_trap(r0,0xffffffff,f_overflow);
}
break;
}
case uwordhd:{
if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(r0,0xffff,f_overflow);
}
else{
test_unsigned(r0,0xffff,trap_label(e));
}
break;
}
case swordhd:{
if (error_treatment_is_trap(e)) {
test_signed_and_trap(r0,-0x8000L,0x7fff,f_overflow);
}
else{
test_signed(r0,-0x8000L,0x7fff,trap_label(e));
}
break;
}
case ucharhd:{
if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(r0,255,f_overflow);
}
else{
test_unsigned(r0,255,trap_label(e));
}
break;
}
case scharhd:{
if (error_treatment_is_trap(e)) {
test_signed_and_trap(r0,-128,127,f_overflow);
}
else{
test_signed(r0,-128,127,trap_label(e));
}
break;
}
default:failer("illegal shape");
}
set_label(mult_end_lab);
setregalt(aa,r0);
mka.regmove = move(aa,dest,nsp,0);
}
return mka;
} /* end mult */
case div1_tag:
case div2_tag:
case offset_div_by_int_tag:
case offset_div_tag:
case div0_tag:{
exp rop = bro(son(e));
exp lop = son(e);
bool uns = (name (sh (e)) & 1) == 0; /* ?? */
space nsp;
int r0;
ans aa;
ash a;
instruction div_ins;
if (name(rop) == val_tag) {
/* unsigned division by constant */
int m = no(rop);
if ((m == 0) && !optop(e)) {
integer_branch(i_br,31,trap_label(e));
}
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,(guardreg(r,sp)));
operate_fmt_immediate((uns)? i_srl : i_sra,r, shleng,rr);
setregalt(aa, rr);
mka.regmove = move(aa, dest, guardreg(r,guardreg(rr, sp)), 1);
return mka;
}
else if (use_umulh_for_div) {
if (m>0) {
int r = reg_operand(son(e),sp);
int rr = regfrmdest(&dest,sp);
if(m!=1){ /* no point in dividing by 1 ! */
#if DO_NEW_DIVISION
divide_by_constant(e,lop,rop,rr,nsp);
#else
divide_by_constant(r,make_INT64(0,m),rr,guardreg(r,sp));
#endif
}
else{
rr=r;
}
setregalt(aa, rr);
mka.regmove = move(aa, dest, guardreg(rr, sp), 1);
return mka;
}
}
}
a = ashof(sh(son(e)));
if (!optop(e) && !error_treatment_is_trap(e)) {/* test for (-inf)/-1 and /0 */
check_exception(e,sp);
}
nsp.fixed = (sp.fixed) | (1<<23) | (1<<24) | (1<<25) | (1<<27);
div_ins= (uns)?((a.ashsize==32)?i_divlu:i_divqu):
(a.ashsize==32)?i_divl:i_divq;
if (!optop(e) && !error_treatment_is_trap(e)) {
int rd = reg_operand(rop,sp);
integer_branch(i_beq,rd,no(son(pt(e))));
}
r0 = divide_using_div(e,lop,rop,dest,nsp,div_ins);
setregalt(aa, r0);
clear_reg(AT);
clear_reg(23);
clear_reg(24);
clear_reg(25);
clear_reg(27);
mka.regmove = move(aa, dest, guardreg(r0,sp), 0);
return mka;
}
#if 0
case div1_tag: { /* only applies to signed operands */
exp rop = bro(son(e));
exp lop = son(e);
int ne = name(e);
space nsp;
int r0, r1, r2;
int lab, treg;
ans aa;
r2 = reg_operand(rop, sp);
nsp = guardreg(r2, sp);
r1 = reg_operand(lop, nsp);
if (!optop(e)) { /* test for (-inf)/-1 and /0 */
long over = new_label();
long trap = no(son(pt(e)));
ans aa;
set_label(over);
}
r0 = regfrmdest(&dest,nsp);
treg = getreg(guardreg(r0,nsp).fixed);
lab = new_label();
operate_fmt(i_xor, treg, r2, treg);
operate_fmt(i_sra, treg, 31,treg);
operate_fmt(i_addq, r0,treg,r0);
set_label(lab);
setregalt(aa, r0);
mka.regmove = move(aa, dest, guardreg(r0,sp), 0);
return mka;
}
#endif
case neg_tag:
case offset_negate_tag:{
if (optop(e) /* || (name(sh(e)) & 1) ==0 */ ) {
int r1=getreg(sp.fixed);
int a1;
space nsp;
a1 = reg_operand(son(e),sp);
if (dest.answhere.discrim == inreg) {
int d = regalt(dest.answhere);
operate_fmt(is64(sh(e))?i_subq:i_subl,31,a1,d);
/*if (optop(e)) tidyshort(d,sh(e));*/
}
else {
ans a;
setregalt(a,r1);
operate_fmt(is64(sh(e))?i_subq:i_subl,31,a1,r1);
/*if (optop(e)) tidyshort(r1,sh(e));*/
nsp=guardreg(r1,sp);
move(a,dest,nsp,1);
mka.regmove = r1;
}
return mka;
}
else {
int r1 = reg_operand(son(e), sp);
space nsp;
/* int trap = trap_label(e); */
int r2;
ans aa;
nsp = guardreg(r1,sp);
r2 = getreg(nsp.fixed);
operate_fmt(i_subq,31,r1,r2);
switch (name(sh(e))) {
case ucharhd:{
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(r2,255,f_overflow);
}
else{
test_unsigned(r2,255,trap_label(e));
}
}
break;
}
case scharhd:{
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
test_signed_and_trap(r2,-128,127,f_overflow);
}
else{
test_signed(r2,-128,127,trap_label(e));
}
}
break;
}
case uwordhd:{
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(r2,0xffff,f_overflow);
}
else{
test_unsigned(r2,0xffff,trap_label(e));
}
}
break;
}
case swordhd: {
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
test_signed_and_trap(r2,-0x8000L,0x7fff,f_overflow);
}
else{
test_signed(r2,-0x8000L,0x7fff,trap_label(e));
}
}
break;
}
case ulonghd:{
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(r2,0xffffffff,f_overflow);
}
else{
test_unsigned(r2,0xffffffff,trap_label(e));
}
}
break;
}
case slonghd:{
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
test_signed_and_trap(r2,-0x80000000L,0x7fffffff,f_overflow);
}
else{
test_signed(r2,-0x80000000L,0x7fffffff,trap_label(e));
}
}
break;
}
case s64hd:{
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(r1,0x7fffffffffffffffL,f_overflow);
}
else{
test_unsigned(r1,0x7fffffffffffffffL,trap_label(e));
}
}
break;
}
case u64hd:{
if (!optop(e)) {
if (error_treatment_is_trap(e)) {
int new_lab = new_label();
integer_branch(i_ble,r1,new_lab);
do_exception(f_overflow);
set_label(new_lab);
}
else{
integer_branch(i_bgt,r1,trap_label(e));
}
}
break;
}
default:failer("Illegal shape in neg");
}
setregalt(aa, r2);
mka.regmove = move(aa, dest, guardreg(r2, nsp), 0);
return mka;
}
} /* end neg */
case goto_lv_tag: {
int r = reg_operand(son(e),sp);
integer_jump(i_jmp,31,r,0);
clear_all();
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)));
(void)make_code(son(e), sp, w , 0);
nsp = guardreg(sr, sp);
dr = getreg(nsp.fixed);
setregalt(w.answhere, dr);
(void)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);
(void)make_code(szarg, nsp, w, 0);
nsp = guardreg(szr, nsp);
mr = getreg(nsp.fixed);
bytemove = al2(sh(szarg)) >>3;
if (name(szarg)!= val_tag || no(szarg) == 0) {
integer_branch(i_beq,szr,lout);
}
if (isnooverlap(e)) {
move_dlts(dr,sr,szr,mr, bytemove,sp);
}
else {
int gtlab = new_label();
int rtmp=getreg(nsp.fixed);
operate_fmt(i_cmple,dr,sr,rtmp);
integer_branch(i_beq,rtmp,gtlab);
move_dlts(dr,sr,szr, mr, bytemove,sp);
integer_branch(i_br,31,lout);
set_label(gtlab);
move_dgts(dr,sr,szr, mr, bytemove,sp);
}
set_label(lout);
return mka;
}
case set_stack_limit_tag: {
int reg = reg_operand(son(e),sp);
baseoff b;
/* b = find_tag("__TDFstacklim");*/
b = find_tag("__alpha_stack_limit");
load_store(i_stq,reg,b);
return mka;
}
case give_stack_limit_tag: {
ans aa;
baseoff b;
int reg = regfrmdest(&dest,sp);
/* b = find_tag("__TDFstacklim");*/
b = find_tag("__alpha_stack_limit");
load_store(i_ldq,reg,b);
setregalt(aa,reg);
move(aa,dest,guardreg(reg,sp),1);
return mka;
}
case shl_tag:
case shr_tag:{
exp s = son(e);
exp b = bro(s);
int a;
int d;
int src_reg;
ans aa;
space nsp;
bool sgned = is_signed(sh(e));
instruction shnat;
instruction shun;
a = reg_operand(s, sp);
/* choose which shift instruction */
if (name(e) == shr_tag) {
shnat = (sgned)? i_sra : i_srl;
shun = i_sll;
}
else {
shnat = i_sll;
shun = (sgned)? i_sra : i_srl;
}
nsp = guardreg(a, sp);
d = regfrmdest(&dest, nsp);
/* when applying right shifts to unsigned data which is less then
the full (64 bit) register length, we must ensure that all the
unused bits in the upper part of the register are set to zero */
if (!is64(sh(son(e))) && !is_signed(sh(son(e)))
&& ins_equal(i_srl,shnat)) {
src_reg = getreg(nsp.fixed);
if (name(sh(son(e))) == ulonghd)
operate_fmt_immediate(i_zapnot,a,15,src_reg);
else if (name(sh(son(e))) == uwordhd)
operate_fmt_immediate(i_zapnot,a,3,src_reg);
else if (name(sh(son(e))) == ucharhd)
operate_fmt_immediate(i_zapnot,a,1,src_reg);
}
else {
src_reg = a;
}
nsp = guardreg(src_reg,nsp);
if (name(b) == val_tag) {
/* if its a constant shift we dont have to choose shift
dynamically ... */
if (no(b) >= 0) {
#if 0
if (!is64(sh(son(e))) && !is_signed(sh(son(e))) &&
ins_equal(i_srl,shnat)) {
/* if quantity being shifted right is not 64 bits wide
then the top 32 bits of the register containing it
must be set to zero. This does not apply to
arithmetic shifts. */
operate_fmt_immediate(i_zapnot,a,15,a);
}
#endif
operate_fmt_immediate(shnat,src_reg, no(b),d);
}
else {
operate_fmt_immediate(shun,src_reg, -no(b),d);
}
}
else {
int sr = getreg(nsp.fixed);
int ar = reg_operand(b, nsp);
if (!is_signed(sh(b))/* unsigned */
|| (name(b) == and_tag && name(bro(son(b))) == val_tag
&& no(bro(son(b))) > 0 && no(bro(son(b))) <= 31)
) { /* ... similarly in these cases */
operate_fmt(shnat,src_reg, ar,d);
}
else { /* choose shift dynamically */
int l = new_label();
int endl = new_label();
if (!is64(sh(son(e)))) {
operate_fmt_immediate(i_sll,src_reg,32,src_reg);
operate_fmt_immediate(is_signed(sh(son(e)))?i_sra:i_srl,src_reg
,32,src_reg);
/*operate_fmt_immediate(i_zap,a,240,a);*/ /* ?? */
}
integer_branch(i_bge,ar,l);
operate_fmt(i_subq,31,ar,sr);
operate_fmt(shun,src_reg, sr,d);
integer_branch(i_br,31,endl);
set_label(l);
operate_fmt(shnat,src_reg, ar,d);
set_label(endl);
}
}
if (is32(sh(e)) && (name(e) == shl_tag)) {
operate_fmt_immediate(i_addl,d,0,d);
}
setregalt(aa, d);
move(aa, dest, nsp, 1);
mka.regmove = d;
return mka;
} /* end shl */
#if 0
case mod_tag:{
/* only applies to signed operands */
exp rop = bro(son(e));
exp lop = son(e);
int ne = name(e);
space nsp;
int r0, r1, r2;
int lab, treg;
ans aa;
failer("mod_tag not implemented correctly");
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 = no(son(pt(e)));
int rt = getreg(guardreg(r2,nsp).fixed);
ans aa;
integer_branch(i_beq,r2,trap);
operate_fmt_immediate(i_cmpeq,r2,-1,rt);
integer_branch(i_bne,r2,over);
operate_fmt_big_immediate(i_cmpeq,r1,maxmin(sh(e)).mini,rt);
integer_branch(i_beq,rt,trap);
set_label(over);
}
r0 = regfrmdest(&dest, nsp);
failer("mod tag not implemented correctly");
/* operate_fmt(i_rem, r0, r1, r2);*/
treg= getreg(guardreg(r0, nsp).fixed);
lab = new_label();
/* condri_ins(i_beq, r0, 0, lab);*/
operate_fmt(i_xor, treg, r0, r2);
/* condri_ins(i_bge, treg, 0, lab);*/
operate_fmt(i_addq, r0, r0, r2);
set_label(lab);
setregalt(aa, r0);
mka.regmove = move(aa, dest, guardreg(r0,sp), 0);
return mka;
}
#endif
/* Remainder operations have the same effect on the registers
AT,23,24,25 and 27 as the division operations,
so they must be treated in the same way.*/
case mod_tag:
case rem0_tag:
case rem2_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 0
int size=dest.ashwhere.ashsize;
#endif
nsp = sp;
if (name(rop) ==val_tag) {
/* if the second argument is a constant then we can
replace the rem* instruction by either an and
instruction, or an umulh and multiplication
followed by a subtraction */
int r = reg_operand(son(e),sp);
int m = no(rop); /* value of constant */
int rres = regfrmdest(&dest,sp);
int rtmp = getreg(guardreg(rres,sp).fixed);
if (m>1 && ((m& (m-1)) ==0)) {
/* if the constant is a power of 2 then use an and */
ans aa;
operate_fmt_immediate(i_and,r, no(rop) - 1,rres);
setregalt(aa, rres);
mka.regmove = move(aa, dest, guardreg(rres, sp), 1);
return mka;
}
else{
if (m!=1) {
if (use_umulh_for_div) {
#if DO_NEW_DIVISION
divide_by_constant(e,lop,rop,rtmp,nsp);
#else
divide_by_constant(r,make_INT64(0,m),rtmp,guardreg(r,sp));
#endif
}
else{
if (!optop(e) && (m == 0)) {
if (error_treatment_is_trap(e)) {
do_exception(f_overflow);
}
else {
integer_branch(i_br,31,trap_label(e));
}
}
else {
operate_fmt_immediate(uns?i_divqu : i_divq,r,m,rtmp);
}
}
operate_fmt_immediate(i_mulq,rtmp,m,rtmp);
operate_fmt(i_subq,r,rtmp,rres);
}
else{
load_store_immediate(i_ldiq,rres,make_INT64(0,0));
}
setregalt(aa,rres);
mka.regmove = move(aa, dest, guardreg(rres,sp), 1);
return mka;
}
}
nsp.fixed |= ((1<<23) | (1<<24) | (1<<25) | (1<<27));
r1 = reg_operand(lop, nsp);
clear_reg(23);
clear_reg(24);
clear_reg(25);
clear_reg(27);
nsp = guardreg(r1, nsp);
r2 = reg_operand(rop, nsp);
if (!optop(e)) { /* test for (-inf)/-1 and /0 */
check_exception(e,nsp);
}
if ((r0 = regfrmdest(&dest, nsp)) == NO_REG) {
r0 = getreg(nsp.fixed);
}
nsp = guardreg(r0,nsp);
if (!optop(e)) {
integer_branch(i_beq,r2,trap_label(e));
}
operate_fmt((uns)?((is64(sh(e)))?i_remqu : i_remlu):
((is64(sh(e)))?i_remq : i_reml),r1,r2,r0);
#if 0
operate_fmt((uns)?((size==32)?i_remlu:i_remqu):
((size==32)?i_reml:i_remq),
r1,r2,r0);
#endif
if (name(e) == mod_tag) {
int res_neg = new_label();
int exitlab = new_label();
integer_branch(i_beq,r0,exitlab);
integer_branch(i_blt,r0,res_neg);
integer_branch(i_bge,r2,exitlab);
#if 0
operate_fmt((size == 32)?i_addl:i_addq,r0,r2,r0);
#endif
operate_fmt(is64(sh(e))?i_addq : i_addl,r0,r2,r0);
integer_branch(i_br,31,exitlab);
set_label(res_neg);
integer_branch(i_ble,r2,exitlab);
#if 0
operate_fmt((size == 32)?i_addl:i_addq,r0,r2,r0);
#endif
operate_fmt(is64(sh(e))? i_addq : i_addl,r0,r2,r0);
set_label(exitlab);
}
setregalt(aa, r0);
if ((r2 == 23) || (r2 == 24) || (r2 == 25) || (r2 == AT)) {
clear_dep_reg(rop);
}
if ((r1 == 23) || (r1 == 24) || (r1 == 25) || (r1 == AT)) {
clear_dep_reg(lop);
}
clear_reg(23);
clear_reg(24);
clear_reg(25);
clear_reg(27);
mka.regmove = move(aa, dest, guardreg(r0,nsp), 0);
return mka;
} /* end mod */
case offset_pad_tag:{
int rdest = regfrmdest(&dest,sp);
int roff = reg_operand(son(e),sp);
ans aa;
if (al2(sh(son(e))) >= al2(sh(e))) {
if (al2(sh(e))!=1 || al2(sh(son(e))) ==1) {
e = son(e);
goto tailrecurse;
}
operate_fmt_immediate(i_sll,roff,3,rdest);
}
else{
int al = (al2(sh(son(e))) ==1)?al2(sh(e)):(al2(sh(e)) /8);
operate_fmt_immediate(i_addq,roff,al-1,rdest);
operate_fmt_immediate(i_and,rdest,-al,rdest);
if (al2(sh(son(e))) == 1) {
operate_fmt_immediate(i_sra,rdest,3,rdest);
}
}
setregalt(aa,rdest);
mka.regmove = move(aa,dest,guardreg(rdest,sp),0);
return mka;
}
#ifdef make_stack_limit_tag
case make_stack_limit_tag:
#endif
case minptr_tag:{
mka.regmove = non_comm_op(e, sp, dest, i_subq);
return mka;
}
case abs_tag: {
int arg = reg_operand(son(e),sp);
int rtmp = getreg(guardreg(arg,sp).fixed);
int destreg;
ans tmp;
switch (dest.answhere.discrim) {
case inreg:{
destreg = regalt(dest.answhere);
break;
}
default:{
destreg = getreg(sp.fixed);
break;
}
}
if (destreg == NO_REG)destreg = getreg(sp.fixed);
operate_fmt(i_bis,arg,arg,destreg);
operate_fmt(i_subq,31,arg,rtmp);
operate_fmt(i_cmovgt,rtmp,rtmp,destreg);
if(!optop(e) /*&& !error_treatment_is_trap(e)*/) {
int rt = getreg(sp.fixed);
operate_fmt_big_immediate(i_subq,destreg,maxmin(sh(e)).maxi,rt);
if (error_treatment_is_trap(e)) {
int newl = new_label();
integer_branch(i_ble,rt,newl);
do_exception(f_overflow);
set_label(newl);
}
else{
integer_branch(i_bgt,rt,trap_label(e));
}
}
setregalt(tmp,destreg);
mka.regmove = move(tmp,dest,sp,1);
return mka;
}
case fplus_tag:{
mka.regmove =
fop(e, sp, dest,(name(sh(e))!= shrealhd)? i_addt : i_adds);
if ((name(sh(e))!=shrealhd) &&
(fregalt(dest.answhere).type==IEEE_single) &&
dest.answhere.discrim==infreg) {
}
if (!optop(e))check_exception(e, sp);
return mka;
}
case fminus_tag:{
mka.regmove =
fop(e, sp, dest,(name(sh(e))!= shrealhd)? i_subt : i_subs);
if (!optop(e))check_exception(e,sp);
return mka;
}
case fmult_tag:{
instruction mult_ins;
mult_ins = (name(sh(e))!= shrealhd)?i_mult:i_muls;
mka.regmove = fop(e, sp, dest, mult_ins);
if (!optop(e) && !error_treatment_is_trap(e))check_exception(e,sp);
return mka;
}
case fdiv_tag:{
instruction div_ins;
div_ins = (name(sh(e))!= shrealhd)?i_divt:i_divs;
/*
if(!optop(e)){
div_ins = (name(sh(e)) != shrealhd)?i_divtsu:i_divssu;
}
else{
div_ins = (name(sh(e)) != shrealhd)?i_divt:i_divs;
}
*/
if (!optop(e) && !error_treatment_is_trap(e)) {
int fr = freg_operand(bro(son(e)),sp);
float_branch(i_fbeq,fr,no(son(pt(e))));
}
mka.regmove = fop(e, sp, dest, div_ins);
if (!optop(e) && !error_treatment_is_trap(e))check_exception(e,sp);
return mka;
}
case fneg_tag:
case fabs_tag:{
instruction ins;
freg fr;
int arg=freg_operand(son(e),sp);
if (name(e) == fneg_tag) {
if (optop(e))ins = (name(sh(e))!= shrealhd)?i_subt:i_subs;
else
ins = (name(sh(e))!= shrealhd)?i_subtsu:i_subssu;
}
else{
ins = i_cpys;
}
switch (dest.answhere.discrim) {
case infreg:{
fr=fregalt(dest.answhere);
float_op(ins,31,arg,fr.fr);
break;
}
default :{
ans tmp;
fr.type= (dest.ashwhere.ashsize==32)?IEEE_single:IEEE_double;
fr.fr=getfreg(sp.flt);
setfregalt(tmp,fr);
float_op(ins,31,arg,fr.fr);
move(tmp,dest,sp,1);
}
}
if (!optop(e) && (name(e) ==fneg_tag) && !error_treatment_is_trap(e))
check_exception(e,sp);
mka.regmove= ((fr.type==IEEE_double)? - (fr.fr+32):(fr.fr+32));
return mka;
}
case float_tag: {
exp in = son(e);
where w;
int r;
int f
= (dest.answhere.discrim == infreg)? regalt(dest.answhere)
: getfreg(sp.flt);
freg frg;
ans aa;
ash ain;
bool quad;
ain = ashof(sh(in));
quad = (ain.ashsize!=32);
frg.fr = f;
frg.type = IEEE_single;
if (ain.ashsize<32) {
/* go via fixed point register for bytes and words */
where tmp;
ans src;
r=reg_operand(in,sp);
setregalt(tmp.answhere,r);
tmp.ashwhere=ashof(sh(in));
/*code_here(in,sp,tmp);*/ /* move it into fixed pt reg r */
setregalt(src,r);
frg.type=IEEE_double;
setfregalt(tmp.answhere,frg);
move(src,tmp,sp,0);
}
else{
switch (name(sh(in))) {
case swordhd:
case uwordhd:
case slonghd:
case ulonghd:
case s64hd:
case u64hd:{
freg load_reg;
load_reg.type = IEEE_double; /* so we load in an octaword */
load_reg.fr=f;
setfregalt(w.answhere,load_reg);
w.ashwhere=ashof(sh(in));
code_here(in,sp,w);
break;
}
default:
setfregalt(w.answhere,frg);
w.ashwhere = ashof(sh(in));
code_here(in,sp,w);
break;
}
}
if (!quad) {
float_convert(i_cvtlq,f,f);
}
float_convert((name(sh(e)) ==shrealhd)?i_cvtqs:i_cvtqt,f,f);
if (name(sh(e))!= shrealhd) {
frg.type = IEEE_double;
}
setfregalt(aa, frg);
move(aa, dest, sp, 1);
if (name(sh(in)) ==u64hd|| (name(sh(in)) ==ulonghd)) {
fix_unsigned(frg,sp,name(sh(in)));
}
mka.regmove = (frg.type==IEEE_double)? - (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);
}
if(dto) /* was dfrom */
frg.type = IEEE_double;
else
frg.type = IEEE_single;
setfregalt(aa, frg);
w.answhere = aa;
w.ashwhere = ashof(sh(son(e)));
code_here(son(e), sp, w);
if (dto)
frg.type = IEEE_double;
else
frg.type = IEEE_single;
if ((!dto) && dfrom) {
/* If converting from double to single then we
need to use a conversion */
float_convert(i_cvtts,frg.fr,frg.fr);
}
setfregalt(aa, frg);
move(aa, dest, sp, 1);
mka.regmove = (frg.type==IEEE_double)?- (frg.fr + 32):(frg.fr + 32);
if (!optop(e) && !dto && !error_treatment_is_trap(e))check_exception(e,sp);
return mka;
}
}
case and_tag: {
if (use_andcomp && name(bro(son(e))) == not_tag) {
bro(son(e)) = son(bro(son(e)));
mka.regmove = comm_op(e,sp,dest,i_bic);
}
else if (use_andcomp && name(son(e)) == not_tag) {
exp tmp = copyexp(son(e));
son(e) = bro(son(e));
bro(son(e)) = son(tmp);
/*retcell(tmp)*/;
mka.regmove = comm_op(e,sp,dest,i_bic);
}
else
mka.regmove = comm_op(e, sp, dest, i_and);
return mka;
}
case andcomp_tag:{
mka.regmove = comm_op(e,sp,dest,i_bic);
return mka;
}
case or_tag: {
mka.regmove = comm_op(e, sp, dest, i_bis);
return mka;
}
case xor_tag:{
mka.regmove = comm_op(e, sp, dest, i_xor);
return mka;
}
case not_tag: {
int arg=reg_operand(son(e),sp);
switch (dest.answhere.discrim) {
case inreg:{
int the_dest = regalt(dest.answhere);
operate_fmt(i_ornot,31,arg,the_dest);
break;
}
default:{
ans a;
space nsp;
int reg=getreg(sp.fixed);
setregalt(a,reg);
operate_fmt(i_ornot,31,arg,reg);
tidyshort(reg,sh(e));
nsp=guardreg(reg,sp);
move(a,dest,nsp,is_signed(sh(e)));
}
}
return mka;
}
case locptr_tag: {
int ptr = reg_operand(son(e),sp);
int ansr = regfrmdest(&dest,sp);
baseoff b;
ans aa;
b.base = ptr;
b.offset = -arg_stack_space -3*(PTR_SZ>>3);
load_store(i_ldq,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:NO_REG;
desper = ashof(sh(e));
if (name(e) == contvol_tag) {
clear_all();
/*setvolatile ();*/
}
clear_dep_reg(e);
w = locate(e, guardreg(dr,sp), sh(e), dr);
/* 'address of argument */
/*sgned = ((w.ashwhere.ashsize >= 64)
|| name (sh (e)) & 1) ? 1 : 0;*/
sgned = is_signed(sh(e));
mka.regmove = move(w.answhere, dest,(guard(w, sp)), sgned);
clear_dep_reg(e);
if (name(e) == contvol_tag) {
mka.regmove = NOREG;
/* setnovolatile ();*/
}
return mka;
} /* end cont */
#if (FBASE != 10)
case real_tag:
#endif
case string_tag:{
instore isa;
ans aa;
bool sgned = ((ashof(sh(e)).ashsize >= 32) || name(sh(e)) & 1)? 1 : 0;
if (name(e) ==real_tag) {
bool is_denorm = is_denormal(e);
if (is_fzero(flptnos[no(e)]) || (is_denorm && treat_denorm_specially)) {
freg frg;
frg.fr = 31;
frg.type = (shape_size(sh(e)) == 32)?IEEE_single:IEEE_double;
setfregalt(aa,frg);
mka.regmove = move(aa,dest,sp,sgned);
if (is_denorm) {
if (fail_with_denormal_constant) {
failer("Denormalised constant encountered");
exit(EXIT_FAILURE);
}
alphawarn("Replaced IEEE denormal with 0.0!");
comment("Replaced IEEE denormal with 0.0");
}
return mka;
}
}
#if DO_SCHEDULE
start_new_capsule(false);
#endif
isa=evaluated(e,0);
set_text_section();
#if DO_SCHEDULE
close_capsule();
#endif
setinsalt(aa,isa);
mka.regmove=move(aa,dest,sp,sgned);
return mka;
}
#if (FBASE == 10) /* now defunct */
case real_tag:{
instore isa;
ans aa;
char *flt_string; /* a string representing the real literal */
char *ld_ins;
freg fr;
int use_fzero; /* set if value of real is 0.0 */
bool sgned = ((ashof(sh(e)).ashsize >= 32) || name(sh(e)) & 1)? 1 : 0;
flt_string = floating_value(e);
use_fzero = !strcmp(flt_string,"0.0");
switch (dest.answhere.discrim) {
case infreg:
fr.fr = regalt(dest.answhere);
fr.type = (dest.ashwhere.ashsize==32)?IEEE_single:IEEE_double;
break;
case insomefreg:
if (!use_fzero) {
fr.fr = getfreg(sp.flt);
fr.type = (dest.ashwhere.ashsize==32)?IEEE_single:IEEE_double;
}
break;
case notinreg:
fr.fr=getfreg(sp.flt);
fr.type= (dest.ashwhere.ashsize==32)?IEEE_single:IEEE_double;
break;
default:
failer("dubious target for real_tag ");
}
ld_ins = (fr.type==IEEE_single)?i_ldis:i_ldit;
if (use_fzero) {
if (dest.answhere.discrim==insomefreg) {
*dest.answhere.val.somefregans.fr=31;
return mka;
}
else
float_op(i_cpys,31,31,fr.fr);
}
else
float_load_store_immediate(ld_ins,fr.fr,flt_string);
if (dest.answhere.discrim==insomefreg)
*dest.answhere.val.somefregans.fr = fr.fr;
if (dest.answhere.discrim==notinreg) {
/* put reg contents into memory */
ans src;
setfregalt(src,fr);
mka.regmove=move(src,dest,sp,sgned);
}
return mka;
} /* end eval */
#endif /* (FBASE==10) */
case val_tag: {
if (no(e) == 0 && !isbigval(e)) {
goto null_tag_case;
}
else {
ash a;
a = ashof(sh(e));
switch (a.ashsize) {
case 8:{
low_INT64(constval) = no(e) &255;
if (is_signed(sh(e)))
low_INT64(constval) -= (low_INT64(constval) &128) <<1;
break;
}
case 32:{
low_INT64(constval) = no(e);
}
#if 0
if (is_signed(sh(e))) {
low_INT64(constval) = no(e);
}
else{
low_INT64(constval) = uno(e);
}
#endif
break;
case 64:{
int findex = no(e);
int ov;
if (isbigval(e)) {
flt64 res;
res = flt_to_f64(findex,is_signed(sh(e)),&ov);
INT64_assign(constval, flt64_to_INT64(res));
}
else low_INT64(constval) = no(e);
break;
}
default:{
low_INT64(constval) = no(e) &65535;
if (is_signed(sh(e)))
low_INT64(constval) -= (low_INT64(constval) &32768) <<1;
break;
}
}
goto moveconst;
}
}
case prof_tag:
case top_tag: {
return mka;
}
case dump_tag: {
int fxd = no(e);
int fld = no(pt(e));
int old_fixdone = fixdone;
int old_fltdone = fltdone;
int old_result_label = result_label;
exp l;
result_label=0;
dump_sregs(fxd, fld);
if ((fxd & (1<<RA)))sp.fixed &= ~(1<<RA);
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 & (1<< (sr)))!=0) {
if (name(sh(son(l)))!= shrealhd) {
float_op(i_cpys,tr,tr,sr);
}
else {
float_op(i_cpys,tr,tr,sr);
}
sp.flt &= ~(1<<tr); /* release fpar reg */
no(l) = sr; props(son(l)) = tr;
}
else
if (((fxd & (1<<sr))!=0) && (props(l) & inreg_bits)) {
operate_fmt(i_bis,tr,tr,sr);
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 & (1<< (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 general_proc_tag:
case proc_tag: {
/*
set up locals_offset, fixdump, floatdump,
frame_size, dumpstart
dec stack ; output frame and mask
code here;
The standard stack layout for a make_proc is as follows:
------------------------------------- Bottom of env
space for caller params to be passed on stack
(If containing apply or apply_general)
space for dumped s registers
locals
space for dumped arguments (first 6)
-------------------------------------- Top of env
remaining arguments (in callers frame)
for general procs the frame will be set up as follows:
---------------------------- Bottom of callee env
extra caller parameters (If containing apply or apply_general)
callee parameters (1,2,,,,,)
space for dumped s registers
locals
caller local reg
callee local reg
callee top of stack
caller frame pointer
Up to 6 caller parameters
--------------------------- Top of callee env
Any remaining caller parameters
*/
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;
int i;
int has_va;
setframe_flags(e, leaf);
has_va = has_c_vararg(e) || ((name(e) == general_proc_tag) &&
(!Has_no_vcallers));
in_general_proc = (name(e) ==general_proc_tag);
old_postludes = (postlude_chain*)NULL;
crt_proc = e;
frame_size = pr->frame_size;
locals_offset = pr->locals_offset;
max_args = pr->max_args;
param_stack_space = (min(max_args,
(Has_no_vcallers)?6*PTR_SZ : 12*PTR_SZ)) >>3;
arg_stack_space = min(pr->needsproc.numparams,
(has_va)?12*PTR_SZ : 6*PTR_SZ) >>3;
#if 0
if (pr->needsproc.numparams > 11 * PTR_SZ) {
arg_stack_space = 12*PTR_SZ;
}
else {
arg_stack_space = max(pr->needsproc.numparams,
(Has_no_vcallers?6*PTR_SZ : 12*PTR_SZ));
}
#endif
/* this doesn't actually waste much space, and simplifies matters
later */
if(name(e) == general_proc_tag /* || proc_has_gen_call(e)*/) {
int old_arg_count = arg_stack_space;
arg_stack_space = ((has_va)?12*PTR_SZ : 6*PTR_SZ) >>3;
if (arg_stack_space > old_arg_count)
frame_size += ((arg_stack_space - old_arg_count) <<3);
}
/*
param_stack_space contains the maximum number of bytes
that will be required to save the registers used by this
proc when passing parameters to other procedures. As
the space is actually allocated in the callee frame, this
is only needed for apply_general_proc. arg_stack_space
contains the number of arguments passed to this proc,
and for which space must be reserved within the current
frame.
*/
for (i=0;i<min(pr->needsproc.numparams>>6,NUM_PARAM_REGS);++i) {
sp = guardreg(FIRST_INT_ARG+i,sp);
}
paramsdumpstart = pr->paramsdumpstart;
/* the fixed point registers will be stored in the space
starting from gpdumpstart */
gpdumpstart = (has_va)?paramsdumpstart+384:paramsdumpstart;
proc_has_vararg = (has_va)?1:0;
fixdump = pr->fixdump;
floatdump = pr->floatdump;
dumpstart = pr->dumpstart;
fldumpstart = pr->fldumpstart;
callee_size = pr->callee_size;
stack_top= (locals_offset>>3) -8;
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<<RA);
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 |= (1<<no(l));
}
}
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);
set_global_pointer();
if (name(e) ==general_proc_tag) {
if (Has_vcallees) {
baseoff b;
b.base = FP;
b.offset = (-4 * PTR_SZ>>3) - arg_stack_space;
load_store(i_stq, local_reg, b);
operate_fmt(i_bis,SP,SP,local_reg);
if (!leaf) {
b.offset = (-3*PTR_SZ>>3) - arg_stack_space;
load_store(i_stq, local_reg, b);
}
}
else if (Has_fp && name(e) ==general_proc_tag) {
operate_fmt_immediate(i_addq,SP, arg_stack_space+
(callee_size>>3),FP);
}
#if DO_SCHEDULE
close_capsule();
start_new_capsule(true);
#endif
if (frame_size != 0 || callee_size!=0) {
operate_fmt_immediate(i_subq,SP,(frame_size+callee_size) >>3,SP);
}
}
else{
if (st != 0) {
baseoff a;
a.base = SP;
a.offset=-st;
load_store(i_lda,SP,a);
}
setframe(st,0);
/* I'm not sure that this is the right order for these -
diagnostics ? */
setprologue(2);
#if DO_SCHEDULE
close_capsule();
start_new_capsule(true);
#endif
if (Has_fp) {
baseoff b;
b.base = SP;
#if 0
b.offset = ((callee_size+frame_size) >>3) -
arg_stack_space- (PTR_SZ>>3);
#endif
b.offset = ((callee_size+frame_size-PTR_SZ) >>3) -
((in_general_proc)?0:arg_stack_space);
b.offset = ((callee_size+frame_size-PTR_SZ) >>3) -
(arg_stack_space);
load_store(i_stq,FP,b);
operate_fmt_immediate(i_addq,SP,st,FP);
/*operate_fmt(i_bis,SP,SP,FP);*/
if (Has_tos) {
b.base = FP;
b.offset = - ((PTR_SZ>>3)*2) - (arg_stack_space);
load_store(i_stq,SP,b);
}
}
}
if (proc_has_checkstack(e)) {
baseoff b;
int rtmp = getreg(sp.fixed);
/* b = find_tag("__TDFstacklim");*/
b = find_tag("__alpha_stack_limit");
stackerr_lab = new_label();
load_store(i_ldq,rtmp,b);
setnoat();
operate_fmt(i_cmplt,SP,rtmp,AT);
integer_branch(i_bne,AT,stackerr_lab);
setat();
}
else{
stackerr_lab = 0;
}
if ((pprops & realresult_bit)!= 0) {
/* proc has real result */
/* add an entry for complex result : returned in f0/f1 */
freg frg;
frg.fr = 0;
if (pprops & longrealresult_bit)
frg.type = IEEE_double;
else
frg.type = IEEE_single;
setfregalt(procans, frg);
}
else if ((pprops & has_result_bit)!= 0) {
/* proc has fixed pt result */
setregalt(procans, RESULT_REG);
}
else { /* proc has no result */
setregalt(procans, NO_REG);
}
result_label = 0;
aritherr_lab = 0;
/* fix up integers passed in registers */
for (l = son(e);name(l) == ident_tag && isparam(l);l=bro(son(l))) {
if (props(l) & inreg_bits) {
int n = props(son(l));
Assert((n>=FIRST_INT_ARG) && (n<=LAST_INT_ARG));
if (is32(sh(son(l))))operate_fmt_immediate(i_addl,n,0,n);
}
}
code_here(son(e), guardreg(RA,sp), nowhere);
param_stack_space = arg_stack_space = sizecallers = 0;
/* evaluate body of proc */
if (stackerr_lab) {
set_label(stackerr_lab);
operate_fmt_immediate(i_addq,SP,frame_size>>3,SP);
do_exception(f_stack_overflow);
}
if (aritherr_lab) {
set_label(aritherr_lab);
do_exception(f_overflow);
}
return mka;
} /* end proc */
case alloca_tag: {
exp s = son(e);
int r = regfrmdest(&dest, sp);
int rd;
ans aa;
comment("alloca");
if (checkalloc(e)) {
rd = getreg(sp.fixed);
operate_fmt(i_bis,SP,SP,rd);
}
else{
rd = SP;
}
if (name(s) ==val_tag) {
operate_fmt_immediate(i_subq, rd,(no(s) +7) &~7,rd);
}
else {
int tmp = getreg(sp.fixed);
int rop = reg_operand(s,sp);
operate_fmt_immediate(i_addq,rop,7,tmp);
operate_fmt_immediate(i_bic,tmp,7,tmp);
operate_fmt(i_subq,rd,tmp,rd);
}
if (checkalloc(e)) {
int rt = getreg(sp.fixed);
baseoff b;
b = find_tag("__alpha_stack_limit");
load_store(i_ldq,rt,b);
setnoat();
operate_fmt(i_cmple,rt,SP,AT);
if (stackerr_lab == 0)stackerr_lab = new_label();
integer_branch(i_beq,AT,stackerr_lab);
setat();
operate_fmt(i_bis,rd,rd,SP);
}
reset_tos();
operate_fmt_immediate(i_addq,SP,max(0,(max_args-6*(PTR_SZ)) >>3),r);
/*operate_fmt(i_bis,SP,SP,r);*/
setregalt(aa, r);
mka.regmove = move(aa, dest, sp, 1);
return mka;
}
case last_local_tag: {
int r = regfrmdest(&dest, sp);
ans aa;
/*operate_fmt_immediate(i_addq,SP,max_args>>3,r);*/
operate_fmt(i_bis,SP,SP,r);
setregalt(aa, r);
mka.regmove = move(aa, dest, sp, 1);
return mka;
}
case local_free_tag: {
exp s = son(e);
int r = reg_operand(s, sp);
exp off = bro(s);
comment("local_free_tag");
if (name(off) == val_tag) {
operate_fmt_immediate(i_addq, r,((no(off) >>3) +7) &~7,r);
}
else{
int rtmp = reg_operand(off,guardreg(r,sp));
operate_fmt_immediate(i_addq,rtmp,7,rtmp);
operate_fmt_immediate(i_bic,rtmp,7,rtmp);
operate_fmt(i_addq,r,rtmp,r);
}
if (Has_fp) {
/*operate_fmt_immediate(i_subq,r,max_args>>3,SP);*/
operate_fmt(i_bis,r,r,SP);
reset_tos();
}
return mka;
}
case local_free_all_tag: {
if (Has_fp) {
operate_fmt_immediate(i_subq,FP,(frame_size+callee_size) >>3,SP);
reset_tos();
}
return mka;
}
case current_env_tag: {
int r = regfrmdest(&dest, sp);
ans aa;
if (Has_fp) {
operate_fmt(i_bis,FP,FP,r);
}
else {
operate_fmt_immediate(i_addq, SP,(frame_size+callee_size) >>3,r);
}
setregalt(aa, r);
mka.regmove = move(aa, dest, sp, 1);
return mka;
}
case general_env_offset_tag:
case env_offset_tag: {
low_INT64(constval) = frame_offset(son(e));
goto moveconst;
}
case null_tag:
null_tag_case : {
ans aa;
setregalt(aa, 31);
mka.regmove = move(aa, dest, sp, 1);
return mka;
}
case round_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);
ash a;
ans aa;
int s;
instruction ins;
int truncate = (round_number(e)!=f_to_nearest);
a = ashof(sh(son(e)));
s = a.ashsize;
if (r == NO_REG) {
Assert(!optop(e));
r = getreg(sp.fixed);
}
/* start of round */
/* simply do a conversion: double->long or float->int */
/* need to check FPCR for possible [over/under]flow */
ins = (truncate)?i_cvttqc:i_cvttq;
if (round_number(e) == f_toward_zero) {
ins = i_cvttqc;
}
else if (round_number(e) == f_toward_smaller) {
ins = i_cvttqm;
}
else if (round_number(e) == f_toward_larger) {
set_up_rounding_mode(PLUS_INFINITY);
ins = i_cvttqd;
}
else{
ins = i_cvttq;
}
float_convert(ins,sfr,dfr); /* convert to integer QW */
/* now move the result into register r */
{
ans source;
where d;
freg fr;
fr.fr=dfr;
fr.type= (s==32)?IEEE_single:IEEE_double;
setfregalt(source,fr);
setregalt(d.answhere,r);
d.ashwhere=a;
move(source,d,sp,0);
}
/* we may have to cope with overflow a la C */
if (name(sh(e)) == ucharhd) {
if (!optop(e) && !error_treatment_is_trap(e)) {
test_unsigned(r,255,trap_label(e));
}
else if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(r,255,f_overflow);
}
operate_fmt_immediate(i_and, r, 255,r);
}
else if (name(sh(e)) == uwordhd) {
if (!optop(e) && !error_treatment_is_trap(e)) {
test_unsigned(r,0xffff,trap_label(e));
}
else if (error_treatment_is_trap(e)) {
test_unsigned_and_trap(r,0xffff,f_overflow);
}
operate_fmt_immediate(i_and, r,(1 << 16) - 1,r);
}
else if (name(sh(e)) == scharhd) {
if (!optop(e) && !error_treatment_is_trap(e)) {
test_signed(r,-128,127,trap_label(e));
}
else if (error_treatment_is_trap(e)) {
test_signed_and_trap(r,-128,127,f_overflow);
}
operate_fmt_immediate(i_sll, r,56, r);
operate_fmt_immediate(i_sra, r, 56, r);
}
else if (name(sh(e)) == swordhd) {
if (!optop(e) && !error_treatment_is_trap(e)) {
test_signed(r,-0x8000L,0x7fff,trap_label(e));
}
else if (error_treatment_is_trap(e)) {
test_signed_and_trap(r,-0x8000L,0x7fff,f_overflow);
}
operate_fmt_immediate(i_sll, r, 48,r);
operate_fmt_immediate(i_sra, r, 48,r);
}
else if (name(sh(e)) == slonghd) {
if (!optop(e) && !error_treatment_is_trap(e)) {
test_signed(r,-0x80000000L,0x7fffffff,trap_label(e));
}
else if (error_treatment_is_trap(e)) {
test_signed_and_trap(r,-0x80000000L,0x7fffffff,f_overflow);
}
operate_fmt_immediate(i_sll,r,32,r);
operate_fmt_immediate(i_sra,r,32,r);
}
else if (name(sh(e)) == ulonghd) {
if (!optop(e) && !error_treatment_is_trap(e)) {
test_unsigned(r,0xffffffff,trap_label(e));
}
else if (error_treatment_is_trap(e)) {
test_unsigned(r,0xffffffff,f_overflow);
}
operate_fmt_immediate(i_zap,r,240,r);
}
setregalt(aa, r);
mka.regmove = move(aa, dest, sp, 1);
return mka;
/* end of round */
}
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) {
operate_fmt_immediate(i_and, r,(1 << a.ashsize) - 1,r);
}
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 != 64) {
if ((name((sh(e))) & 1) == 1) {
operate_fmt_immediate(i_sll, r,64 - a.ashsize,r);
operate_fmt_immediate(i_sra, r,64 - a.ashsize,r);
}
else {
operate_fmt_immediate(i_and,r,((1 << a.ashsize) - 1),r);
}
}
move(w.answhere, dest, guardreg(r, sp), 0);
keepreg(e, r);
return mka;
}
#ifdef trap_tag
case trap_tag: {
if (no(e) == f_overflow) {
do_exception(f_overflow);
}
else if (no(e) == f_nil_access) {
do_exception(f_nil_access);
}
else {
do_exception(f_stack_overflow);
}
return mka;
}
#endif
case special_tag:{
if (no(e) == 0) {
no_parameter_instructions(i_trapb);
}
return mka;
}
#if 1
case condassign_tag:{
/*
This handles a conditional assignment of the form:
IF ( A .rel. B) THEN X = Y, using conditional moves.
son(e) is the test_tag and bro(son(e)) is the assignment.
Note that the test condition is the opposite of the
condition for the conditional move (because the original
test is a jump over the assigment).
*/
where assdest;
instruction cinst;
exp ctest = son(e);
exp cass = bro(ctest);
exp ltest = son(ctest); /* lhs of test */
exp rtest = bro(ltest); /* rhs of test */
int testid = props(ctest) & 127;
int targ1,targ2; /* arguments of test */
int aarg1,aarg2; /* arguments of assignment */
int rev = 0; /* set if test is reversed */
ans aa;
exp rhs = bro(son(cass));
failer("ERROR: condassign_tag should not be encountered");
assdest = locate(son(cass),sp,sh(rhs),NO_REG);
if (((is_floating(name(sh(ltest)))) &&
(!is_floating(name(sh(son(cass))))))
|| ((!is_floating(name(sh(ltest))))
&& (is_floating((name(sh(son(cass)))))))) {
return make_code(ctest,sp,dest,exitlab);
}
if (is_floating(name(sh(ltest)))) {
bool fcompare = (name(sh(ltest))!= shrealhd);
instruction compare_ins;
space nsp;
int rdest = getfreg(sp.flt);
freg frg;
targ1 = freg_operand(ltest,sp);
nsp = guardreg(targ1,sp);
targ2 = freg_operand(rtest,nsp);
if (fcompare) {
rev = fdouble_comparisons(&compare_ins,testid);
float_op(compare_ins,targ1,targ2,rdest);
}
else {
float_op(i_subs,targ1,targ2,rdest);
}
aarg1 = freg_operand(son(cass),sp);
nsp = guardreg(aarg1,sp);
aarg2 = freg_operand(bro(son(cass)),nsp);
frg.fr = aarg1;
frg.type = (name(sh(ltest)) == shrealhd)?IEEE_single:IEEE_double;
float_op(rev?i_fcmovne:i_fcmoveq,rdest,aarg2,aarg1);
setfregalt(aa,frg);
}
else { /* integer */
bool is_compare = ((!is_signed(sh(ltest))) && ((testid-5) <0) &&
(name(sh(ltest))!=ptrhd)) || ((is64(sh(ltest))));
instruction compare_ins;
int rres; /* the result of the test */
if (is_compare) {
rev = comparisons(&compare_ins,sh(ltest),testid);
}
targ1 = reg_operand(ltest,sp);
if (name(rtest) == val_tag) {
space nsp;
if (no(rtest) || (isbigval(rtest))) {
nsp = guardreg(targ1,sp);
rres = getreg(nsp.fixed);
if (is_compare) {
if (isbigval(rtest)) {
operate_fmt_big_immediate(compare_ins,targ1,
exp_to_INT64(rtest),rres);
}
else{
operate_fmt_immediate(compare_ins,targ1,no(rtest),rres);
}
}
else{
if (name(sh(ltest)) == ulonghd) {
operate_fmt_immediate(i_addl,targ1,0,targ1);
}
if (isbigval(rtest)) {
operate_fmt_big_immediate(i_subq,targ1,exp_to_INT64(rtest),
rres);
}
else{
operate_fmt_immediate(i_subq,targ1,no(rtest),rres);
}
}
}
else{ /* test against zero */
rev = 0;
rres = targ1;
}
}
else{
space nsp;
nsp = guardreg(targ1,sp);
targ2 = reg_operand(rtest,nsp);
if (targ2 == 31) {
rev = 0;
rres = targ1;
}
else{
rres = getreg(nsp.fixed);
if (is_compare) {
operate_fmt(compare_ins,targ1,targ2,rres);
}
else{
operate_fmt(i_subq,targ1,targ2,rres);
}
}
}
aarg1 = regfrmdest(&assdest,sp);
cinst = condmove((!rev)?testrev[testid-1]:testid);
if (is_compare) {
cinst = rev?i_cmovne:i_cmoveq;
}
else{
cinst = condmove((!rev)?testrev[testid-1]:testid);
}
if (name(rhs) == val_tag) {
if (isbigval(rhs)) {
operate_fmt_big_immediate(cinst,rres,exp_to_INT64(rhs),aarg1);
}
else{
if (no(rhs) == 0 && (testid == 5)) {
operate_fmt_immediate(i_cmpeq,rres,31,aarg1);
}
else{
operate_fmt_big_immediate(cinst,rres,exp_to_INT64(rhs),aarg1);
}
}
}
else{
int r2 = reg_operand(rhs,sp);
operate_fmt(cinst,rres,r2,aarg1);
}
setregalt(aa,aarg1);
}
(void)move(aa,assdest,sp,1);
(void)move(aa,dest,sp,1);
clear_dep_reg(son(cass));
return mka;
}
#endif
default:
alphafail(TAG_NOT_IMPLEMENTED);
} /* end outer switch */
moveconst:{
int r = regfrmdest(&dest, sp);
ans aa;
if (r==NO_REG)
r=getreg(sp.fixed);
if (r != 31) { /* somewhere! */
if (INT64_eq(constval,zero_int64))
operate_fmt(i_bis,31,31,r);
else{
load_store_immediate(is64(sh(e))?i_ldiq:i_ldil,r,constval);
}
setregalt(aa, r);
move(aa, dest, guardreg(r, sp), 1);
}
mka.regmove = r;
return mka;
}
} /* end make_code */