Add replace-evt

As suggested by Jan Dvořák.

The event created by `replace-evt` is a kind of event-gated
version of `guard-evt`. In particular,

 (guard-evt thunk)

could be expressed as

 (replace-evt always-evt (lambda (_) (thunk)))

Use `replace-evt` as a shortcut for the case when you want to
synchronize on either A or C, but you need to wait for B to get C.
You could wait on A+B and then, if B is selected, wait on A+C;
wrapping B with `replace-evt` to generate C is a kind of shortcut that
is eaiser to write and avoids tear-down and re-setup of A.

The `replace-evt` constructor is more than a shortcut in the sense
that it builds the pattern A+B->A+C into `sync`, which enables
abstractions that need a B->C transition. So, `replace-evt` adds
expressiveness, but (perhap reassuringly) it does not add any new
rendezvous capability.

Naturally, the procedure given to `replace-evt` can produce
another `replace-evt`, and the event argument to
`replace-evt` could also be a `replace-evt`.

pkgs/base/info.rkt

@@ -12,7 +12,7 @@
 
 (define collection 'multi)
 
-(define version "6.0.1.13")
+(define version "6.1.0.3")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

pkgs/racket-pkgs/racket-doc/scribblings/reference/evts.scrbl

@@ -246,6 +246,30 @@ for synchronization}, with itself as its @tech{synchronization result}.
 ]}
 
 
+@defproc[(replace-evt [evt evt?] [maker (any/c ... . -> . evt?)]) evt?]{
+
+Like @racket[guard-evt], but @racket[maker] is called only after
+@racket[evt] becomes @tech{ready for synchronization}, and the
+@tech{synchronization result} of @racket[evt] is passed to @racket[maker].
+
+The attempt to synchronize on @racket[evt] proceeds concurrently as
+the attempt to synchronize on the result @racket[_guard] from
+@racket[replace-evt]; despite that concurrency, if @racket[maker] is
+called, it is called in the thread that is synchronizing on
+@racket[_guard]. Synchronization can succeed for both @racket[evt] and
+another synchronized with @racket[_guard] at the same time; the
+single-choice guarantee of synchronization applies only to the result
+of @racket[maker] and other events synchronized with @racket[_guard].
+
+If @racket[maker] returns a non-event, then @racket[maker]'s
+result is replaced with an event that is @tech{ready for
+synchronization} and whose @tech{synchronization result} is
+@racket[_guard].
+
+@history[#:added "6.1.0.3"]}
+
+
+
 @defthing[never-evt evt?]{A constant event that is never @tech{ready
 for synchronization}.
 

pkgs/racket-pkgs/racket-test/tests/racket/sync.rktl

@@ -543,6 +543,89 @@
                                   s))
                 (make-semaphore))))
 
