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

JIT-inline `procedure-arity-includes?'

Browse Source
This commit is contained in:
Matthew Flatt 2011-04-27 12:59:46 -06:00
parent 69b7923cf1
commit 0e229529c0
7 changed files with 162 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -642,6 +642,15 @@
(lambda () v) 0 "other"
(lambda () (test "other" unbox v))))
(bin-exact #t 'procedure-arity-includes? cons 2)
(bin-exact #f 'procedure-arity-includes? cons 1)
(bin-exact #f 'procedure-arity-includes? cons 3)
(bin-exact #t 'procedure-arity-includes? car 1)
(bin-exact #t 'procedure-arity-includes? car 1)
(bin-exact #t 'procedure-arity-includes? (lambda (x) x) 1)
(bin-exact #f 'procedure-arity-includes? (lambda (x) x) 2)
(bin-exact #t 'procedure-arity-includes? (lambda x x) 2)
))
(define (comp=? c1 c2)

15
src/racket/src/fun.c
View File

@ -168,7 +168,6 @@ static Scheme_Object *seconds_to_date(int argc, Scheme_Object **argv);
static Scheme_Object *object_name(int argc, Scheme_Object *argv[]);
static Scheme_Object *procedure_arity(int argc, Scheme_Object *argv[]);
static Scheme_Object *procedure_arity_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *procedure_arity_includes(int argc, Scheme_Object *argv[]);
static Scheme_Object *procedure_reduce_arity(int argc, Scheme_Object *argv[]);
static Scheme_Object *procedure_rename(int argc, Scheme_Object *argv[]);
static Scheme_Object *procedure_to_method(int argc, Scheme_Object *argv[]);
@ -502,12 +501,12 @@ scheme_init_fun (Scheme_Env *env)
1, 1, 1),
env);
scheme_procedure_arity_includes_proc = scheme_make_folding_prim(procedure_arity_includes,
"procedure-arity-includes?",
2, 2, 1);
scheme_add_global_constant("procedure-arity-includes?",
scheme_procedure_arity_includes_proc,
env);
o = scheme_make_folding_prim(scheme_procedure_arity_includes,
"procedure-arity-includes?",
2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(o) |= SCHEME_PRIM_IS_BINARY_INLINED;
scheme_procedure_arity_includes_proc = o;
scheme_add_global_constant("procedure-arity-includes?", o, env);
scheme_add_global_constant("procedure-reduce-arity",
scheme_make_prim_w_arity(procedure_reduce_arity,
@ -3758,7 +3757,7 @@ static Scheme_Object *procedure_arity_p(int argc, Scheme_Object *argv[])
return scheme_false;
}
static Scheme_Object *procedure_arity_includes(int argc, Scheme_Object *argv[])
Scheme_Object *scheme_procedure_arity_includes(int argc, Scheme_Object *argv[])
{
intptr_t n;

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

@ -245,6 +245,7 @@ struct scheme_jit_common_record {
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;
void *proc_arity_includes_code;
#ifdef CAN_INLINE_ALLOC
void *make_list_code, *make_list_star_code;
@ -1005,6 +1006,22 @@ static void emit_indentation(mz_jit_state *jitter)
mz_patch_ucbranch(refcont); \
__END_TINY_JUMPS__(1); \
}
# define mz_finish_prim_lwe(prim, refr) \
{ \
GC_CAN_IGNORE jit_insn *refdirect, *refdone; \
int argstate; \
__START_TINY_JUMPS__(1); \
jit_save_argstate(argstate); \
mz_tl_ldi_i(JIT_R0, tl_scheme_use_rtcall); \
refdirect = jit_beqi_i(jit_forward(), JIT_R0, 0); \
(void)mz_finish_lwe(prim, refr); \
refdone = jit_jmpi(jit_forward()); \
jit_restore_argstate(argstate); \
mz_patch_branch(refdirect); \
(void)mz_finish(prim); \
mz_patch_ucbranch(refdone); \
__END_TINY_JUMPS__(1); \
}
#else
/* futures not enabled */
# define mz_prepare_direct_prim(n) mz_prepare(n)
@ -1015,6 +1032,7 @@ static void emit_indentation(mz_jit_state *jitter)
# define ts_make_fsemaphore scheme_make_fsemaphore
# define mz_generate_direct_prim(direct_only, first_arg, reg, prim_indirect) \
(mz_direct_only(direct_only), first_arg, mz_finishr_direct_prim(reg, prim_indirect))
# define mz_finish_prim_lwe(prim, refr) (void)mz_finish_lwe(ts_scheme_equal, refr)
#endif
/**********************************************************************/

2
src/racket/src/jit_ts.c
View File

@ -82,6 +82,7 @@ define_ts_s_s(scheme_unbox, FSRC_MARKS)
define_ts_si_s(scheme_struct_ref, FSRC_MARKS)
define_ts_sis_v(scheme_struct_set, FSRC_MARKS)
define_ts_iS_s(scheme_extract_checked_procedure, FSRC_MARKS)
define_ts_iS_s(scheme_procedure_arity_includes, FSRC_MARKS)
#endif
#ifdef JITCALL_TS_PROCS
@ -190,6 +191,7 @@ define_ts_s_s(scheme_box, FSRC_OTHER)
# define ts_scheme_checked_fxvector_set scheme_checked_fxvector_set
# define ts_scheme_checked_syntax_e scheme_checked_syntax_e
# define ts_scheme_extract_checked_procedure scheme_extract_checked_procedure
# define ts_scheme_procedure_arity_includes scheme_procedure_arity_includes
# define ts_apply_checked_fail apply_checked_fail
# define ts_scheme_build_list_offset scheme_build_list_offset
# define ts_wrong_argument_count wrong_argument_count

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

@ -2073,6 +2073,119 @@ static int common9(mz_jit_state *jitter, void *_data)
return 1;
}
static int common10(mz_jit_state *jitter, void *_data)
{
/* proc_arity_includes_code */
/* R0 has proc, R1 has arity */
{
GC_CAN_IGNORE jit_insn *ref, *refslow, *refr ,*ref_nc, *ref_prim, *refno;
sjc.proc_arity_includes_code = jit_get_ip().ptr;
mz_prolog(JIT_R2);
__START_SHORT_JUMPS__(1);
ref = jit_bmsi_l(jit_forward(), JIT_R1, 0x1);
refslow = _jit.x.pc;
jit_subi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(2));
JIT_UPDATE_THREAD_RSPTR();
jit_stxi_p(WORDS_TO_BYTES(1), JIT_RUNSTACK, JIT_R1);
jit_str_p(JIT_RUNSTACK, JIT_R0);
CHECK_LIMIT();
jit_movi_i(JIT_R0, 2);
mz_prepare(2);
jit_pusharg_p(JIT_RUNSTACK);
jit_pusharg_i(JIT_R0);
__END_SHORT_JUMPS__(1);
mz_finish_prim_lwe(ts_scheme_procedure_arity_includes, refr);
__START_SHORT_JUMPS__(1);
jit_retval(JIT_R0);
jit_addi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(2));
JIT_UPDATE_THREAD_RSPTR();
CHECK_LIMIT();
mz_epilog(JIT_R2);
refno = _jit.x.pc;
jit_movi_p(JIT_R0, scheme_false);
mz_epilog(JIT_R2);
/* R1 has fixnum ... check non-negative and them proc type */
mz_patch_branch(ref);
(void)jit_blti_l(refslow, JIT_R1, 0);
jit_ldxi_s(JIT_R2, JIT_R0, &((Scheme_Object *)0x0)->type);
ref_nc = jit_beqi_i(jit_forward(), JIT_R2, scheme_native_closure_type);
ref_prim = jit_beqi_i(jit_forward(), JIT_R2, scheme_prim_type);
(void)jit_jmpi(refslow);
CHECK_LIMIT();
/* native: */
mz_patch_branch(ref_nc);
jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Native_Closure *)0x0)->code);
jit_ldxi_i(JIT_R2, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->closure_size);
(void)jit_blti_i(refslow, JIT_R2, 0); /* case lambda */
jit_ldxi_p(JIT_R2, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->code);
ref_nc = jit_beqi_p(jit_forward(), JIT_R2, scheme_on_demand_jit_code); /* not yet JITted */
jit_rshi_l(JIT_V1, JIT_R1, 1);
jit_addi_l(JIT_V1, JIT_V1, 1);
CHECK_LIMIT();
mz_prepare(3);
jit_pusharg_i(JIT_V1); /* anything */
jit_pusharg_i(JIT_V1);
jit_pusharg_p(JIT_R0);
(void)jit_finish(sjc.check_arity_code);
jit_retval(JIT_R0);
(void)jit_beqi_i(refno, JIT_R0, 0);
jit_movi_p(JIT_R0, scheme_true);
mz_epilog(JIT_R2);
CHECK_LIMIT();
/* not-yet-JITted native: */
mz_patch_branch(ref_nc);
jit_ldxi_p(JIT_R0, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->u2.orig_code);
jit_rshi_l(JIT_V1, JIT_R1, 1);
jit_ldxi_i(JIT_R2, JIT_R0, &((Scheme_Closure_Data *)0x0)->num_params);
jit_ldxi_s(JIT_R0, JIT_R0, &SCHEME_CLOSURE_DATA_FLAGS(((Scheme_Closure_Data *)0x0)));
ref_nc = jit_bmsi_i(jit_forward(), JIT_R0, CLOS_HAS_REST);
(void)jit_bner_i(refno, JIT_V1, JIT_R2);
jit_movi_p(JIT_R0, scheme_true);
mz_epilog(JIT_R2);
CHECK_LIMIT();
/* has rest arg: */
mz_patch_branch(ref_nc);
jit_subi_i(JIT_R2, JIT_R2, 1);
(void)jit_bltr_i(refno, JIT_V1, JIT_R2);
jit_movi_p(JIT_R0, scheme_true);
mz_epilog(JIT_R2);
CHECK_LIMIT();
/* primitive: */
mz_patch_branch(ref_prim);
jit_ldxi_i(JIT_R2, JIT_R0, &((Scheme_Primitive_Proc *)0x0)->mina);
(void)jit_blti_i(refslow, JIT_R2, 0); /* case lambda */
jit_rshi_l(JIT_V1, JIT_R1, 1);
(void)jit_bltr_i(refno, JIT_V1, JIT_R2);
jit_ldxi_i(JIT_R2, JIT_R0, &((Scheme_Primitive_Proc *)0x0)->mu.maxa);
(void)jit_bgtr_i(refno, JIT_V1, JIT_R2);
CHECK_LIMIT();
jit_movi_p(JIT_R0, scheme_true);
mz_epilog(JIT_R2);
__END_SHORT_JUMPS__(1);
scheme_jit_register_sub_func(jitter, sjc.proc_arity_includes_code, scheme_false);
CHECK_LIMIT();
}
return 1;
}
int scheme_do_generate_common(mz_jit_state *jitter, void *_data)
{
if (!common0(jitter, _data)) return 0;
@ -2086,6 +2199,7 @@ int scheme_do_generate_common(mz_jit_state *jitter, void *_data)
if (!common7(jitter, _data)) return 0;
if (!common8(jitter, _data)) return 0;
if (!common9(jitter, _data)) return 0;
if (!common10(jitter, _data)) return 0;
return 1;
}

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

@ -1716,27 +1716,7 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
jit_prepare(2);
jit_pusharg_p(JIT_R0);
jit_pusharg_p(JIT_R1);
#ifdef MZ_USE_FUTURES
{
/* inline in-future check, just like other direct prim calls */
GC_CAN_IGNORE jit_insn *refdirect, *refdone;
int argstate;
__START_TINY_JUMPS__(1);
jit_save_argstate(argstate);
mz_tl_ldi_i(JIT_R0, tl_scheme_use_rtcall);
refdirect = jit_beqi_i(jit_forward(), JIT_R0, 0);
(void)mz_finish_lwe(ts_scheme_equal, refr);
refdone = jit_jmpi(jit_forward());
jit_restore_argstate(argstate);
mz_patch_branch(refdirect);
(void)mz_finish(scheme_equal);
mz_patch_ucbranch(refdone);
__END_TINY_JUMPS__(1);
}
#else
(void)mz_finish_lwe(ts_scheme_equal, refr);
#endif
mz_finish_prim_lwe(ts_scheme_equal, refr);
jit_retval(JIT_R0);
CHECK_LIMIT();
@ -2561,6 +2541,16 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
allocate_rectangular(jitter);
return 1;
} else if (IS_NAMED_PRIM(rator, "procedure-arity-includes?")) {
LOG_IT(("inlined procedure-arity-includes?\n"));
generate_two_args(app->rand1, app->rand2, jitter, 1, 2);
CHECK_LIMIT();
mz_rs_sync();
(void)jit_calli(sjc.proc_arity_includes_code);
return 1;
} else if (IS_NAMED_PRIM(rator, "values")) {
Scheme_Object *args[3];

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

@ -3568,6 +3568,7 @@ Scheme_Object *scheme_checked_make_rectangular (int argc, Scheme_Object *argv[])
Scheme_Object *scheme_checked_flreal_part (int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_checked_flimag_part (int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_checked_make_flrectangular (int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_procedure_arity_includes(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_chaperone_vector_copy(Scheme_Object *obj);
Scheme_Object *scheme_chaperone_hash_table_copy(Scheme_Object *obj);