From 0d88a08c48ba10b219643d036fd33bad54bd6f87 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 3 May 2012 17:07:14 -0600 Subject: [PATCH] implement branch mode JIT generation for `box-cas!' Also, move slow path into common code --- collects/tests/future/future.rkt | 27 +----- collects/tests/racket/optimize.rktl | 16 +++- collects/tests/racket/sync.rktl | 26 ++++++ src/racket/src/jit.h | 2 +- src/racket/src/jit_ts.c | 2 +- src/racket/src/jitcommon.c | 16 ++++ src/racket/src/jitinline.c | 139 +++++++++++++++------------- 7 files changed, 133 insertions(+), 95 deletions(-) diff --git a/collects/tests/future/future.rkt b/collects/tests/future/future.rkt index 12a28d829b..5d27a8f303 100644 --- a/collects/tests/future/future.rkt +++ b/collects/tests/future/future.rkt @@ -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) diff --git a/collects/tests/racket/optimize.rktl b/collects/tests/racket/optimize.rktl index 3b603b51bc..702be44924 100644 --- a/collects/tests/racket/optimize.rktl +++ b/collects/tests/racket/optimize.rktl @@ -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) diff --git a/collects/tests/racket/sync.rktl b/collects/tests/racket/sync.rktl index 9b3deb132a..f0bf05884d 100644 --- a/collects/tests/racket/sync.rktl +++ b/collects/tests/racket/sync.rktl @@ -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) diff --git a/src/racket/src/jit.h b/src/racket/src/jit.h index f70cbe086c..4216fb581f 100644 --- a/src/racket/src/jit.h +++ b/src/racket/src/jit.h @@ -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; diff --git a/src/racket/src/jit_ts.c b/src/racket/src/jit_ts.c index 521b9decb3..537ed0a43b 100644 --- a/src/racket/src/jit_ts.c +++ b/src/racket/src/jit_ts.c @@ -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 diff --git a/src/racket/src/jitcommon.c b/src/racket/src/jitcommon.c index aad5437260..f4ca973e23 100644 --- a/src/racket/src/jitcommon.c +++ b/src/racket/src/jitcommon.c @@ -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; diff --git a/src/racket/src/jitinline.c b/src/racket/src/jitinline.c index d4319df1bb..5481c8aeca 100644 --- a/src/racket/src/jitinline.c +++ b/src/racket/src/jitinline.c @@ -2823,82 +2823,89 @@ 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; - int unsafe = 0; + GC_CAN_IGNORE jit_insn *ref, *ref3, *reffalse, *reftrue; + int unsafe = 0; - if (IS_NAMED_PRIM(rator, "unsafe-box*-cas!")) { - unsafe = 1; - } + if (IS_NAMED_PRIM(rator, "unsafe-box*-cas!")) { + unsafe = 1; + } - /* generate code to evaluate the arguments */ - scheme_generate_app(app, NULL, 3, jitter, 0, 0, 2); - CHECK_LIMIT(); - mz_rs_sync(); + /* generate code to evaluate the arguments */ + scheme_generate_app(app, NULL, 3, jitter, 0, 0, 2); + CHECK_LIMIT(); + mz_rs_sync(); - mz_rs_ldr(JIT_R1); + mz_rs_ldr(JIT_R1); + if (!unsafe) { __START_TINY_JUMPS__(1); - - if (!unsafe) { - /* 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); - - /* 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 */ - - /* jump to here if the type tag tests succeed */ - mz_patch_branch(ref); - } - - /* 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 */ - -#ifdef MZ_USE_FUTURES - if (scheme_is_multiprocessor(0)) { - jit_lock_cmpxchgr_l(JIT_R1, JIT_V1); /* implicitly uses JIT_R0 */ - reffalse = (JNEm(jit_forward(), 0,0,0), _jit.x.pc); - } else -#endif - { - jit_ldr_p(JIT_R2, JIT_R1); - reffalse = jit_bner_p(jit_forward(), JIT_R2, JIT_R0); - jit_str_p(JIT_R1, JIT_V1); - } - - jit_movi_p(JIT_R0, scheme_true); - reftrue = jit_jmpi(jit_forward()); - - mz_patch_branch(reffalse); - jit_movi_p(JIT_R0, scheme_false); - - mz_patch_branch(reftrue); - + /* 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); - /* pop off 3 arguments */ - mz_rs_inc(3); - mz_runstack_popped(jitter, 3); + (void)jit_calli(sjc.box_cas_fail_code); - return 1; + __START_TINY_JUMPS__(1); + /* jump to here if the type tag tests succeed */ + mz_patch_branch(ref); + __END_TINY_JUMPS__(1); + } - } else if (IS_NAMED_PRIM(rator, "vector-set!") + /* 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 */ + + /* 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 */ + reffalse = (JNEm(jit_forward(), 0,0,0), _jit.x.pc); + } else +#endif + { + jit_ldr_p(JIT_R2, JIT_R1); + reffalse = jit_bner_p(jit_forward(), JIT_R2, JIT_R0); + 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()); + + mz_patch_branch(reffalse); + jit_movi_p(JIT_R0, scheme_false); + + mz_patch_branch(reftrue); + __END_TINY_JUMPS__(1); + } + + return 1; + } 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!")