+;; ----------------------------------------
+;; Replace waitables
+
+(arity-test replace-evt 2 2)
+
+(err/rt-test (replace-evt 10 void))
+(err/rt-test (replace-evt always-evt 10))
+
+(test 10 sync (replace-evt always-evt
+                           (lambda (r)
+                             (wrap-evt always-evt (lambda (v) 10)))))
+
+(test 10 sync (let loop ([n 10])
+                (if (zero? n)
+                    (wrap-evt always-evt (lambda (_) 0))
+                    (replace-evt always-evt
+                                 (lambda (r)
+                                   (wrap-evt
+                                    (loop (sub1 n))
+                                    add1))))))
+
+(let ()
+  (define nacks null)
+
+  (define (deep nacks? base n)
+    (if (zero? n)
+        base
+        (deep
+         nacks?
+         (choice-evt
+          (if nacks?
+              (nack-guard-evt (lambda (s)
+                                (set! nacks (cons s nacks))
+                                never-evt))
+              never-evt)
+          (replace-evt base
+                       (lambda (v) v)))
+         (sub1 n))))
+
+  (sync (deep #t always-evt 10))
+  (for-each sync nacks)
+
+  ;; - - - - - - - - - - - - - - - - - - - - - - - -
+
+  (set! nacks null)
+  (define-values (i o) (make-pipe))
+  (define t0
+    (thread
+     (lambda ()
+       (sync (deep #t i 10)))))
+  (sync (system-idle-evt))
+  (test #f sync/timeout 0 t0)
+  (write-byte 1 o)
+  (sync t0)
+  (for-each sync nacks)
+
+  ;; - - - - - - - - - - - - - - - - - - - - - - - -
+
+  ;; Pick something large enough that it would overflow if
+  ;; the implementation used the C stack. Note that quadratic
+  ;; behavior of nested `replace-evt`s means that we could
+  ;; never get an answe back from this depth:
+  (define overflow-depth 40000)
+
+  (set! nacks null)
+  (define t
+    (thread (lambda ()
+              (with-handlers ([exn:break? void])
+                (sync (deep #t (current-input-port) overflow-depth))))))
+  (sync (system-idle-evt))
+
+  (test #f sync/timeout 0 t)
+  (break-thread t)
+  (sync t)
+
+  (for-each sync nacks))
+
+(let ([e (replace-evt always-evt (lambda (x) 'non-evt))])
+  (test e sync e))
+
+(test always-evt sync always-evt (replace-evt never-evt (lambda () 10)))
+(err/rt-test (sync (replace-evt always-evt (lambda () 10))))
+
 ;; ----------------------------------------
 ;; Structures as waitables
 
@@ -906,7 +989,8 @@
   (check-threads-gcable 'guard (lambda () (sync (c (guard-evt (lambda () (make-semaphore)))))))
   (check-threads-gcable 'nack (lambda () (sync (c (nack-guard-evt (lambda (nack) (make-semaphore)))))))
   (check-threads-gcable 'poll (lambda () (sync (c (poll-guard-evt (lambda (poll?) (make-semaphore)))))))
-  (check-threads-gcable 'never (lambda () (sync (c never-evt)))))
+  (check-threads-gcable 'never (lambda () (sync (c never-evt))))
+  (check-threads-gcable 'replace (lambda () (sync (c (replace-evt always-evt (lambda (always) (make-semaphore))))))))
 (check/combine values)
 (check/combine (lambda (x) (choice-evt x (make-semaphore))))
 (check/combine (lambda (x) (choice-evt (make-semaphore) x)))

racket/src/racket/src/mzmark_struct.inc

@@ -236,6 +236,37 @@ static int mark_nack_guard_evt_FIXUP(void *p, struct NewGC *gc) {
 #define mark_nack_guard_evt_IS_CONST_SIZE 1
 
 
+static int mark_active_replace_evt_SIZE(void *p, struct NewGC *gc) {
+  return
+  gcBYTES_TO_WORDS(sizeof(Active_Replace_Evt));
+}
+
+static int mark_active_replace_evt_MARK(void *p, struct NewGC *gc) {
+  Active_Replace_Evt *a = (Active_Replace_Evt *)p;
+
+  gcMARK2(a->syncing, gc);
+  gcMARK2(a->wrapper, gc);
+  gcMARK2(a->orig, gc);
+
+  return
+  gcBYTES_TO_WORDS(sizeof(Active_Replace_Evt));
+}
+
+static int mark_active_replace_evt_FIXUP(void *p, struct NewGC *gc) {
+  Active_Replace_Evt *a = (Active_Replace_Evt *)p;
+
+  gcFIXUP2(a->syncing, gc);
+  gcFIXUP2(a->wrapper, gc);
+  gcFIXUP2(a->orig, gc);
+
+  return
+  gcBYTES_TO_WORDS(sizeof(Active_Replace_Evt));
+}
+
+#define mark_active_replace_evt_IS_ATOMIC 0
+#define mark_active_replace_evt_IS_CONST_SIZE 1
+
+
 static int mark_chaperone_SIZE(void *p, struct NewGC *gc) {
   return
   gcBYTES_TO_WORDS(sizeof(Scheme_Chaperone));

racket/src/racket/src/mzmarksrc.c

@@ -2225,6 +2225,18 @@ mark_nack_guard_evt {
   gcBYTES_TO_WORDS(sizeof(Nack_Guard_Evt));
 }
 
+mark_active_replace_evt {
+ mark:
+  Active_Replace_Evt *a = (Active_Replace_Evt *)p;
+
+  gcMARK2(a->syncing, gc);
+  gcMARK2(a->wrapper, gc);
+  gcMARK2(a->orig, gc);
+
+ size:
+  gcBYTES_TO_WORDS(sizeof(Active_Replace_Evt));
+}
+
 mark_chaperone {
  mark:
   Scheme_Chaperone *px = (Scheme_Chaperone *)p;

racket/src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1124
+#define EXPECTED_PRIM_COUNT 1125
 #define EXPECTED_UNSAFE_COUNT 106
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_EXTFL_COUNT 45

racket/src/racket/src/schpriv.h

@@ -732,6 +732,7 @@ typedef struct {
   double sleep_end;
   int w_i;
   char spin, is_poll, no_redirect;
+  Scheme_Object *replace_chain; /* turns non-tail replace_evt recursion into a loop */
 } Scheme_Schedule_Info;
 
 typedef Scheme_Object *(*Scheme_Accept_Sync)(Scheme_Object *wrap);
@@ -742,6 +743,15 @@ void scheme_set_sync_target(Scheme_Schedule_Info *sinfo, Scheme_Object *target,
 struct Syncing;
 void scheme_accept_sync(struct Syncing *syncing, int i);
 
+struct Syncing *scheme_make_syncing(int argc, Scheme_Object **argv);
+int scheme_syncing_ready(struct Syncing *s, Scheme_Schedule_Info *sinfo, int can_suspend);
+void scheme_syncing_needs_wakeup(struct Syncing *s, void *fds);
+void scheme_escape_during_sync(struct Syncing *syncing);
+Scheme_Object *scheme_syncing_result(struct Syncing *syncing, int tailok);
+
+struct Syncing *scheme_replace_evt_nack(Scheme_Object *active_replace);
+struct Syncing *scheme_replace_evt_needs_wakeup(Scheme_Object *o);
+
 typedef int (*Scheme_Ready_Fun_FPC)(Scheme_Object *o, Scheme_Schedule_Info *sinfo);
 typedef int (*Scheme_Out_Ready_Fun_FPC)(Scheme_Output_Port *port, Scheme_Schedule_Info *sinfo);
 typedef int (*Scheme_In_Ready_Fun_FPC)(Scheme_Input_Port *port, Scheme_Schedule_Info *sinfo);

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "6.1.0.2"
+#define MZSCHEME_VERSION "6.1.0.3"
 
 #define MZSCHEME_VERSION_X 6
 #define MZSCHEME_VERSION_Y 1
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 2
+#define MZSCHEME_VERSION_W 3
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

racket/src/racket/src/struct.c

@@ -84,6 +84,14 @@ typedef struct {
   Scheme_Object *maker;
 } Nack_Guard_Evt;
 
+typedef struct {
+  Scheme_Object so;
+  int done;
+  Syncing *syncing;
+  Scheme_Object *wrapper;
+  Scheme_Object *orig;
+} Active_Replace_Evt;
+
 static Scheme_Object *make_inspector(int argc, Scheme_Object *argv[]);
 static Scheme_Object *make_sibling_inspector(int argc, Scheme_Object *argv[]);
 static Scheme_Object *inspector_p(int argc, Scheme_Object *argv[]);
@@ -117,6 +125,7 @@ static Scheme_Object *make_struct_field_mutator(int argc, Scheme_Object *argv[])
 
 static Scheme_Object *nack_evt(int argc, Scheme_Object *argv[]);
 static Scheme_Object *handle_evt(int argc, Scheme_Object *argv[]);
+static Scheme_Object *replace_evt(int argc, Scheme_Object *argv[]);
 static Scheme_Object *chaperone_evt(int argc, Scheme_Object *argv[]);
 static Scheme_Object *handle_evt_p(int argc, Scheme_Object *argv[]);
 
@@ -157,6 +166,9 @@ static int wrapped_evt_is_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo);
 static int nack_guard_evt_is_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo);
 static int nack_evt_is_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo);
 static int poll_evt_is_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo);
+static int replace_evt_is_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo);
+static int active_replace_evt_is_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo);
+static void active_replace_evt_needs_wakeup(Scheme_Object *s, void *fds);
 
 static int chaperone_evt_is_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo);
 static int is_chaperone_evt(Scheme_Object *o);
@@ -557,6 +569,11 @@ scheme_init_struct (Scheme_Env *env)
 						      "handle-evt",
 						      2, 2),
 			     env);
+  scheme_add_global_constant("replace-evt",
+			     scheme_make_prim_w_arity(replace_evt,
+						      "replace-evt",
+						      2, 2),
+			     env);
   scheme_add_global_constant("chaperone-evt",
 			     scheme_make_prim_w_arity(chaperone_evt,
 						      "chaperone-evt",
@@ -845,6 +862,13 @@ void scheme_init_struct_wait()
   scheme_add_evt(scheme_handle_evt_type,
 		 (Scheme_Ready_Fun)wrapped_evt_is_ready,
 		 NULL, NULL, 1);
+  scheme_add_evt(scheme_replace_evt_type,
+		 (Scheme_Ready_Fun)replace_evt_is_ready,
+		 NULL, NULL, 1);
+  scheme_add_evt(scheme_active_replace_evt_type,
+		 (Scheme_Ready_Fun)active_replace_evt_is_ready,
+		 active_replace_evt_needs_wakeup,
+		 NULL, 1);
   scheme_add_evt(scheme_chaperone_type,
 		 (Scheme_Ready_Fun)chaperone_evt_is_ready,
 		 NULL, 
@@ -3393,7 +3417,7 @@ static Scheme_Object *make_struct_field_mutator(int argc, Scheme_Object *argv[])
 /*                           wraps and nacks                              */
 /*========================================================================*/
 
-static Scheme_Object *wrap_evt(const char *who, int wrap, int argc, Scheme_Object *argv[])
+static Scheme_Object *wrap_evt(const char *who, Scheme_Type ty, int argc, Scheme_Object *argv[])
 {
   Wrapped_Evt *ww;
 
@@ -3404,7 +3428,7 @@ static Scheme_Object *wrap_evt(const char *who, int wrap, int argc, Scheme_Objec
     scheme_wrong_contract(who, "procedure?", 1, argc, argv);
 
   ww = MALLOC_ONE_TAGGED(Wrapped_Evt);
-  ww->so.type = (wrap ? scheme_wrap_evt_type : scheme_handle_evt_type);
+  ww->so.type = ty;
   ww->evt = argv[0];
   ww->wrapper = argv[1];
 
@@ -3413,12 +3437,17 @@ static Scheme_Object *wrap_evt(const char *who, int wrap, int argc, Scheme_Objec
 
 Scheme_Object *scheme_wrap_evt(int argc, Scheme_Object *argv[])
 {
-  return wrap_evt("wrap-evt", 1, argc, argv);
+  return wrap_evt("wrap-evt", scheme_wrap_evt_type, argc, argv);
 }
 
 Scheme_Object *handle_evt(int argc, Scheme_Object *argv[])
 {
-  return wrap_evt("handle-evt", 0, argc, argv);
+  return wrap_evt("handle-evt", scheme_handle_evt_type, argc, argv);
+}
+
+Scheme_Object *replace_evt(int argc, Scheme_Object *argv[])
+{
+  return wrap_evt("replace-evt", scheme_replace_evt_type, argc, argv);
 }
 
 Scheme_Object *handle_evt_p(int argc, Scheme_Object *argv[])
@@ -3648,27 +3677,8 @@ static int chaperone_evt_is_ready(Scheme_Object *obj, Scheme_Schedule_Info *sinf
   return 0;
 }
 
-static Scheme_Object *is_chaperone_evt_k(void)
-{
-  Scheme_Thread *p = scheme_current_thread;
-  Scheme_Object *o = (Scheme_Object *)p->ku.k.p1;
-  int c;
-
-  p->ku.k.p1 = NULL;
-
-  c = is_chaperone_evt(o);
-
-  return scheme_make_integer(c);
-}
-
 static int is_chaperone_evt(Scheme_Object *o)
 {
-#include "mzstkchk.h"
-  {
-    scheme_current_thread->ku.k.p1 = (void *)o;
-    return SCHEME_INT_VAL(scheme_handle_stack_overflow(is_chaperone_evt_k));
-  }
-
   return scheme_is_evt(SCHEME_CHAPERONE_VAL(o));
 }
 
@@ -3788,6 +3798,156 @@ static int poll_evt_is_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo)
     return 1; /* Non-evt => ready */
 }
 
+static int replace_evt_is_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo)
+{
+  Active_Replace_Evt *a;
+  Syncing *s;
+  Scheme_Object *argv[1];
+
+  argv[0] = ((Wrapped_Evt *)o)->evt;
+  s = scheme_make_syncing(1, argv);
+
+  a = MALLOC_ONE_TAGGED(Active_Replace_Evt);
+  a->so.type = scheme_active_replace_evt_type;
+  a->done = 0;
+  a->wrapper = ((Wrapped_Evt *)o)->wrapper;
+  a->syncing = s;
+  a->orig = o;
+
+  scheme_set_sync_target(sinfo, (Scheme_Object *)a, NULL, NULL, 0, 1, NULL);
+  return 0;
+}
+
+static int active_replace_evt_is_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo)
+{
+  Active_Replace_Evt *a = (Active_Replace_Evt *)o;
+  int nested = 0;
+
+  if (!a->syncing)
+    return 0;
+
+  do {
+    if (a->syncing) {
+      /* Can't finish in a scheduler context: */
+      if (a->done && sinfo->false_positive_ok) {
+        sinfo->potentially_false_positive = 1;
+        if (nested)
+          sinfo->replace_chain = NULL;
+        return 1;
+      }
+
+      if (!a->done && sinfo->replace_chain && !nested) {
+        /* In a nested context; trampoline to avoid stack overflow.
+           If the trampolined check succeeds, then the context calling here will
+           not see it; we'll return a potentially-false-positive success,
+           and then check again in a way that bubbles results up. */
+        Scheme_Object *l;
+        l = scheme_make_pair((Scheme_Object *)a, sinfo->replace_chain);
+        sinfo->replace_chain = l;
+        return 0;
+      }
+
+      if (!a->done && !sinfo->replace_chain) {
+        /* In a non-nested scheduler context; We can receive trampolined syncs: */
+        sinfo->replace_chain = scheme_null;
+      }
+
+      if (a->done || scheme_syncing_ready(a->syncing, sinfo, 0)) {
+        sinfo->replace_chain = NULL;
+
+        if (sinfo->potentially_false_positive)
+          return 1;
+
+        a->done = 1;
+        if (sinfo->false_positive_ok) {
+          sinfo->potentially_false_positive = 1;
+          return 1;
+        } else if (nested) {
+          /* We're in a trampilined sync. Now that we've recorded success,
+             wait for the next round, and we won't trampoline then. This
+             waiting causes a quadratic bubbling effect for deeply nested
+             events, so uses of `replace-evt` shouldn't deeply nest! */
+          sinfo->spin = 1;
+          return 0;
+        } else {
+          /* Non-nested, non-scheduler context. */
+          Scheme_Object *v, *argv[1], **args;
+          Syncing *s = a->syncing;
+          int argc;
+
+          a->syncing = NULL;
+
+          v = scheme_syncing_result(s, 0);
+
+          if (SAME_OBJ(v, SCHEME_MULTIPLE_VALUES)) {
+            argc = scheme_multiple_count;
+            args = scheme_multiple_array;
+            scheme_detach_multple_array(args);
+          } else {
+            argv[0] = v;
+            args = argv;
+            argc = 1;
+          }
+
+          v = scheme_apply(a->wrapper, argc, args);
+
+          if (scheme_is_evt(v)) {
+            scheme_set_sync_target(sinfo, v, NULL, NULL, 0, 1, NULL);
+            return 0;
+          } else {
+            /* Non-event => ready */
+            scheme_set_sync_target(sinfo, a->orig, NULL, NULL, 0, 1, NULL);
+            return 1;
+          }
+        }
+      }
+    }
+
+    if (sinfo->replace_chain && !SCHEME_NULLP(sinfo->replace_chain)) {
+      /* Receive a trampoline */
+      a = (Active_Replace_Evt *)SCHEME_CAR(sinfo->replace_chain);
+      sinfo->replace_chain = SCHEME_CDR(sinfo->replace_chain);
+      nested = 1;
+    } else
+      a = NULL;
+  } while (a);
+
+  sinfo->replace_chain = NULL;
+
+  return 0;
+}
+
+static void active_replace_evt_needs_wakeup(Scheme_Object *o, void *fds)
+{
+  Active_Replace_Evt *a = (Active_Replace_Evt *)o;
+
+  if (a->syncing && !a->done)
+    scheme_syncing_needs_wakeup(a->syncing, fds);
+}
+
+Syncing *scheme_replace_evt_needs_wakeup(Scheme_Object *o)
+{
+  Active_Replace_Evt *a = (Active_Replace_Evt *)o;
+
+  if (a->syncing && !a->done)
+    return a->syncing;
+
+  return NULL;
+}
+
+Syncing *scheme_replace_evt_nack(Scheme_Object *o)
+{
+  Active_Replace_Evt *a = (Active_Replace_Evt *)o;
+  Syncing *s = NULL;
+
+  if (a->syncing) {
+    s = a->syncing;
+    a->syncing = NULL;
+  }
+
+  return s;
+}
+
 /*========================================================================*/
 /*                          struct op maker                               */
 /*========================================================================*/
@@ -5900,6 +6060,8 @@ static void register_traversers(void)
   GC_REG_TRAV(scheme_handle_evt_type, mark_wrapped_evt);
   GC_REG_TRAV(scheme_nack_guard_evt_type, mark_nack_guard_evt);
   GC_REG_TRAV(scheme_poll_evt_type, mark_nack_guard_evt);
+  GC_REG_TRAV(scheme_replace_evt_type, mark_wrapped_evt);
+  GC_REG_TRAV(scheme_active_replace_evt_type, mark_active_replace_evt);
 
   GC_REG_TRAV(scheme_chaperone_type, mark_chaperone);
   GC_REG_TRAV(scheme_proc_chaperone_type, mark_chaperone);

racket/src/racket/src/stypes.h

@@ -145,154 +145,156 @@ enum {
   scheme_evt_set_type,                  /* 121 */
   scheme_wrap_evt_type,                 /* 122 */
   scheme_handle_evt_type,               /* 123 */
-  scheme_nack_guard_evt_type,           /* 124 */
+  scheme_replace_evt_type,              /* 124 */
-  scheme_semaphore_repost_type,         /* 125 */
+  scheme_active_replace_evt_type,       /* 125 */
-  scheme_channel_type,                  /* 126 */
+  scheme_nack_guard_evt_type,           /* 126 */
-  scheme_channel_put_type,              /* 127 */
+  scheme_semaphore_repost_type,         /* 127 */
-  scheme_thread_resume_type,            /* 128 */
+  scheme_channel_type,                  /* 128 */
-  scheme_thread_suspend_type,           /* 129 */
+  scheme_channel_put_type,              /* 129 */
-  scheme_thread_dead_type,              /* 130 */
+  scheme_thread_resume_type,            /* 130 */
-  scheme_poll_evt_type,                 /* 131 */
+  scheme_thread_suspend_type,           /* 131 */
-  scheme_nack_evt_type,                 /* 132 */
+  scheme_thread_dead_type,              /* 132 */
-  scheme_module_registry_type,          /* 133 */
+  scheme_poll_evt_type,                 /* 133 */
-  scheme_thread_set_type,               /* 134 */
+  scheme_nack_evt_type,                 /* 134 */
-  scheme_string_converter_type,         /* 135 */
+  scheme_module_registry_type,          /* 135 */
-  scheme_alarm_type,                    /* 136 */
+  scheme_thread_set_type,               /* 136 */
-  scheme_thread_recv_evt_type,          /* 137 */
+  scheme_string_converter_type,         /* 137 */
-  scheme_thread_cell_type,              /* 138 */
+  scheme_alarm_type,                    /* 138 */
-  scheme_channel_syncer_type,           /* 139 */
+  scheme_thread_recv_evt_type,          /* 139 */
-  scheme_special_comment_type,          /* 140 */
+  scheme_thread_cell_type,              /* 140 */
-  scheme_write_evt_type,                /* 141 */
+  scheme_channel_syncer_type,           /* 141 */
-  scheme_always_evt_type,               /* 142 */
+  scheme_special_comment_type,          /* 142 */
-  scheme_never_evt_type,                /* 143 */
+  scheme_write_evt_type,                /* 143 */
-  scheme_progress_evt_type,             /* 144 */
+  scheme_always_evt_type,               /* 144 */
-  scheme_place_dead_type,               /* 145 */
+  scheme_never_evt_type,                /* 145 */
-  scheme_already_comp_type,             /* 146 */
+  scheme_progress_evt_type,             /* 146 */
-  scheme_readtable_type,                /* 147 */
+  scheme_place_dead_type,               /* 147 */
-  scheme_intdef_context_type,           /* 148 */
+  scheme_already_comp_type,             /* 148 */
-  scheme_lexical_rib_type,              /* 149 */
+  scheme_readtable_type,                /* 149 */
-  scheme_thread_cell_values_type,       /* 150 */
+  scheme_intdef_context_type,           /* 150 */
-  scheme_global_ref_type,               /* 151 */
+  scheme_lexical_rib_type,              /* 151 */
-  scheme_cont_mark_chain_type,          /* 152 */
+  scheme_thread_cell_values_type,       /* 152 */
-  scheme_raw_pair_type,                 /* 153 */
+  scheme_global_ref_type,               /* 153 */
-  scheme_prompt_type,                   /* 154 */
+  scheme_cont_mark_chain_type,          /* 154 */
-  scheme_prompt_tag_type,               /* 155 */
+  scheme_raw_pair_type,                 /* 155 */
-  scheme_continuation_mark_key_type,    /* 156 */
+  scheme_prompt_type,                   /* 156 */
-  scheme_expanded_syntax_type,          /* 157 */
+  scheme_prompt_tag_type,               /* 157 */
-  scheme_delay_syntax_type,             /* 158 */
+  scheme_continuation_mark_key_type,    /* 158 */
-  scheme_cust_box_type,                 /* 159 */
+  scheme_expanded_syntax_type,          /* 159 */
-  scheme_resolved_module_path_type,     /* 160 */
+  scheme_delay_syntax_type,             /* 160 */
-  scheme_module_phase_exports_type,     /* 161 */
+  scheme_cust_box_type,                 /* 161 */
-  scheme_logger_type,                   /* 162 */
+  scheme_resolved_module_path_type,     /* 162 */
-  scheme_log_reader_type,               /* 163 */
+  scheme_module_phase_exports_type,     /* 163 */
-  scheme_free_id_info_type,             /* 164 */
+  scheme_logger_type,                   /* 164 */
-  scheme_rib_delimiter_type,            /* 165 */
+  scheme_log_reader_type,               /* 165 */
-  scheme_noninline_proc_type,           /* 166 */
+  scheme_free_id_info_type,             /* 166 */
-  scheme_prune_context_type,            /* 167 */
+  scheme_rib_delimiter_type,            /* 167 */
-  scheme_future_type,                   /* 168 */
+  scheme_noninline_proc_type,           /* 168 */
-  scheme_flvector_type,                 /* 169 */
+  scheme_prune_context_type,            /* 169 */
-  scheme_extflvector_type,              /* 170 */
+  scheme_future_type,                   /* 170 */
-  scheme_fxvector_type,                 /* 171 */
+  scheme_flvector_type,                 /* 171 */
-  scheme_place_type,                    /* 172 */
+  scheme_extflvector_type,              /* 172 */
-  scheme_place_object_type,             /* 173 */
+  scheme_fxvector_type,                 /* 173 */
-  scheme_place_async_channel_type,      /* 174 */
+  scheme_place_type,                    /* 174 */
-  scheme_place_bi_channel_type,         /* 175 */
+  scheme_place_object_type,             /* 175 */
-  scheme_once_used_type,                /* 176 */
+  scheme_place_async_channel_type,      /* 176 */
-  scheme_serialized_symbol_type,        /* 177 */
+  scheme_place_bi_channel_type,         /* 177 */
-  scheme_serialized_keyword_type,       /* 178 */
+  scheme_once_used_type,                /* 178 */
-  scheme_serialized_structure_type,     /* 179 */
+  scheme_serialized_symbol_type,        /* 179 */
-  scheme_fsemaphore_type,               /* 180 */
+  scheme_serialized_keyword_type,       /* 180 */
-  scheme_serialized_tcp_fd_type,        /* 181 */
+  scheme_serialized_structure_type,     /* 181 */
-  scheme_serialized_file_fd_type,       /* 182 */
+  scheme_fsemaphore_type,               /* 182 */
-  scheme_port_closed_evt_type,          /* 183 */
+  scheme_serialized_tcp_fd_type,        /* 183 */
-  scheme_proc_shape_type,               /* 184 */
+  scheme_serialized_file_fd_type,       /* 184 */
-  scheme_struct_proc_shape_type,        /* 185 */
+  scheme_port_closed_evt_type,          /* 185 */
-  scheme_phantom_bytes_type,            /* 186 */
+  scheme_proc_shape_type,               /* 186 */
-  scheme_environment_variables_type,    /* 187 */
+  scheme_struct_proc_shape_type,        /* 187 */
-  scheme_filesystem_change_evt_type,    /* 188 */
+  scheme_phantom_bytes_type,            /* 188 */
-  scheme_ctype_type,                    /* 189 */
+  scheme_environment_variables_type,    /* 189 */
-  scheme_plumber_type,                  /* 190 */
+  scheme_filesystem_change_evt_type,    /* 190 */
-  scheme_plumber_handle_type,           /* 191 */
+  scheme_ctype_type,                    /* 191 */
+  scheme_plumber_type,                  /* 192 */
+  scheme_plumber_handle_type,           /* 193 */
                                         
 #ifdef MZTAG_REQUIRED                            
-  _scheme_last_normal_type_,            /* 192 */
+  _scheme_last_normal_type_,            /* 194 */
                                                  
-  scheme_rt_weak_array,                 /* 193 */
+  scheme_rt_weak_array,                 /* 195 */
                                         
-  scheme_rt_comp_env,                   /* 194 */
+  scheme_rt_comp_env,                   /* 196 */
-  scheme_rt_constant_binding,           /* 195 */
+  scheme_rt_constant_binding,           /* 197 */
-  scheme_rt_resolve_info,               /* 196 */
+  scheme_rt_resolve_info,               /* 198 */
-  scheme_rt_unresolve_info,             /* 197 */
+  scheme_rt_unresolve_info,             /* 199 */
-  scheme_rt_optimize_info,              /* 198 */
+  scheme_rt_optimize_info,              /* 200 */
-  scheme_rt_compile_info,               /* 199 */
+  scheme_rt_compile_info,               /* 201 */
-  scheme_rt_cont_mark,                  /* 200 */
+  scheme_rt_cont_mark,                  /* 202 */
-  scheme_rt_saved_stack,                /* 201 */
+  scheme_rt_saved_stack,                /* 203 */
-  scheme_rt_reply_item,                 /* 202 */
+  scheme_rt_reply_item,                 /* 204 */
-  scheme_rt_closure_info,               /* 203 */
+  scheme_rt_closure_info,               /* 205 */
-  scheme_rt_overflow,                   /* 204 */
+  scheme_rt_overflow,                   /* 206 */
-  scheme_rt_overflow_jmp,               /* 205 */
+  scheme_rt_overflow_jmp,               /* 207 */
-  scheme_rt_meta_cont,                  /* 206 */
+  scheme_rt_meta_cont,                  /* 208 */
-  scheme_rt_dyn_wind_cell,              /* 207 */
+  scheme_rt_dyn_wind_cell,              /* 209 */
-  scheme_rt_dyn_wind_info,              /* 208 */
+  scheme_rt_dyn_wind_info,              /* 210 */
-  scheme_rt_dyn_wind,                   /* 209 */
+  scheme_rt_dyn_wind,                   /* 211 */
-  scheme_rt_dup_check,                  /* 210 */
+  scheme_rt_dup_check,                  /* 212 */
-  scheme_rt_thread_memory,              /* 211 */
+  scheme_rt_thread_memory,              /* 213 */
-  scheme_rt_input_file,                 /* 212 */
+  scheme_rt_input_file,                 /* 214 */
-  scheme_rt_input_fd,                   /* 213 */
+  scheme_rt_input_fd,                   /* 215 */
-  scheme_rt_oskit_console_input,        /* 214 */
+  scheme_rt_oskit_console_input,        /* 216 */
-  scheme_rt_tested_input_file,          /* 215 */
+  scheme_rt_tested_input_file,          /* 217 */
-  scheme_rt_tested_output_file,         /* 216 */
+  scheme_rt_tested_output_file,         /* 218 */
-  scheme_rt_indexed_string,             /* 217 */
+  scheme_rt_indexed_string,             /* 219 */
-  scheme_rt_output_file,                /* 218 */
+  scheme_rt_output_file,                /* 220 */
-  scheme_rt_load_handler_data,          /* 219 */
+  scheme_rt_load_handler_data,          /* 221 */
-  scheme_rt_pipe,                       /* 220 */
+  scheme_rt_pipe,                       /* 222 */
-  scheme_rt_beos_process,               /* 221 */
+  scheme_rt_beos_process,               /* 223 */
-  scheme_rt_system_child,               /* 222 */
+  scheme_rt_system_child,               /* 224 */
-  scheme_rt_tcp,                        /* 223 */
+  scheme_rt_tcp,                        /* 225 */
-  scheme_rt_write_data,                 /* 224 */
+  scheme_rt_write_data,                 /* 226 */
-  scheme_rt_tcp_select_info,            /* 225 */
+  scheme_rt_tcp_select_info,            /* 227 */
-  scheme_rt_param_data,                 /* 226 */
+  scheme_rt_param_data,                 /* 228 */
-  scheme_rt_will,                       /* 227 */
+  scheme_rt_will,                       /* 229 */
-  scheme_rt_linker_name,                /* 228 */
+  scheme_rt_linker_name,                /* 230 */
-  scheme_rt_param_map,                  /* 229 */
+  scheme_rt_param_map,                  /* 231 */
-  scheme_rt_finalization,               /* 230 */
+  scheme_rt_finalization,               /* 232 */
-  scheme_rt_finalizations,              /* 231 */
+  scheme_rt_finalizations,              /* 233 */
-  scheme_rt_cpp_object,                 /* 232 */
+  scheme_rt_cpp_object,                 /* 234 */
-  scheme_rt_cpp_array_object,           /* 233 */
+  scheme_rt_cpp_array_object,           /* 235 */
-  scheme_rt_stack_object,               /* 234 */
+  scheme_rt_stack_object,               /* 236 */
-  scheme_rt_preallocated_object,        /* 235 */
+  scheme_rt_preallocated_object,        /* 237 */
-  scheme_thread_hop_type,               /* 236 */
+  scheme_thread_hop_type,               /* 238 */
-  scheme_rt_srcloc,                     /* 237 */
+  scheme_rt_srcloc,                     /* 239 */
-  scheme_rt_evt,                        /* 238 */
+  scheme_rt_evt,                        /* 240 */
-  scheme_rt_syncing,                    /* 239 */
+  scheme_rt_syncing,                    /* 241 */
-  scheme_rt_comp_prefix,                /* 240 */
+  scheme_rt_comp_prefix,                /* 242 */
-  scheme_rt_user_input,                 /* 241 */
+  scheme_rt_user_input,                 /* 243 */
-  scheme_rt_user_output,                /* 242 */
+  scheme_rt_user_output,                /* 244 */
-  scheme_rt_compact_port,               /* 243 */
+  scheme_rt_compact_port,               /* 245 */
-  scheme_rt_read_special_dw,            /* 244 */
+  scheme_rt_read_special_dw,            /* 246 */
-  scheme_rt_regwork,                    /* 245 */
+  scheme_rt_regwork,                    /* 247 */
-  scheme_rt_rx_lazy_string,             /* 246 */
+  scheme_rt_rx_lazy_string,             /* 248 */
-  scheme_rt_buf_holder,                 /* 247 */
+  scheme_rt_buf_holder,                 /* 249 */
-  scheme_rt_parameterization,           /* 248 */
+  scheme_rt_parameterization,           /* 250 */
-  scheme_rt_print_params,               /* 249 */
+  scheme_rt_print_params,               /* 251 */
-  scheme_rt_read_params,                /* 250 */
+  scheme_rt_read_params,                /* 252 */
-  scheme_rt_native_code,                /* 251 */
+  scheme_rt_native_code,                /* 253 */
-  scheme_rt_native_code_plus_case,      /* 252 */
+  scheme_rt_native_code_plus_case,      /* 254 */
-  scheme_rt_jitter_data,                /* 253 */
+  scheme_rt_jitter_data,                /* 255 */
-  scheme_rt_module_exports,             /* 254 */
+  scheme_rt_module_exports,             /* 256 */
-  scheme_rt_delay_load_info,            /* 255 */
+  scheme_rt_delay_load_info,            /* 257 */
-  scheme_rt_marshal_info,               /* 256 */
+  scheme_rt_marshal_info,               /* 258 */
-  scheme_rt_unmarshal_info,             /* 257 */
+  scheme_rt_unmarshal_info,             /* 259 */
-  scheme_rt_runstack,                   /* 258 */
+  scheme_rt_runstack,                   /* 260 */
-  scheme_rt_sfs_info,                   /* 259 */
+  scheme_rt_sfs_info,                   /* 261 */
-  scheme_rt_validate_clearing,          /* 260 */
+  scheme_rt_validate_clearing,          /* 262 */
-  scheme_rt_avl_node,                   /* 261 */
+  scheme_rt_avl_node,                   /* 263 */
-  scheme_rt_lightweight_cont,           /* 262 */
+  scheme_rt_lightweight_cont,           /* 264 */
-  scheme_rt_export_info,                /* 263 */
+  scheme_rt_export_info,                /* 265 */
-  scheme_rt_cont_jmp,                   /* 264 */
+  scheme_rt_cont_jmp,                   /* 266 */
-  scheme_rt_letrec_check_frame,         /* 265 */
+  scheme_rt_letrec_check_frame,         /* 267 */
 #endif
-  scheme_deferred_expr_type,            /* 266 */
+  scheme_deferred_expr_type,            /* 268 */
 
   _scheme_last_type_
 };

racket/src/racket/src/thread.c

@@ -425,7 +425,6 @@ static Scheme_Object *will_executor_go(int argc, Scheme_Object *args[]);
 static Scheme_Object *will_executor_sema(Scheme_Object *w, int *repost);
 
 static Scheme_Object *check_break_now(int argc, Scheme_Object *args[]);
-static int syncing_ready(Scheme_Object *s, Scheme_Schedule_Info *sinfo);
 
 static void make_initial_config(Scheme_Thread *p);
 
@@ -434,6 +433,8 @@ static void suspend_thread(Scheme_Thread *p);
 
 static int check_sleep(int need_activity, int sleep_now);
 
+static int syncing_ready(Syncing *syncing, Scheme_Schedule_Info *sinfo);
+
 static void remove_thread(Scheme_Thread *r);
 static void exit_or_escape(Scheme_Thread *p);
 
@@ -4417,6 +4418,7 @@ static void init_schedule_info(Scheme_Schedule_Info *sinfo, Scheme_Thread *false
   sinfo->is_poll = 0;
   sinfo->no_redirect = no_redirect;
   sinfo->sleep_end = sleep_end;
+  sinfo->replace_chain = NULL;
 }
 
 Scheme_Object *scheme_current_break_cell()
@@ -6168,7 +6170,6 @@ void scheme_clear_thread_sync(Scheme_Thread *p)
 /*                              syncing                                   */
 /*========================================================================*/
 
-static void syncing_needs_wakeup(Scheme_Object *s, void *fds);
 static Evt_Set *make_evt_set(const char *name, int argc, Scheme_Object **argv, int delta, int flatten);
 
 typedef struct Evt {
@@ -6316,6 +6317,15 @@ static Syncing *make_syncing(Evt_Set *evt_set, float timeout, double start_time)
   return syncing;
 }
 
+Syncing *scheme_make_syncing(int argc, Scheme_Object **argv)
+{
+  Evt_Set *evt_set;
+
+  evt_set = make_evt_set("sync", argc, argv, 0, 1);
+
+  return make_syncing(evt_set, -1.0, 0);
+}
+
 static void *splice_ptr_array(void **a, int al, void **b, int bl, int i)
 {
   void **r;
@@ -6499,13 +6509,12 @@ void scheme_set_sync_target(Scheme_Schedule_Info *sinfo, Scheme_Object *target,
   }
 }
 
-static int syncing_ready(Scheme_Object *s, Scheme_Schedule_Info *sinfo)
+int scheme_syncing_ready(Syncing *syncing, Scheme_Schedule_Info *sinfo, int can_suspend)
 {
   int i, redirections = 0, all_semas = 1, j, result = 0;
   Evt *w;
   Scheme_Object *o;
   Scheme_Schedule_Info r_sinfo;
-  Syncing *syncing = (Syncing *)s;
   Evt_Set *evt_set;
   int is_poll;
   double sleep_end;
@@ -6550,10 +6559,12 @@ static int syncing_ready(Scheme_Object *s, Scheme_Schedule_Info *sinfo)
       r_sinfo.current_syncing = (Scheme_Object *)syncing;
       r_sinfo.w_i = i;
       r_sinfo.is_poll = is_poll;
+      r_sinfo.replace_chain = sinfo->replace_chain;
 
       yep = ready(o, &r_sinfo);
 
       sleep_end = r_sinfo.sleep_end;
+      sinfo->replace_chain = r_sinfo.replace_chain;
 
       /* Calling a guard can allow thread swap, which might choose a
          semaphore or a channel, so check for a result: */
@@ -6615,7 +6626,7 @@ static int syncing_ready(Scheme_Object *s, Scheme_Schedule_Info *sinfo)
   if (syncing->timeout >= 0.0) {
     if (syncing->sleep_end <= scheme_get_inexact_milliseconds())
       result = 1;
-  } else if (all_semas) {
+  } else if (all_semas && can_suspend) {
     /* Try to block in a GCable way: */
     if (sinfo->false_positive_ok) {
       /* In scheduler. Swap us in so we can suspend. */
@@ -6645,6 +6656,11 @@ static int syncing_ready(Scheme_Object *s, Scheme_Schedule_Info *sinfo)
   return result;
 }
 
+static int syncing_ready(Syncing *syncing, Scheme_Schedule_Info *sinfo)
+{
+  return scheme_syncing_ready(syncing, sinfo, 1);
+}
+
 void scheme_accept_sync(Syncing *syncing, int i)
 {
   /* run atomic accept action to revise the wrap */
@@ -6664,23 +6680,40 @@ void scheme_accept_sync(Syncing *syncing, int i)
   syncing->wrapss[i] = pr;
 }
 
-static void syncing_needs_wakeup(Scheme_Object *s, void *fds)
+void scheme_syncing_needs_wakeup(Syncing *s, void *fds)
 {
   int i;
-  Scheme_Object *o;
+  Scheme_Object *o, *syncs = NULL;
+  Syncing *next;
   Evt *w;
-  Evt_Set *evt_set = ((Syncing *)s)->set;
+  Evt_Set *evt_set;
 
-  for (i = 0; i < evt_set->argc; i++) {
+  do {
-    o = evt_set->argv[i];
+    evt_set = s->set;
-    w = evt_set->ws[i];
 
-    if (w->needs_wakeup) {
+    for (i = 0; i < evt_set->argc; i++) {
-      Scheme_Needs_Wakeup_Fun nw = w->needs_wakeup;
+      o = evt_set->argv[i];
+      w = evt_set->ws[i];
       
-      nw(o, fds);
+      if (SAME_TYPE(SCHEME_TYPE(o), scheme_active_replace_evt_type)) {
+        /* Handle active_replace_evt specially to avoid stack overflow: */
+        next = scheme_replace_evt_needs_wakeup(o);
+        if (next)
+          syncs = scheme_make_raw_pair((Scheme_Object *)next, syncs);
+      } else if (w->needs_wakeup) {
+        Scheme_Needs_Wakeup_Fun nw = w->needs_wakeup;
+        
+        nw(o, fds);
+      }
     }
-  }
+
+    if (!syncs)
+      s = NULL;
+    else {
+      s = (Syncing *)SCHEME_CAR(syncs);
+      syncs = SCHEME_CDR(syncs);
+    }
+  } while (s);
 }
 
 static Scheme_Object *evt_p(int argc, Scheme_Object *argv[])
@@ -6796,52 +6829,183 @@ Scheme_Object *scheme_make_evt_set(int argc, Scheme_Object **argv)
   return (Scheme_Object *)make_evt_set("internal-make-evt-set", argc, argv, 0, 1);
 }
 
-void scheme_post_syncing_nacks(Syncing *syncing)
+static void post_syncing_nacks(Syncing *syncing, int as_escape)
-     /* Also removes channel-syncers. Can be called multiple times. */
+/* Also removes channel-syncers. Can be called multiple times. */
 {
   int i, c;
-  Scheme_Object *l;
+  Scheme_Object *l, *syncs = NULL;
+  Syncing *next;
 
-  if (syncing->thread && syncing->thread->sync_box)
+  do {
-    syncing->thread->sync_box = NULL;
+    if (as_escape) {
+      Scheme_Thread *p = syncing->thread;
+      
+      syncing->thread = NULL;
+      
+      if (p && p->sync_box)
+        scheme_post_sema_all(p->sync_box);
+      
+#ifdef MZ_PRECISE_GC
+      if (p && p->place_channel_msg_in_flight) {
+        GC_destroy_orphan_msg_memory(p->place_channel_msg_in_flight);
+        p->place_channel_msg_in_flight = NULL;
+      }
+#endif
+    }
 
-  if (syncing->set) {
+    if (syncing->thread && syncing->thread->sync_box)
-    c = syncing->set->argc;
+      syncing->thread->sync_box = NULL;
+
+    if (syncing->set) {
+      c = syncing->set->argc;
     
-    for (i = 0; i < c; i++) {
+      for (i = 0; i < c; i++) {
-      if (SAME_TYPE(SCHEME_TYPE(syncing->set->argv[i]), scheme_channel_syncer_type))
+        if (SAME_TYPE(SCHEME_TYPE(syncing->set->argv[i]), scheme_channel_syncer_type))
-	scheme_get_outof_line((Scheme_Channel_Syncer *)syncing->set->argv[i]);
+          scheme_get_outof_line((Scheme_Channel_Syncer *)syncing->set->argv[i]);
-      if (syncing->nackss) {
+        else if (SAME_TYPE(SCHEME_TYPE(syncing->set->argv[i]), scheme_active_replace_evt_type)) {
-	if ((i + 1) != syncing->result) {
+         /* Handle active_replace_evt specially to avoid stack overflow: */
-	  l = syncing->nackss[i];
+          next = scheme_replace_evt_nack(syncing->set->argv[i]);
-	  if (l) {
+          if (next) {
-	    for (; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) {
+            syncs = scheme_make_raw_pair((Scheme_Object *)next, syncs);
-	      scheme_post_sema_all(SCHEME_CAR(l));
+            if ((i + 1) != syncing->result)
-	    }
+              syncs = scheme_make_raw_pair(scheme_true, syncs);
+          }
+        }
+
+        if (syncing->nackss) {
+          if ((i + 1) != syncing->result) {
+            l = syncing->nackss[i];
+            if (l) {
+              for (; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) {
+                scheme_post_sema_all(SCHEME_CAR(l));
+              }
+            }
+            syncing->nackss[i] = NULL;
+          }
+        }
+      }
+    }
+
+    if (!syncs)
+      syncing = NULL;
+    else {
+      if (SAME_OBJ(scheme_true, SCHEME_CAR(syncs))) {
+        as_escape = 1;
+        syncs = SCHEME_CDR(syncs);
+      } else
+        as_escape = 0;
+
+      syncing = (Syncing *)SCHEME_CAR(syncs);
+      syncs = SCHEME_CDR(syncs);
+    }
+  } while (syncing);
+}
+
+void scheme_post_syncing_nacks(Syncing *syncing)
+{
+  post_syncing_nacks(syncing, 0);
+}
+
+void scheme_escape_during_sync(Syncing *syncing)
+{
+  post_syncing_nacks(syncing, 1);
+}
+
+Scheme_Object *scheme_syncing_result(Syncing *syncing, int tailok)
+{
+  if (syncing->result) {
+    /* Apply wrap functions to the selected evt: */
+    Scheme_Object *o, *l, *a, *to_call = NULL, *args[1], **mv = NULL;
+    int to_call_is_handle = 0, rc = 1;
+    Scheme_Cont_Frame_Data cframe;
+
+    o = syncing->set->argv[syncing->result - 1];
+    if (SAME_TYPE(SCHEME_TYPE(o), scheme_channel_syncer_type)) {
+      /* This is a put that got changed to a syncer, but not changed back */
+      o = ((Scheme_Channel_Syncer *)o)->obj;
+    }
+    if (syncing->wrapss) {
+      l = syncing->wrapss[syncing->result - 1];
+      if (l) {
+	for (; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) {
+	  a = SCHEME_CAR(l);
+	  if (to_call) {
+            if (rc == 1) {
+              mv = args;
+              args[0] = o;
+            }
+	    
+	    /* Call wrap proc with breaks disabled */
+	    scheme_push_break_enable(&cframe, 0, 0);
+	    
+	    o = scheme_apply_multi(to_call, rc, mv);
+
+            if (SAME_OBJ(o, SCHEME_MULTIPLE_VALUES)) {
+              rc = scheme_multiple_count;
+              mv = scheme_multiple_array;
+              scheme_detach_multple_array(mv);
+            } else {
+              rc = 1;
+              mv = NULL;
+            }
+	    
+	    scheme_pop_break_enable(&cframe, 0);
+
+	    to_call = NULL;
+	  }
+	  if (SCHEME_BOXP(a) || SCHEME_PROCP(a)) {
+	    if (SCHEME_BOXP(a)) {
+	      a = SCHEME_BOX_VAL(a);
+	      to_call_is_handle = 1;
+	    }
+	    to_call = a;
+	  } else if (SAME_TYPE(scheme_thread_suspend_type, SCHEME_TYPE(a))
+		     || SAME_TYPE(scheme_thread_resume_type, SCHEME_TYPE(a))) {
+	    o = SCHEME_PTR2_VAL(a);
+            rc = 1;
+          } else {
+	    o = a;
+            rc = 1;
+          }
+	}
+
+	if (to_call) {
+          if (rc == 1) {
+            mv = args;
+            args[0] = o;
+          }
+	  
+	  /* If to_call is still a wrap-evt (not a handle-evt),
+	     then set the config one more time: */
+	  if (!to_call_is_handle) {
+	    scheme_push_break_enable(&cframe, 0, 0);
+	    tailok = 0;
+	  }
+
+	  if (tailok) {
+	    return _scheme_tail_apply(to_call, rc, mv);
+	  } else {
+	    o = scheme_apply_multi(to_call, rc, mv);
+
+            if (SAME_OBJ(o, SCHEME_MULTIPLE_VALUES)) {
+              rc = scheme_multiple_count;
+              mv = scheme_multiple_array;
+              scheme_detach_multple_array(mv);
+              if (!to_call_is_handle)
+                scheme_pop_break_enable(&cframe, 1);
+              return scheme_values(rc, mv);
+            } else {
+              if (!to_call_is_handle)
+                scheme_pop_break_enable(&cframe, 1);
+              return o;
+            }
 	  }
-	  syncing->nackss[i] = NULL;
 	}
       }
     }
-  }
+    return o;
-}
+  } else
-
+    return NULL;
-static void escape_during_sync(Syncing *syncing)
-{
-  Scheme_Thread *p = syncing->thread;
-
-  syncing->thread = NULL;
-
-  if (p && p->sync_box)
-    scheme_post_sema_all(p->sync_box);
-  scheme_post_syncing_nacks(syncing);
-
-#ifdef MZ_PRECISE_GC
-  if (p && p->place_channel_msg_in_flight) {
-    GC_destroy_orphan_msg_memory(p->place_channel_msg_in_flight);
-    p->place_channel_msg_in_flight = NULL;
-  }
-#endif
 }
 
 static Scheme_Object *do_sync(const char *name, int argc, Scheme_Object *argv[], 
@@ -6941,8 +7105,9 @@ static Scheme_Object *do_sync(const char *name, int argc, Scheme_Object *argv[],
     syncing->disable_break = scheme_current_thread;
   }
 
-  BEGIN_ESCAPEABLE(escape_during_sync, syncing);
+  BEGIN_ESCAPEABLE(scheme_escape_during_sync, syncing);
-  scheme_block_until((Scheme_Ready_Fun)syncing_ready, syncing_needs_wakeup, 
+  scheme_block_until((Scheme_Ready_Fun)syncing_ready,
+                     (Scheme_Needs_Wakeup_Fun)scheme_syncing_needs_wakeup,
 		     (Scheme_Object *)syncing, timeout);
   END_ESCAPEABLE();
 
@@ -6959,95 +7124,7 @@ static Scheme_Object *do_sync(const char *name, int argc, Scheme_Object *argv[],
   }
 
   if (syncing->result) {
-    /* Apply wrap functions to the selected evt: */
+    return scheme_syncing_result(syncing, tailok);
-    Scheme_Object *o, *l, *a, *to_call = NULL, *args[1], **mv = NULL;
-    int to_call_is_handle = 0, rc = 1;
-
-    o = evt_set->argv[syncing->result - 1];
-    if (SAME_TYPE(SCHEME_TYPE(o), scheme_channel_syncer_type)) {
-      /* This is a put that got changed to a syncer, but not changed back */
-      o = ((Scheme_Channel_Syncer *)o)->obj;
-    }
-    if (syncing->wrapss) {
-      l = syncing->wrapss[syncing->result - 1];
-      if (l) {
-	for (; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) {
-	  a = SCHEME_CAR(l);
-	  if (to_call) {
-            if (rc == 1) {
-              mv = args;
-              args[0] = o;
-            }
-	    
-	    /* Call wrap proc with breaks disabled */
-	    scheme_push_break_enable(&cframe, 0, 0);
-	    
-	    o = scheme_apply_multi(to_call, rc, mv);
-
-            if (SAME_OBJ(o, SCHEME_MULTIPLE_VALUES)) {
-              rc = scheme_multiple_count;
-              mv = scheme_multiple_array;
-              scheme_detach_multple_array(mv);
-            } else {
-              rc = 1;
-              mv = NULL;
-            }
-	    
-	    scheme_pop_break_enable(&cframe, 0);
-
-	    to_call = NULL;
-	  }
-	  if (SCHEME_BOXP(a) || SCHEME_PROCP(a)) {
-	    if (SCHEME_BOXP(a)) {
-	      a = SCHEME_BOX_VAL(a);
-	      to_call_is_handle = 1;
-	    }
-	    to_call = a;
-	  } else if (SAME_TYPE(scheme_thread_suspend_type, SCHEME_TYPE(a))
-		     || SAME_TYPE(scheme_thread_resume_type, SCHEME_TYPE(a))) {
-	    o = SCHEME_PTR2_VAL(a);
-            rc = 1;
-          } else {
-	    o = a;
-            rc = 1;
-          }
-	}
-
-	if (to_call) {
-          if (rc == 1) {
-            mv = args;
-            args[0] = o;
-          }
-	  
-	  /* If to_call is still a wrap-evt (not a handle-evt),
-	     then set the config one more time: */
-	  if (!to_call_is_handle) {
-	    scheme_push_break_enable(&cframe, 0, 0);
-	    tailok = 0;
-	  }
-
-	  if (tailok) {
-	    return _scheme_tail_apply(to_call, rc, mv);
-	  } else {
-	    o = scheme_apply_multi(to_call, rc, mv);
-
-            if (SAME_OBJ(o, SCHEME_MULTIPLE_VALUES)) {
-              rc = scheme_multiple_count;
-              mv = scheme_multiple_array;
-              scheme_detach_multple_array(mv);
-              if (!to_call_is_handle)
-                scheme_pop_break_enable(&cframe, 1);
-              return scheme_values(rc, mv);
-            } else {
-              if (!to_call_is_handle)
-                scheme_pop_break_enable(&cframe, 1);
-              return o;
-            }
-	  }
-	}
-      }
-    }
-    return o;
   } else {
     if (with_timeout && SCHEME_PROCP(argv[0])) {
       if (tailok)

racket/src/racket/src/type.c

@@ -258,6 +258,7 @@ scheme_init_type ()
   set_name(scheme_evt_set_type, "<evt-set>");
   set_name(scheme_wrap_evt_type, "<evt>");
   set_name(scheme_handle_evt_type, "<evt>");
+  set_name(scheme_replace_evt_type, "<evt>");
   set_name(scheme_nack_evt_type, "<evt>");
   set_name(scheme_nack_guard_evt_type, "<evt>");
   set_name(scheme_poll_evt_type, "<evt>");