From 2f7d4b5eafb24e2a5f79b36089743b757d7d5b55 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 5 Sep 2012 12:20:50 -0600 Subject: [PATCH] change a thread's initial prompt to use the default handler The thread's initial prompt previously ignored its arguments. --- collects/scribblings/reference/cont.scrbl | 7 ++- collects/tests/racket/thread.rktl | 15 ++++- doc/release-notes/racket/HISTORY.txt | 2 + src/racket/src/fun.c | 70 +++++++++++++++++------ 4 files changed, 73 insertions(+), 21 deletions(-) diff --git a/collects/scribblings/reference/cont.scrbl b/collects/scribblings/reference/cont.scrbl index 978384492c..e1527e4d1c 100644 --- a/collects/scribblings/reference/cont.scrbl +++ b/collects/scribblings/reference/cont.scrbl @@ -83,7 +83,12 @@ The protocol for @racket[v]s supplied to an abort is specific to the should be supplied that is suitable for use with the default prompt handler. Similarly, when @racket[call-with-continuation-prompt] is used with @racket[(default-continuation-prompt-tag)], the associated -handler should generally accept a single thunk argument.} +handler should generally accept a single thunk argument. + +Each @tech{thread}'s continuation starts with a prompt for +@racket[(default-continuation-prompt-tag)] that uses the default +handler, which accepts a single thunk to apply (with the prompt +intact).} @defproc*[([(make-continuation-prompt-tag) continuation-prompt-tag?] [(make-continuation-prompt-tag [sym symbol?]) continuation-prompt-tag?])]{ diff --git a/collects/tests/racket/thread.rktl b/collects/tests/racket/thread.rktl index 9b8b514774..1f0744802f 100644 --- a/collects/tests/racket/thread.rktl +++ b/collects/tests/racket/thread.rktl @@ -1437,7 +1437,20 @@ [current-logger l]) (raise 'ack)))) (vector-ref (sync r) 1))) - + + +; -------------------- +;; initial prompt uses the default abort handler: + +(let ([v #f]) + (sync + (thread + (lambda () + (abort-current-continuation + (default-continuation-prompt-tag) + (lambda () (set! v "yes")))))) + (test "yes" values v)) + ; -------------------- (report-errs) diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index 7cf67411bf..31f84364ae 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/doc/release-notes/racket/HISTORY.txt @@ -1,4 +1,6 @@ Version 5.3.0.22 +Changed a thread's initial prompt to use the default handler + (instead of accepting and ignoring abort arguments) ffi/unsafe: added cpointer-gcable? racket/class: added dynamic-get-field and dynamic-set-field! diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index 9731701150..68f57cf8c9 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -192,6 +192,7 @@ scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key MZ_MARK_POS_TYPE *_vpos); static Scheme_Object *jump_to_alt_continuation(); +static void reset_cjs(Scheme_Continuation_Jump_State *a); typedef void (*DW_PrePost_Proc)(void *); @@ -1084,6 +1085,24 @@ void scheme_set_dynamic_state(Scheme_Dynamic_State *state, Scheme_Comp_Env *env, state->menv = menv; } +static void *apply_again_k() +{ + Scheme_Thread *p = scheme_current_thread; + Scheme_Object *val = p->ku.k.p1; + int num_vals = p->ku.k.i1; + + p->ku.k.p1 = NULL; + + if (num_vals != 1) { + scheme_wrong_return_arity("call-with-continuation-prompt", 1, num_vals, (Scheme_Object **)val, + "application of default prompt handler"); + return NULL; + } else { + scheme_check_proc_arity("default-continuation-prompt-handler", 0, 0, 1, &val); + return (void *)_scheme_apply(val, 0, NULL); + } +} + void *scheme_top_level_do(void *(*k)(void), int eb) { return scheme_top_level_do_worker(k, eb, 0, NULL); } @@ -1147,33 +1166,46 @@ void *scheme_top_level_do_worker(void *(*k)(void), int eb, int new_thread, Schem save = p->error_buf; p->error_buf = &newbuf; - if (scheme_setjmp(newbuf)) { - if (!new_thread) { + while (1) { + + if (scheme_setjmp(newbuf)) { p = scheme_current_thread; - scheme_restore_env_stack_w_thread(envss, p); + if (SAME_OBJ(p->cjs.jumping_to_continuation, (Scheme_Object *)original_default_prompt)) { + /* an abort to the thread start; act like the default prompt handler */ + p->ku.k.i1 = p->cjs.num_vals; + p->ku.k.p1 = p->cjs.val; + reset_cjs(&p->cjs); + k = apply_again_k; + } else { + if (!new_thread) { + scheme_restore_env_stack_w_thread(envss, p); #ifdef MZ_PRECISE_GC - if (scheme_set_external_stack_val) - scheme_set_external_stack_val(external_stack); + if (scheme_set_external_stack_val) + scheme_set_external_stack_val(external_stack); #endif - if (prompt) { - scheme_pop_continuation_frame(&cframe); - if (old_pcc == scheme_prompt_capture_count) { - /* It wasn't used */ - available_prompt = prompt; + if (prompt) { + scheme_pop_continuation_frame(&cframe); + if (old_pcc == scheme_prompt_capture_count) { + /* It wasn't used */ + available_prompt = prompt; + } + } + restore_dynamic_state(&save_dyn_state, p); } + scheme_longjmp(*save, 1); } - restore_dynamic_state(&save_dyn_state, p); + } else { + if (new_thread) { + /* check for initial break before we do anything */ + scheme_check_break_now(); + } + + v = k(); + + break; } - scheme_longjmp(*save, 1); } - if (new_thread) { - /* check for initial break before we do anything */ - scheme_check_break_now(); - } - - v = k(); - /* IMPORTANT: no GCs from here to return, since v may refer to multiple values, and we don't want the multiple-value array cleared. */