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

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

collects/tests/racket/thread.rktl

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

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!
 

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,9 +1166,18 @@ void *scheme_top_level_do_worker(void *(*k)(void), int eb, int new_thread, Schem
   save = p->error_buf;
   p->error_buf = &newbuf;
 
+  while (1) {
+
     if (scheme_setjmp(newbuf)) {
-    if (!new_thread) {
       p = scheme_current_thread;
+      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)
@@ -1166,7 +1194,7 @@ void *scheme_top_level_do_worker(void *(*k)(void), int eb, int new_thread, Schem
         }
         scheme_longjmp(*save, 1);
       }
-
+    } else {
       if (new_thread) {
         /* check for initial break before we do anything */
         scheme_check_break_now();
@@ -1174,6 +1202,10 @@ void *scheme_top_level_do_worker(void *(*k)(void), int eb, int new_thread, Schem
       
       v = k();
 
+      break;
+    }
+  }
+
   /* IMPORTANT: no GCs from here to return, since v
      may refer to multiple values, and we don't want the
      multiple-value array cleared. */