change a thread's initial prompt to use the default handler

The thread's initial prompt previously ignored its arguments.
This commit is contained in:
Matthew Flatt 2012-09-05 12:20:50 -06:00
parent 3a7724e422
commit 2f7d4b5eaf
4 changed files with 73 additions and 21 deletions

View File

@ -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?])]{

View File

@ -1438,6 +1438,19 @@
(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)

View File

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

View File

@ -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. */