From 32a3828a2e610263335402ab281b114a244c0883 Mon Sep 17 00:00:00 2001 From: James Swaine Date: Thu, 14 Jul 2011 19:30:25 -0600 Subject: [PATCH] Made continuation-mark-set-first future-safe. Fixed a rarely occurring bug with lightweight continuation capture for futures. --- collects/tests/future/future.rkt | 189 ++++++++++++++++++++++++++- collects/tests/racket/optimize.rktl | 28 ++-- src/racket/src/fun.c | 12 +- src/racket/src/future.c | 10 +- src/racket/src/future.h | 14 +- src/racket/src/gen-jit-ts.rkt | 3 +- src/racket/src/jit_ts.c | 8 +- src/racket/src/jit_ts_def.c | 9 ++ src/racket/src/jit_ts_future_glue.c | 184 +++++++++++++++----------- src/racket/src/jit_ts_protos.h | 53 ++++---- src/racket/src/jit_ts_runtime_glue.c | 14 ++ src/racket/src/jitinline.c | 75 +++++++++++ 12 files changed, 469 insertions(+), 130 deletions(-) diff --git a/collects/tests/future/future.rkt b/collects/tests/future/future.rkt index 0e4436ba0d..2878586e40 100644 --- a/collects/tests/future/future.rkt +++ b/collects/tests/future/future.rkt @@ -16,6 +16,190 @@ We should also test deep continuations. ;; ---------------------------------------- +(check-equal? + 'yes + (let/ec k + (call-with-exception-handler + (lambda (exn) + (k (continuation-mark-set-first #f 'special))) + (lambda () + (touch + (future + (lambda () + (with-continuation-mark + 'special 'yes + (set-box! 1 1))))))))) + +(check-equal? + 'yes + (let/ec k + (call-with-exception-handler + (lambda (exn) + (k (continuation-mark-set-first #f 'special))) + (lambda () + (touch + (future + (lambda () + (with-continuation-mark + 'special 'yes + (vector-ref (chaperone-vector + (vector 1) + (lambda (vec i val) 2) + (lambda (vec i val) val)) + 0))))))))) + +;; ---------------------------------------- + +(check-equal? + #f + (touch + (future + (lambda () + (continuation-mark-set-first + #f + 'key))))) + +(check-equal? + 'an-arbitrary-value + (touch + (future + (lambda () + (with-continuation-mark + 'key 'an-arbitrary-value + (continuation-mark-set-first + #f + 'key)))))) + +(check-equal? + 'an-arbitrary-value + (let ([f (future + (lambda () + (continuation-mark-set-first + #f + 'key)))]) + (with-continuation-mark + 'key 'an-arbitrary-value + (touch f)))) + +(check-equal? + #f + (touch + (future + (lambda () + (with-continuation-mark + 'key 'an-arbitrary-value + (continuation-mark-set-first + #f + 'other-key)))))) + +(check-equal? + 'another-value + (touch + (future + (lambda () + (with-continuation-mark + 'key 'an-arbitrary-value + (with-continuation-mark + 'other-key 'another-value + (continuation-mark-set-first + #f + 'other-key))))))) + +(check-equal? + 'an-arbitrary-value + (touch + (future + (lambda () + (with-continuation-mark + 'key 'an-arbitrary-value + (with-continuation-mark + 'other-key 'another-value + (continuation-mark-set-first + #f + 'key))))))) + +(check-equal? + 'an-arbitrary-value + (touch + (future + (lambda () + (with-continuation-mark + 'key 'an-arbitrary-value + (values + (with-continuation-mark + 'other-key 'another-value + (continuation-mark-set-first + #f + 'key)))))))) + +(check-equal? + 1 + (touch + (future + (lambda () + (let nt-loop ([x 100]) + (if (zero? x) + (continuation-mark-set-first + #f + 'key) + (values + (with-continuation-mark + 'key x + (nt-loop (sub1 x)))))))))) + +(check-equal? + 77 + (touch + (future + (lambda () + (with-continuation-mark + 'deep-key 77 + (let nt-loop ([x 100]) + (if (zero? x) + (continuation-mark-set-first + #f + 'deep-key) + (values + (with-continuation-mark + 'key x + (nt-loop (sub1 x))))))))))) + +(check-equal? + 77 + (touch + (future + (lambda () + (with-continuation-mark + 'early-key 77 + (let nt-loop ([x 100]) + (if (zero? x) + (continuation-mark-set-first + #f + 'early-key) + (with-continuation-mark + x (sqrt x) + (nt-loop (sub1 x)))))))))) + +(check-equal? + 1050 + (touch + (future + (lambda () + (with-continuation-mark + 'early-key 77 + (let nt-loop ([x 100]) + (if (zero? x) + (continuation-mark-set-first + #f + 50) + (with-continuation-mark + x (+ 1000 x) + (nt-loop (sub1 x)))))))))) + +;(error "stop") + +;; ---------------------------------------- + (check-equal? 2 (touch (future (λ () 2)))) @@ -508,8 +692,5 @@ We should also test deep continuations. (for/fold ([t (future (lambda () 0))]) ([i (in-range 10000)]) (future (lambda () (touch t)))))) +;; ---------------------------------------- - - - - diff --git a/collects/tests/racket/optimize.rktl b/collects/tests/racket/optimize.rktl index 1b5dd1ad17..e92299f621 100644 --- a/collects/tests/racket/optimize.rktl +++ b/collects/tests/racket/optimize.rktl @@ -31,7 +31,8 @@ exact-integer? exact-nonnegative-integer? exact-positive-integer? - thing?)) + thing? + continuation-mark-set-first)) (let ([s (with-handlers ([exn? exn-message]) (proc (if fixnum? 10 'bad)))] [name (symbol->string name)]) @@ -68,21 +69,25 @@ [bin0 (lambda (v op arg1 arg2) ;; (printf "Trying ~a ~a ~a\n" op arg1 arg2); (let ([name `(,op ,arg1 ,arg2)]) - (test v name ((eval `(lambda (x) (,op x ,arg2))) arg1)) - (test v name ((eval `(lambda (x) (,op ,arg1 x))) arg2)) + (test v name ((eval `(lambda (x) (,op x ',arg2))) arg1)) + (test v name ((eval `(lambda (x) (,op ',arg1 x))) arg2)) (test v name ((eval `(lambda (x y) (,op x y))) arg1 arg2)) + (test v name ((eval `(lambda (x y) + (let ([z 'not-a-legitimate-argument]) + (,op (begin (set! z y) x) z)))) + arg1 arg2)) (when (boolean? v) ;; (printf " for branch...\n") - (test (if v 'yes 'no) name ((eval `(lambda (x) (if (,op x ,arg2) 'yes 'no))) arg1)) - (test (if v 'yes 'no) name ((eval `(lambda (x) (if (,op ,arg1 x) 'yes 'no))) arg2)))))] + (test (if v 'yes 'no) name ((eval `(lambda (x) (if (,op x ',arg2) 'yes 'no))) arg1)) + (test (if v 'yes 'no) name ((eval `(lambda (x) (if (,op ',arg1 x) 'yes 'no))) arg2)))))] [bin-exact (lambda (v op arg1 arg2 [check-fixnum-as-bad? #f]) - (check-error-message op (eval `(lambda (x) (,op x ,arg2)))) - (check-error-message op (eval `(lambda (x) (,op ,arg1 x)))) + (check-error-message op (eval `(lambda (x) (,op x ',arg2)))) + (check-error-message op (eval `(lambda (x) (,op ',arg1 x)))) (when check-fixnum-as-bad? - (check-error-message op (eval `(lambda (x) (,op x ,arg2))) #t) + (check-error-message op (eval `(lambda (x) (,op x ',arg2))) #t) (check-error-message op (eval `(lambda (x) (,op x 10))) #t) (unless (fixnum? arg2) - (check-error-message op (eval `(lambda (x) (,op ,arg1 x))) #t))) + (check-error-message op (eval `(lambda (x) (,op ',arg1 x))) #t))) (bin0 v op arg1 arg2))] [bin-int (lambda (v op arg1 arg2 [check-fixnum-as-bad? #f]) (bin-exact v op arg1 arg2 check-fixnum-as-bad?) @@ -669,6 +674,11 @@ (bin-exact #f 'procedure-arity-includes? (lambda (x) x) 2) (bin-exact #t 'procedure-arity-includes? (lambda x x) 2) + (bin-exact #f 'continuation-mark-set-first #f 'key) + (with-continuation-mark + 'key 'the-value + (bin-exact 'the-value 'continuation-mark-set-first #f 'key)) + (un0 'yes 'thing-ref a-rock) (bin0 'yes 'thing-ref a-rock 99) (bin0 99 'thing-ref 10 99) diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index 8d048379f4..37f6b37087 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -408,11 +408,13 @@ scheme_init_fun (Scheme_Env *env) "continuation-mark-set->list*", 2, 4), env); - scheme_add_global_constant("continuation-mark-set-first", - scheme_make_prim_w_arity(extract_one_cc_mark, - "continuation-mark-set-first", - 2, 4), - env); + + o = scheme_make_prim_w_arity(extract_one_cc_mark, + "continuation-mark-set-first", + 2, 4); + SCHEME_PRIM_PROC_FLAGS(o) |= SCHEME_PRIM_IS_BINARY_INLINED; + scheme_add_global_constant("continuation-mark-set-first", o, env); + scheme_add_global_constant("call-with-immediate-continuation-mark", scheme_make_prim_w_arity2(call_with_immediate_cc_mark, "call-with-immediate-continuation-mark", diff --git a/src/racket/src/future.c b/src/racket/src/future.c index a6cc8a57b4..6248f8290f 100644 --- a/src/racket/src/future.c +++ b/src/racket/src/future.c @@ -2256,6 +2256,7 @@ void scheme_check_future_work() if (ft) { fs->future_waiting_atomic = ft->next_waiting_atomic; ft->next_waiting_atomic = NULL; + ft->in_queue_waiting_for_lwc = 0; if ((ft->status == WAITING_FOR_PRIM) && ft->rt_prim_is_atomic) { ft->status = HANDLING_PRIM; ft->want_lw = 0; /* we expect to handle it quickly, @@ -2441,8 +2442,12 @@ static void future_do_runtimecall(Scheme_Future_Thread_State *fts, if (insist_to_suspend) { /* couldn't capture the continuation locally, so ask the runtime thread to capture it: */ - future->next_waiting_lwc = fs->future_waiting_lwc; - fs->future_waiting_lwc = future; + if (!future->in_queue_waiting_for_lwc) { + future->next_waiting_lwc = fs->future_waiting_lwc; + fs->future_waiting_lwc = future; + future->in_queue_waiting_for_lwc = 1; + } + future->want_lw = 1; } } @@ -2478,6 +2483,7 @@ static void future_do_runtimecall(Scheme_Future_Thread_State *fts, future = fts->thread->current_ft; if (future) { + future->want_lw = 0; if (future->no_retval) { record_fevent(FEVENT_RTCALL_ABORT, fid); future->status = FINISHED; diff --git a/src/racket/src/future.h b/src/racket/src/future.h index 6be19ab482..7ddd7139d7 100644 --- a/src/racket/src/future.h +++ b/src/racket/src/future.h @@ -40,9 +40,17 @@ typedef void (*prim_allocate_values_t)(int, Scheme_Thread *); #define WAITING_FOR_FSEMA 6 #define SUSPENDED 7 +/* FSRC_OTHER means: descriptive string is provided for logging, + called function *DOES NOT NEED* to lookup continuation marks. */ #define FSRC_OTHER 0 +/* FSRC_RATOR means: Racket function provided, so use it in logging, + called function can lookup continuation marks. */ #define FSRC_RATOR 1 -#define FSRC_PRIM 2 +/* FSRC_PRIM means: Racket primitive provided, so use it in logging, + called function can lookup continuation marks. */ +#define FSRC_PRIM 2 +/* FSRC_MARKS means: like FSRC_OTHER, but + called function may need to lookup continuation marks. */ #define FSRC_MARKS 3 typedef struct future_t { @@ -67,7 +75,9 @@ typedef struct future_t { /* Runtime call stuff */ int want_lw; /* flag to indicate waiting for lw capture */ - int in_touch_queue; /* flag to indicate waiting for lw capture */ + /* flag to indicate whether the future is in the "waiting for lwc" queue */ + int in_queue_waiting_for_lwc; + int in_touch_queue; int rt_prim_is_atomic; double time_of_request; const char *source_of_request; diff --git a/src/racket/src/gen-jit-ts.rkt b/src/racket/src/gen-jit-ts.rkt index 5030efd629..138fdd4a66 100644 --- a/src/racket/src/gen-jit-ts.rkt +++ b/src/racket/src/gen-jit-ts.rkt @@ -194,7 +194,8 @@ si_s sis_v ss_i - iSp_v)) + iSp_v + sss_s)) (with-output-to-file "jit_ts_def.c" #:exists 'replace diff --git a/src/racket/src/jit_ts.c b/src/racket/src/jit_ts.c index 8822cc268e..4e645faad9 100644 --- a/src/racket/src/jit_ts.c +++ b/src/racket/src/jit_ts.c @@ -46,7 +46,7 @@ define_ts_s_s(call_with_values_from_multiple_result, FSRC_MARKS) define_ts_S_s(apply_checked_fail, FSRC_MARKS) define_ts_Sl_s(scheme_delayed_rename, FSRC_OTHER) define_ts_b_v(scheme_unbound_global, FSRC_MARKS) -define_ts_ss_v(scheme_set_box, FSRC_OTHER) +define_ts_ss_v(scheme_set_box, FSRC_MARKS) define_ts_iS_s(scheme_checked_car, FSRC_MARKS) define_ts_iS_s(scheme_checked_cdr, FSRC_MARKS) define_ts_iS_s(scheme_checked_caar, FSRC_MARKS) @@ -84,7 +84,7 @@ 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) -define_ts_ssi_s(vector_check_chaperone_of, FSRC_OTHER) +define_ts_ssi_s(vector_check_chaperone_of, FSRC_MARKS) define_ts_iS_s(scheme_checked_list_ref, FSRC_MARKS) define_ts_iS_s(scheme_checked_list_tail, FSRC_MARKS) #endif @@ -109,7 +109,8 @@ define_ts_ss_s(scheme_jit_make_two_element_vector, FSRC_OTHER) define_ts_l_s(scheme_jit_make_ivector, FSRC_OTHER) define_ts_l_s(scheme_jit_make_vector, FSRC_OTHER) # endif -define_ts_ss_i(scheme_equal, FSRC_OTHER) +define_ts_ss_i(scheme_equal, FSRC_MARKS) +define_ts_sss_s(scheme_extract_one_cc_mark_to_tag, FSRC_MARKS) #endif #ifdef JIT_APPLY_TS_PROCS @@ -180,6 +181,7 @@ define_ts_s_s(scheme_box, FSRC_OTHER) # define ts_scheme_struct_ref scheme_struct_ref # define ts_scheme_struct_set scheme_struct_set # define ts_scheme_equal scheme_equal +# define ts_scheme_extract_one_cc_mark_to_tag scheme_extract_one_cc_mark_to_tag # define ts_tail_call_with_values_from_multiple_result tail_call_with_values_from_multiple_result # define ts_raise_bad_call_with_values raise_bad_call_with_values # define ts_call_with_values_from_multiple_result_multi call_with_values_from_multiple_result_multi diff --git a/src/racket/src/jit_ts_def.c b/src/racket/src/jit_ts_def.c index 698e404d26..417c3b65de 100644 --- a/src/racket/src/jit_ts_def.c +++ b/src/racket/src/jit_ts_def.c @@ -232,3 +232,12 @@ static void ts_ ## id(int g53, Scheme_Object** g54, void* g55) \ else \ id(g53, g54, g55); \ } +#define define_ts_sss_s(id, src_type) \ +static Scheme_Object* ts_ ## id(Scheme_Object* g56, Scheme_Object* g57, Scheme_Object* g58) \ + XFORM_SKIP_PROC \ +{ \ + if (scheme_use_rtcall) \ + return scheme_rtcall_sss_s("[" #id "]", src_type, id, g56, g57, g58); \ + else \ + return id(g56, g57, g58); \ +} diff --git a/src/racket/src/jit_ts_future_glue.c b/src/racket/src/jit_ts_future_glue.c index bc729f70ad..2a1181203f 100644 --- a/src/racket/src/jit_ts_future_glue.c +++ b/src/racket/src/jit_ts_future_glue.c @@ -1,4 +1,4 @@ - Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g56, int g57, Scheme_Object** g58) + Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g59, int g60, Scheme_Object** g61) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -13,9 +13,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g56; - future->arg_i1 = g57; - future->arg_S2 = g58; + future->arg_s0 = g59; + future->arg_i1 = g60; + future->arg_S2 = g61; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -24,7 +24,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g59, Scheme_Object** g60, Scheme_Object* g61) + Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g62, Scheme_Object** g63, Scheme_Object* g64) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -39,9 +39,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_i0 = g59; - future->arg_S1 = g60; - future->arg_s2 = g61; + future->arg_i0 = g62; + future->arg_S1 = g63; + future->arg_s2 = g64; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -50,7 +50,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g62) + Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g65) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -65,8 +65,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g62; - send_special_result(future, g62); + future->arg_s0 = g65; + send_special_result(future, g65); future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; retval = future->retval_s; @@ -74,7 +74,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Closure_Data* g63) + Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Closure_Data* g66) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -89,7 +89,7 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_n0 = g63; + future->arg_n0 = g66; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -122,7 +122,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g64, Scheme_Object* g65) + Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g67, Scheme_Object* g68) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -137,8 +137,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g64; - future->arg_s1 = g65; + future->arg_s0 = g67; + future->arg_s1 = g68; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -147,7 +147,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g66, Scheme_Object* g67, int g68) + Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g69, Scheme_Object* g70, int g71) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -162,9 +162,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g66; - future->arg_s1 = g67; - future->arg_i2 = g68; + future->arg_s0 = g69; + future->arg_s1 = g70; + future->arg_i2 = g71; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -173,7 +173,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g69, const Scheme_Object* g70) + Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g72, const Scheme_Object* g73) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -188,8 +188,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_t0 = g69; - future->arg_t1 = g70; + future->arg_t0 = g72; + future->arg_t1 = g73; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -198,7 +198,7 @@ receive_special_result(future, retval, 1); return retval; } - MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g71, Scheme_Object* g72) + MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g74, Scheme_Object* g75) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -213,8 +213,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g71; - future->arg_s1 = g72; + future->arg_s0 = g74; + future->arg_s1 = g75; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -223,7 +223,7 @@ return retval; } - Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g73, intptr_t g74) + Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g76, intptr_t g77) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -238,8 +238,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_S0 = g73; - future->arg_l1 = g74; + future->arg_S0 = g76; + future->arg_l1 = g77; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -248,7 +248,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g75) + Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g78) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -263,7 +263,7 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_l0 = g75; + future->arg_l0 = g78; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -272,7 +272,7 @@ receive_special_result(future, retval, 1); return retval; } - void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g76, Scheme_Object* g77, int g78) + void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g79, Scheme_Object* g80, int g81) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -287,9 +287,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_b0 = g76; - future->arg_s1 = g77; - future->arg_i2 = g78; + future->arg_b0 = g79; + future->arg_s1 = g80; + future->arg_i2 = g81; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -298,7 +298,7 @@ } - void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g79, int g80, Scheme_Object** g81) + void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g82, int g83, Scheme_Object** g84) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -313,9 +313,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_i0 = g79; - future->arg_i1 = g80; - future->arg_S2 = g81; + future->arg_i0 = g82; + future->arg_i1 = g83; + future->arg_S2 = g84; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -324,7 +324,7 @@ } - void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g82, Scheme_Object* g83) + void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g85, Scheme_Object* g86) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -339,8 +339,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g82; - future->arg_s1 = g83; + future->arg_s0 = g85; + future->arg_s1 = g86; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -349,7 +349,7 @@ } - void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g84) + void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g87) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -364,7 +364,7 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_b0 = g84; + future->arg_b0 = g87; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -373,7 +373,7 @@ } - Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g85, intptr_t g86) + Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g88, intptr_t g89) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -388,8 +388,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g85; - future->arg_l1 = g86; + future->arg_s0 = g88; + future->arg_l1 = g89; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -398,7 +398,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g87, Scheme_Object** g88) + Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g90, Scheme_Object** g91) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -413,8 +413,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_i0 = g87; - future->arg_S1 = g88; + future->arg_i0 = g90; + future->arg_S1 = g91; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -423,7 +423,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g89) + Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g92) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -438,7 +438,7 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_S0 = g89; + future->arg_S0 = g92; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -447,7 +447,7 @@ receive_special_result(future, retval, 1); return retval; } - void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g90) + void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g93) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -462,8 +462,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g90; - send_special_result(future, g90); + future->arg_s0 = g93; + send_special_result(future, g93); future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -471,7 +471,7 @@ } - Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g91, Scheme_Object** g92, int g93) + Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g94, Scheme_Object** g95, int g96) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -486,9 +486,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_i0 = g91; - future->arg_S1 = g92; - future->arg_i2 = g93; + future->arg_i0 = g94; + future->arg_S1 = g95; + future->arg_i2 = g96; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -497,7 +497,7 @@ receive_special_result(future, retval, 1); return retval; } - void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g94, int g95, Scheme_Object** g96) + void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g97, int g98, Scheme_Object** g99) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -512,9 +512,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g94; - future->arg_i1 = g95; - future->arg_S2 = g96; + future->arg_s0 = g97; + future->arg_i1 = g98; + future->arg_S2 = g99; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -523,7 +523,7 @@ } - void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g97) + void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g100) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -538,7 +538,7 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_z0 = g97; + future->arg_z0 = g100; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -547,7 +547,7 @@ return retval; } - Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g98, int g99) + Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g101, int g102) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -562,8 +562,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g98; - future->arg_i1 = g99; + future->arg_s0 = g101; + future->arg_i1 = g102; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -572,7 +572,7 @@ receive_special_result(future, retval, 1); return retval; } - void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g100, int g101, Scheme_Object* g102) + void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g103, int g104, Scheme_Object* g105) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -587,9 +587,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g100; - future->arg_i1 = g101; - future->arg_s2 = g102; + future->arg_s0 = g103; + future->arg_i1 = g104; + future->arg_s2 = g105; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -598,7 +598,7 @@ } - int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g103, Scheme_Object* g104) + int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g106, Scheme_Object* g107) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -613,8 +613,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g103; - future->arg_s1 = g104; + future->arg_s0 = g106; + future->arg_s1 = g107; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -623,7 +623,7 @@ return retval; } - void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g105, Scheme_Object** g106, void* g107) + void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g108, Scheme_Object** g109, void* g110) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -638,9 +638,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_i0 = g105; - future->arg_S1 = g106; - future->arg_p2 = g107; + future->arg_i0 = g108; + future->arg_S1 = g109; + future->arg_p2 = g110; future_do_runtimecall(fts, (void*)f, 0, 1); future = fts->thread->current_ft; @@ -648,4 +648,30 @@ +} + Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g111, Scheme_Object* g112, Scheme_Object* g113) + XFORM_SKIP_PROC +{ + Scheme_Future_Thread_State *fts = scheme_future_thread_state; + future_t *future; + double tm; + Scheme_Object* retval; + + future = fts->thread->current_ft; + future->prim_protocol = SIG_sss_s; + future->prim_func = f; + tm = get_future_timestamp(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; + future->arg_s0 = g111; + future->arg_s1 = g112; + future->arg_s2 = g113; + + future_do_runtimecall(fts, (void*)f, 0, 1); + future = fts->thread->current_ft; + retval = future->retval_s; + future->retval_s = 0; + receive_special_result(future, retval, 1); + return retval; } diff --git a/src/racket/src/jit_ts_protos.h b/src/racket/src/jit_ts_protos.h index d13b8cb28b..3f0bd821d2 100644 --- a/src/racket/src/jit_ts_protos.h +++ b/src/racket/src/jit_ts_protos.h @@ -1,78 +1,81 @@ #define SIG_siS_s 10 typedef Scheme_Object* (*prim_siS_s)(Scheme_Object*, int, Scheme_Object**); -Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g160, int g161, Scheme_Object** g162); +Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g169, int g170, Scheme_Object** g171); #define SIG_iSs_s 11 typedef Scheme_Object* (*prim_iSs_s)(int, Scheme_Object**, Scheme_Object*); -Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g163, Scheme_Object** g164, Scheme_Object* g165); +Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g172, Scheme_Object** g173, Scheme_Object* g174); #define SIG_s_s 12 typedef Scheme_Object* (*prim_s_s)(Scheme_Object*); -Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g166); +Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g175); #define SIG_n_s 13 typedef Scheme_Object* (*prim_n_s)(Scheme_Native_Closure_Data*); -Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Closure_Data* g167); +Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Closure_Data* g176); #define SIG__s 14 typedef Scheme_Object* (*prim__s)(); Scheme_Object* scheme_rtcall__s(const char *who, int src_type, prim__s f ); #define SIG_ss_s 15 typedef Scheme_Object* (*prim_ss_s)(Scheme_Object*, Scheme_Object*); -Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g168, Scheme_Object* g169); +Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g177, Scheme_Object* g178); #define SIG_ssi_s 16 typedef Scheme_Object* (*prim_ssi_s)(Scheme_Object*, Scheme_Object*, int); -Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g170, Scheme_Object* g171, int g172); +Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g179, Scheme_Object* g180, int g181); #define SIG_tt_s 17 typedef Scheme_Object* (*prim_tt_s)(const Scheme_Object*, const Scheme_Object*); -Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g173, const Scheme_Object* g174); +Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g182, const Scheme_Object* g183); #define SIG_ss_m 18 typedef MZ_MARK_STACK_TYPE (*prim_ss_m)(Scheme_Object*, Scheme_Object*); -MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g175, Scheme_Object* g176); +MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g184, Scheme_Object* g185); #define SIG_Sl_s 19 typedef Scheme_Object* (*prim_Sl_s)(Scheme_Object**, intptr_t); -Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g177, intptr_t g178); +Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g186, intptr_t g187); #define SIG_l_s 20 typedef Scheme_Object* (*prim_l_s)(intptr_t); -Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g179); +Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g188); #define SIG_bsi_v 21 typedef void (*prim_bsi_v)(Scheme_Bucket*, Scheme_Object*, int); -void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g180, Scheme_Object* g181, int g182); +void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g189, Scheme_Object* g190, int g191); #define SIG_iiS_v 22 typedef void (*prim_iiS_v)(int, int, Scheme_Object**); -void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g183, int g184, Scheme_Object** g185); +void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g192, int g193, Scheme_Object** g194); #define SIG_ss_v 23 typedef void (*prim_ss_v)(Scheme_Object*, Scheme_Object*); -void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g186, Scheme_Object* g187); +void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g195, Scheme_Object* g196); #define SIG_b_v 24 typedef void (*prim_b_v)(Scheme_Bucket*); -void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g188); +void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g197); #define SIG_sl_s 25 typedef Scheme_Object* (*prim_sl_s)(Scheme_Object*, intptr_t); -Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g189, intptr_t g190); +Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g198, intptr_t g199); #define SIG_iS_s 26 typedef Scheme_Object* (*prim_iS_s)(int, Scheme_Object**); -Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g191, Scheme_Object** g192); +Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g200, Scheme_Object** g201); #define SIG_S_s 27 typedef Scheme_Object* (*prim_S_s)(Scheme_Object**); -Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g193); +Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g202); #define SIG_s_v 28 typedef void (*prim_s_v)(Scheme_Object*); -void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g194); +void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g203); #define SIG_iSi_s 29 typedef Scheme_Object* (*prim_iSi_s)(int, Scheme_Object**, int); -Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g195, Scheme_Object** g196, int g197); +Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g204, Scheme_Object** g205, int g206); #define SIG_siS_v 30 typedef void (*prim_siS_v)(Scheme_Object*, int, Scheme_Object**); -void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g198, int g199, Scheme_Object** g200); +void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g207, int g208, Scheme_Object** g209); #define SIG_z_p 31 typedef void* (*prim_z_p)(size_t); -void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g201); +void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g210); #define SIG_si_s 32 typedef Scheme_Object* (*prim_si_s)(Scheme_Object*, int); -Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g202, int g203); +Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g211, int g212); #define SIG_sis_v 33 typedef void (*prim_sis_v)(Scheme_Object*, int, Scheme_Object*); -void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g204, int g205, Scheme_Object* g206); +void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g213, int g214, Scheme_Object* g215); #define SIG_ss_i 34 typedef int (*prim_ss_i)(Scheme_Object*, Scheme_Object*); -int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g207, Scheme_Object* g208); +int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g216, Scheme_Object* g217); #define SIG_iSp_v 35 typedef void (*prim_iSp_v)(int, Scheme_Object**, void*); -void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g209, Scheme_Object** g210, void* g211); +void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g218, Scheme_Object** g219, void* g220); +#define SIG_sss_s 36 +typedef Scheme_Object* (*prim_sss_s)(Scheme_Object*, Scheme_Object*, Scheme_Object*); +Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g221, Scheme_Object* g222, Scheme_Object* g223); diff --git a/src/racket/src/jit_ts_runtime_glue.c b/src/racket/src/jit_ts_runtime_glue.c index 872098d2df..b0e37151b9 100644 --- a/src/racket/src/jit_ts_runtime_glue.c +++ b/src/racket/src/jit_ts_runtime_glue.c @@ -360,5 +360,19 @@ case SIG_iSp_v: f(arg_i0, arg_S1, arg_p2); + break; + } +case SIG_sss_s: + { + prim_sss_s f = (prim_sss_s)future->prim_func; + GC_CAN_IGNORE Scheme_Object* retval; + JIT_TS_LOCALIZE(Scheme_Object*, arg_s0); JIT_TS_LOCALIZE(Scheme_Object*, arg_s1); JIT_TS_LOCALIZE(Scheme_Object*, arg_s2); + + future->arg_s0 = NULL; future->arg_s1 = NULL; future->arg_s2 = NULL; + + retval = + f(arg_s0, arg_s1, arg_s2); + future->retval_s = retval; + send_special_result(future, retval); break; } diff --git a/src/racket/src/jitinline.c b/src/racket/src/jitinline.c index 0188c783c4..2b2d81b596 100644 --- a/src/racket/src/jitinline.c +++ b/src/racket/src/jitinline.c @@ -47,6 +47,61 @@ static Scheme_Object *ts_scheme_make_fsemaphore(int argc, Scheme_Object **argv) # define ts_scheme_make_fsemaphore scheme_make_fsemaphore #endif +static Scheme_Object *cont_mark_set_first_try_fast(Scheme_Object *cms, Scheme_Object *key) + XFORM_SKIP_PROC +{ + Scheme_Object *r; + Scheme_Object *nullableCms; + Scheme_Object *prompt_tag; + + prompt_tag = SCHEME_PTR_VAL(scheme_default_prompt_tag); + if (key == scheme_parameterization_key || key == scheme_break_enabled_key) + prompt_tag = NULL; + + nullableCms = SCHEME_FALSEP(cms) ? NULL : cms; + + /*Fast path here */ + if (!nullableCms) { + intptr_t findpos, bottom, startpos, minbottom; + intptr_t pos; + Scheme_Object *val = NULL; + Scheme_Cont_Mark *seg; + Scheme_Thread *p = scheme_current_thread; + + startpos = (intptr_t)MZ_CONT_MARK_STACK; + if (!p->cont_mark_stack_segments) + startpos = 0; + + bottom = p->cont_mark_stack_bottom; + findpos = startpos; + minbottom = findpos - 16; + if (bottom < minbottom) + bottom = minbottom; + + while (findpos-- > bottom) { + seg = p->cont_mark_stack_segments[findpos >> SCHEME_LOG_MARK_SEGMENT_SIZE]; + pos = findpos & SCHEME_MARK_SEGMENT_MASK; + + if (SAME_OBJ(seg[pos].key, key)) { + val = seg[pos].val; + break; + } else if (SAME_OBJ(seg[pos].key, prompt_tag)) { + break; + } + } + + if (val) { + return val; + } + } + + /* Otherwise, slow path */ + r = ts_scheme_extract_one_cc_mark_to_tag(nullableCms, key, prompt_tag); + if (!r) r = scheme_false; + + return r; +} + static int generate_two_args(Scheme_Object *rand1, Scheme_Object *rand2, mz_jit_state *jitter, int order_matters, int skipped); @@ -2672,6 +2727,26 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i mz_rs_inc(2); /* no sync */ mz_runstack_popped(jitter, 2); + return 1; + } else if (IS_NAMED_PRIM(rator, "continuation-mark-set-first")) { + GC_CAN_IGNORE jit_insn *refr; + + LOG_IT(("inlined continuation-mark-set-first\n")); + + generate_two_args(app->rand1, app->rand2, jitter, 1, 2); + CHECK_LIMIT(); + /* R0 has the first argument, R1 has the second argument */ + + mz_rs_sync(); + JIT_UPDATE_THREAD_RSPTR(); + + jit_prepare(2); + jit_pusharg_p(JIT_R1); + jit_pusharg_p(JIT_R0); + mz_finish_prim_lwe(cont_mark_set_first_try_fast, refr); + jit_retval(JIT_R0); + CHECK_LIMIT(); + return 1; } }