suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

unboxing of intermediate results in some 'unsafe-fl' combinations

Browse Source 
svn: r16229
This commit is contained in:
Matthew Flatt 2009-10-03 14:10:55 +00:00
parent c579734e6b
commit 9852bb16a2
2 changed files with 783 additions and 594 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/tests/mzscheme/unsafe.ss
View File

@ -122,6 +122,24 @@
(test-un 8.0 'unsafe-fx->fl 8)
(test-un -8.0 'unsafe-fx->fl -8)
;; test unboxing:
(test-tri 9.0 '(lambda (x y z) (unsafe-fl+ (unsafe-fl- x z) y)) 4.5 7.0 2.5)
(test-tri 9.0 '(lambda (x y z) (unsafe-fl+ y (unsafe-fl- x z))) 4.5 7.0 2.5)
(test-bin 10.0 '(lambda (x y) (unsafe-fl+ (unsafe-fx->fl x) y)) 2 8.0)
(test-bin 10.0 '(lambda (x y) (unsafe-fl+ (unsafe-fx->fl x) y)) 2 8.0)
(test-tri (/ 20.0 0.8) '(lambda (x y z) (unsafe-fl/ (unsafe-fl* x z) y)) 4.0 0.8 5.0)
(test-tri (/ 0.8 20.0) '(lambda (x y z) (unsafe-fl/ y (unsafe-fl* x z))) 4.0 0.8 5.0)
(test-tri #t '(lambda (x y z) (unsafe-fl< (unsafe-fl+ x y) z)) 1.2 3.4 5.0)
(test-tri 'yes '(lambda (x y z) (if (unsafe-fl< (unsafe-fl+ x y) z) 'yes 'no)) 1.2 3.4 5.0)
(test-tri #f '(lambda (x y z) (unsafe-fl> (unsafe-fl+ x y) z)) 1.2 3.4 5.0)
(test-tri 'no '(lambda (x y z) (if (unsafe-fl> (unsafe-fl+ x y) z) 'yes 'no)) 1.2 3.4 5.0)
;; test unboxing interaction with free variables:
(test-tri 4.4 '(lambda (x y z) (with-handlers ([exn:fail:contract:variable?
(lambda (exn) (unsafe-fl+ x y))])
(unsafe-fl- (unsafe-fl+ x y) NO-SUCH-VARIABLE)))
1.1 3.3 5.2)
(test-un 5 'unsafe-car (cons 5 9))
(test-un 9 'unsafe-cdr (cons 5 9))
(test-un 15 'unsafe-mcar (mcons 15 19))

235
src/mzscheme/src/jit.c
View File

@ -189,6 +189,7 @@ typedef struct {
int reg_status;
void *patch_depth;
int rs_virtual_offset;
int unbox, unbox_depth;
} mz_jit_state;
#define mz_RECORD_STATUS(s) (jitter->status_at_ptr = _jit.x.pc, jitter->reg_status = (s))
@ -3185,6 +3186,76 @@ static int generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
return is_tail ? 2 : 1;
}
static int is_unboxable_op(Scheme_Object *obj, int flag)
{
if (!SCHEME_PRIMP(obj))
return 0;
if (!(SCHEME_PRIM_PROC_FLAGS(obj) & flag))
return 0;
if (IS_NAMED_PRIM(obj, "unsafe-fl+")) return 1;
if (IS_NAMED_PRIM(obj, "unsafe-fl-")) return 1;
if (IS_NAMED_PRIM(obj, "unsafe-fl*")) return 1;
if (IS_NAMED_PRIM(obj, "unsafe-fl/")) return 1;
if (IS_NAMED_PRIM(obj, "unsafe-fx->fl")) return 1;
return 0;
}
static int generate_pop_unboxed(mz_jit_state *jitter)
{
#if defined(MZ_USE_JIT_I386)
/* If we have some arguments pushed on the FP stack, we need
to pop them off before escaping. */
int i;
for (i = jitter->unbox_depth; i--; ) {
FUCOMPr(1); /* compare with single pop; we ignore the compare result, of course */
}
CHECK_LIMIT();
#endif
return 1;
}
static int can_unbox(Scheme_Object *obj, int fuel, int regs)
/* Assuming that `arg' is unsafely assumed to produce a flonum, can we
just unbox it without using more than `regs' registers? There
cannot be any errors or function calls, unless we've specifically
instrumented them to save/pop floating-point values before
jumping. */
{
Scheme_Type t;
if (!fuel) return 0;
if (!regs) return 0;
t = SCHEME_TYPE(obj);
switch (t) {
case scheme_application2_type:
{
Scheme_App2_Rec *app = (Scheme_App2_Rec *)obj;
if (!is_unboxable_op(app->rator, SCHEME_PRIM_IS_UNARY_INLINED))
return 0;
return can_unbox(app->rand, fuel - 1, regs);
}
case scheme_application3_type:
{
Scheme_App3_Rec *app = (Scheme_App3_Rec *)obj;
if (!is_unboxable_op(app->rator, SCHEME_PRIM_IS_BINARY_INLINED))
return 0;
if (!can_unbox(app->rand1, fuel - 1, regs))
return 0;
return can_unbox(app->rand2, fuel - 1, regs - 1);
}
case scheme_toplevel_type:
case scheme_local_type:
case scheme_local_unbox_type:
return 1;
break;
default:
return (t > _scheme_values_types_);
}
}
static jit_insn *generate_arith_slow_path(mz_jit_state *jitter, Scheme_Object *rator,
jit_insn **_ref, jit_insn **_ref4,
jit_insn **for_branch,
@ -3291,6 +3362,7 @@ static int can_fast_double(int arith, int cmp, int two_args)
#if !defined(MZ_USE_JIT_I386)
/* Not FP stack, so use normal variants. */
#define DIRECT_FPR_ACCESS
#define jit_movi_d_fppush(rd,immd) jit_movi_d(rd,immd)
#define jit_ldi_d_fppush(rd, is) jit_ldi_d(rd, is)
#define jit_ldr_d_fppush(rd, rs) jit_ldr_d(rd, rs)
@ -3318,16 +3390,28 @@ static int can_fast_double(int arith, int cmp, int two_args)
#define jit_extr_l_d_fppush(rd, rs) jit_extr_l_d(rd, rs)
#endif
static int generate_unboxing(mz_jit_state *jitter)
{
int fpr0;
fpr0 = JIT_FPR(jitter->unbox_depth);
jit_ldxi_d_fppush(fpr0, JIT_R0, &((Scheme_Double *)0x0)->double_val);
jitter->unbox_depth++;
return 1;
}
static int generate_alloc_double(mz_jit_state *jitter)
/* value should be in JIT_FPR0 */
{
#ifdef INLINE_FP_OPS
# ifdef CAN_INLINE_ALLOC
inline_alloc(jitter, sizeof(Scheme_Double), scheme_double_type, 0, 0, 1, 0);
CHECK_LIMIT();
jit_addi_p(JIT_R0, JIT_V1, GC_OBJHEAD_SIZE);
(void)jit_stxi_d_fppop(&((Scheme_Double *)0x0)->double_val, JIT_R0, JIT_FPR1);
(void)jit_stxi_d_fppop(&((Scheme_Double *)0x0)->double_val, JIT_R0, JIT_FPR0);
# else
(void)jit_sti_d_fppop(&double_result, JIT_FPR1);
(void)jit_sti_d_fppop(&double_result, JIT_FPR0);
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
mz_prepare(0);
(void)mz_finish(malloc_double);
@ -3339,11 +3423,15 @@ static int generate_alloc_double(mz_jit_state *jitter)
static int generate_double_arith(mz_jit_state *jitter, int arith, int cmp, int reversed, int two_args, int second_const,
jit_insn **_refd, jit_insn **_refdt,
int branch_short, int unsafe_fl)
int branch_short, int unsafe_fl, int unboxed, int unboxed_result)
/* Unless unboxed, first arg is in JIT_R1, second in JIT_R0.
If unboxed in push/pop mode, first arg is pushed before second.
If unboxed in direct mode, first arg is in JIT_FPR0+depth
and second is in JIT_FPR1+depth (which is backward). */
{
#if defined(INLINE_FP_OPS) || defined(INLINE_FP_COMP)
GC_CAN_IGNORE jit_insn *ref8, *ref9, *ref10, *refd, *refdt;
int no_alloc = 0;
int no_alloc = unboxed_result;
if (!unsafe_fl) {
/* Maybe they're doubles */
@ -3370,12 +3458,17 @@ static int generate_double_arith(mz_jit_state *jitter, int arith, int cmp, int r
/* Special case: multiplication by exact 0 */
(void)jit_movi_p(JIT_R0, scheme_make_integer(0));
} else {
/* Yes, they're doubles. */
if (arith != 12) {
jit_ldxi_d_fppush(JIT_FPR1, JIT_R0, &((Scheme_Double *)0x0)->double_val);
}
/* Yes, they're doubles. First arg is in JIT_R1, second is in JIT_R0.
Put the first arg in fpr0 and second (if any) into fpr1. To work
right with stacks, that means pushing the second argument first. */
int fpr1, fpr0;
fpr0 = JIT_FPR(jitter->unbox_depth);
fpr1 = JIT_FPR(1+jitter->unbox_depth);
if (two_args) {
jit_ldxi_d_fppush(JIT_FPR0, JIT_R1, &((Scheme_Double *)0x0)->double_val);
if (!unboxed)
jit_ldxi_d_fppush(fpr1, JIT_R1, &((Scheme_Double *)0x0)->double_val);
} else if ((arith == -1) && !second_const && reversed) {
reversed = 0;
} else if (arith == 11) {
@ -3384,33 +3477,48 @@ static int generate_double_arith(mz_jit_state *jitter, int arith, int cmp, int r
/* exact->inexact needs no extra number */
} else {
double d = second_const;
jit_movi_d_fppush(JIT_FPR0, d);
jit_movi_d_fppush(fpr1, d);
reversed = !reversed;
cmp = -cmp;
}
if (!unboxed) {
if (arith != 12) {
jit_ldxi_d_fppush(fpr0, JIT_R0, &((Scheme_Double *)0x0)->double_val);
}
}
#ifdef DIRECT_FPR_ACCESS
if (unboxed) {
/* arguments are backward */
reversed = !reversed;
cmp = -cmp;
}
#endif
if (arith) {
switch (arith) {
case 1:
jit_addr_d_fppop(JIT_FPR1, JIT_FPR0, JIT_FPR1);
jit_addr_d_fppop(fpr0, fpr0, fpr1);
break;
case 2:
jit_mulr_d_fppop(JIT_FPR1, JIT_FPR0, JIT_FPR1);
jit_mulr_d_fppop(fpr0, fpr0, fpr1);
break;
case -2:
if (reversed)
jit_divrr_d_fppop(JIT_FPR1, JIT_FPR0, JIT_FPR1);
if (!reversed)
jit_divrr_d_fppop(fpr0, fpr0, fpr1);
else
jit_divr_d_fppop(JIT_FPR1, JIT_FPR0, JIT_FPR1);
jit_divr_d_fppop(fpr0, fpr0, fpr1);
break;
case -1:
{
if (!two_args && !second_const && !reversed) {
/* Need a special case to make sure that (- 0.0) => -0.0 */
jit_negr_d_fppop(JIT_FPR1, JIT_FPR1);
jit_negr_d_fppop(fpr0, fpr0);
} else if (reversed)
jit_subrr_d_fppop(JIT_FPR1, JIT_FPR0, JIT_FPR1);
jit_subr_d_fppop(fpr0, fpr0, fpr1);
else
jit_subr_d_fppop(JIT_FPR1, JIT_FPR0, JIT_FPR1);
jit_subrr_d_fppop(fpr0, fpr0, fpr1);
}
break;
case 9: /* min */
@ -3419,22 +3527,24 @@ static int generate_double_arith(mz_jit_state *jitter, int arith, int cmp, int r
GC_CAN_IGNORE jit_insn *refc, *refn;
__START_TINY_JUMPS__(1);
/* If R0 is nan, then copy to R1, ensuring nan result */
refn = jit_beqr_d(jit_forward(), JIT_FPR1, JIT_FPR1);
refn = jit_beqr_d(jit_forward(), fpr0, fpr0);
jit_movr_p(JIT_R1, JIT_R0);
mz_patch_branch(refn);
if (arith == 9) {
refc = jit_bger_d_fppop(jit_forward(), JIT_FPR0, JIT_FPR1);
refc = jit_bltr_d_fppop(jit_forward(), fpr0, fpr1);
} else {
refc = jit_bltr_d_fppop(jit_forward(), JIT_FPR0, JIT_FPR1);
refc = jit_bger_d_fppop(jit_forward(), fpr0, fpr1);
}
jit_movr_p(JIT_R0, JIT_R1);
mz_patch_branch(refc);
__END_TINY_JUMPS__(1);
/* no unsafe version of `min' and `max', so we never need an
unboxed result, but we've already set JIT_R0 */
no_alloc = 1;
}
break;
case 11: /* abs */
jit_abs_d_fppop(JIT_FPR1, JIT_FPR1);
jit_abs_d_fppop(fpr0, fpr0);
break;
case 12: /* exact->inexact */
no_alloc = 1;
@ -3445,8 +3555,11 @@ static int generate_double_arith(mz_jit_state *jitter, int arith, int cmp, int r
CHECK_LIMIT();
if (!no_alloc) {
mz_rs_sync(); /* needed if arguments were unboxed */
generate_alloc_double(jitter);
CHECK_LIMIT();
} else if (unboxed_result) {
jitter->unbox_depth++;
}
} else {
/* The "anti" variants below invert the branch. Unlike the "un"
@ -3455,19 +3568,19 @@ static int generate_double_arith(mz_jit_state *jitter, int arith, int cmp, int r
__START_SHORT_JUMPS__(branch_short);
switch (cmp) {
case -2:
refd = jit_bantiltr_d_fppop(jit_forward(), JIT_FPR0, JIT_FPR1);
refd = jit_bantigtr_d_fppop(jit_forward(), fpr0, fpr1);
break;
case -1:
refd = jit_bantiler_d_fppop(jit_forward(), JIT_FPR0, JIT_FPR1);
refd = jit_bantiger_d_fppop(jit_forward(), fpr0, fpr1);
break;
case 0:
refd = jit_bantieqr_d_fppop(jit_forward(), JIT_FPR0, JIT_FPR1);
refd = jit_bantieqr_d_fppop(jit_forward(), fpr0, fpr1);
break;
case 1:
refd = jit_bantiger_d_fppop(jit_forward(), JIT_FPR0, JIT_FPR1);
refd = jit_bantiler_d_fppop(jit_forward(), fpr0, fpr1);
break;
case 2:
refd = jit_bantigtr_d_fppop(jit_forward(), JIT_FPR0, JIT_FPR1);
refd = jit_bantiltr_d_fppop(jit_forward(), fpr0, fpr1);
break;
default:
refd = NULL;
@ -3533,6 +3646,40 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
LOG_IT(("inlined %s\n", ((Scheme_Primitive_Proc *)rator)->name));
if (unsafe_fl
&& can_unbox(rand, 5, JIT_FPR_NUM-2)
&& (!rand2 || can_unbox(rand2, 5, JIT_FPR_NUM-3))) {
/* Unsafe, unboxed floating-point ops. */
jitter->unbox++;
if (!rand2) {
mz_runstack_skipped(jitter, 1);
generate(rand, jitter, 0, 1, JIT_R0);
CHECK_LIMIT();
mz_runstack_unskipped(jitter, 1);
} else {
mz_runstack_skipped(jitter, 2);
generate(rand, jitter, 0, 1, JIT_R0);
CHECK_LIMIT();
generate(rand2, jitter, 0, 1, JIT_R0);
CHECK_LIMIT();
mz_runstack_unskipped(jitter, 2);
}
--jitter->unbox;
jitter->unbox_depth -= (rand2 ? 2 : 1);
generate_double_arith(jitter, arith, cmp, 0, !!rand2, 0,
&refd, &refdt, branch_short, 1, 1, jitter->unbox);
CHECK_LIMIT();
ref3 = NULL;
ref = NULL;
ref4 = NULL;
__START_SHORT_JUMPS__(branch_short);
} else {
int unbox = jitter->unbox;
/* While generating a fixnum op, don't unbox! */
jitter->unbox = 0;
if (rand2) {
if (SCHEME_INTP(rand2)
&& SCHEME_INT_SMALL_ENOUGH(rand2)
@ -3663,7 +3810,7 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
if (unsafe_fl || (!unsafe_fx && !SCHEME_INTP(rand) && can_fast_double(arith, cmp, 1))) {
/* Maybe they're both doubles... */
if (unsafe_fl) mz_rs_sync();
generate_double_arith(jitter, arith, cmp, reversed, 1, 0, &refd, &refdt, branch_short, unsafe_fl);
generate_double_arith(jitter, arith, cmp, reversed, 1, 0, &refd, &refdt, branch_short, unsafe_fl, 0, 0);
CHECK_LIMIT();
}
@ -3712,7 +3859,7 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
if (unsafe_fl || (!unsafe_fx && can_fast_double(arith, cmp, 1))) {
/* Maybe they're both doubles... */
if (unsafe_fl) mz_rs_sync();
generate_double_arith(jitter, arith, cmp, reversed, 1, 0, &refd, &refdt, branch_short, unsafe_fl);
generate_double_arith(jitter, arith, cmp, reversed, 1, 0, &refd, &refdt, branch_short, unsafe_fl, 0, 0);
CHECK_LIMIT();
}
@ -3758,7 +3905,7 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
/* watch out: divide by 0 is special: */
&& ((arith != -2) || v || reversed))) {
/* Maybe it's a double... */
generate_double_arith(jitter, arith, cmp, reversed, 0, v, &refd, &refdt, branch_short, unsafe_fl);
generate_double_arith(jitter, arith, cmp, reversed, 0, v, &refd, &refdt, branch_short, unsafe_fl, 0, 0);
CHECK_LIMIT();
}
@ -4074,12 +4221,19 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
CHECK_LIMIT();
} else if (arith == 12) {
/* exact->inexact */
int fpr0;
fpr0 = JIT_FPR(jitter->unbox_depth);
jit_rshi_l(JIT_R0, JIT_R0, 1);
jit_extr_l_d_fppush(JIT_FPR1, JIT_R0);
jit_extr_l_d_fppush(fpr0, JIT_R0);
CHECK_LIMIT();
if (!unbox) {
mz_rs_sync(); /* needed for unsafe op before allocation */
__END_SHORT_JUMPS__(branch_short);
generate_alloc_double(jitter);
__START_SHORT_JUMPS__(branch_short);
} else {
jitter->unbox_depth++;
}
CHECK_LIMIT();
}
}
@ -4168,6 +4322,9 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
ref3 = NULL;
}
jitter->unbox = unbox;
}
if (!arith) {
if (refdt)
mz_patch_ucbranch(refdt);
@ -6232,8 +6389,11 @@ static int generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int m
if (!(SCHEME_TOPLEVEL_FLAGS(obj)
& (SCHEME_TOPLEVEL_CONST | SCHEME_TOPLEVEL_READY))) {
/* Is it NULL? */
generate_pop_unboxed(jitter);
CHECK_LIMIT();
(void)jit_beqi_p(unbound_global_code, target, 0);
}
if (jitter->unbox) generate_unboxing(jitter);
END_JIT_DATA(0);
return 1;
}
@ -6253,6 +6413,8 @@ static int generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int m
if (SCHEME_LOCAL_FLAGS(obj) & SCHEME_LOCAL_CLEAR_ON_READ) {
mz_rs_stxi(pos, JIT_RUNSTACK);
}
CHECK_LIMIT();
if (jitter->unbox) generate_unboxing(jitter);
END_JIT_DATA(2);
return 1;
}
@ -6270,6 +6432,8 @@ static int generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int m
mz_rs_stxi(pos, JIT_RUNSTACK);
}
VALIDATE_RESULT(target);
CHECK_LIMIT();
if (jitter->unbox) generate_unboxing(jitter);
END_JIT_DATA(3);
return 1;
@ -7143,7 +7307,14 @@ static int generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int m
return 1;
}
default:
{
if (jitter->unbox && SCHEME_FLOATP(obj)) {
double d = SCHEME_FLOAT_VAL(obj);
int fpr0;
fpr0 = JIT_FPR(jitter->unbox_depth);
jit_movi_d_fppush(fpr0, d);
jitter->unbox_depth++;
return 1;
} else {
int retptr;
Scheme_Type type = SCHEME_TYPE(obj);
START_JIT_DATA();