custodian box as synchronizable event

collects/scribblings/reference/custodians.scrbl

@@ -111,7 +111,11 @@ immediate allocations can be rejected with an
 @defproc[(make-custodian-box [cust custodian?] [v any/c]) custodian-box?]{
 
 Returns a @tech{custodian box} that contains @racket[v] as long as
-@racket[cust] has not been shut down.}
+@racket[cust] has not been shut down.
+
+A @tech{custodian box} is a @tech{synchronizable event} for use with
+functions like @racket[sync]. The @tech{custodian box} becomes ready
+when its custodian is shut down.}
 
 @defproc[(custodian-box? [v any/c]) boolean?]{Returns @racket[#t] if
  @racket[v] is a @tech{custodian box} produced by

collects/scribblings/reference/evts.scrbl

@@ -2,10 +2,10 @@
 @(require scribble/struct
           "mz.ss")
 
-@(define (ResultItself x)
+@(define-syntax-rule (ResultItself x)
    (make-element #f (list "The "
                           (tech "synchronization result")
-                          " of " x " is " x " itself")))
+                          " of " @racket[x] " is " @racket[x] " itself")))
 
 @title[#:tag "sync"]{Events}
 
@@ -39,12 +39,12 @@ generate events (see @racket[prop:evt]).
 @itemize[
 
  @item{@racket[_semaphore] --- a semaphore is ready when
- @racket[semaphore-wait] would not block.  @ResultItself{semaphore}.}
+ @racket[semaphore-wait] would not block.  @ResultItself[_semaphore].}
 
  @item{@racket[_semaphore-peek] --- a semaphore-peek event returned by
  @racket[semaphore-peek-evt] applied to @racket[_semaphore] is ready
  exactly when @racket[_semaphore] is
- ready. @ResultItself{semaphore-peek}.}
+ ready. @ResultItself[_semaphore-peek].}
 
  @item{@racket[_channel] --- a channel returned by
  @racket[make-channel] is ready when @racket[channel-get] would not
@@ -54,30 +54,30 @@ generate events (see @racket[prop:evt]).
  @item{@racket[_channel-put] --- an event returned by
  @racket[channel-put-evt] applied to @racket[_channel] is ready when
  @racket[channel-put] would not block on
- @racket[_channel]. @ResultItself{channel-put}.}
+ @racket[_channel]. @ResultItself[_channel-put].}
 
  @item{@racket[_input-port] --- an input port is ready as an event when
- @racket[read-byte] would not block. @ResultItself{input-port}.}
+ @racket[read-byte] would not block. @ResultItself[_input-port].}
 
  @item{@racket[_output-port] --- an output port is ready when
  @racket[write-bytes-avail] would not block or
  when the port contains buffered characters and
  @racket[write-bytes-avail*] can flush part of the buffer (although
- @racket[write-bytes-avail] might block). @ResultItself{output-port}.}
+ @racket[write-bytes-avail] might block). @ResultItself[_output-port].}
 
  @item{@racket[_progress] --- an event produced by
  @racket[port-progress-evt] applied to @racket[_input-port] is ready after
- any subsequent read from @racket[_input-port]. @ResultItself{progress}.}
+ any subsequent read from @racket[_input-port]. @ResultItself[_progress].}
 
  @item{@racket[_tcp-listener] --- a TCP listener is ready when
- @racket[tcp-accept] would not block.  @ResultItself{listener}.}
+ @racket[tcp-accept] would not block.  @ResultItself[_listener].}
 
  @item{@racket[_thd] --- a thread is ready when @racket[thread-wait]
- would not block. @ResultItself{thread}.}
+ would not block. @ResultItself[_thread].}
 
  @item{@racket[_thread-dead] --- an event returned by
  @racket[thread-dead-evt] applied to @racket[thd] is ready when
- @racket[thd] has terminated.  @ResultItself{thread-dead}.}
+ @racket[thd] has terminated.  @ResultItself[_thread-dead].}
 
  @item{@racket[_thread-resume] --- an event returned by
  @racket[thread-resume-evt] applied to @racket[thd] is ready when
@@ -90,19 +90,22 @@ generate events (see @racket[prop:evt]).
  suspended).  The event's result is @racket[thd].}
 
  @item{@racket[_alarm] --- an event returned by @racket[alarm-evt] is
- ready after a particular date and time.  @ResultItself{alarm}.}
+ ready after a particular date and time.  @ResultItself[_alarm].}
 
  @item{@racket[_subprocess] --- a subprocess is ready when
  @racket[subprocess-wait] would not block.
- @ResultItself{subprocess}.}
+ @ResultItself[_subprocess].}
 
