diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index d2a983ef02..dfeb9a4562 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "7.6.0.16") +(define version "7.6.0.17") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/reference/cont.scrbl b/pkgs/racket-doc/scribblings/reference/cont.scrbl index 2c789f4972..277fae7064 100644 --- a/pkgs/racket-doc/scribblings/reference/cont.scrbl +++ b/pkgs/racket-doc/scribblings/reference/cont.scrbl @@ -199,6 +199,46 @@ for @racket[call/cc] to improve performance.} The @racket[call/ec] binding is an alias for @racket[call-with-escape-continuation]. } +@defproc[(call-in-continuation [k continuation?] + [proc (-> any)]) + any]{ + +Similar to applying the continuation @racket[k], but instead of +delivering values to the continuation, @racket[proc] is called with +@racket[k] as the continuation of the call (so the result of +@racket[proc] is returned to the continuation). If @racket[k] +is a composable continuation, the continuation of the call to +@racket[proc] is the current continuation extended with @racket[k]. + +@mz-examples[ +(+ 1 + (call/cc (lambda (k) + (call-in-continuation k (lambda () 4))))) +(+ 1 + (call/cc (lambda (k) + (let ([n 0]) + (dynamic-wind + void + (lambda () + (code:comment @#,elem{@racket[n] accessed after post thunk}) + (call-in-continuation k (lambda () n))) + (lambda () + (set! n 4))))))) +(+ 1 + (with-continuation-mark + 'n 4 + (call/cc (lambda (k) + (with-continuation-mark + 'n 0 + (call-in-continuation + k + (lambda () + (code:comment @#,elem{@racket['n] mark accessed in continuation}) + (continuation-mark-set-first #f 'n)))))))) +] + +@history[#:added "7.6.0.17"]} + @defform[(let/cc k body ...+)]{ Equivalent to @racket[(call/cc (lambda (k) body ...))]. } diff --git a/pkgs/racket-test-core/tests/racket/prompt-tests.rktl b/pkgs/racket-test-core/tests/racket/prompt-tests.rktl index 36253adc33..7498aa038c 100644 --- a/pkgs/racket-test-core/tests/racket/prompt-tests.rktl +++ b/pkgs/racket-test-core/tests/racket/prompt-tests.rktl @@ -2424,3 +2424,169 @@ (compose-continuations c1 c1)) tag) 'test))) + +;; ---------------------------------------- + +(test '(outer) + 'call-in-cont + (with-continuation-mark + 'k 'outer + (call/cc + (lambda (k) + (values + (with-continuation-mark + 'k 'inner + (call-in-continuation + k + (lambda () + (continuation-mark-set->list + (current-continuation-marks) + 'k))))))))) + +(test '(outer) + 'call-in-cont/ec + (with-continuation-mark + 'k 'outer + (call/ec + (lambda (k) + (values + (with-continuation-mark + 'k 'inner + (call-in-continuation + k + (lambda () + (continuation-mark-set->list + (current-continuation-marks) + 'k))))))))) + +(test '(outer) + 'call-in-cont + (with-continuation-mark + 'k 'outer + (call/cc + (lambda (k) + (with-continuation-mark + 'k 'outer2 + (call-in-continuation + k + (lambda () + (continuation-mark-set->list + (current-continuation-marks) + 'k)))))))) + +(test '(outer) + 'call-in-cont + (with-continuation-mark + 'k 'outer + (call/cc + (lambda (k) + (with-continuation-mark + 'k 'outer2 + (values + (with-continuation-mark + 'k 'inner + (call-in-continuation + k + (lambda () + (continuation-mark-set->list + (current-continuation-marks) + 'k)))))))))) + +(test '(outer3) + 'call-in-cont + (with-continuation-mark + 'k 'outer + (call/cc + (lambda (k) + (call-in-continuation + k + (lambda () + (with-continuation-mark + 'k 'outer3 + (continuation-mark-set->list + (current-continuation-marks) + 'k)))))))) + +(test '(post pre) + 'call-in-cont/dw + (let ([did '()]) + (call/cc + (lambda (k) + (dynamic-wind + (lambda () (set! did (cons 'pre did))) + (lambda () + (call-in-continuation + k + (lambda () did))) + (lambda () (set! did (cons 'post did)))))))) + +(test '(pre post2 pre2 post pre) + 'call-in-cont/dw + (let ([did '()]) + (let ([k (dynamic-wind + (lambda () (set! did (cons 'pre did))) + (lambda () + (call/cc + (lambda (k) + k))) + (lambda () (set! did (cons 'post did))))]) + (if (procedure? k) + (dynamic-wind + (lambda () (set! did (cons 'pre2 did))) + (lambda () + (call-in-continuation + k + (lambda () did))) + (lambda () (set! did (cons 'post2 did)))) + k)))) + +(test '(y (x orig)) + 'call-in-cont/comp + (let ([k (call-with-continuation-prompt + (lambda () + (with-continuation-mark + 'here 'orig + (list 'x (call-with-composable-continuation + (lambda (k) + (abort-current-continuation + (default-continuation-prompt-tag) + (lambda () k))))))))]) + (with-continuation-mark + 'here 'later + (list 'y (call-in-continuation k (lambda () + (continuation-mark-set-first #f 'here))))))) + +(test '(y (x orig)) + 'call-in-cont/comp + (let ([k (call-with-continuation-prompt + (lambda () + (with-continuation-mark + 'here 'orig + (list 'x (call-with-composable-continuation + (lambda (k) + (abort-current-continuation + (default-continuation-prompt-tag) + (lambda () k))))))))]) + (call-with-continuation-prompt + (lambda () + (with-continuation-mark + 'here 'later + (list 'y (call-in-continuation k (lambda () + (continuation-mark-set-first #f 'here))))))))) + +(test '((y (x orig))) + 'call-in-cont/comp + (let ([k (call-with-continuation-prompt + (lambda () + (with-continuation-mark + 'here 'orig + (list 'x (call-with-composable-continuation + (lambda (k) + (abort-current-continuation + (default-continuation-prompt-tag) + (lambda () k))))))))]) + (with-continuation-mark + 'here 'later + (list + (list 'y (call-in-continuation k (lambda () + (continuation-mark-set-first #f 'here)))))))) diff --git a/racket/src/cs/chezpart.sls b/racket/src/cs/chezpart.sls index a963fbfaf9..3a5a306e14 100644 --- a/racket/src/cs/chezpart.sls +++ b/racket/src/cs/chezpart.sls @@ -27,6 +27,7 @@ date? make-date dynamic-wind call-with-current-continuation + call-in-continuation make-engine engine-block engine-return current-eval load sleep thread? buffer-mode? diff --git a/racket/src/cs/primitive/kernel.ss b/racket/src/cs/primitive/kernel.ss index 6e37991e26..c0a4587448 100644 --- a/racket/src/cs/primitive/kernel.ss +++ b/racket/src/cs/primitive/kernel.ss @@ -96,6 +96,7 @@ [cadddr (known-procedure/no-prompt 2)] [caddr (known-procedure/no-prompt 2)] [cadr (known-procedure/no-prompt 2)] + [call-in-continuation (known-procedure 4)] [call-in-nested-thread (known-procedure 6)] [call-with-composable-continuation (known-procedure 6)] [call-with-continuation-barrier (known-procedure 2)] diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls index 5c69427f1b..d0943dfdc9 100644 --- a/racket/src/cs/rumble.sls +++ b/racket/src/cs/rumble.sls @@ -11,6 +11,7 @@ call-with-current-continuation call-with-composable-continuation call-with-escape-continuation + call-in-continuation continuation? make-continuation-prompt-tag diff --git a/racket/src/cs/rumble/control.ss b/racket/src/cs/rumble/control.ss index c191a0c6d2..aa0c7c147c 100644 --- a/racket/src/cs/rumble/control.ss +++ b/racket/src/cs/rumble/control.ss @@ -51,7 +51,7 @@ ;; metacontinuation frames between the abort and prompt are removed ;; one-by-one, running any winders in each frame. Finally, the ;; `resume-k` continuation of the target prompt's metacontinuation is -;; called; the `resume-k` is called using `call-in-continuation` to +;; called; the `resume-k` is called using `#%call-in-continuation` to ;; run a thunk in the restored continuation to apply the prompt's ;; handler. ;; @@ -199,27 +199,30 @@ (define (maybe-future-barricade tag) (when (current-future) - (let ([fp (strip-impersonator (current-future-prompt))] - [tag (strip-impersonator tag)]) - (cond - [(eq? fp tag) - ;; shortcut: boundary is the future prompt - (void)] - [(eq? tag the-root-continuation-prompt-tag) - (block-future)] - [else - (let loop ([mc (current-metacontinuation)]) - (cond - [(null? mc) - ;; Won't happen normally, since every thread starts with a explicit prompt - (block-future)] - [(eq? tag (strip-impersonator (metacontinuation-frame-tag (car mc)))) - (void)] - [(eq? (metacontinuation-frame-tag (car mc)) fp) - ;; tag must be above future prompt - (block-future)] - [else - (loop (cdr mc))]))])))) + (#%$app/no-inline future-barricade tag))) + +(define (future-barricade tag) + (let ([fp (strip-impersonator (current-future-prompt))] + [tag (strip-impersonator tag)]) + (cond + [(eq? fp tag) + ;; shortcut: boundary is the future prompt + (void)] + [(eq? tag the-root-continuation-prompt-tag) + (block-future)] + [else + (let loop ([mc (current-metacontinuation)]) + (cond + [(null? mc) + ;; Won't happen normally, since every thread starts with a explicit prompt + (block-future)] + [(eq? tag (strip-impersonator (metacontinuation-frame-tag (car mc)))) + (void)] + [(eq? (metacontinuation-frame-tag (car mc)) fp) + ;; tag must be above future prompt + (block-future)] + [else + (loop (cdr mc))]))]))) (define/who call-with-continuation-prompt (case-lambda @@ -268,8 +271,8 @@ (assert-not-in-system-wind) (call/cc (lambda (resume-k) - (let ([marks (current-mark-stack)]) ; grab marks before `call-in-continuation` - (call-in-continuation + (let ([marks (current-mark-stack)]) ; grab marks before `#%call-in-continuation` + (#%call-in-continuation #%$null-continuation '() (lambda () @@ -302,7 +305,7 @@ [else (start-uninterrupted 'resume-mc) (let ([mf (pop-metacontinuation-frame)]) - (call-in-continuation + (#%call-in-continuation (metacontinuation-frame-resume-k mf) (metacontinuation-frame-marks mf) (lambda () @@ -324,7 +327,7 @@ (call/cc (lambda (resume-k) (let ([marks (current-mark-stack)]) - (call-in-continuation + (#%call-in-continuation #%$null-continuation '() (lambda () @@ -343,7 +346,7 @@ (current-metacontinuation (cons mf (current-metacontinuation))) (let ([r (proc (current-metacontinuation))]) (let ([mf (pop-metacontinuation-frame)]) - (call-in-continuation + (#%call-in-continuation (metacontinuation-frame-resume-k mf) (metacontinuation-frame-marks mf) (lambda () r))))))))))) @@ -411,6 +414,8 @@ [tag (strip-impersonator tag)]) (do-abort-current-continuation who tag args #f))) +;; `args` can be a thunk if `do-abort-current-continuation` is +;; called via `apply-continuation` (define (do-abort-current-continuation who tag args wind?) (assert-in-uninterrupted) (cond @@ -425,13 +430,15 @@ ;; Remove the prompt and resume its continuation ;; as we call the handler: (let ([mf (pop-metacontinuation-frame)]) - (call-in-continuation + (#%call-in-continuation (metacontinuation-frame-resume-k mf) (metacontinuation-frame-marks mf) (lambda () (end-uninterrupted/call-hook 'handle) - (apply (metacontinuation-frame-handler mf) - args))))] + (if (#%procedure? args) + (args) ; assuming that handler is `values` + (apply (metacontinuation-frame-handler mf) + args)))))] [else ;; Aborting to an enclosing prompt, so keep going: (pop-metacontinuation-frame) @@ -538,6 +545,17 @@ tag values))) +(define/who (call-in-continuation c proc) + (check who continuation? c) + (cond + [(and (#%procedure? proc) + (chez:procedure-arity-includes? proc 0)) + (apply-continuation c proc)] + [else + (check who (procedure-arity-includes/c 0) proc) + (apply-continuation c (lambda () (proc)))])) + +;; `args` is either a list or a procedure for which `#%procedure?` is true (define (apply-continuation c args) (cond [(composable-continuation? c) @@ -569,7 +587,10 @@ (eq? (car marks) 'empty))))) ;; Shortcut for no winds and no change to break status: (end-uninterrupted 'cc) - (#%apply (full-continuation-k c) args)] + (if (#%procedure? args) + (#%call-in-continuation (full-continuation-k c) (full-continuation-mark-stack c) + (lambda () (args))) + (#%apply (full-continuation-k c) args))] [(not (composable-continuation-wind? c)) (apply-immediate-continuation/no-wind c args)] [else @@ -608,7 +629,10 @@ ;; changes or changes to marks (so no break-enabled changes), ;; and no tag impersonators to deal with (end-uninterrupted 'cc) - (#%apply (full-continuation-k c) args)] + (if (#%procedure? args) + (#%call-in-continuation (full-continuation-k c) (full-continuation-mark-stack c) + (lambda () (args))) + (#%apply (full-continuation-k c) args))] [else (let-values ([(common-mc ; shared part of the current metacontinuation rmc-append) ; non-shared part of the destination metacontinuation @@ -659,7 +683,7 @@ (activate-and-wrap-cc-guard-for-impersonator! (full-continuation-tag c))) (end-uninterrupted 'cc) - (apply-with-break-transition (full-continuation-k c) args)) + (apply-with-break-transition (full-continuation-k c) mark-stack args)) ;; If a winder changed the meta-continuation, try again for a ;; non-composable continuation: (and (non-composable-continuation? c) @@ -674,7 +698,7 @@ (current-winders (full-continuation-winders c)) (current-mark-splice (full-continuation-mark-splice c)) (end-uninterrupted 'cc) - (apply-with-break-transition (full-continuation-k c) args)) + (apply-with-break-transition (full-continuation-k c) (full-continuation-mark-stack c) args)) ;; Used as a "handler" for a prompt without a tag, which is used for ;; composable continuations @@ -1885,7 +1909,7 @@ [winders (cdr winders)]) (current-winders winders) (let ([thunk (winder-thunk winder)]) - (call-in-continuation + (#%call-in-continuation (winder-k winder) (winder-marks winder) (lambda () @@ -1963,15 +1987,15 @@ (define (set-break-enabled-transition-hook! proc) (set! break-enabled-transition-hook proc)) -(define (apply-with-break-transition k args) - ;; Install attachments of `k` before calling - ;; `break-enabled-transition-hook`. Technically, the hook is called - ;; with the wrong Scheme continuation, which might keep the - ;; continuation live longer than it should. But the hook can't see - ;; the difference, and its only options are to return or escape. - (current-mark-stack (continuation-next-attachments k)) - (break-enabled-transition-hook) - (#%apply k args)) +(define (apply-with-break-transition k all-marks args) + (#%call-in-continuation + k + all-marks + (lambda () + (break-enabled-transition-hook) + (if (#%procedure? args) + (args) + (#%apply values args))))) ;; ---------------------------------------- ;; Metacontinuation swapping for engines diff --git a/racket/src/racket/src/fun.c b/racket/src/racket/src/fun.c index 71dfc7b570..c89aea0af0 100644 --- a/racket/src/racket/src/fun.c +++ b/racket/src/racket/src/fun.c @@ -83,6 +83,7 @@ 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 *call_in_continuation (int argc, Scheme_Object *argv[]); static Scheme_Object *propagate_abort (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[]); @@ -291,6 +292,13 @@ scheme_init_fun (Scheme_Startup_Env *env) scheme_addto_prim_instance("call-with-current-continuation", o, env); + scheme_addto_prim_instance("call-with-composable-continuation", + scheme_make_prim_w_arity2(call_with_control, + "call-with-composable-continuation", + 1, 2, + 0, -1), + env); + scheme_addto_prim_instance("continuation?", scheme_make_folding_prim(continuation_p, "continuation?", @@ -313,11 +321,11 @@ scheme_init_fun (Scheme_Startup_Env *env) call_with_prompt_proc, env); - scheme_addto_prim_instance("call-with-composable-continuation", - scheme_make_prim_w_arity2(call_with_control, - "call-with-composable-continuation", - 1, 2, - 0, -1), + scheme_addto_prim_instance("call-in-continuation", + scheme_make_prim_w_arity2(call_in_continuation, + "call-in-continuation", + 2, 2, + 0, -1), env); REGISTER_SO(abort_continuation_proc); @@ -4314,6 +4322,8 @@ do_call_ec (int argc, Scheme_Object *argv[], Scheme_Object *_for_cc) scheme_check_break_now(); if (n != 1) v = scheme_values(n, (Scheme_Object **)v); + else if (v && SAME_TYPE(SCHEME_TYPE(v), scheme_thunk_for_continue_type)) + v = _scheme_apply_multi(SCHEME_PTR_VAL(v), 0, NULL); } else { scheme_longjmp(*cont->saveerr, 1); } @@ -6221,8 +6231,12 @@ internal_call_cc (int argc, Scheme_Object *argv[]) get_set_cont_mark_by_pos(prompt_cc_guard_key, p, mc, pos, cc_guard); } } - - return result; + + if ((result != SCHEME_MULTIPLE_VALUES) + && SAME_TYPE(SCHEME_TYPE(result), scheme_thunk_for_continue_type)) + return _scheme_tail_apply(SCHEME_PTR_VAL(result), 0, NULL); + else + return result; } else if (composable || cont->escape_cont) { Scheme_Object *argv2[1]; @@ -6249,6 +6263,35 @@ finish_call_cc (int argc, Scheme_Object *argv[]) return do_call_ec(1, argv, argv[1]); } +static Scheme_Object *call_in_continuation (int argc, Scheme_Object *argv[]) +{ + Scheme_Object *k = argv[0], *p, *a[1]; + + if (!SCHEME_CONTP(k) && !SCHEME_ECONTP(k)) + scheme_wrong_contract("call-in-continuation", "continuation?", 0, argc, argv); + + scheme_check_proc_arity("call-in-continuation", 0, 1, argc, argv); + + /* Instead of allocating, we chould thread a flag through to say + that the value in `argv` should be applied instead of returned. + But we're not likely to notice the cost of this allocation, + anyway. */ + p = scheme_alloc_small_object(); + p->type = scheme_thunk_for_continue_type; + SCHEME_PTR_VAL(p) = argv[1]; + + a[0] = p; + + if (SCHEME_CONTP(k)) { + /* We can use escape mode only if coontinuation marks didn't change. */ + int can_escape = 0; + return scheme_jump_to_continuation(k, 1, a, MZ_RUNSTACK, can_escape); + } else { + scheme_escape_to_continuation(k, 1, a, NULL); + return NULL; + } +} + static Scheme_Object *continuation_p (int argc, Scheme_Object *argv[]) { return ((SCHEME_CONTP(argv[0]) || SCHEME_ECONTP(argv[0])) diff --git a/racket/src/racket/src/schminc.h b/racket/src/racket/src/schminc.h index 741c8752f6..74b47a1c37 100644 --- a/racket/src/racket/src/schminc.h +++ b/racket/src/racket/src/schminc.h @@ -14,7 +14,7 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 1465 +#define EXPECTED_PRIM_COUNT 1466 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 152d77f40a..73259adb66 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -2026,6 +2026,7 @@ void scheme_about_to_move_C_stack(void); Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands, Scheme_Object **old_runstack, int can_ec); +void scheme_escape_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands, Scheme_Object *alt_full); Scheme_Object *scheme_chaperone_do_continuation_mark(const char *name, int is_get, Scheme_Object *key, Scheme_Object *val); diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 653916bb4c..d5b1f0eb11 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 6 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 16 +#define MZSCHEME_VERSION_W 17 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x diff --git a/racket/src/racket/src/stypes.h b/racket/src/racket/src/stypes.h index dbb5c94895..ad8fe49787 100644 --- a/racket/src/racket/src/stypes.h +++ b/racket/src/racket/src/stypes.h @@ -220,80 +220,81 @@ enum { scheme_deferred_expr_type, /* 183 */ scheme_unquoted_printing_string_type, /* 184 */ scheme_will_be_lambda_type, /* 185 */ + scheme_thunk_for_continue_type, /* 186 */ #ifdef MZTAG_REQUIRED - _scheme_last_normal_type_, /* 186 */ + _scheme_last_normal_type_, /* 187 */ /* The remaining tags exist for GC tracing (in non-conservative mode), but they are not needed for run-time tag tests */ - scheme_rt_weak_array, /* 187 */ + scheme_rt_weak_array, /* 188 */ - scheme_rt_comp_env, /* 188 */ - scheme_rt_constant_binding, /* 189 */ - scheme_rt_resolve_info, /* 190 */ - scheme_rt_unresolve_info, /* 191 */ - scheme_rt_optimize_info, /* 192 */ - scheme_rt_cont_mark, /* 193 */ - scheme_rt_saved_stack, /* 194 */ - scheme_rt_reply_item, /* 195 */ - scheme_rt_ir_lambda_info, /* 196 */ - scheme_rt_overflow, /* 197 */ - scheme_rt_overflow_jmp, /* 198 */ - scheme_rt_meta_cont, /* 199 */ - scheme_rt_dyn_wind_cell, /* 200 */ - scheme_rt_dyn_wind_info, /* 201 */ - scheme_rt_dyn_wind, /* 202 */ - scheme_rt_dup_check, /* 203 */ - scheme_rt_thread_memory, /* 204 */ - scheme_rt_input_file, /* 205 */ - scheme_rt_input_fd, /* 206 */ - scheme_rt_oskit_console_input, /* 207 */ - scheme_rt_tested_input_file, /* 208 */ - scheme_rt_tested_output_file, /* 209 */ - scheme_rt_indexed_string, /* 210 */ - scheme_rt_output_file, /* 211 */ - scheme_rt_pipe, /* 212 */ - scheme_rt_system_child, /* 213 */ - scheme_rt_tcp, /* 214 */ - scheme_rt_write_data, /* 215 */ - scheme_rt_tcp_select_info, /* 216 */ - scheme_rt_param_data, /* 217 */ - scheme_rt_will, /* 218 */ - scheme_rt_finalization, /* 219 */ - scheme_rt_finalizations, /* 220 */ - scheme_rt_cpp_object, /* 221 */ - scheme_rt_cpp_array_object, /* 222 */ - scheme_rt_stack_object, /* 223 */ - scheme_thread_hop_type, /* 224 */ - scheme_rt_srcloc, /* 225 */ - scheme_rt_evt, /* 226 */ - scheme_rt_syncing, /* 227 */ - scheme_rt_comp_prefix, /* 228 */ - scheme_rt_user_input, /* 229 */ - scheme_rt_user_output, /* 230 */ - scheme_rt_compact_port, /* 231 */ - scheme_rt_read_special_dw, /* 232 */ - scheme_rt_regwork, /* 233 */ - scheme_rt_rx_lazy_string, /* 234 */ - scheme_rt_buf_holder, /* 235 */ - scheme_rt_parameterization, /* 236 */ - scheme_rt_print_params, /* 237 */ - scheme_rt_read_params, /* 238 */ - scheme_rt_native_code, /* 239 */ - scheme_rt_native_code_plus_case, /* 240 */ - scheme_rt_jitter_data, /* 241 */ - scheme_rt_module_exports, /* 242 */ - scheme_rt_delay_load_info, /* 243 */ - scheme_rt_marshal_info, /* 244 */ - scheme_rt_unmarshal_info, /* 245 */ - scheme_rt_runstack, /* 246 */ - scheme_rt_sfs_info, /* 247 */ - scheme_rt_validate_clearing, /* 248 */ - scheme_rt_lightweight_cont, /* 249 */ - scheme_rt_export_info, /* 250 */ - scheme_rt_cont_jmp, /* 251 */ - scheme_rt_letrec_check_frame, /* 252 */ + scheme_rt_comp_env, /* 189 */ + scheme_rt_constant_binding, /* 190 */ + scheme_rt_resolve_info, /* 191 */ + scheme_rt_unresolve_info, /* 192 */ + scheme_rt_optimize_info, /* 193 */ + scheme_rt_cont_mark, /* 194 */ + scheme_rt_saved_stack, /* 195 */ + scheme_rt_reply_item, /* 196 */ + scheme_rt_ir_lambda_info, /* 197 */ + scheme_rt_overflow, /* 198 */ + scheme_rt_overflow_jmp, /* 199 */ + scheme_rt_meta_cont, /* 200 */ + scheme_rt_dyn_wind_cell, /* 201 */ + scheme_rt_dyn_wind_info, /* 202 */ + scheme_rt_dyn_wind, /* 203 */ + scheme_rt_dup_check, /* 204 */ + scheme_rt_thread_memory, /* 205 */ + scheme_rt_input_file, /* 206 */ + scheme_rt_input_fd, /* 207 */ + scheme_rt_oskit_console_input, /* 208 */ + scheme_rt_tested_input_file, /* 209 */ + scheme_rt_tested_output_file, /* 210 */ + scheme_rt_indexed_string, /* 211 */ + scheme_rt_output_file, /* 212 */ + scheme_rt_pipe, /* 213 */ + scheme_rt_system_child, /* 214 */ + scheme_rt_tcp, /* 215 */ + scheme_rt_write_data, /* 216 */ + scheme_rt_tcp_select_info, /* 217 */ + scheme_rt_param_data, /* 218 */ + scheme_rt_will, /* 219 */ + scheme_rt_finalization, /* 220 */ + scheme_rt_finalizations, /* 221 */ + scheme_rt_cpp_object, /* 222 */ + scheme_rt_cpp_array_object, /* 223 */ + scheme_rt_stack_object, /* 224 */ + scheme_thread_hop_type, /* 225 */ + scheme_rt_srcloc, /* 226 */ + scheme_rt_evt, /* 227 */ + scheme_rt_syncing, /* 228 */ + scheme_rt_comp_prefix, /* 229 */ + scheme_rt_user_input, /* 230 */ + scheme_rt_user_output, /* 231 */ + scheme_rt_compact_port, /* 232 */ + scheme_rt_read_special_dw, /* 233 */ + scheme_rt_regwork, /* 234 */ + scheme_rt_rx_lazy_string, /* 235 */ + scheme_rt_buf_holder, /* 236 */ + scheme_rt_parameterization, /* 237 */ + scheme_rt_print_params, /* 238 */ + scheme_rt_read_params, /* 239 */ + scheme_rt_native_code, /* 240 */ + scheme_rt_native_code_plus_case, /* 241 */ + scheme_rt_jitter_data, /* 242 */ + scheme_rt_module_exports, /* 243 */ + scheme_rt_delay_load_info, /* 244 */ + scheme_rt_marshal_info, /* 245 */ + scheme_rt_unmarshal_info, /* 246 */ + scheme_rt_runstack, /* 247 */ + scheme_rt_sfs_info, /* 248 */ + scheme_rt_validate_clearing, /* 249 */ + scheme_rt_lightweight_cont, /* 250 */ + scheme_rt_export_info, /* 251 */ + scheme_rt_cont_jmp, /* 252 */ + scheme_rt_letrec_check_frame, /* 253 */ #endif _scheme_last_type_ diff --git a/racket/src/racket/src/type.c b/racket/src/racket/src/type.c index 5415917a38..1060917bad 100644 --- a/racket/src/racket/src/type.c +++ b/racket/src/racket/src/type.c @@ -270,6 +270,8 @@ scheme_init_type () set_name(scheme_unquoted_printing_string_type, ""); + set_name(scheme_thunk_for_continue_type, ""); + #ifdef MZ_PRECISE_GC set_name(scheme_rt_runstack, ""); set_name(scheme_rt_meta_cont, ""); @@ -649,6 +651,8 @@ void scheme_register_traversers(void) GC_REG_TRAV(scheme_thread_cell_values_type, small_object); + GC_REG_TRAV(scheme_thunk_for_continue_type, small_object); + GC_REG_TRAV(scheme_global_ref_type, twoptr_obj); GC_REG_TRAV(scheme_delay_syntax_type, small_object);