fix `nack-guard-evt'

The generated NACK shouldn't become ready when the thread where
the NACK is created terminates.

collects/tests/racket/sync.rktl

@@ -478,6 +478,20 @@
     (test 10 channel-get ch)
     (test (void) sync/timeout 0 n)))
 	       
+(let ()
+  (define ok? 'not-ready)
+  (thread-wait
+   (thread
+    (lambda ()
+      (sync (nack-guard-evt 
+             (lambda (nack)
+               (thread (lambda () 
+                         (sync nack) 
+                         (set! ok? #f)))
+               (sync (system-idle-evt))
+               always-evt))))))
+  (sync (system-idle-evt))
+  (test 'not-ready values ok?))
 
 ;; ----------------------------------------
 ;; Poll waitables

src/racket/include/scheme.h

@@ -1116,6 +1116,7 @@ typedef struct Scheme_Thread {
   Scheme_Object *resumed_box;   /* contains pointer to thread when it's resumed */
   Scheme_Object *dead_box;      /* contains non-zero when the thread is dead */
   Scheme_Object *running_box;   /* contains pointer to thread when it's running */
+  Scheme_Object *sync_box;      /* semaphore used for NACK events */
 
   struct Scheme_Thread *gc_prep_chain;
 

src/racket/src/mzmark_type.inc

@@ -1872,6 +1872,7 @@ static int thread_val_MARK(void *p, struct NewGC *gc) {
   gcMARK2(pr->resumed_box, gc);
   gcMARK2(pr->dead_box, gc);
   gcMARK2(pr->running_box, gc);
+  gcMARK2(pr->sync_box, gc);
 
   gcMARK2(pr->mbox_first, gc);
   gcMARK2(pr->mbox_last, gc);
@@ -1986,6 +1987,7 @@ static int thread_val_FIXUP(void *p, struct NewGC *gc) {
   gcFIXUP2(pr->resumed_box, gc);
   gcFIXUP2(pr->dead_box, gc);
   gcFIXUP2(pr->running_box, gc);
+  gcFIXUP2(pr->sync_box, gc);
 
   gcFIXUP2(pr->mbox_first, gc);
   gcFIXUP2(pr->mbox_last, gc);

src/racket/src/mzmarksrc.c

@@ -784,6 +784,7 @@ thread_val {
   gcMARK2(pr->resumed_box, gc);
   gcMARK2(pr->dead_box, gc);
   gcMARK2(pr->running_box, gc);
+  gcMARK2(pr->sync_box, gc);
 
   gcMARK2(pr->mbox_first, gc);
   gcMARK2(pr->mbox_last, gc);

src/racket/src/schpriv.h

@@ -636,6 +636,8 @@ void *scheme_win32_get_break_semaphore(void *th);
 
 Scheme_Object *scheme_get_thread_dead(Scheme_Thread *p);
 Scheme_Object *scheme_get_thread_suspend(Scheme_Thread *p);
+Scheme_Object *scheme_get_thread_sync(Scheme_Thread *p);
+void scheme_clear_thread_sync(Scheme_Thread *p);
 
 void scheme_zero_unneeded_rands(Scheme_Thread *p);
 

src/racket/src/struct.c

@@ -3601,7 +3601,7 @@ static int nack_guard_evt_is_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo
   nack = scheme_alloc_object();
   nack->type = scheme_nack_evt_type;
   SCHEME_PTR1_VAL(nack) = sema;
-  result = scheme_get_thread_dead(scheme_current_thread);
+  result = scheme_get_thread_sync(scheme_current_thread);
   SCHEME_PTR2_VAL(nack) = result;
 
   a[0] = nack;

src/racket/src/thread.c

@@ -2630,6 +2630,10 @@ static void thread_is_dead(Scheme_Thread *r)
     o = SCHEME_PTR_VAL(r->dead_box);
     scheme_post_sema_all(o);
   }
+  if (r->sync_box) {
+    scheme_post_sema_all(r->sync_box);
+    r->sync_box = NULL;
+  }
   if (r->running_box) {
     SCHEME_PTR_VAL(r->running_box) = NULL;
     r->running_box = NULL;
@@ -5854,6 +5858,23 @@ static int dead_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo)
   return 0;
 }
 
+Scheme_Object *scheme_get_thread_sync(Scheme_Thread *p)
+{
+  if (!p->sync_box) {
+    Scheme_Object *sema;
+    sema = scheme_make_sema(0);
+    p->sync_box = sema;
+  }
+  
+  return p->sync_box;
+}
+
+void scheme_clear_thread_sync(Scheme_Thread *p)
+{
+  if (p->sync_box)
+    p->sync_box = NULL;
+}
+
 /*========================================================================*/
 /*                              syncing                                   */
 /*========================================================================*/
@@ -6483,6 +6504,9 @@ void scheme_post_syncing_nacks(Syncing *syncing)
   int i, c;
   Scheme_Object *l;
 
+  if (syncing->thread && syncing->thread->sync_box)
+    syncing->thread->sync_box = NULL;
+
   if (syncing->set) {
     c = syncing->set->argc;
     
@@ -6504,11 +6528,14 @@ void scheme_post_syncing_nacks(Syncing *syncing)
   }
 }
 
-static void escape_during_sync(Syncing *syncing) {
-#ifdef MZ_PRECISE_GC
+static void escape_during_sync(Syncing *syncing)
+{
   Scheme_Thread *p = syncing->thread;
-#endif
 
+  syncing->thread = NULL;
+
+  if (p->sync_box)
+    scheme_post_sema_all(p->sync_box);
   scheme_post_syncing_nacks(syncing);
 
 #ifdef MZ_PRECISE_GC
@@ -6516,7 +6543,6 @@ scheme_post_syncing_nacks(syncing);
     GC_destroy_orphan_msg_memory(p->place_channel_msg_in_flight);
     p->place_channel_msg_in_flight = NULL;
   }
-  syncing->thread = NULL;
 #endif
 }