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

JIT-inline `list?'

Browse Source
This commit is contained in:
Matthew Flatt 2011-03-20 09:42:50 -06:00
parent 39ebb083cc
commit ed96b89c45
7 changed files with 202 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
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?
(unless (memq name '(eq? not null? pair? list?
real? number? boolean?
procedure? symbol?
string? bytes?
@ -146,7 +146,12 @@
(tri0 v op get-arg1 arg2 arg3 check-effect))])
(un #f 'null? 0)
(un-exact #t 'null? '())
(un #f 'pair? 0)
(un-exact #t 'pair? '(1 2))
(un #f 'list? 0)
(un #f 'list? '(1 2 . 3))
(un-exact #t 'list? '(1 2 3))
(un #f 'boolean? 0)
(un #t 'boolean? #t)
(un #t 'boolean? #f)
@ -712,6 +717,8 @@
'(expt 5 (* 5 6)))
(test-comp 88
'(if (pair? null) 89 88))
(test-comp 89
'(if (list? null) 89 88))
(test-comp '(if _x_ 2 1)
'(if (not _x_) 1 2))
(test-comp '(if _x_ 2 1)

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

@ -236,6 +236,7 @@ struct scheme_jit_common_record {
void *bad_app_vals_target;
void *app_values_slow_code, *app_values_multi_slow_code, *app_values_tail_slow_code;
void *values_code;
void *list_p_code, *list_p_branch_code;
void *finish_tail_call_code, *finish_tail_call_fixup_code;
void *module_run_start_code, *module_exprun_start_code, *module_start_start_code;
void *box_flonum_from_stack_code;

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

@ -267,7 +267,7 @@ static int common0(mz_jit_state *jitter, void *_data)
static int common1(mz_jit_state *jitter, void *_data)
{
int i;
GC_CAN_IGNORE jit_insn *ref, *ref2;
GC_CAN_IGNORE jit_insn *ref;
/* *** [bad_][m]{car,cdr,...,{imag,real}_part}_code *** */
/* Argument is in R0 for car/cdr, R2 otherwise */
@ -861,7 +861,6 @@ static int common2(mz_jit_state *jitter, void *_data)
static int common3(mz_jit_state *jitter, void *_data)
{
int i, ii, iii;
GC_CAN_IGNORE jit_insn *ref;
/* *** {vector,string,bytes}_{ref,set}_[check_index_]code *** */
/* R0 is vector/string/bytes, R1 is index (Scheme number in check-index mode),
@ -1815,6 +1814,130 @@ static int common6(mz_jit_state *jitter, void *_data)
return 1;
}
static int common7(mz_jit_state *jitter, void *_data)
{
int i;
/* list_p_[branch_]code */
/* argument is in R0, and it's a pair */
/* for branch, V1 holds return address for false */
for (i = 0; i < 2; i++) {
GC_CAN_IGNORE void *code;
GC_CAN_IGNORE jit_insn *refloop, *ref1, *ref2, *ref3, *ref4;
GC_CAN_IGNORE jit_insn *ref5, *ref6, *ref7, *ref8;
code = jit_get_ip().ptr;
if (!i)
sjc.list_p_code = code;
else
sjc.list_p_branch_code = code;
mz_prolog(JIT_R2);
__START_SHORT_JUMPS__(1);
/* R0 is hare, R1 is turtle */
jit_movr_p(JIT_R1, JIT_R0);
/* Note: there's no fuel check in this loop, just like there isn't in
scheme_is_list(). */
refloop = _jit.x.pc;
jit_ldxi_s(JIT_R2, JIT_R0, &MZ_OPT_HASH_KEY(&((Scheme_Stx *)0x0)->iso));
ref1 = jit_bmsi_ul(jit_forward(), JIT_R2, PAIR_FLAG_MASK);
jit_ldxi_p(JIT_R0, JIT_R0, (intptr_t)&SCHEME_CDR(0x0));
ref2 = jit_beqi_p(jit_forward(), JIT_R0, scheme_null);
ref8 = jit_bmsi_l(jit_forward(), JIT_R0, 0x1);
jit_ldxi_s(JIT_R2, JIT_R0, &((Scheme_Object *)0x0)->type);
ref3 = jit_bnei_i(jit_forward(), JIT_R2, scheme_pair_type);
jit_ldxi_s(JIT_R2, JIT_R0, &MZ_OPT_HASH_KEY(&((Scheme_Stx *)0x0)->iso));
ref4 = jit_bmsi_ul(jit_forward(), JIT_R2, PAIR_FLAG_MASK);
jit_ldxi_p(JIT_R0, JIT_R0, (intptr_t)&SCHEME_CDR(0x0));
jit_ldxi_p(JIT_R1, JIT_R1, (intptr_t)&SCHEME_CDR(0x0));
ref5 = jit_beqi_p(jit_forward(), JIT_R0, scheme_null);
ref7 = jit_bmsi_l(jit_forward(), JIT_R0, 0x1);
jit_ldxi_s(JIT_R2, JIT_R0, &((Scheme_Object *)0x0)->type);
(void)jit_beqi_i(refloop, JIT_R2, scheme_pair_type);
ref6 = jit_jmpi(jit_forward());
/* R2 has flags, and either list or non-list is set */
mz_patch_branch(ref1);
mz_patch_branch(ref4);
ref1 = jit_bmci_ul(jit_forward(), JIT_R2, PAIR_IS_LIST);
/* it's a list: */
mz_patch_branch(ref2);
mz_patch_branch(ref5);
jit_ldxi_s(JIT_R2, JIT_R1, &MZ_OPT_HASH_KEY(&((Scheme_Stx *)0x0)->iso));
#ifdef MZ_USE_FUTURES
/* Need an atomic update in case another thread is setting
a hash code on the target pair. */
/* Assumes little-endian and that a short hash follows a short type tag: */
ref5 = jit_bmsi_i(jit_forward(), JIT_R2, PAIR_IS_LIST);
jit_rshi_i(JIT_R0, JIT_R2, 16);
jit_ori_i(JIT_R0, JIT_R0, scheme_pair_type);
jit_ori_i(JIT_R2, JIT_R0, (PAIR_IS_LIST << 16));
/* In the unlikely case that the compare-and-swap fails, then it's ok to
lose the caching of the list bit: */
jit_lock_cmpxchgr_i(JIT_R1, JIT_R2);
mz_patch_branch(ref5);
#else
jit_ori_i(JIT_R2, JIT_R2, PAIR_IS_LIST);
jit_stxi_s(&MZ_OPT_HASH_KEY(&((Scheme_Stx *)0x0)->iso), JIT_R1, JIT_R2);
#endif
__END_SHORT_JUMPS__(1);
if (!i)
jit_movi_p(JIT_R0, scheme_true);
mz_epilog(JIT_R2);
__START_SHORT_JUMPS__(1);
/* it's a non-list: */
mz_patch_branch(ref1);
mz_patch_branch(ref3);
mz_patch_branch(ref7);
mz_patch_branch(ref8);
mz_patch_ucbranch(ref6);
jit_ldxi_s(JIT_R2, JIT_R1, &MZ_OPT_HASH_KEY(&((Scheme_Stx *)0x0)->iso));
#ifdef MZ_USE_FUTURES
/* As above: */
ref5 = jit_bmsi_i(jit_forward(), JIT_R2, PAIR_IS_NON_LIST);
jit_rshi_i(JIT_R0, JIT_R2, 16);
jit_ori_i(JIT_R0, JIT_R0, scheme_pair_type);
jit_ori_i(JIT_R2, JIT_R0, (PAIR_IS_NON_LIST << 16));
jit_lock_cmpxchgr_i(JIT_R1, JIT_R2);
mz_patch_branch(ref5);
#else
jit_ori_i(JIT_R2, JIT_R2, PAIR_IS_NON_LIST);
jit_stxi_s(&MZ_OPT_HASH_KEY(&((Scheme_Stx *)0x0)->iso), JIT_R1, JIT_R2);
#endif
__END_SHORT_JUMPS__(1);
if (i) {
mz_epilog_without_jmp();
jit_jmpr(JIT_V1);
} else {
jit_movi_p(JIT_R0, scheme_false);
mz_epilog(JIT_R2);
}
scheme_jit_register_sub_func(jitter, code, scheme_false);
}
return 1;
}
int scheme_do_generate_common(mz_jit_state *jitter, void *_data)
{
if (!common0(jitter, _data)) return 0;
@ -1825,6 +1948,7 @@ int scheme_do_generate_common(mz_jit_state *jitter, void *_data)
if (!common4(jitter, _data)) return 0;
if (!common5(jitter, _data)) return 0;
if (!common6(jitter, _data)) return 0;
if (!common7(jitter, _data)) return 0;
return 1;
}

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

@ -431,6 +431,63 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
return 1;
} else if (IS_NAMED_PRIM(rator, "odd?")) {
scheme_generate_arith(jitter, rator, app->rand, NULL, 1, 0, -4, 0, for_branch, branch_short, 0, 0, NULL);
return 1;
} else if (IS_NAMED_PRIM(rator, "list?")) {
GC_CAN_IGNORE jit_insn *ref0, *ref1, *ref2, *ref3, *ref4;
mz_runstack_skipped(jitter, 1);
scheme_generate_non_tail(app->rand, jitter, 0, 1, 0);
CHECK_LIMIT();
mz_runstack_unskipped(jitter, 1);
if (need_sync) mz_rs_sync();
__START_SHORT_JUMPS__(branch_short);
if (for_branch) {
scheme_prepare_branch_jump(jitter, for_branch);
CHECK_LIMIT();
}
ref1 = jit_bmsi_ul(jit_forward(), JIT_R0, 0x1);
jit_ldxi_s(JIT_R1, JIT_R0, &((Scheme_Object *)0x0)->type);
ref3 = jit_beqi_p(jit_forward(), JIT_R1, scheme_null_type);
ref4 = jit_bnei_p(jit_forward(), JIT_R1, scheme_pair_type);
CHECK_LIMIT();
if (for_branch) {
ref0 = jit_patchable_movi_p(JIT_V1, jit_forward());
(void)jit_calli(sjc.list_p_branch_code);
mz_patch_branch(ref3);
scheme_add_branch_false_movi(for_branch, ref0);
scheme_add_branch_false(for_branch, ref1);
scheme_add_branch_false(for_branch, ref4);
scheme_branch_for_true(jitter, for_branch);
} else {
GC_CAN_IGNORE jit_insn *ref5;
(void)jit_calli(sjc.list_p_code);
ref5 = jit_jmpi(jit_forward());
mz_patch_branch(ref1);
mz_patch_branch(ref4);
(void)jit_movi_p(JIT_R0, scheme_false);
ref1 = jit_jmpi(jit_forward());
mz_patch_branch(ref3);
(void)jit_movi_p(JIT_R0, scheme_true);
mz_patch_ucbranch(ref5);
mz_patch_ucbranch(ref1);
}
CHECK_LIMIT();
__END_SHORT_JUMPS__(branch_short);
return 1;
} else if (IS_NAMED_PRIM(rator, "exact-nonnegative-integer?")
|| IS_NAMED_PRIM(rator, "exact-positive-integer?")) {

2
src/racket/src/lightning/i386/asm.h
View File

@ -709,6 +709,8 @@ typedef _uc jit_insn;
#define MOVSWQmr(MD, MB, MI, MS, RD) _qOO_r_X (0x0fbf ,_r1(RD) ,MD,MB,MI,MS )
#define CMPXCHGr(RS, RD) (_jit_B(0xF), _O_r_X(0xb1 ,_r4(RD) ,0,RS,0,0 ))
#define LOCK_PREFIX(i) (_jit_B(0xf0), i)
#define MULBr(RS) _O_Mrm (0xf6 ,_b11,_b100 ,_r1(RS) )
#define MULBm(MD,MB,MI,MS) _O_r_X (0xf6 ,_b100 ,MD,MB,MI,MS )

1
src/racket/src/lightning/i386/core.h
View File

@ -682,6 +682,7 @@ static intptr_t _CHECK_TINY(intptr_t diff) { if ((diff < -128) || (diff > 127))
# define jit_sti_i(id, rs) _jit_sti_i(id, rs)
#endif
# define jit_lock_cmpxchgr_i(rd, rs) LOCK_PREFIX(CMPXCHGr(rd, rs))
/* Extra */
#define jit_nop() NOP_()

12
src/racket/src/list.c
View File

@ -223,11 +223,9 @@ scheme_init_list (Scheme_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant ("null?", p, env);
scheme_add_global_constant ("list?",
scheme_make_immed_prim(list_p_prim,
"list?",
1, 1),
env);
p = scheme_make_folding_prim(list_p_prim, "list?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant ("list?", p, env);
REGISTER_SO(scheme_list_proc);
p = scheme_make_immed_prim(list_prim, "list", 0, -1);
@ -1076,6 +1074,10 @@ int scheme_is_list(Scheme_Object *obj1)
obj2 = obj1;
/* There's no fuel check in this loop. Checking a very long list
could interfere with thread switching --- but only once, because
another query on the same list will take half as long. */
while (1) {
obj1 = SCHEME_CDR(obj1);