From fb730cb1c2c0246116c1e56556f4bc727ae9d0f8 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 4 Jul 2010 10:42:38 -0600 Subject: [PATCH] custodian box as synchronizable event --- .../scribblings/reference/custodians.scrbl | 6 ++- collects/scribblings/reference/evts.scrbl | 37 ++++++++++--------- collects/tests/racket/will.rktl | 14 +++++++ src/racket/src/port.c | 2 +- src/racket/src/thread.c | 9 +++++ 5 files changed, 49 insertions(+), 19 deletions(-) diff --git a/collects/scribblings/reference/custodians.scrbl b/collects/scribblings/reference/custodians.scrbl index 01cbacdbaa..a1e92fdfbb 100644 --- a/collects/scribblings/reference/custodians.scrbl +++ b/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 diff --git a/collects/scribblings/reference/evts.scrbl b/collects/scribblings/reference/evts.scrbl index 8513848af3..a101f608dd 100644 --- a/collects/scribblings/reference/evts.scrbl +++ b/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.} diff --git a/collects/tests/racket/will.rktl b/collects/tests/racket/will.rktl index e87bef8ae2..feda49fcab 100644 --- a/collects/tests/racket/will.rktl +++ b/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) diff --git a/src/racket/src/port.c b/src/racket/src/port.c index 3662a63696..1a28f12def 100644 --- a/src/racket/src/port.c +++ b/src/racket/src/port.c @@ -7225,7 +7225,7 @@ static Scheme_Object *subprocess_kill(int argc, Scheme_Object **argv) if (sp->done) return scheme_void; if(scheme_get_child_status(sp->pid, &status)) { - return scheme_void; + return scheme_void; } } # else diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index 3bc4124c83..8c6274f17f 100644 --- a/src/racket/src/thread.c +++ b/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) {