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

JIT: inline vector and struct CAS primitives

Browse Source
This commit is contained in:
Matthew Flatt 2017-10-25 13:57:18 -07:00
parent c52bd91c54
commit 55c1685526
6 changed files with 99 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
pkgs/racket-test-core/tests/racket/jitinline.rktl
View File

@ -894,6 +894,21 @@
(lambda () v) 0 "other"
(lambda () (test 77 unbox v))))
(let ([v (vector 1 0)])
(check-error-message 'vector-cas! (eval `(lambda (x) (vector-cas! x 10 11 12))))
(tri0 #t
'(lambda (v i nv) (vector-cas! v i (vector-ref v i) nv))
(lambda () v) 1 "other"
(lambda ()
(test 1 vector-ref v 0)
(test "other" vector-ref v 1)))
(tri0 #f
'(lambda (v i nv) (vector-cas! v i (gensym) nv))
(lambda () v) 1 "next"
(lambda ()
(test 1 vector-ref v 0)
(test "other" vector-ref v 1))))
(bin-exact #t 'procedure-arity-includes? cons 2 #t)
(bin-exact #f 'procedure-arity-includes? cons 1)
(bin-exact #f 'procedure-arity-includes? cons 3)

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

@ -307,6 +307,7 @@ struct scheme_jit_common_record {
void *imag_part_code, *real_part_code, *make_rectangular_code;
void *bad_flimag_part_code, *bad_flreal_part_code, *bad_make_flrectangular_code;
void *unbox_code, *set_box_code, *box_cas_fail_code;
void *vector_cas_fail_code;
void *bad_vector_length_code;
void *bad_flvector_length_code;
void *bad_fxvector_length_code;

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

@ -105,6 +105,7 @@ define_ts_iS_s(scheme_checked_list_tail, FSRC_MARKS)
define_ts_iSs_s(scheme_struct_getter, FSRC_MARKS)
define_ts_iSs_s(scheme_struct_setter, FSRC_MARKS)
define_ts_iS_s(scheme_box_cas, FSRC_MARKS)
define_ts_iS_s(scheme_checked_vector_cas, FSRC_MARKS)
define_ts__v(chaperone_set_mark, FSRC_MARKS)
define_ts_ss_s(scheme_chaperone_get_immediate_cc_mark, FSRC_MARKS)
define_ts_iS_s(scheme_checked_char_to_integer, FSRC_MARKS)
@ -209,6 +210,7 @@ define_ts_s_s(scheme_box, FSRC_OTHER)
# define ts_scheme_unbox scheme_unbox
# define ts_scheme_set_box scheme_set_box
# define ts_scheme_box_cas scheme_box_cas
# define ts_scheme_checked_vector_cas scheme_checked_vector_cas
# define ts_chaperone_set_mark chaperone_set_mark
# define ts_scheme_chaperone_get_immediate_cc_mark scheme_chaperone_get_immediate_cc_mark
# define ts_scheme_vector_length scheme_vector_length

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

@ -547,21 +547,33 @@ static int common1b(mz_jit_state *jitter, void *_data)
mz_epilog(JIT_R2);
scheme_jit_register_sub_func(jitter, sjc.set_box_code, scheme_false);
/* *** box_cas_fail_code *** */
/* *** {box,vector}_cas_fail_code *** */
/* Arguments are on runstack; */
/* call scheme_box_cas to raise the exception,
/* call scheme_{box,vector}_cas to raise the exception,
we use mz_finish_lwe because it will capture the stack,
and the ts_ version because we may be in a future */
sjc.box_cas_fail_code = jit_get_ip();
mz_prolog(JIT_R2);
JIT_UPDATE_THREAD_RSPTR();
jit_movi_l(JIT_R0, 3);
mz_prepare(2);
jit_pusharg_p(JIT_RUNSTACK);
jit_pusharg_l(JIT_R0);
CHECK_LIMIT();
(void)mz_finish_lwe(ts_scheme_box_cas, ref); /* doesn't return */
scheme_jit_register_sub_func(jitter, sjc.box_cas_fail_code, scheme_false);
for (i = 0; i < 2; i++) {
ref = jit_get_ip();
if (!i)
sjc.box_cas_fail_code = ref;
else
sjc.vector_cas_fail_code = ref;
mz_prolog(JIT_R2);
JIT_UPDATE_THREAD_RSPTR();
if (!i)
jit_movi_l(JIT_R0, 3);
else
jit_movi_l(JIT_R0, 4);
mz_prepare(2);
jit_pusharg_p(JIT_RUNSTACK);
jit_pusharg_l(JIT_R0);
CHECK_LIMIT();
if (!i)
(void)mz_finish_lwe(ts_scheme_box_cas, ref); /* doesn't return */
else
(void)mz_finish_lwe(ts_scheme_checked_vector_cas, ref); /* doesn't return */
scheme_jit_register_sub_func(jitter, ref, scheme_false);
}
/* *** bad_vector_length_code *** */
/* R0 is argument */

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

@ -4252,20 +4252,33 @@ int scheme_generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
(void)mz_finish(scheme_current_future);
jit_retval(dest);
return 1;
} else if (IS_NAMED_PRIM(rator, "box-cas!") || (IS_NAMED_PRIM(rator, "unsafe-box*-cas!"))) {
} else if (IS_NAMED_PRIM(rator, "box-cas!")
|| IS_NAMED_PRIM(rator, "unsafe-box*-cas!")
|| IS_NAMED_PRIM(rator, "vector-cas!")
|| IS_NAMED_PRIM(rator, "unsafe-vector*-cas!")
|| IS_NAMED_PRIM(rator, "unsafe-struct*-cas!")) {
GC_CAN_IGNORE jit_insn *ref, *reffail, *reffalse, *reftrue;
int unsafe = 0;
int unsafe = 1, for_type = scheme_vector_type, c = app->num_args;
if (IS_NAMED_PRIM(rator, "unsafe-box*-cas!")) {
unsafe = 1;
}
if (IS_NAMED_PRIM(rator, "box-cas!")) {
unsafe = 0;
for_type = scheme_box_type;
} else if (IS_NAMED_PRIM(rator, "unsafe-box*-cas!"))
for_type = scheme_box_type;
else if (IS_NAMED_PRIM(rator, "vector-cas!"))
unsafe = 0;
else if (IS_NAMED_PRIM(rator, "unsafe-struct*-cas!"))
for_type = scheme_structure_type;
/* generate code to evaluate the arguments */
scheme_generate_app(app, NULL, 3, 3, jitter, 0, 0, 0, 2);
scheme_generate_app(app, NULL, c, c, jitter, 0, 0, 0, 2);
CHECK_LIMIT();
mz_rs_sync();
mz_rs_ldr(JIT_R1);
if (for_type != scheme_box_type) {
mz_rs_ldxi(JIT_R0, 1); /* index */
}
if (!unsafe) {
__START_TINY_JUMPS__(1);
@ -4274,29 +4287,54 @@ int scheme_generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
reffail = jit_get_ip();
__END_TINY_JUMPS__(1);
(void)jit_calli(sjc.box_cas_fail_code);
if (for_type == scheme_box_type)
(void)jit_calli(sjc.box_cas_fail_code);
else
(void)jit_calli(sjc.vector_cas_fail_code);
__START_TINY_JUMPS__(1);
/* jump to here if the type tag tests succeed */
mz_patch_branch(ref);
/* Get the type tag, fail if it isn't a box */
(void)mz_bnei_t(reffail, JIT_R1, scheme_box_type, JIT_R2);
/* Get the type tag, fail if it isn't a box/vector */
(void)mz_bnei_t(reffail, JIT_R1, for_type, JIT_R2);
/* fail if immutable: */
jit_ldxi_s(JIT_R2, JIT_R1, &MZ_OPT_HASH_KEY((Scheme_Inclhash_Object *)0x0));
(void)jit_bmsi_ul(reffail, JIT_R2, 0x1);
if (for_type != scheme_box_type) {
/* fail if index isn't a fixnum */
(void)jit_bmci_ul(reffail, JIT_R0, 0x1);
}
__END_TINY_JUMPS__(1);
}
CHECK_LIMIT();
/* box is in JIT_R1 */
jit_addi_l(JIT_R1, JIT_R1, (intptr_t)&SCHEME_BOX_VAL(0x0));
mz_rs_ldxi(JIT_R0, 1); /* old val */
mz_rs_ldxi(JIT_V1, 2); /* new val */
/* box/vector/struct is in JIT_R1 */
if (for_type == scheme_box_type) {
jit_addi_l(JIT_R1, JIT_R1, (intptr_t)&SCHEME_BOX_VAL(0x0));
/* pop off 3 arguments */
mz_rs_inc(3);
mz_runstack_popped(jitter, 3);
mz_rs_ldxi(JIT_R0, 1); /* old val */
mz_rs_ldxi(JIT_V1, 2); /* new val */
/* pop off 3 arguments */
mz_rs_inc(3);
mz_runstack_popped(jitter, 3);
} else {
if (for_type == scheme_vector_type)
jit_addi_l(JIT_R1, JIT_R1, (intptr_t)&SCHEME_VEC_ELS(0x0));
else
jit_addi_l(JIT_R1, JIT_R1, (intptr_t)&((Scheme_Structure *)0x0)->slots);
jit_rshi_ul(JIT_R0, JIT_R0, 1);
jit_lshi_ul(JIT_R0, JIT_R0, JIT_LOG_WORD_SIZE);
jit_addr_p(JIT_R1, JIT_R1, JIT_R0);
mz_rs_ldxi(JIT_R0, 2); /* old val */
mz_rs_ldxi(JIT_V1, 3); /* new val */
/* pop off 4 arguments */
mz_rs_inc(4);
mz_runstack_popped(jitter, 4);
}
if (for_branch) {
__START_SHORT_JUMPS__(branch_short);

6
racket/src/racket/src/vector.c
View File

@ -33,7 +33,6 @@ READ_ONLY Scheme_Object *scheme_make_vector_proc;
READ_ONLY Scheme_Object *scheme_vector_immutable_proc;
READ_ONLY Scheme_Object *scheme_vector_ref_proc;
READ_ONLY Scheme_Object *scheme_vector_set_proc;
READ_ONLY Scheme_Object *scheme_vector_cas_proc;
READ_ONLY Scheme_Object *scheme_list_to_vector_proc;
READ_ONLY Scheme_Object *scheme_unsafe_vector_length_proc;
READ_ONLY Scheme_Object *scheme_unsafe_string_length_proc;
@ -136,11 +135,10 @@ scheme_init_vector (Scheme_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("vector-set!", p, env);
REGISTER_SO(scheme_vector_cas_proc);
p = scheme_make_noncm_prim(scheme_checked_vector_cas,
"vector-cas!",
4, 4);
scheme_vector_cas_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("vector-cas!", p, env);
scheme_add_global_constant("vector->list",
@ -243,6 +241,7 @@ scheme_init_unsafe_vector (Scheme_Env *env)
scheme_add_global_constant("unsafe-vector*-set!", p, env);
p = scheme_make_immed_prim(unsafe_vector_star_cas, "unsafe-vector*-cas!", 4, 4);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("unsafe-vector*-cas!", p, env);
REGISTER_SO(scheme_unsafe_struct_ref_proc);
@ -270,6 +269,7 @@ scheme_init_unsafe_vector (Scheme_Env *env)
scheme_add_global_constant("unsafe-struct*-set!", p, env);
p = scheme_make_immed_prim(unsafe_struct_star_cas, "unsafe-struct*-cas!", 4, 4);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("unsafe-struct*-cas!", p, env);
REGISTER_SO(scheme_unsafe_string_length_proc);