diff --git a/collects/rnrs/base-6.rkt b/collects/rnrs/base-6.rkt index 6fd4e2249b..d293606ba8 100644 --- a/collects/rnrs/base-6.rkt +++ b/collects/rnrs/base-6.rkt @@ -158,8 +158,8 @@ ;; 11.15 (rename-out [r5rs:apply apply] - [r6rs:call/cc call-with-current-continuation] - [r6rs:call/cc call/cc]) + [call-with-current-continuation call/cc]) + call-with-current-continuation values call-with-values dynamic-wind @@ -595,43 +595,3 @@ [(_ ([id expr] ...) body ...) (syntax/loc stx (splicing-letrec-syntax ([id (wrap-as-needed expr)] ...) body ...))])) - -;; ---------------------------------------- - -(define detect-tail-key (gensym)) - -(define (mk-k full-k tag) - (lambda args - (if (continuation-prompt-available? tag) - (abort-current-continuation - tag - (lambda () (apply values args))) - (apply full-k args)))) - -(define (r6rs:call/cc f) - (unless (and (procedure? f) - (procedure-arity-includes? f 1)) - ;; let call/cc report the error: - (call/cc f)) - ;; To support call/cc-based jumps in exception - ;; handlers, we both grab a continuation and set a prompt - (let/cc k - (let ([v (make-continuation-prompt-tag 'r6rs:call/cc)] - [orig-key (continuation-mark-set-first #f detect-tail-key)]) - (with-continuation-mark detect-tail-key v - (let ([new-key (continuation-mark-set-first #f detect-tail-key)]) - (if (not (eq? new-key orig-key)) - ;; Old mark surived => not tail wrt old call. - ;; Create an escape continuation to use for - ;; error escapes. Of course, we rely on the fact - ;; that continuation marks are not visible to EoPL - ;; programs. - (call-with-continuation-prompt - (lambda () - (f (mk-k k new-key))) - new-key) - ;; Old mark replaced => tail wrt old call. - ;; To preserve tail semantics for all but the first call - ;; reuse `mark' instead of creating a new escape continuation: - (with-continuation-mark detect-tail-key orig-key - (f (mk-k k orig-key))))))))) diff --git a/collects/scribblings/reference/cont.scrbl b/collects/scribblings/reference/cont.scrbl index b88ad06ba6..6142902583 100644 --- a/collects/scribblings/reference/cont.scrbl +++ b/collects/scribblings/reference/cont.scrbl @@ -8,9 +8,9 @@ information about continuations. Racket's support for prompts and composable continuations most closely resembles Dorai Sitaram's @racket[%] and @racket[fcontrol] operator @cite["Sitaram93"]. -Racket installs a @defterm{continuation barrier} around evaluation in -the following contexts, preventing full-continuation jumps across the -barrier: +Racket installs a @tech{continuation barrier} around evaluation in the +following contexts, preventing full-continuation jumps into the +evaluation context protected by the barrier: @itemize[ @@ -123,20 +123,19 @@ prompt tagged by @racket[prompt-tag] (not including the prompt; if no such prompt exists, the @exnraise[exn:fail:contract:continuation]), or up to the nearest continuation frame (if any) shared by the current and captured continuations---whichever is first. While removing -continuation frames, @racket[dynamic-wind] @racket[post-thunk]s are +continuation frames, @racket[dynamic-wind] @racket[_post-thunk]s are executed. Finally, the (unshared portion of the) captured continuation is appended to the remaining continuation, applying -@racket[dynamic-wind] @racket[pre-thunk]s. +@racket[dynamic-wind] @racket[_pre-thunk]s. The arguments supplied to an applied procedure become the result values for the restored continuation. In particular, if multiple arguments are supplied, then the continuation receives multiple results. -If, at application time, a continuation barrier appears between the -current continuation and the prompt tagged with @racket[prompt-tag], -and if the same barrier is not part of the captured continuation, then -the @exnraise[exn:fail:contract:continuation]. +If, at application time, a @tech{continuation barrier} would be +introduced by replacing the current continuation with the applied one, +then the @exnraise[exn:fail:contract:continuation]. A continuation can be invoked from the thread (see @secref["threads"]) other than the one where it was captured.} @@ -159,10 +158,13 @@ the resulting continuation procedure does not remove any portion of the current continuation. Instead, application always extends the current continuation with the captured continuation (without installing any prompts other than those be captured in the -continuation). When @racket[call-with-composable-continuation] is -called, if a continuation barrier appears in the continuation before -the closest prompt tagged by @racket[prompt-tag], the -@exnraise[exn:fail:contract:continuation].} +continuation). + +When @racket[call-with-composable-continuation] is called, if a +continuation barrier appears in the continuation before the closest +prompt tagged by @racket[prompt-tag], the +@exnraise[exn:fail:contract:continuation] (because attempting to apply +the continuation would always fail).} @defproc[(call-with-escape-continuation [proc (continuation? . -> . any)]) @@ -171,8 +173,7 @@ the closest prompt tagged by @racket[prompt-tag], the Like @racket[call-with-current-continuation], but @racket[proc] is not called in tail position, and the continuation procedure supplied to @racket[proc] can only be called during the dynamic extent of the -@racket[call-with-escape-continuation] call. A continuation barrier, -however, never prevents the application of the continuation. +@racket[call-with-escape-continuation] call. Due to the limited applicability of its continuation, @racket[call-with-escape-continuation] can be implemented more efficiently @@ -201,9 +202,10 @@ Equivalent to @racket[(call/ec (lambda (k) body ...))]. @defproc[(call-with-continuation-barrier [thunk (-> any)]) any]{ -Applies @racket[thunk] with a barrier between the application and the -current continuation. The results of @racket[thunk] are the results of -the @racket[call-with-continuation-barrier] call.} +Applies @racket[thunk] with a @tech{continuation barrier} between the +application and the current continuation. The results of +@racket[thunk] are the results of the +@racket[call-with-continuation-barrier] call.} @defproc[(continuation-prompt-available? diff --git a/collects/scribblings/reference/eval-model.scrbl b/collects/scribblings/reference/eval-model.scrbl index 75aee47fae..6031c55a04 100644 --- a/collects/scribblings/reference/eval-model.scrbl +++ b/collects/scribblings/reference/eval-model.scrbl @@ -656,19 +656,19 @@ the marks associated with the relevant frames are also captured. A @deftech{continuation barrier} is another kind of continuation frame that prohibits certain replacements of the current continuation with -another. Specifically, while an abort is allowed to remove a portion -of the continuation containing a prompt, the continuation can be -replaced by another only when the replacement also includes the -continuation barrier. Certain operations install barriers -automatically; in particular, when an exception handler is called, a -continuation barrier prohibits the continuation of the handler from -capturing the continuation past the exception point. +another. Specifically, a continuation can be replaced by another only +when the replacement does not introduce any continuation barriers (but +it may remove them). A continuation barrier thus prevents ``downward +jumps'' into a continuation that is protected by a barrier. Certain operations +install barriers automatically; in particular, when an exception +handler is called, a continuation barrier prohibits the continuation +of the handler from capturing the continuation past the exception +point. A @deftech{escape continuation} is essentially a derived concept. It combines a prompt for escape purposes with a continuation for mark-gathering purposes. As the name implies, escape continuations are -used only to abort to the point of capture, which means that -escape-continuation aborts can cross continuation barriers. +used only to abort to the point of capture. @;------------------------------------------------------------------------ @section[#:tag "thread-model"]{Threads} diff --git a/collects/tests/racket/basic.rktl b/collects/tests/racket/basic.rktl index a47a495f2e..6e25f935e6 100644 --- a/collects/tests/racket/basic.rktl +++ b/collects/tests/racket/basic.rktl @@ -1693,12 +1693,19 @@ (lambda () (k2 12))))) (k0 13)))))) + + ;; Interaction with exceptions: + (test 42 test-call/cc (lambda (k) + (call-with-exception-handler k (lambda () (add1 (raise 42)))))) + )) (test-cc-values call/cc) (test-cc-values call/ec) + + (test 'ok 'ec-cc-exn-combo (with-handlers ([void (lambda (x) 'ok)]) diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index 2d16da1b94..f5f06f904d 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/doc/release-notes/racket/HISTORY.txt @@ -1,3 +1,7 @@ +Version 5.0.0.9 +Continuation barriers now block only downward continuation jumps + and allow escapes through full continuations + Version 5.0.0.8 Changed internal-definition handling to allow expressions mixed with definitions diff --git a/src/racket/include/scheme.h b/src/racket/include/scheme.h index 76e1a6e9da..4f8bb38147 100644 --- a/src/racket/include/scheme.h +++ b/src/racket/include/scheme.h @@ -879,6 +879,7 @@ typedef struct Scheme_Jumpup_Buf_Holder { typedef struct Scheme_Continuation_Jump_State { struct Scheme_Object *jumping_to_continuation; + struct Scheme_Object *alt_full_continuation; Scheme_Object *val; /* or **vals */ mzshort num_vals; short is_kill, is_escape; diff --git a/src/racket/src/error.c b/src/racket/src/error.c index 912f1c2f0a..21ef665937 100644 --- a/src/racket/src/error.c +++ b/src/racket/src/error.c @@ -2465,6 +2465,7 @@ def_error_escape_proc(int argc, Scheme_Object *argv[]) if (prompt) { p->cjs.jumping_to_continuation = prompt; + p->cjs.alt_full_continuation = NULL; p->cjs.num_vals = 1; p->cjs.val = scheme_void_proc; } diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c index 7c1809df08..602c7ad103 100644 --- a/src/racket/src/eval.c +++ b/src/racket/src/eval.c @@ -259,6 +259,8 @@ static Scheme_Object *finish_optimize_application(Scheme_App_Rec *app, Optimize_ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimize_Info *info, int context, int rator_flags); static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimize_Info *info, int context, int rator_flags); +void scheme_escape_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands, Scheme_Object *alt_full); + #define cons(x,y) scheme_make_pair(x,y) typedef void (*DW_PrePost_Proc)(void *); @@ -8773,6 +8775,12 @@ Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Sc MZ_MARK_POS_TYPE prompt_pos; Scheme_Prompt *prompt, *barrier_prompt; int common_depth; + + c = (Scheme_Cont *)obj; + + if (c->escape_cont + && scheme_escape_continuation_ok(c->escape_cont)) + scheme_escape_to_continuation(c->escape_cont, num_rands, rands, (Scheme_Object *)c); if (num_rands != 1) { GC_CAN_IGNORE Scheme_Object **vals; @@ -8790,8 +8798,6 @@ Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Sc } else value = rands[0]; - c = (Scheme_Cont *)obj; - DO_CHECK_FOR_BREAK(p, ;); if (!c->runstack_copied) { @@ -8892,6 +8898,7 @@ Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Sc } /* Immediate destination is in scheme_handle_stack_overflow(). */ p->cjs.jumping_to_continuation = (Scheme_Object *)c; + p->cjs.alt_full_continuation = NULL; p->overflow = overflow; p->stack_start = overflow->stack_start; scheme_longjmpup(&overflow->jmp->cont); @@ -8900,6 +8907,7 @@ Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Sc /* The prompt is different than when we captured the continuation, so we need to compose the continuation with the current prompt. */ p->cjs.jumping_to_continuation = (Scheme_Object *)prompt; + p->cjs.alt_full_continuation = NULL; p->cjs.num_vals = 1; p->cjs.val = (Scheme_Object *)c; p->cjs.is_escape = 1; @@ -8963,7 +8971,7 @@ Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Sc } } -void scheme_escape_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands) +void scheme_escape_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands, Scheme_Object *alt_full) { Scheme_Thread *p = scheme_current_thread; Scheme_Object *value; @@ -8994,6 +9002,7 @@ void scheme_escape_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Obj p->cjs.val = value; p->cjs.jumping_to_continuation = obj; + p->cjs.alt_full_continuation = alt_full; scheme_longjmp(MZTHREADELEM(p, error_buf), 1); } @@ -9466,7 +9475,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands, v = scheme_jump_to_continuation(obj, num_rands, rands, old_runstack); } else if (type == scheme_escaping_cont_type) { UPDATE_THREAD_RSPTR(); - scheme_escape_to_continuation(obj, num_rands, rands); + scheme_escape_to_continuation(obj, num_rands, rands, NULL); return NULL; } else if (type == scheme_proc_struct_type) { int is_method; diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index 831678f807..b0a584265b 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -104,6 +104,7 @@ READ_ONLY static Scheme_Prompt *original_default_prompt; /* for escapes, represe READ_ONLY static Scheme_Object *call_with_prompt_proc; READ_ONLY static Scheme_Object *abort_continuation_proc; READ_ONLY static Scheme_Object *internal_call_cc_prim; +READ_ONLY static Scheme_Object *finish_call_cc_prim; /* Caches need to be thread-local: */ THREAD_LOCAL_DECL(static Scheme_Prompt *available_prompt); @@ -132,6 +133,7 @@ static Scheme_Object *andmap (int argc, Scheme_Object *argv[]); static Scheme_Object *ormap (int argc, Scheme_Object *argv[]); static Scheme_Object *call_cc (int argc, Scheme_Object *argv[]); static Scheme_Object *internal_call_cc (int argc, Scheme_Object *argv[]); +static Scheme_Object *finish_call_cc (int argc, Scheme_Object *argv[]); static Scheme_Object *continuation_p (int argc, Scheme_Object *argv[]); static Scheme_Object *call_with_continuation_barrier (int argc, Scheme_Object *argv[]); static Scheme_Object *call_with_prompt (int argc, Scheme_Object *argv[]); @@ -292,6 +294,11 @@ scheme_init_fun (Scheme_Env *env) "call-with-current-continuation", 1, 3, 0, -1); + REGISTER_SO(finish_call_cc_prim); + finish_call_cc_prim = scheme_make_prim_w_arity2(finish_call_cc, + "finish-call-with-current-continuation", + 2, 2, + 0, -1); o = scheme_make_prim_w_arity2(call_cc, "call-with-current-continuation", @@ -4467,6 +4474,7 @@ void scheme_detach_multple_array(Scheme_Object **values) static void reset_cjs(Scheme_Continuation_Jump_State *a) { a->jumping_to_continuation = NULL; + a->alt_full_continuation = NULL; a->val = NULL; a->num_vals = 0; a->is_kill = 0; @@ -4484,6 +4492,7 @@ void scheme_clear_escape(void) static void copy_cjs(Scheme_Continuation_Jump_State *a, Scheme_Continuation_Jump_State *b) { a->jumping_to_continuation = b->jumping_to_continuation; + a->alt_full_continuation = b->alt_full_continuation; a->val = b->val; a->num_vals = b->num_vals; a->is_kill = b->is_kill; @@ -4491,7 +4500,7 @@ static void copy_cjs(Scheme_Continuation_Jump_State *a, Scheme_Continuation_Jump } Scheme_Object * -scheme_call_ec (int argc, Scheme_Object *argv[]) +do_call_ec (int argc, Scheme_Object *argv[], Scheme_Object *_for_cc) { mz_jmp_buf newbuf; Scheme_Escaping_Cont * volatile cont; @@ -4500,9 +4509,7 @@ scheme_call_ec (int argc, Scheme_Object *argv[]) Scheme_Object *a[1]; Scheme_Cont_Frame_Data cframe; Scheme_Prompt *barrier_prompt; - - scheme_check_proc_arity("call-with-escape-continuation", 1, - 0, argc, argv); + Scheme_Object * volatile for_cc = _for_cc; cont = MALLOC_ONE_TAGGED(Scheme_Escaping_Cont); cont->so.type = scheme_escaping_cont_type; @@ -4518,7 +4525,8 @@ scheme_call_ec (int argc, Scheme_Object *argv[]) scheme_prompt_capture_count++; - scheme_push_continuation_frame(&cframe); + if (!for_cc) + scheme_push_continuation_frame(&cframe); scheme_set_cont_mark((Scheme_Object *)cont, scheme_true); if (scheme_setjmp(newbuf)) { @@ -4535,6 +4543,12 @@ scheme_call_ec (int argc, Scheme_Object *argv[]) } else { scheme_longjmp(*cont->saveerr, 1); } + } else if (for_cc) { + ((Scheme_Cont *)for_cc)->escape_cont = (Scheme_Object *)cont; + a[0] = (Scheme_Object *)for_cc; + MZ_CONT_MARK_POS -= 2; + v = _scheme_apply_multi(argv[0], 1, a); + MZ_CONT_MARK_POS += 2; } else { a[0] = (Scheme_Object *)cont; v = _scheme_apply_multi(argv[0], 1, a); @@ -4543,11 +4557,21 @@ scheme_call_ec (int argc, Scheme_Object *argv[]) p1 = scheme_current_thread; p1->error_buf = cont->saveerr; - scheme_pop_continuation_frame(&cframe); + if (!for_cc) + scheme_pop_continuation_frame(&cframe); return v; } +Scheme_Object * +scheme_call_ec (int argc, Scheme_Object *argv[]) +{ + scheme_check_proc_arity("call-with-escape-continuation", 1, + 0, argc, argv); + + return do_call_ec(argc, argv, NULL); +} + int scheme_escape_continuation_ok(Scheme_Object *ec) { Scheme_Escaping_Cont *cont = (Scheme_Escaping_Cont *)ec; @@ -6038,6 +6062,8 @@ internal_call_cc (int argc, Scheme_Object *argv[]) cont->buf.cont = sub_cont; sub_cont = sub_cont->buf.cont; + cont->escape_cont = sub_cont->escape_cont; + /* This mark stack won't be restored, but it may be used by `continuation-marks'. */ cont->ss.cont_mark_stack = MZ_CONT_MARK_STACK; @@ -6161,15 +6187,29 @@ internal_call_cc (int argc, Scheme_Object *argv[]) scheme_check_break_now(); return result; - } else { + } else if (composable) { Scheme_Object *argv2[1]; argv2[0] = (Scheme_Object *)cont; ret = _scheme_tail_apply(argv[0], 1, argv2); return ret; + } else { + Scheme_Object *argv2[2]; + + argv2[0] = argv[0]; + argv2[1] = (Scheme_Object *)cont; + + ret = _scheme_tail_apply(finish_call_cc_prim, 2, argv2); + return ret; } } +static Scheme_Object * +finish_call_cc (int argc, Scheme_Object *argv[]) +{ + return do_call_ec(1, argv, argv[1]); +} + static Scheme_Object *continuation_p (int argc, Scheme_Object *argv[]) { return ((SCHEME_CONTP(argv[0]) || SCHEME_ECONTP(argv[0])) @@ -7052,6 +7092,7 @@ Scheme_Object *scheme_compose_continuation(Scheme_Cont *cont, int num_rands, Sch } p->cjs.jumping_to_continuation = cm_info; /* vector => trampoline */ + p->cjs.alt_full_continuation = NULL; p->cjs.val = (Scheme_Object *)cont; p->cjs.num_vals = 1; p->cjs.is_escape = 1; @@ -7124,6 +7165,7 @@ static Scheme_Object *abort_continuation (int argc, Scheme_Object *argv[]) p->cjs.val = (Scheme_Object *)vals; } p->cjs.jumping_to_continuation = (Scheme_Object *)prompt; + p->cjs.alt_full_continuation = NULL; scheme_longjmp(*p->error_buf, 1); @@ -8336,6 +8378,18 @@ Scheme_Object *scheme_dynamic_wind(void (*pre)(void *), p->cjs.jumping_to_continuation = (Scheme_Object *)prompt; } else if (SCHEME_ECONTP(p->cjs.jumping_to_continuation)) { if (!scheme_escape_continuation_ok(p->cjs.jumping_to_continuation)) { + if (p->cjs.alt_full_continuation) { + /* We were trying to execute a full-continuation jump through + an escape-continuation jump. Go back to full-jump mode. */ + Scheme_Object *a[1], **args, *fc; + a[0] = p->cjs.val; + fc = p->cjs.alt_full_continuation; + args = ((p->cjs.num_vals == 1) ? a : (Scheme_Object **)p->cjs.val); + p->cjs.jumping_to_continuation = NULL; + p->cjs.alt_full_continuation = NULL; + p->cjs.val = NULL; + return scheme_jump_to_continuation(fc, p->cjs.num_vals, args, NULL); + } scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, "jump to escape continuation in progress," " but the target is not in the current continuation" diff --git a/src/racket/src/mzmark.c b/src/racket/src/mzmark.c index 507b8ef240..dbb8109aee 100644 --- a/src/racket/src/mzmark.c +++ b/src/racket/src/mzmark.c @@ -918,6 +918,8 @@ static int cont_proc_MARK(void *p, struct NewGC *gc) { gcMARK2(c->prompt_id, gc); gcMARK2(c->prompt_buf, gc); + gcMARK2(c->escape_cont, gc); + gcMARK2(c->value, gc); gcMARK2(c->resume_to, gc); gcMARK2(c->use_next_cont, gc); @@ -958,6 +960,8 @@ static int cont_proc_FIXUP(void *p, struct NewGC *gc) { gcFIXUP2(c->prompt_id, gc); gcFIXUP2(c->prompt_buf, gc); + gcFIXUP2(c->escape_cont, gc); + gcFIXUP2(c->value, gc); gcFIXUP2(c->resume_to, gc); gcFIXUP2(c->use_next_cont, gc); diff --git a/src/racket/src/mzmarksrc.c b/src/racket/src/mzmarksrc.c index a717b387f1..e19cea5e9f 100644 --- a/src/racket/src/mzmarksrc.c +++ b/src/racket/src/mzmarksrc.c @@ -360,6 +360,8 @@ cont_proc { gcMARK2(c->prompt_id, gc); gcMARK2(c->prompt_buf, gc); + gcMARK2(c->escape_cont, gc); + gcMARK2(c->value, gc); gcMARK2(c->resume_to, gc); gcMARK2(c->use_next_cont, gc); diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index c005b032c5..c4eb4e113e 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -1341,6 +1341,8 @@ typedef struct Scheme_Cont { struct Scheme_Overflow *save_overflow; mz_jmp_buf *savebuf; /* save old error buffer here */ + Scheme_Object *escape_cont; + /* Arguments passed to a continuation invocation to the continuation restorer: */ Scheme_Object *value; /* argument(s) to continuation */ struct Scheme_Overflow *resume_to; /* meta-continuation return */ @@ -1471,6 +1473,8 @@ void scheme_about_to_move_C_stack(void); Scheme_Object *scheme_apply_multi_with_dynamic_state(Scheme_Object *rator, int num_rands, Scheme_Object **rands, Scheme_Dynamic_State *dyn_state); +Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands, Scheme_Object **old_runstack); + /*========================================================================*/ /* semaphores and locks */ /*========================================================================*/ diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index f96e0bfbaa..ecd8c95588 100644 --- a/src/racket/src/thread.c +++ b/src/racket/src/thread.c @@ -3269,6 +3269,7 @@ static Scheme_Object *def_nested_exn_handler(int argc, Scheme_Object *argv[]) if (scheme_current_thread->nester) { Scheme_Thread *p = scheme_current_thread; p->cjs.jumping_to_continuation = (Scheme_Object *)scheme_current_thread; + p->cjs.alt_full_continuation = NULL; p->cjs.val = argv[0]; p->cjs.is_kill = 0; scheme_longjmp(*p->error_buf, 1); @@ -3872,6 +3873,7 @@ static void exit_or_escape(Scheme_Thread *p) if (p->running & MZTHREAD_KILLED) p->running -= MZTHREAD_KILLED; p->cjs.jumping_to_continuation = (Scheme_Object *)p; + p->cjs.alt_full_continuation = NULL; p->cjs.is_kill = 1; scheme_longjmp(*p->error_buf, 1); } diff --git a/src/racket/src/type.c b/src/racket/src/type.c index 2c4478d8bf..a13fc29bad 100644 --- a/src/racket/src/type.c +++ b/src/racket/src/type.c @@ -424,12 +424,14 @@ static int bad_trav_FIXUP(void *p, struct NewGC *gc) static void MARK_cjs(Scheme_Continuation_Jump_State *cjs, struct NewGC *gc) { gcMARK2(cjs->jumping_to_continuation, gc); + gcMARK2(cjs->alt_full_continuation, gc); gcMARK2(cjs->val, gc); } static void FIXUP_cjs(Scheme_Continuation_Jump_State *cjs, struct NewGC *gc) { gcFIXUP2(cjs->jumping_to_continuation, gc); + gcFIXUP2(cjs->alt_full_continuation, gc); gcFIXUP2(cjs->val, gc); }