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

implement branch mode JIT generation for `box-cas!'

Browse Source 
Also, move slow path into common code
This commit is contained in:
Matthew Flatt 2012-05-03 17:07:14 -06:00
parent 23d46620f2
commit 0d88a08c48
7 changed files with 133 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/tests/future/future.rkt
View File

@ -750,32 +750,7 @@ We should also test deep continuations.
(for/fold ([t (func (lambda () 0))]) ([i (in-range 10000)])
(func (lambda () (touch t))))))
;; box-cas! tests
;; successful cas
(let ()
(define b (box #f))
(check-equal? (box-cas! b #f #true) #true)
(check-equal? (unbox b) #true))
;; unsuccessful cas
(let ()
(define b (box #f))
(check-equal? (box-cas! b #true #f) #f)
(check-equal? (unbox b) #f))
;; cas using allocated data
(let ()
(define b (box '()))
(define x (cons 1 (unbox b)))
(check-equal? (box-cas! b '() x) #true)
(check-equal? (unbox b) x)
(check-equal? (box-cas! b x '()) #true)
(check-equal? (unbox b) '())
(check-equal? (box-cas! b x '()) #f)
(check-equal? (unbox b) '()))
;; failure tests
;; box-cas failure tests
(let ()
(define (f x) (box-cas! x 1 2))
(define (g x y) y)

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

@ -140,7 +140,11 @@
(test v name ((eval `(lambda (y) ,(wrap `(,op (,get-arg1) _arg2 y)))) arg3))
(check-effect)
(test v name ((eval `(lambda (x y z) ,(wrap `(,op x y z)))) (get-arg1) arg2 arg3))
(check-effect)))]
(check-effect)
(when (boolean? v)
;; (printf " for branch...\n")
(test (if v 'yes 'no) name ((eval `(lambda (x y z) (if ,(wrap `(,op x y z)) 'yes 'no))) (get-arg1) arg2 arg3))
(check-effect))))]
[tri (lambda (v op get-arg1 arg2 arg3 check-effect #:wrap [wrap values])
(define (e->i n) (if (number? n) (exact->inexact n) n))
(tri0 v op get-arg1 arg2 arg3 check-effect #:wrap wrap)
@ -666,6 +670,16 @@
(lambda () v) 0 "other"
(lambda () (test "other" unbox v))))
(let ([v (box 10)])
(check-error-message 'box-cas! (eval `(lambda (x) (box-cas! x 10 11))))
(tri0 #t '(lambda (b i v) (box-cas! b (unbox b) v))
(lambda () v) 0 "other"
(lambda () (test "other" unbox v)))
(set-box! v 77)
(tri0 #f '(lambda (b i v) (box-cas! b (gensym) v))
(lambda () v) 0 "other"
(lambda () (test 77 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)

26
collects/tests/racket/sync.rktl
View File

@ -1177,6 +1177,32 @@
(for/fold ([e (wrap-evt always-evt (lambda (x) 0))]) ([i (in-range N)])
(choice-evt (wrap-evt always-evt (lambda (x) i)) e)))))
;; ----------------------------------------
;; box-cas! tests
;; successful cas
(let ()
(define b (box #f))
(test #true box-cas! b #f #true)
(test #true unbox b))
;; unsuccessful cas
(let ()
(define b (box #f))
(test #f box-cas! b #true #f)
(test #f unbox b))
;; cas using allocated data
(let ()
(define b (box '()))
(define x (cons 1 (unbox b)))
(test #true box-cas! b '() x)
(test x unbox b)
(test #true box-cas! b x '())
(test '() unbox b)
(test #f box-cas! b x '())
(test '() unbox b))
;; ----------------------------------------
(report-errs)

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

@ -234,7 +234,7 @@ struct scheme_jit_common_record {
void *bad_set_mcar_code, *bad_set_mcdr_code;
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;
void *unbox_code, *set_box_code, *box_cas_fail_code;
void *bad_vector_length_code;
void *bad_flvector_length_code;
void *bad_fxvector_length_code;

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

@ -90,6 +90,7 @@ define_ts_iS_s(scheme_checked_list_ref, FSRC_MARKS)
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)
#endif
#ifdef JITCALL_TS_PROCS
@ -114,7 +115,6 @@ define_ts_l_s(scheme_jit_make_vector, FSRC_OTHER)
# endif
define_ts_ss_i(scheme_equal, FSRC_MARKS)
define_ts_sss_s(extract_one_cc_mark_to_tag, FSRC_MARKS)
define_ts_iS_s(scheme_box_cas, FSRC_MARKS)
#endif
#ifdef JIT_APPLY_TS_PROCS

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

@ -512,6 +512,22 @@ 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 *** */
/* Arguments are on runstack; */
/* call scheme_box_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().ptr;
mz_prolog(JIT_R2);
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
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);
/* *** bad_vector_length_code *** */
/* R0 is argument */
sjc.bad_vector_length_code = jit_get_ip().ptr;

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

@ -2823,10 +2823,9 @@ int scheme_generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
(void)mz_finish(scheme_current_future);
jit_retval(JIT_R0);
return 1;
} else if (!for_branch) {
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!"))) {
GC_CAN_IGNORE jit_insn *ref, *ref3, *refr, *reffalse, *reftrue;
GC_CAN_IGNORE jit_insn *ref, *ref3, *reffalse, *reftrue;
int unsafe = 0;
if (IS_NAMED_PRIM(rator, "unsafe-box*-cas!")) {
@ -2840,29 +2839,22 @@ int scheme_generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
mz_rs_ldr(JIT_R1);
__START_TINY_JUMPS__(1);
if (!unsafe) {
__START_TINY_JUMPS__(1);
/* Fail if this isn't a pointer (0x1 is the integer tag) */
ref3 = jit_bmsi_ul(jit_forward(), JIT_R1, 0x1);
/* Get the type tag, fail if it isn't a box */
ref = mz_beqi_t(jit_forward(), JIT_R1, scheme_box_type, JIT_R2);
/* jump to here if it wasn't a pointer */
mz_patch_branch(ref3);
__END_TINY_JUMPS__(1);
/* call scheme_box_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 */
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
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, refr); /* doesn't return */
(void)jit_calli(sjc.box_cas_fail_code);
__START_TINY_JUMPS__(1);
/* jump to here if the type tag tests succeed */
mz_patch_branch(ref);
__END_TINY_JUMPS__(1);
}
/* box is in JIT_R1 */
@ -2870,6 +2862,19 @@ int scheme_generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
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);
if (for_branch) {
__START_SHORT_JUMPS__(branch_short);
scheme_prepare_branch_jump(jitter, for_branch);
CHECK_LIMIT();
} else {
__START_TINY_JUMPS__(1);
}
/* This is the actual CAS: */
#ifdef MZ_USE_FUTURES
if (scheme_is_multiprocessor(0)) {
jit_lock_cmpxchgr_l(JIT_R1, JIT_V1); /* implicitly uses JIT_R0 */
@ -2882,6 +2887,12 @@ int scheme_generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
jit_str_p(JIT_R1, JIT_V1);
}
/* Branch or set true/false: */
if (for_branch) {
scheme_branch_for_true(jitter, for_branch);
scheme_add_branch_false(for_branch, reffalse);
__END_SHORT_JUMPS__(branch_short);
} else {
jit_movi_p(JIT_R0, scheme_true);
reftrue = jit_jmpi(jit_forward());
@ -2889,16 +2900,12 @@ int scheme_generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
jit_movi_p(JIT_R0, scheme_false);
mz_patch_branch(reftrue);
__END_TINY_JUMPS__(1);
/* pop off 3 arguments */
mz_rs_inc(3);
mz_runstack_popped(jitter, 3);
}
return 1;
} else if (IS_NAMED_PRIM(rator, "vector-set!")
} else if (!for_branch) {
if (IS_NAMED_PRIM(rator, "vector-set!")
|| IS_NAMED_PRIM(rator, "unsafe-vector-set!")
|| IS_NAMED_PRIM(rator, "unsafe-vector*-set!")
|| IS_NAMED_PRIM(rator, "flvector-set!")