Made continuation-mark-set-first future-safe. Fixed a rarely occurring bug with lightweight continuation capture for futures.

This commit is contained in:
James Swaine 2011-07-14 19:30:25 -06:00
parent 4d03ffb57d
commit 32a3828a2e
12 changed files with 469 additions and 130 deletions

View File

@ -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))))))
;; ----------------------------------------

View File

@ -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)

View File

@ -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",

View File

@ -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;

View File

@ -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;

View File

@ -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

View File

@ -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

View File

@ -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); \
}

View File

@ -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;
}

View File

@ -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);

View File

@ -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;
}

View File

@ -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;
}
}