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

JIT-inline `eqv?'

Browse Source
This commit is contained in:
Matthew Flatt 2011-04-22 21:20:50 -06:00
parent e78a60016f
commit f54d977de1
5 changed files with 150 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/tests/racket/optimize.rktl
View File

@ -15,7 +15,7 @@
(namespace-require 'racket/flonum)
(namespace-require 'racket/fixnum)
(let* ([check-error-message (lambda (name proc [fixnum? #f])
(unless (memq name '(eq? not null? pair? list?
(unless (memq name '(eq? eqv? not null? pair? list?
real? number? boolean?
procedure? symbol?
string? bytes?
@ -173,6 +173,22 @@
(un #t 'bytes? #"apple")
(bin #f 'eq? 0 10)
(bin-exact #t 'eq? 10 10)
(bin-exact #f 'eqv? 0 10)
(bin-exact #f 'eqv? "apple" "banana")
(bin-exact #t 'eqv? 10 10)
(bin-exact #t 'eqv? #\a #\a)
(bin-exact #f 'eqv? #\a #\b)
(bin-exact #t 'eqv? #\u3bb #\u3bb)
(bin-exact #f 'eqv? #\u3bb #\u3bc)
(bin-exact #t 'eqv? 1.0 1.0)
(bin-exact #f 'eqv? 1.0 2.0)
(bin-exact #t 'eqv? +nan.0 +nan.0)
(bin-exact #t 'eqv? 1/2 1/2)
(bin-exact #f 'eqv? 1/2 1/3)
(bin-exact #t 'eqv? 1+2i 1+2i)
(bin-exact #f 'eqv? 1+2i 1+3i)
(un #t 'zero? 0)
(un #f 'zero? 1)

4
src/racket/src/bool.c
View File

@ -95,7 +95,9 @@ void scheme_init_bool (Scheme_Env *env)
scheme_eq_prim = p;
scheme_add_global_constant("eq?", p, env);
scheme_eqv_prim = scheme_make_folding_prim(eqv_prim, "eqv?", 2, 2, 1);
p = scheme_make_folding_prim(eqv_prim, "eqv?", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
scheme_eqv_prim = p;
scheme_add_global_constant("eqv?", scheme_eqv_prim, env);
scheme_equal_prim = scheme_make_prim_w_arity(equal_prim, "equal?", 2, 2);

1
src/racket/src/jit.h
View File

@ -244,6 +244,7 @@ struct scheme_jit_common_record {
void *fl1_fail_code, *fl2rr_fail_code[2], *fl2fr_fail_code[2], *fl2rf_fail_code[2];
void *wcm_code, *wcm_nontail_code;
void *apply_to_list_tail_code, *apply_to_list_code, *apply_to_list_multi_ok_code;
void *eqv_code, *eqv_branch_code;
#ifdef CAN_INLINE_ALLOC
void *make_list_code, *make_list_star_code;

58
src/racket/src/jitcommon.c
View File

@ -2023,6 +2023,63 @@ static int common8(mz_jit_state *jitter, void *_data)
return 1;
}
static int common9(mz_jit_state *jitter, void *_data)
{
int i;
/* eqv[_branch]_code */
/* arguments in R0 and R1; for branch, false return address in V1 */
for (i = 0; i < 2; i++) {
void *code;
GC_CAN_IGNORE jit_insn *ref;
code = jit_get_ip().ptr;
if (i == 0)
sjc.eqv_code = code;
else
sjc.eqv_branch_code = code;
mz_prolog(JIT_R2);
CHECK_LIMIT();
jit_prepare(2);
jit_pusharg_p(JIT_R0);
jit_pusharg_p(JIT_R1);
(void)jit_finish(scheme_eqv); /* NONGCING, so ok from a future thread */
jit_retval(JIT_R0);
CHECK_LIMIT();
__START_TINY_JUMPS__(1);
ref = jit_beqi_i(jit_forward(), JIT_R0, 0);
__END_TINY_JUMPS__(1);
if (i) {
mz_epilog(JIT_R2);
} else {
(void)jit_movi_p(JIT_R0, scheme_true);
mz_epilog(JIT_R2);
}
__START_TINY_JUMPS__(1);
mz_patch_branch(ref);
__END_TINY_JUMPS__(1);
if (i) {
mz_epilog_without_jmp();
jit_jmpr(JIT_V1);
} else {
(void)jit_movi_p(JIT_R0, scheme_false);
mz_epilog(JIT_R2);
}
scheme_jit_register_sub_func(jitter, code, scheme_false);
CHECK_LIMIT();
}
return 1;
}
int scheme_do_generate_common(mz_jit_state *jitter, void *_data)
{
if (!common0(jitter, _data)) return 0;
@ -2035,6 +2092,7 @@ int scheme_do_generate_common(mz_jit_state *jitter, void *_data)
if (!common6(jitter, _data)) return 0;
if (!common7(jitter, _data)) return 0;
if (!common8(jitter, _data)) return 0;
if (!common9(jitter, _data)) return 0;
return 1;
}

71
src/racket/src/jitinline.c
View File

@ -1697,6 +1697,77 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
__END_SHORT_JUMPS__(branch_short);
}
return 1;
} else if (IS_NAMED_PRIM(rator, "eqv?")) {
GC_CAN_IGNORE jit_insn *ref_f1, *ref_f2, *ref_f3, *ref_f4, *ref_f5;
GC_CAN_IGNORE jit_insn *ref_d1, *ref_d2, *ref_t1;
generate_two_args(app->rand1, app->rand2, jitter, 0, 2);
CHECK_LIMIT();
if (need_sync) mz_rs_sync();
__START_SHORT_JUMPS__(branch_short);
if (for_branch) {
scheme_prepare_branch_jump(jitter, for_branch);
CHECK_LIMIT();
}
/* eq? */
ref_t1 = jit_beqr_p(jit_forward(), JIT_R0, JIT_R1);
/* if either is fixnum, result is false */
ref_f1 = jit_bmsi_ul(jit_forward(), JIT_R0, 0x1);
ref_f2 = jit_bmsi_ul(jit_forward(), JIT_R1, 0x1);
CHECK_LIMIT();
/* Both have a tag */
jit_ldxi_s(JIT_R2, JIT_R0, &((Scheme_Object *)0x0)->type);
jit_ldxi_s(JIT_V1, JIT_R1, &((Scheme_Object *)0x0)->type);
ref_f3 = jit_bner_i(jit_forward(), JIT_R2, JIT_V1);
/* check in range of type treated by eqv: */
ref_f4 = jit_blti_i(jit_forward(), JIT_R2, scheme_char_type);
ref_f5 = jit_bgti_i(jit_forward(), JIT_R2, scheme_complex_type);
CHECK_LIMIT();
/* in range of interesting types, so break out the generic comparison */
if (for_branch) {
scheme_add_branch_false_movi(for_branch, jit_patchable_movi_p(JIT_V1, jit_forward()));
(void)jit_calli(sjc.eqv_branch_code);
scheme_add_branch_false(for_branch, ref_f1);
scheme_add_branch_false(for_branch, ref_f2);
scheme_add_branch_false(for_branch, ref_f3);
scheme_add_branch_false(for_branch, ref_f4);
scheme_add_branch_false(for_branch, ref_f5);
mz_patch_branch(ref_t1);
scheme_branch_for_true(jitter, for_branch);
} else {
(void)jit_calli(sjc.eqv_code);
jit_retval(JIT_R0);
ref_d1 = jit_jmpi(jit_forward());
mz_patch_branch(ref_t1);
jit_movi_p(JIT_R0, scheme_true);
ref_d2 = jit_jmpi(jit_forward());
mz_patch_branch(ref_f1);
mz_patch_branch(ref_f2);
mz_patch_branch(ref_f3);
mz_patch_branch(ref_f4);
mz_patch_branch(ref_f5);
jit_movi_p(JIT_R0, scheme_false);
mz_patch_ucbranch(ref_d1);
mz_patch_ucbranch(ref_d2);
}
__END_SHORT_JUMPS__(branch_short);
return 1;
} else if (IS_NAMED_PRIM(rator, "=")) {
scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, 0, 0, 0, for_branch, branch_short, 0, 0, NULL);