diff --git a/collects/scribblings/reference/futures.scrbl b/collects/scribblings/reference/futures.scrbl index b15fbe4ece..bfc74918fe 100644 --- a/collects/scribblings/reference/futures.scrbl +++ b/collects/scribblings/reference/futures.scrbl @@ -69,9 +69,11 @@ in parallel. See also @guidesecref["effective-futures"]. @defproc[(current-future) (or/c #f future?)]{ - Returns the descriptor for the future that is evaluating the current thunk. - If not currently running inside a future thunk (or - futures are disabled), returns @racket[#f]. + Returns the descriptor of the future whose thunk execution is the + current continuation. If a future thunk uses @racket[touch], the + future executions can be nested, in which case the descriptor of the + most immediately executing future is returned. If the current + continuation is not a future-thunk execution, the result is @racket[#f]. } @@ -81,7 +83,7 @@ in parallel. See also @guidesecref["effective-futures"]. } @defproc[(processor-count) exact-positive-integer?]{ - Returns the number of parallel computations units (e.g., processors + Returns the number of parallel computation units (e.g., processors or cores) that are available on the current machine. } diff --git a/collects/tests/future/future.rkt b/collects/tests/future/future.rkt index 34ec6ae2df..3371ef6105 100644 --- a/collects/tests/future/future.rkt +++ b/collects/tests/future/future.rkt @@ -192,14 +192,13 @@ We should also test deep continuations. (let* ([fs (build-list 20 (λ (n) (future (λ () (current-future)))))] [retvalfs (map touch fs)]) (check-equal? 20 (length (remove-duplicates retvalfs)))) - - - - - - - - - - +;; Check `current-future' more, specially trying to get +;; the runtime thread to nest `touch'es: +(let loop ([i 20][f (future (lambda () (current-future)))]) + (if (zero? i) + (check-equal? f (touch f)) + (loop (sub1 i) + (future (lambda () + (and (eq? (touch f) f) + (current-future))))))) diff --git a/src/racket/gc2/newgc.c b/src/racket/gc2/newgc.c index 78015cb3e8..b8aac8f4fc 100644 --- a/src/racket/gc2/newgc.c +++ b/src/racket/gc2/newgc.c @@ -645,6 +645,7 @@ int GC_is_allocated(void *p) */ THREAD_LOCAL_DECL(unsigned long GC_gen0_alloc_page_ptr = 0); THREAD_LOCAL_DECL(unsigned long GC_gen0_alloc_page_end = 0); +THREAD_LOCAL_DECL(int GC_gen0_alloc_only = 0); /* miscellaneous variables */ static const char *zero_sized[4]; /* all 0-sized allocs get this */ diff --git a/src/racket/include/scheme.h b/src/racket/include/scheme.h index e5b2ec1ba1..3b007eaff4 100644 --- a/src/racket/include/scheme.h +++ b/src/racket/include/scheme.h @@ -1016,6 +1016,8 @@ typedef struct Scheme_Thread { struct Scheme_Thread *nester, *nestee; + struct future_t *current_ft; + double sleep_end; /* blocker has starting sleep time */ int block_descriptor; Scheme_Object *blocker; /* semaphore or port */ diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index 9bae691941..b64614724c 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -8474,6 +8474,27 @@ static void *apply_lwc_k() return scheme_apply_lightweight_continuation(lw, result); } +int scheme_can_apply_lightweight_continuation(Scheme_Lightweight_Continuation *lw) +{ +#ifdef DO_STACK_CHECK + /* enough room on C stack? */ + unsigned long size; + size = (unsigned long)lw->saved_lwc->stack_start - (unsigned long)lw->saved_lwc->stack_end; + + { +# define SCHEME_PLUS_STACK_DELTA(x) ((x) - size) +# include "mzstkchk.h" + { + return 0; + } + } + + return 1; +#else + return 0; +#endif +} + Scheme_Object *scheme_apply_lightweight_continuation(Scheme_Lightweight_Continuation *lw, Scheme_Object *result) XFORM_SKIP_PROC { @@ -8490,8 +8511,6 @@ Scheme_Object *scheme_apply_lightweight_continuation(Scheme_Lightweight_Continua scheme_current_thread->ku.k.p2 = result; return (Scheme_Object *)scheme_enlarge_runstack(len, apply_lwc_k); } - - /* FIXME: check whether the C stack is big enough */ /* application of a lightweight continuation forms a lightweight continuation: */ scheme_current_lwc->runstack_start = MZ_RUNSTACK; diff --git a/src/racket/src/future.c b/src/racket/src/future.c index 1f7ba10d53..667c33c262 100644 --- a/src/racket/src/future.c +++ b/src/racket/src/future.c @@ -86,17 +86,22 @@ static Scheme_Object *touch(int argc, Scheme_Object *argv[]) scheme_post_sema(ft->running_sema); } else { Scheme_Object *sema; + future_t *old_ft; mz_jmp_buf newbuf, * volatile savebuf; Scheme_Thread *p = scheme_current_thread; /* In case another Scheme thread touches the future. */ sema = scheme_make_sema(0); ft->running_sema = sema; + + old_ft = p->current_ft; + p->current_ft = ft; savebuf = p->error_buf; p->error_buf = &newbuf; if (scheme_setjmp(newbuf)) { ft->no_retval = 1; + p->current_ft = old_ft; scheme_post_sema(ft->running_sema); scheme_longjmp(*savebuf, 1); } else { @@ -111,6 +116,7 @@ static Scheme_Object *touch(int argc, Scheme_Object *argv[]) p->ku.multiple.array = NULL; } scheme_post_sema(ft->running_sema); + p->current_ft = old_ft; p->error_buf = savebuf; } } @@ -125,10 +131,10 @@ static Scheme_Object *processor_count(int argc, Scheme_Object *argv[]) } Scheme_Object *scheme_current_future(int argc, Scheme_Object *argv[]) - XFORM_SKIP_PROC -/* Called from any thread (either runtime or future) */ { - return scheme_false; + future_t *ft = scheme_current_thread->current_ft; + + return (ft ? (Scheme_Object *)ft : scheme_false); } # define FUTURE_PRIM_W_ARITY(name, func, a1, a2, env) GLOBAL_PRIM_W_ARITY(name, func, a1, a2, env) @@ -237,13 +243,14 @@ typedef struct Scheme_Future_Thread_State { int id; int worker_gc_counter; mzrt_sema *worker_can_continue_sema; - future_t *current_ft; long runstack_size; volatile int *fuel_pointer; volatile unsigned long *stack_boundary_pointer; volatile int *need_gc_pointer; + Scheme_Thread *thread; + unsigned long gen0_start; unsigned long gen0_size; unsigned long gen0_initial_offset; @@ -269,6 +276,8 @@ static future_t *enqueue_future(Scheme_Future_State *fs, future_t *ft);; static future_t *get_pending_future(Scheme_Future_State *fs); static void receive_special_result(future_t *f, Scheme_Object *retval, int clear); static void send_special_result(future_t *f, Scheme_Object *retval); +static Scheme_Object *_apply_future_lw(future_t *ft); +static Scheme_Object *apply_future_lw(future_t *ft); READ_ONLY static int cpucount; static void init_cpucount(void); @@ -289,7 +298,6 @@ typedef struct future_thread_params_t { struct NewGC *shared_GC; Scheme_Future_State *fs; Scheme_Future_Thread_State *fts; - Scheme_Thread *thread_skeleton; Scheme_Object **runstack_start; Scheme_Object ***scheme_current_runstack_ptr; @@ -382,13 +390,6 @@ void futures_init(void) REGISTER_SO(fs->future_waiting_lwc); REGISTER_SO(jit_future_storage); - /* Create a 'dummy' future thread state object for the runtime - thread, so that current-future will work even for - thunks that are touched before fetched by a worker thread - and are executed on the runtime thread */ - scheme_future_thread_state = (Scheme_Future_Thread_State*)malloc(sizeof(Scheme_Future_Thread_State)); - memset(scheme_future_thread_state, 0, sizeof(Scheme_Future_Thread_State)); - mzrt_mutex_create(&fs->future_mutex); mzrt_sema_create(&fs->future_pending_sema, 0); mzrt_sema_create(&fs->gc_ok_c, 0); @@ -428,6 +429,9 @@ static void init_future_thread(Scheme_Future_State *fs, int i) skeleton = MALLOC_ONE_TAGGED(Scheme_Thread); skeleton->so.type = scheme_thread_type; + scheme_register_static(&fts->thread, sizeof(Scheme_Thread*)); + fts->thread = skeleton; + { Scheme_Object **rs_start, **rs; long init_runstack_size = FUTURE_RUNSTACK_SIZE; @@ -439,7 +443,6 @@ static void init_future_thread(Scheme_Future_State *fs, int i) /* Fill in GCable values just before creating the thread, because the GC ignores `params': */ - params.thread_skeleton = skeleton; params.runstack_start = runstack_start; mzrt_sema_create(¶ms.ready_sema, 0); @@ -447,7 +450,6 @@ static void init_future_thread(Scheme_Future_State *fs, int i) mzrt_sema_wait(params.ready_sema); mzrt_sema_destroy(params.ready_sema); - scheme_register_static(&fts->current_ft, sizeof(void*)); scheme_register_static(params.scheme_current_runstack_ptr, sizeof(void*)); scheme_register_static(params.scheme_current_runstack_start_ptr, sizeof(void*)); scheme_register_static(params.jit_future_storage_ptr, 2 * sizeof(void*)); @@ -649,11 +651,16 @@ Scheme_Object *scheme_future(int argc, Scheme_Object *argv[]) ft->code = (void*)ncd->code; - mzrt_mutex_lock(fs->future_mutex); - enqueue_future(fs, ft); - /* Signal that a future is pending */ - mzrt_sema_post(fs->future_pending_sema); - mzrt_mutex_unlock(fs->future_mutex); + if (ft->status != PENDING_OVERSIZE) { + mzrt_mutex_lock(fs->future_mutex); + enqueue_future(fs, ft); + /* Signal that a future is pending */ + mzrt_sema_post(fs->future_pending_sema); + /* Alert the runtime thread, in case it wants to + run the future itself: */ + scheme_signal_received_at(fs->signal_handle); + mzrt_mutex_unlock(fs->future_mutex); + } return (Scheme_Object*)ft; } @@ -666,7 +673,7 @@ int future_ready(Scheme_Object *obj) future_t *ft = (future_t*)obj; mzrt_mutex_lock(fs->future_mutex); - if (ft->work_completed || ft->rt_prim) { + if (ft->work_completed || ft->rt_prim || ft->maybe_suspended_lw) { ret = 1; } mzrt_mutex_unlock(fs->future_mutex); @@ -694,11 +701,61 @@ static void dequeue_future(Scheme_Future_State *fs, future_t *ft) --fs->future_queue_count; } +static void future_in_runtime(future_t * volatile ft) +{ + mz_jmp_buf newbuf, * volatile savebuf; + Scheme_Thread *p = scheme_current_thread; + Scheme_Object * volatile retval; + future_t * volatile old_ft; + + old_ft = p->current_ft; + p->current_ft = ft; + + savebuf = p->error_buf; + p->error_buf = &newbuf; + + if (scheme_setjmp(newbuf)) { + ft->no_retval = 1; + retval = NULL; + } else { + if (ft->suspended_lw) { + retval = apply_future_lw(ft); + } else { + retval = scheme_apply_multi(ft->orig_lambda, 0, NULL); + } + send_special_result(ft, retval); + } + + p->error_buf = savebuf; + p->current_ft = old_ft; + + ft->work_completed = 1; + ft->retval = retval; + ft->status = FINISHED; + + if (!retval) { + scheme_longjmp(*savebuf, 1); + } +} + +static int prefer_to_apply_future_in_runtime() +/* Called with the future mutex held. */ +{ + /* Policy question: if the runtime thread is blocked on a + future, should we just run the future (or its suspended continuation) + directly in the runtime thread? + + If we don't, then we're better able to handle non-blocking requests + from future threads. At the same time, the runtime thread shouldn't + wait if no one is working on the future. We err on the safe side + and always run when we're waiting on the future: */ + return 1; +} + Scheme_Object *touch(int argc, Scheme_Object *argv[]) /* Called in runtime thread */ { Scheme_Future_State *fs = scheme_future_state; - Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Object *retval = NULL; future_t *ft; @@ -713,25 +770,24 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[]) #endif mzrt_mutex_lock(fs->future_mutex); - if ((ft->status == PENDING) || (ft->status == PENDING_OVERSIZE)) { + if ((((ft->status == PENDING) + && prefer_to_apply_future_in_runtime()) + || (ft->status == PENDING_OVERSIZE)) + && (!ft->suspended_lw + || scheme_can_apply_lightweight_continuation(ft->suspended_lw))) { if (ft->status == PENDING_OVERSIZE) { scheme_log(scheme_main_logger, SCHEME_LOG_DEBUG, 0, "future: oversize procedure deferred to runtime thread"); + } else { + dequeue_future(fs, ft); } ft->status = RUNNING; mzrt_mutex_unlock(fs->future_mutex); - fts->current_ft = ft; - retval = scheme_apply_multi(ft->orig_lambda, 0, NULL); - send_special_result(ft, retval); - - fts->current_ft = NULL; - mzrt_mutex_lock(fs->future_mutex); - ft->work_completed = 1; - ft->retval = retval; - ft->status = FINISHED; - mzrt_mutex_unlock(fs->future_mutex); + future_in_runtime(ft); + retval = ft->retval; + receive_special_result(ft, retval, 0); return retval; @@ -762,6 +818,21 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[]) invoke_rtcall(fs, ft); LOG0("done.\n"); } + else if (ft->maybe_suspended_lw) + { + ft->maybe_suspended_lw = 0; + if (ft->suspended_lw + && scheme_can_apply_lightweight_continuation(ft->suspended_lw) + && prefer_to_apply_future_in_runtime()) { + ft->status = RUNNING; + dequeue_future(fs, ft); + /* may raise an exception or escape: */ + mzrt_mutex_unlock(fs->future_mutex); + future_in_runtime(ft); + } else { + mzrt_mutex_unlock(fs->future_mutex); + } + } else { mzrt_mutex_unlock(fs->future_mutex); @@ -817,11 +888,9 @@ Scheme_Object *scheme_current_future(int argc, Scheme_Object *argv[]) XFORM_SKIP_PROC /* Called from any thread (either runtime or future) */ { - Scheme_Future_Thread_State *fts = scheme_future_thread_state; - if (NULL == fts || NULL == fts->current_ft) - return scheme_false; - - return (Scheme_Object*)(fts->current_ft); + future_t *ft = scheme_current_thread->current_ft; + + return (ft ? (Scheme_Object *)ft : scheme_false); } /* Entry point for a worker thread allocated for @@ -845,7 +914,6 @@ void *worker_thread_future_loop(void *arg) scheme_future_thread_state = fts; GC_instance = params->shared_GC; - scheme_current_thread = params->thread_skeleton; GC_gen0_alloc_only = 1; @@ -867,6 +935,8 @@ void *worker_thread_future_loop(void *arg) scheme_use_rtcall = 1; + scheme_current_thread = fts->thread; + scheme_fuel_counter = 1; scheme_jit_stack_boundary = ((unsigned long)&v) - INITIAL_C_STACK_SIZE; @@ -898,6 +968,7 @@ void *worker_thread_future_loop(void *arg) /* Work is available for this thread */ ft->status = RUNNING; + ft->maybe_suspended_lw = 0; mzrt_mutex_unlock(fs->future_mutex); ft->thread_short_id = fts->id; @@ -905,7 +976,7 @@ void *worker_thread_future_loop(void *arg) /* Set up the JIT compiler for this thread */ scheme_jit_fill_threadlocal_table(); - fts->current_ft = ft; + fts->thread->current_ft = ft; MZ_RUNSTACK = MZ_RUNSTACK_START + fts->runstack_size; MZ_CONT_MARK_STACK = 0; @@ -919,18 +990,7 @@ void *worker_thread_future_loop(void *arg) /* failed or suspended */ v = NULL; } else { - struct Scheme_Lightweight_Continuation *lw = ft->suspended_lw; - ft->suspended_lw = NULL; - - v = ft->retval_s; - ft->retval_s = NULL; - receive_special_result(ft, v, 1); - - v = scheme_apply_lightweight_continuation(lw, v); - - if (SAME_OBJ(v, SCHEME_TAIL_CALL_WAITING)) { - v = scheme_ts_scheme_force_value_same_mark(v); - } + v = _apply_future_lw(ft); } } else { jitcode = ft->code; @@ -962,7 +1022,7 @@ void *worker_thread_future_loop(void *arg) /* Get future again, since a GC may have occurred or future may have been suspended */ - ft = fts->current_ft; + ft = fts->thread->current_ft; mzrt_mutex_lock(fs->future_mutex); @@ -995,6 +1055,47 @@ void *worker_thread_future_loop(void *arg) return NULL; } +static Scheme_Object *_apply_future_lw(future_t *ft) + XFORM_SKIP_PROC +/* Called from any thread (either runtime or future) */ +{ + struct Scheme_Lightweight_Continuation *lw = ft->suspended_lw; + Scheme_Object *v; + + ft->suspended_lw = NULL; + + v = ft->retval_s; + ft->retval_s = NULL; + receive_special_result(ft, v, 1); + + v = scheme_apply_lightweight_continuation(lw, v); + + if (SAME_OBJ(v, SCHEME_TAIL_CALL_WAITING)) { + v = scheme_ts_scheme_force_value_same_mark(v); + } + + return v; +} + +static void *apply_future_lw_k(void) +{ + Scheme_Thread *p = scheme_current_thread; + future_t *ft = (future_t *)p->ku.k.p1; + + p->ku.k.p1 = NULL; + + return _apply_future_lw(ft); +} + +static Scheme_Object *apply_future_lw(future_t *ft) +{ + Scheme_Thread *p = scheme_current_thread; + + p->ku.k.p1 = ft; + + return (Scheme_Object *)scheme_top_level_do(apply_future_lw_k, 0); +} + static int capture_future_continuation(future_t *ft, void **storage) XFORM_SKIP_PROC /* This function explicitly coorperates with the GC by storing the @@ -1013,10 +1114,12 @@ static int capture_future_continuation(future_t *ft, void **storage) ft = (future_t *)storage[2]; ft->suspended_lw = lw; + ft->maybe_suspended_lw = 1; ft->status = WAITING_FOR_REQUEUE; ft->want_lw = 0; - ft->fts->current_ft = NULL; /* tells worker thread that it no longer - needs to handle the future */ + ft->fts->thread->current_ft = NULL; /* tells worker thread that it no longer + needs to handle the future */ + if (ft->arg_S0) { arg_S = scheme_adjust_runstack_argument(lw, ft->arg_S0); @@ -1100,9 +1203,10 @@ static void future_do_runtimecall(Scheme_Future_Thread_State *fts, future_t *future; Scheme_Future_State *fs = scheme_future_state; void *storage[3]; + int insist_to_suspend, prefer_to_suspend; /* Fetch the future descriptor for this thread */ - future = fts->current_ft; + future = fts->thread->current_ft; if (!is_atomic) { scheme_fill_lwc_end(); @@ -1123,26 +1227,41 @@ static void future_do_runtimecall(Scheme_Future_Thread_State *fts, if (is_atomic) { future->next_waiting_atomic = fs->future_waiting_atomic; fs->future_waiting_atomic = future; - future->status = WAITING_FOR_PRIM; - } else if (GC_gen0_alloc_page_ptr - && capture_future_continuation(future, storage)) { + } + + /* Policy question: When should the future thread suspend + the current future? It costs something to suspend and + resume a future. + The current policy: + Always suspend for a non-atomic (i.e, "unsafe") operation, + because there's no guarantee that `touch' will allow progress + anytime soon. For atomic operations, only suspend if there's + more work available in the future queue, and only if we + can suspend ourselves (because asking the runtime thread + to suspend wouldn't accomplish anything). */ + insist_to_suspend = !is_atomic; + prefer_to_suspend = (insist_to_suspend || fs->future_queue_count); + + if (prefer_to_suspend + && GC_gen0_alloc_page_ptr + && capture_future_continuation(future, storage)) { /* this future thread will suspend handling the future continuation until the result of the blocking call is ready; - fts->current_ft was set to NULL */ - } else { + fts->thread->current_ft was set to NULL */ + } else 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; future->want_lw = 1; - future->status = WAITING_FOR_PRIM; } scheme_signal_received_at(fs->signal_handle); - if (fts->current_ft) { + if (fts->thread->current_ft) { /* Wait for the signal that the RT call is finished or a lightweight continuation has been captured: */ + future->status = WAITING_FOR_PRIM; future->can_continue_sema = fts->worker_can_continue_sema; end_gc_not_ok(fts, fs, MZ_RUNSTACK); /* we rely on this putting MZ_CONT_MARK_STACK into the thread record */ mzrt_mutex_unlock(fs->future_mutex); @@ -1157,7 +1276,7 @@ static void future_do_runtimecall(Scheme_Future_Thread_State *fts, /* Fetch the future instance again, in case the GC has moved the pointer or the future has been requeued. */ - future = fts->current_ft; + future = fts->thread->current_ft; if (!future) { /* future continuation was requeued */ @@ -1177,7 +1296,7 @@ void scheme_rtcall_void_void_3args(const char *who, int src_type, prim_void_void /* Called in future thread */ { Scheme_Future_Thread_State *fts = scheme_future_thread_state; - future_t *future = fts->current_ft; + future_t *future = fts->thread->current_ft; future->prim_protocol = SIG_VOID_VOID_3ARGS; @@ -1225,7 +1344,7 @@ unsigned long scheme_rtcall_alloc(const char *who, int src_type) fts->gen0_size <<= 1; while (1) { - future = fts->current_ft; + future = fts->thread->current_ft; future->time_of_request = scheme_get_inexact_milliseconds(); future->source_of_request = who; future->source_type = src_type; @@ -1235,7 +1354,7 @@ unsigned long scheme_rtcall_alloc(const char *who, int src_type) future_do_runtimecall(fts, (void*)GC_make_jit_nursery_page, 1); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->alloc_retval; future->alloc_retval = 0; @@ -1260,7 +1379,7 @@ void scheme_rtcall_new_mark_segment(Scheme_Thread *p) future_t *future; Scheme_Future_Thread_State *fts = scheme_future_thread_state; - future = fts->current_ft; + future = fts->thread->current_ft; future->time_of_request = scheme_get_inexact_milliseconds(); future->source_of_request = "[allocate_mark_segment]"; future->source_type = FSRC_OTHER; diff --git a/src/racket/src/future.h b/src/racket/src/future.h index 3e6fb47749..752244cbdd 100644 --- a/src/racket/src/future.h +++ b/src/racket/src/future.h @@ -89,6 +89,7 @@ typedef struct future_t { struct Scheme_Future_Thread_State *fts; struct Scheme_Lightweight_Continuation *suspended_lw; + int maybe_suspended_lw; /* set to 1 with suspended_lw untl test in runtime thread */ Scheme_Object *retval_s; void *retval_p; /* use only with conservative GC */ diff --git a/src/racket/src/gen-jit-ts.rkt b/src/racket/src/gen-jit-ts.rkt index 728b002bb3..1f9c9a4422 100644 --- a/src/racket/src/gen-jit-ts.rkt +++ b/src/racket/src/gen-jit-ts.rkt @@ -84,7 +84,7 @@ double tm; @(if (string=? result-type "void") "" @string-append{@|result-type| retval;}) - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_@|ts|; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -99,7 +99,7 @@ "\n") @(if (equal? arg-types '("Scheme_Object*")) @string-append{send_special_result(future, @(car arg-names));} "") future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; @(if (string=? result-type "void") "" @string-append{retval = @|fretval|;}) @(if (string=? result-type "void") "" @string-append{@|fretval| = 0;}) @(if (string=? result-type "Scheme_Object*") @string-append{receive_special_result(future, retval, 1);} "") diff --git a/src/racket/src/jit_ts_future_glue.c b/src/racket/src/jit_ts_future_glue.c index fab3add0e0..0d92ff7c83 100644 --- a/src/racket/src/jit_ts_future_glue.c +++ b/src/racket/src/jit_ts_future_glue.c @@ -6,7 +6,7 @@ double tm; Scheme_Object* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_siS_s; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -18,7 +18,7 @@ future->arg_S2 = g53; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_s; future->retval_s = 0; receive_special_result(future, retval, 1); @@ -32,7 +32,7 @@ double tm; Scheme_Object* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_iSs_s; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -44,7 +44,7 @@ future->arg_s2 = g56; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_s; future->retval_s = 0; receive_special_result(future, retval, 1); @@ -58,7 +58,7 @@ double tm; Scheme_Object* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_s_s; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -68,7 +68,7 @@ future->arg_s0 = g57; send_special_result(future, g57); future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_s; future->retval_s = 0; receive_special_result(future, retval, 1); @@ -82,7 +82,7 @@ double tm; Scheme_Object* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_n_s; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -92,7 +92,7 @@ future->arg_n0 = g58; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_s; future->retval_s = 0; receive_special_result(future, retval, 1); @@ -106,7 +106,7 @@ double tm; Scheme_Object* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG__s; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -116,7 +116,7 @@ future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_s; future->retval_s = 0; receive_special_result(future, retval, 1); @@ -130,7 +130,7 @@ double tm; Scheme_Object* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_ss_s; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -141,7 +141,7 @@ future->arg_s1 = g60; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_s; future->retval_s = 0; receive_special_result(future, retval, 1); @@ -155,7 +155,7 @@ double tm; Scheme_Object* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_tt_s; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -166,7 +166,7 @@ future->arg_t1 = g62; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_s; future->retval_s = 0; receive_special_result(future, retval, 1); @@ -180,7 +180,7 @@ double tm; MZ_MARK_STACK_TYPE retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_ss_m; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -191,7 +191,7 @@ future->arg_s1 = g64; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_m; future->retval_m = 0; @@ -205,7 +205,7 @@ double tm; Scheme_Object* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_Sl_s; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -216,7 +216,7 @@ future->arg_l1 = g66; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_s; future->retval_s = 0; receive_special_result(future, retval, 1); @@ -230,7 +230,7 @@ double tm; Scheme_Object* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_l_s; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -240,7 +240,7 @@ future->arg_l0 = g67; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_s; future->retval_s = 0; receive_special_result(future, retval, 1); @@ -254,7 +254,7 @@ double tm; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_bsi_v; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -266,7 +266,7 @@ future->arg_i2 = g70; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; @@ -280,7 +280,7 @@ double tm; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_iiS_v; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -292,7 +292,7 @@ future->arg_S2 = g73; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; @@ -306,7 +306,7 @@ double tm; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_ss_v; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -317,7 +317,7 @@ future->arg_s1 = g75; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; @@ -331,7 +331,7 @@ double tm; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_b_v; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -341,7 +341,7 @@ future->arg_b0 = g76; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; @@ -355,7 +355,7 @@ double tm; Scheme_Object* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_sl_s; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -366,7 +366,7 @@ future->arg_l1 = g78; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_s; future->retval_s = 0; receive_special_result(future, retval, 1); @@ -380,7 +380,7 @@ double tm; Scheme_Object* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_iS_s; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -391,7 +391,7 @@ future->arg_S1 = g80; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_s; future->retval_s = 0; receive_special_result(future, retval, 1); @@ -405,7 +405,7 @@ double tm; Scheme_Object* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_S_s; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -415,7 +415,7 @@ future->arg_S0 = g81; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_s; future->retval_s = 0; receive_special_result(future, retval, 1); @@ -429,7 +429,7 @@ double tm; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_s_v; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -439,7 +439,7 @@ future->arg_s0 = g82; send_special_result(future, g82); future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; @@ -453,7 +453,7 @@ double tm; Scheme_Object* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_iSi_s; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -465,7 +465,7 @@ future->arg_i2 = g85; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_s; future->retval_s = 0; receive_special_result(future, retval, 1); @@ -479,7 +479,7 @@ double tm; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_siS_v; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -491,7 +491,7 @@ future->arg_S2 = g88; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; @@ -505,7 +505,7 @@ double tm; void* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_z_p; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -515,7 +515,7 @@ future->arg_z0 = g89; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_p; future->retval_p = 0; @@ -529,7 +529,7 @@ double tm; Scheme_Object* retval; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_si_s; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -540,7 +540,7 @@ future->arg_i1 = g91; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; retval = future->retval_s; future->retval_s = 0; receive_special_result(future, retval, 1); @@ -554,7 +554,7 @@ double tm; - future = fts->current_ft; + future = fts->thread->current_ft; future->prim_protocol = SIG_sis_v; future->prim_func = f; tm = scheme_get_inexact_milliseconds(); @@ -566,7 +566,7 @@ future->arg_s2 = g94; future_do_runtimecall(fts, (void*)f, 0); - future = fts->current_ft; + future = fts->thread->current_ft; diff --git a/src/racket/src/mzmark.c b/src/racket/src/mzmark.c index 8a6f1869bf..01ad1b3693 100644 --- a/src/racket/src/mzmark.c +++ b/src/racket/src/mzmark.c @@ -1678,6 +1678,8 @@ static int thread_val_MARK(void *p, struct NewGC *gc) { gcMARK2(pr->nester, gc); gcMARK2(pr->nestee, gc); + + gcMARK2(pr->current_ft, gc); gcMARK2(pr->blocker, gc); gcMARK2(pr->overflow, gc); @@ -1790,6 +1792,8 @@ static int thread_val_FIXUP(void *p, struct NewGC *gc) { gcFIXUP2(pr->nester, gc); gcFIXUP2(pr->nestee, gc); + + gcFIXUP2(pr->current_ft, gc); gcFIXUP2(pr->blocker, gc); gcFIXUP2(pr->overflow, gc); diff --git a/src/racket/src/mzmarksrc.c b/src/racket/src/mzmarksrc.c index 9150202fbb..6c60c9aa24 100644 --- a/src/racket/src/mzmarksrc.c +++ b/src/racket/src/mzmarksrc.c @@ -661,6 +661,8 @@ thread_val { gcMARK2(pr->nester, gc); gcMARK2(pr->nestee, gc); + + gcMARK2(pr->current_ft, gc); gcMARK2(pr->blocker, gc); gcMARK2(pr->overflow, gc); diff --git a/src/racket/src/mzstkchk.h b/src/racket/src/mzstkchk.h index c42851f550..eb881414ec 100644 --- a/src/racket/src/mzstkchk.h +++ b/src/racket/src/mzstkchk.h @@ -4,12 +4,15 @@ #ifndef SCHEME_STACK_BOUNDARY # define SCHEME_STACK_BOUNDARY scheme_stack_boundary #endif +#ifndef SCHEME_PLUS_STACK_DELTA +# define SCHEME_PLUS_STACK_DELTA(x) x +#endif #ifdef SPAWN_NEW_STACK unsigned long _stk_pos; _stk_pos = (unsigned long)&_stk_pos; - if (STK_COMP(_stk_pos, (unsigned long)SCHEME_CURRENT_PROCESS->stack_end) + if (STK_COMP(SCHEME_PLUS_STACK_DELTA(_stk_pos), (unsigned long)SCHEME_CURRENT_PROCESS->stack_end) && !scheme_no_stack_overflow) #else # ifdef USE_STACKAVAIL @@ -23,10 +26,11 @@ _stk_pos = (unsigned long)&_stk_pos; - if (STK_COMP(_stk_pos, SCHEME_STACK_BOUNDARY) +if (STK_COMP(SCHEME_PLUS_STACK_DELTA(_stk_pos), SCHEME_STACK_BOUNDARY) && !scheme_no_stack_overflow) # endif #endif #undef SCHEME_CURRENT_PROCESS #undef SCHEME_STACK_BOUNDARY +#undef SCHEME_PLUS_STACK_DELTA diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 4d5f9358a5..fc636738c6 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -2286,7 +2286,6 @@ Scheme_Object *scheme_call_as_lightweight_continuation(Scheme_Closed_Prim *code, void *scheme_save_lightweight_continuation_stack(Scheme_Current_LWC *lwc); Scheme_Object *scheme_apply_lightweight_continuation_stack(Scheme_Current_LWC *lwc, void *stack, Scheme_Object *result); - struct Scheme_Lightweight_Continuation; typedef struct Scheme_Lightweight_Continuation Scheme_Lightweight_Continuation; Scheme_Lightweight_Continuation *scheme_capture_lightweight_continuation(Scheme_Thread *p, @@ -2297,6 +2296,8 @@ Scheme_Object *scheme_apply_lightweight_continuation(Scheme_Lightweight_Continua Scheme_Object **scheme_adjust_runstack_argument(Scheme_Lightweight_Continuation *captured, Scheme_Object **arg); +int scheme_can_apply_lightweight_continuation(Scheme_Lightweight_Continuation *captured); + int scheme_push_marks_from_thread(Scheme_Thread *p2, Scheme_Cont_Frame_Data *d); int scheme_push_marks_from_lightweight_continuation(Scheme_Lightweight_Continuation *captured, Scheme_Cont_Frame_Data *d);