- @item{@racket[_will-executor] --- a will executor is ready when
+ @item{@racket[_will-executor] --- a @tech{will executor} is ready when
  @racket[will-execute] would not block.
- @ResultItself{will-executor}.}
+ @ResultItself[_will-executor].}
+
+ @item{@racket[_custodian-box] --- a @tech{custodian box} is ready when
+ its custodian is shut down. @ResultItself[_custodian-box].}
 
  @item{@racket[_udp] --- an event returned by @racket[udp-send-evt] or
  @racket[udp-receive!-evt] is ready when a send or receive on the
- original socket would block, respectively. @ResultItself{udp}.}
+ original socket would block, respectively. @ResultItself[_udp].}
 
  @item{@racket[_log-receiver] --- a @tech{log receiver} as produced by
  @racket[make-log-receiver] is ready when a logged message is
@@ -170,7 +173,7 @@ generate events (see @racket[prop:evt]).
  property.}
 
  @item{@racket[always-evt] --- a constant event that is always
- ready. @ResultItself{@racket[always-evt]}.}
+ ready. @ResultItself[always-evt].}
 
  @item{@racket[never-evt] --- a constant event that is never ready.}
 

collects/tests/racket/will.rktl

@@ -75,6 +75,7 @@
               (collect-garbage)
               (collect-garbage))]
         [b1 (make-custodian-box c 12)])
+    (test #f sync/timeout 0 b1)
     (let ([saved (map mk-finalized '(a b c d e f g h i))])
       (let loop ([m 2])
         (unless (zero? m)
@@ -94,6 +95,7 @@
       (set! removed null)
       (custodian-shutdown-all c)
       (test #f custodian-box-value b1)
+      (test b1 sync/timeout 0 b1)
       (test #f ormap values (map custodian-box-value saved))
       (gc)
       (test #t <= 5 (apply + (map (lambda (v) (if (symbol? v) 1 0)) removed))))))
@@ -133,6 +135,18 @@
       (custodian-shutdown-all c)
       (test #f ormap (lambda (b) (number? (custodian-box-value b))) l))))
 
+;; check synchronization again:
+(let ()
+  (define done #f)
+  (define c1 (make-custodian (current-custodian)))
+  (define b1 (make-custodian-box c1 #t))
+  (thread (lambda () (sync b1) (set! done #t)))
+  (sync (system-idle-evt))
+  (test #f values done)
+  (custodian-shutdown-all c1)
+  (sync (system-idle-evt))
+  (test #t values done))
+
 ;; ----------------------------------------
 
 (report-errs)

src/racket/src/thread.c

@@ -369,6 +369,7 @@ static void exit_or_escape(Scheme_Thread *p);
 
 static int resume_suspend_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo);
 static int dead_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo);
+static int cust_box_ready(Scheme_Object *o);
 
 static int can_break_param(Scheme_Thread *p);
 
@@ -559,6 +560,8 @@ void scheme_init_thread(Scheme_Env *env)
   scheme_add_evt(scheme_thread_suspend_type, (Scheme_Ready_Fun)resume_suspend_ready, NULL, NULL, 1);
   scheme_add_evt(scheme_thread_resume_type, (Scheme_Ready_Fun)resume_suspend_ready, NULL, NULL, 1);
   scheme_add_evt(scheme_thread_dead_type, (Scheme_Ready_Fun)dead_ready, NULL, NULL, 1);
+  scheme_add_evt(scheme_cust_box_type, cust_box_ready, NULL, NULL, 0);
+
 
   scheme_add_global_constant("make-custodian",
 			     scheme_make_prim_w_arity(make_custodian,
@@ -1873,6 +1876,12 @@ static Scheme_Object *custodian_box_p(int argc, Scheme_Object *argv[])
     return scheme_false;
 }
 
+static int cust_box_ready(Scheme_Object *o)
+{
+  return ((Scheme_Custodian_Box *)o)->cust->shut_down;
+}
+
+
 #ifndef MZ_PRECISE_GC
 void scheme_clean_cust_box_list(void)
 {