diff --git a/pkgs/racket-doc/scribblings/foreign/custodian.scrbl b/pkgs/racket-doc/scribblings/foreign/custodian.scrbl index 69ed72af57..0b8477b33c 100644 --- a/pkgs/racket-doc/scribblings/foreign/custodian.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/custodian.scrbl @@ -12,7 +12,8 @@ registering shutdown callbacks with custodians.} [callback (any/c . -> . any)] [custodian custodian? (current-custodian)] [#:at-exit? at-exit? any/c #f] - [#:weak? weak? any/c #f]) + [#:weak? weak? any/c #f] + [#:ordered? ordered? any/c #f]) cpointer?]{ Registers @racket[callback] to be applied (in atomic mode and an @@ -25,12 +26,16 @@ a pointer that can be supplied to If @racket[at-exit?] is true, then @racket[callback] is applied when Racket exits, even if the custodian is not explicitly shut down. -If @racket[weak?] is true, then @racket[callback] may not be called +If @racket[weak?] is true, then @racket[callback] may not be called if @racket[v] is determined to be unreachable during garbage collection. The value @racket[v] is always weakly held by the custodian, even if @racket[weak?] is @racket[#f]; see @cpp{scheme_add_managed} for more information. +If @racket[ordered?] is true when @racket[weak] is @racket[#f], then +@racket[v] is retained in a way that allows finalization of @racket[v] +via @racket[register-finalizer] to proceed. + Normally, @racket[weak?] should be false. To trigger actions based on finalization or custodian shutdown---whichever happens first---leave @racket[weak?] as @racket[#f] and have a finalizer run in atomic mode @@ -40,8 +45,16 @@ if the finalizer is not run in atomic mode, then there's no guarantee that either of the custodian or finalizer callbacks has completed by the time that the custodian shutdown has completed; @racket[v] might be no longer registered to the custodian, while the finalizer for -@racket[v] might be still running or merely queued to run. See also -@racket[register-finalizer-and-custodian-shutdown].} +@racket[v] might be still running or merely queued to run. +Furthermore, if finalization is via @racket[register-finalizer] (as +opposed to a @tech[#:doc reference.scrbl]{will executor}), then supply +@racket[ordered?] as true; @racket[ordered?] is false while +@racket[weak?] is false, then @racket[custodian] may retain @racket[v] +in a way that does not allow finalization to be triggered when +@racket[v] is otherwise inaccessible. See also +@racket[register-finalizer-and-custodian-shutdown]. + +@history[#:changed "7.8.0.8" @elem{Added the @racket[#:ordered?] argument.}]} @defproc[(unregister-custodian-shutdown [v any/c] @@ -64,7 +77,10 @@ is taken.} Registers @racket[callback] to be applied (in atomic mode) to @racket[v] when @racket[custodian] is shutdown or when @racket[v] is about to be collected by the garbage collector, whichever happens -first. The @racket[callback] is only applied to @racket[v] once. +first. The @racket[callback] is only applied to @racket[v] once. The +object @racket[v] is subject to the the constraints of +@racket[register-finalizer]---particularly the constraint that +@racket[v] must not be reachable from itself. If @racket[custodian] is already shut down, then @racket[unavailable-callback] is applied in tail position to a diff --git a/pkgs/racket-doc/scribblings/foreign/pointers.scrbl b/pkgs/racket-doc/scribblings/foreign/pointers.scrbl index 07fef8fa36..aa7d3ce08a 100644 --- a/pkgs/racket-doc/scribblings/foreign/pointers.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/pointers.scrbl @@ -386,7 +386,7 @@ been cleared, which implies that the value is unreachable and no normal @tech[#:doc reference.scrbl]{will executor} has a will ready for the value. The finalizer is invoked when the will for @racket[obj] becomes ready in the ``late'' will executor, which means that the -value is unreachable (even from wills) by safe code. +value is unreachable (even from wills, and even from itself) by safe code. The finalizer is invoked in a thread that is in charge of triggering will executors for @racket[register-finalizer]. The given diff --git a/pkgs/racket-doc/scribblings/foreign/unexported.scrbl b/pkgs/racket-doc/scribblings/foreign/unexported.scrbl index d71758c814..3b9d38853a 100644 --- a/pkgs/racket-doc/scribblings/foreign/unexported.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/unexported.scrbl @@ -101,7 +101,12 @@ Creates a ``late'' will executor that readies a will for a value normal weak references to @scheme[_v] are cleared before a will for @racket[_v] is readied by the late will executor, but late weak references created by @racket[make-late-weak-box] and -@racket[make-late-weak-hasheq] are not. +@racket[make-late-weak-hasheq] are not. For the @CS[] variant of +Racket, a will is readied for @racket[_v] only when it is not reachable +from any value that has a late will; if a value @racket[_v] is +reachable from itself (i.e., through any field of @racket[_v], as +opposed to the immediate value itself), a ``late'' will for +@racket[_v] never becomes ready. Unlike a normal will executor, if a late will executor becomes inaccessible, the values for which it has pending wills are retained diff --git a/racket/collects/ffi/unsafe/custodian.rkt b/racket/collects/ffi/unsafe/custodian.rkt index e80dcc11b0..ac7cf77475 100644 --- a/racket/collects/ffi/unsafe/custodian.rkt +++ b/racket/collects/ffi/unsafe/custodian.rkt @@ -16,8 +16,9 @@ (define (register-custodian-shutdown obj proc [custodian (current-custodian)] #:at-exit? [at-exit? #f] - #:weak? [weak? #f]) - (unsafe-custodian-register custodian obj proc at-exit? weak?)) + #:weak? [weak? #f] + #:ordered? [late? #f]) + (unsafe-custodian-register custodian obj proc at-exit? weak? late?)) (define (unregister-custodian-shutdown obj mref) (when mref @@ -33,7 +34,7 @@ (set! done? #t) (callback obj))) (define registration - (register-custodian-shutdown value do-callback custodian #:at-exit? at-exit?)) + (register-custodian-shutdown value do-callback custodian #:at-exit? at-exit? #:ordered? #t)) (define (do-finalizer) (register-finalizer value diff --git a/racket/src/bc/src/thread.c b/racket/src/bc/src/thread.c index 2054185358..4b185e729a 100644 --- a/racket/src/bc/src/thread.c +++ b/racket/src/bc/src/thread.c @@ -656,7 +656,7 @@ scheme_init_unsafe_thread (Scheme_Startup_Env *env) ADD_PRIM_W_ARITY("unsafe-thread-at-root", unsafe_thread_at_root, 1, 1, env); ADD_PRIM_W_ARITY("unsafe-make-custodian-at-root", unsafe_make_custodian_at_root, 0, 0, env); - ADD_PRIM_W_ARITY("unsafe-custodian-register", unsafe_custodian_register, 5, 5, env); + ADD_PRIM_W_ARITY("unsafe-custodian-register", unsafe_custodian_register, 5, 6, env); ADD_PRIM_W_ARITY("unsafe-custodian-unregister", unsafe_custodian_unregister, 2, 2, env); ADD_PRIM_W_ARITY("unsafe-add-post-custodian-shutdown", unsafe_add_post_custodian_shutdown, 1, 2, env); @@ -1418,6 +1418,7 @@ static Scheme_Object *unsafe_custodian_register(int argc, Scheme_Object *argv[]) Scheme_Object *callback = argv[2]; int at_exit = SCHEME_TRUEP(argv[3]); int init_weak = SCHEME_TRUEP(argv[4]); + /* optional `late?` sixth argument is not used */ /* Some checks, just to be polite */ if (!SCHEME_CUSTODIANP(argv[0])) diff --git a/racket/src/cs/schemified/thread.scm b/racket/src/cs/schemified/thread.scm index 0184d21319..f71230f094 100644 --- a/racket/src/cs/schemified/thread.scm +++ b/racket/src/cs/schemified/thread.scm @@ -5625,11 +5625,11 @@ (begin (set-custodian-place! c_0 (custodian-place parent_0)) (let ((cref_0 - (let ((temp31_0 + (let ((temp39_0 (let ((children_0 (custodian-children c_0))) (|#%name| - temp31 + temp39 (lambda (c_1) (begin (begin @@ -5639,10 +5639,11 @@ (do-custodian-register.1 #t #t + #f #t parent_0 c_0 - temp31_0)))) + temp39_0)))) (begin (set-custodian-parent-reference! c_0 cref_0) (if cref_0 @@ -5670,67 +5671,102 @@ (define do-custodian-register.1 (|#%name| do-custodian-register - (lambda (at-exit?6_0 gc-root?8_0 weak?7_0 cust12_0 obj13_0 callback14_0) + (lambda (at-exit?6_0 + gc-root?9_0 + late?8_0 + weak?7_0 + cust14_0 + obj15_0 + callback16_0) (begin (begin (start-atomic) (begin0 - (if (1/custodian-shut-down? cust12_0) + (if (1/custodian-shut-down? cust14_0) #f (let ((we_0 (if (not weak?7_0) - (|#%app| host:make-will-executor void) + (if late?8_0 + (|#%app| host:make-late-will-executor void) + (|#%app| host:make-will-executor void)) #f))) (begin - (let ((app_0 (custodian-children cust12_0))) + (let ((app_0 (custodian-children cust14_0))) (hash-set! app_0 - obj13_0 + obj15_0 (if weak?7_0 - callback14_0 + callback16_0 (if at-exit?6_0 - (at-exit-callback3.1 callback14_0 we_0) - (willed-callback2.1 callback14_0 we_0))))) + (at-exit-callback3.1 callback16_0 we_0) + (willed-callback2.1 callback16_0 we_0))))) (if we_0 - (|#%app| host:will-register we_0 obj13_0 void) + (|#%app| host:will-register we_0 obj15_0 void) (void)) - (if gc-root?8_0 + (if gc-root?9_0 (begin (|#%app| host:disable-interrupts) - (if (custodian-gc-roots cust12_0) + (if (custodian-gc-roots cust14_0) (void) - (set-custodian-gc-roots! cust12_0 (make-weak-hasheq))) - (hash-set! (custodian-gc-roots cust12_0) obj13_0 #t) - (check-limit-custodian cust12_0) + (set-custodian-gc-roots! cust14_0 (make-weak-hasheq))) + (hash-set! (custodian-gc-roots cust14_0) obj15_0 #t) + (check-limit-custodian cust14_0) (|#%app| host:enable-interrupts)) (void)) - (let ((or-part_0 (custodian-self-reference cust12_0))) + (let ((or-part_0 (custodian-self-reference cust14_0))) (if or-part_0 or-part_0 (let ((cref_0 - (custodian-reference4.1 (make-weak-box cust12_0)))) + (custodian-reference4.1 (make-weak-box cust14_0)))) (begin - (set-custodian-self-reference! cust12_0 cref_0) + (set-custodian-self-reference! cust14_0 cref_0) cref_0))))))) (end-atomic))))))) (define 1/unsafe-custodian-register - (|#%name| - unsafe-custodian-register - (lambda (cust_0 obj_0 callback_0 at-exit?_0 weak?_0) - (begin - (do-custodian-register.1 - at-exit?_0 - #f - weak?_0 + (let ((unsafe-custodian-register_0 + (|#%name| + unsafe-custodian-register + (lambda (cust19_0 + obj20_0 + callback21_0 + at-exit?22_0 + weak?23_0 + late?18_0) + (begin + (do-custodian-register.1 + at-exit?22_0 + #f + late?18_0 + weak?23_0 + cust19_0 + obj20_0 + callback21_0)))))) + (|#%name| + unsafe-custodian-register + (case-lambda + ((cust_0 obj_0 callback_0 at-exit?_0 weak?_0) + (begin + (unsafe-custodian-register_0 + cust_0 + obj_0 + callback_0 + at-exit?_0 + weak?_0 + #f))) + ((cust_0 obj_0 callback_0 at-exit?_0 weak?_0 late?18_0) + (unsafe-custodian-register_0 cust_0 obj_0 - callback_0))))) + callback_0 + at-exit?_0 + weak?_0 + late?18_0)))))) (define custodian-register-thread (lambda (cust_0 obj_0 callback_0) - (do-custodian-register.1 #f #t #t cust_0 obj_0 callback_0))) + (do-custodian-register.1 #f #t #f #t cust_0 obj_0 callback_0))) (define custodian-register-place (lambda (cust_0 obj_0 callback_0) - (do-custodian-register.1 #f #t #t cust_0 obj_0 callback_0))) + (do-custodian-register.1 #f #t #f #t cust_0 obj_0 callback_0))) (define 1/unsafe-custodian-unregister (|#%name| unsafe-custodian-unregister @@ -5795,24 +5831,26 @@ #f) #f))) (if (willed-callback? callback_0) - (let ((temp52_0 + (let ((temp61_0 (willed-callback-proc callback_0))) - (let ((temp53_0 + (let ((temp62_0 (at-exit-callback? callback_0))) - (let ((temp52_1 temp52_0)) + (let ((temp61_1 temp61_0)) (do-custodian-register.1 - temp53_0 + temp62_0 gc-root?_0 #f + #f parent_0 child_0 - temp52_1)))) + temp61_1)))) (do-custodian-register.1 #f gc-root?_0 #f + #f parent_0 child_0 callback_0))) @@ -5976,18 +6014,18 @@ (let ((do-custodian-shutdown-all_0 (|#%name| do-custodian-shutdown-all - (lambda (c17_0 only-at-exit?16_0) + (lambda (c25_0 only-at-exit?24_0) (begin - (if (1/custodian-shut-down? c17_0) + (if (1/custodian-shut-down? c25_0) (void) (begin - (set-custodian-shut-down! c17_0) + (set-custodian-shut-down! c25_0) (begin - (if (custodian-sync-futures? c17_0) + (if (custodian-sync-futures? c25_0) (|#%app| futures-sync-for-custodian-shutdown) (void)) (begin - (let ((ht_0 (custodian-children c17_0))) + (let ((ht_0 (custodian-children c25_0))) (begin (letrec* ((for-loop_0 @@ -6004,7 +6042,7 @@ (begin (if (if child_0 (let ((or-part_0 - (not only-at-exit?16_0))) + (not only-at-exit?24_0))) (if or-part_0 or-part_0 (at-exit-callback? @@ -6013,7 +6051,7 @@ (if (procedure-arity-includes? callback_0 2) - (|#%app| callback_0 child_0 c17_0) + (|#%app| callback_0 child_0 c25_0) (|#%app| callback_0 child_0)) (void)) (for-loop_0 @@ -6025,13 +6063,13 @@ (values))))))) (for-loop_0 (hash-iterate-first ht_0))))) (begin - (hash-clear! (custodian-children c17_0)) + (hash-clear! (custodian-children c25_0)) (begin - (if (custodian-gc-roots c17_0) - (hash-clear! (custodian-gc-roots c17_0)) + (if (custodian-gc-roots c25_0) + (hash-clear! (custodian-gc-roots c25_0)) (void)) (begin - (let ((lst_0 (custodian-post-shutdown c17_0))) + (let ((lst_0 (custodian-post-shutdown c25_0))) (begin (letrec* ((for-loop_0 @@ -6048,28 +6086,28 @@ (values))))))) (for-loop_0 lst_0)))) (begin - (set-custodian-post-shutdown! c17_0 null) + (set-custodian-post-shutdown! c25_0 null) (begin - (let ((sema_0 (custodian-shutdown-sema c17_0))) + (let ((sema_0 (custodian-shutdown-sema c25_0))) (if sema_0 (semaphore-post-all sema_0) (void))) (let ((p-cref_0 - (custodian-parent-reference c17_0))) + (custodian-parent-reference c25_0))) (begin (if p-cref_0 (1/unsafe-custodian-unregister - c17_0 + c25_0 p-cref_0) (void)) - (remove-limit-custodian! c17_0) + (remove-limit-custodian! c25_0) (set-custodian-memory-limits! - c17_0 + c25_0 null))))))))))))))))) (case-lambda ((c_0) (do-custodian-shutdown-all_0 c_0 #f)) - ((c_0 only-at-exit?16_0) - (do-custodian-shutdown-all_0 c_0 only-at-exit?16_0))))) + ((c_0 only-at-exit?24_0) + (do-custodian-shutdown-all_0 c_0 only-at-exit?24_0))))) (define custodian-get-shutdown-sema (lambda (c_0) (begin @@ -6090,28 +6128,28 @@ (let ((unsafe-add-post-custodian-shutdown_0 (|#%name| unsafe-add-post-custodian-shutdown - (lambda (proc19_0 custodian18_0) + (lambda (proc27_0 custodian26_0) (begin (begin - (if (if (procedure? proc19_0) - (procedure-arity-includes? proc19_0 0) + (if (if (procedure? proc27_0) + (procedure-arity-includes? proc27_0 0) #f) (void) (raise-argument-error 'unsafe-add-post-custodian-shutdown "(procedure-arity-includes/c 0)" - proc19_0)) + proc27_0)) (begin - (if (let ((or-part_0 (not custodian18_0))) - (if or-part_0 or-part_0 (1/custodian? custodian18_0))) + (if (let ((or-part_0 (not custodian26_0))) + (if or-part_0 or-part_0 (1/custodian? custodian26_0))) (void) (raise-argument-error 'unsafe-add-post-custodian-shutdown "(or/c custodian? #f)" - custodian18_0)) + custodian26_0)) (let ((c_0 - (if custodian18_0 - custodian18_0 + (if custodian26_0 + custodian26_0 (place-custodian (unsafe-place-local-ref cell.1$2))))) (if (if (not @@ -6126,14 +6164,14 @@ (begin0 (set-custodian-post-shutdown! c_0 - (cons proc19_0 (custodian-post-shutdown c_0))) + (cons proc27_0 (custodian-post-shutdown c_0))) (end-atomic)))))))))))) (|#%name| unsafe-add-post-custodian-shutdown (case-lambda ((proc_0) (begin (unsafe-add-post-custodian-shutdown_0 proc_0 #f))) - ((proc_0 custodian18_0) - (unsafe-add-post-custodian-shutdown_0 proc_0 custodian18_0)))))) + ((proc_0 custodian26_0) + (unsafe-add-post-custodian-shutdown_0 proc_0 custodian26_0)))))) (define custodian-subordinate? (lambda (c_0 super-c_0) (letrec* @@ -6226,25 +6264,25 @@ (let ((custodian-limit-memory_0 (|#%name| custodian-limit-memory - (lambda (limit-cust21_0 need-amt22_0 stop-cust20_0) + (lambda (limit-cust29_0 need-amt30_0 stop-cust28_0) (begin (let ((stop-cust_0 - (if (eq? stop-cust20_0 unsafe-undefined) - limit-cust21_0 - stop-cust20_0))) + (if (eq? stop-cust28_0 unsafe-undefined) + limit-cust29_0 + stop-cust28_0))) (begin - (if (1/custodian? limit-cust21_0) + (if (1/custodian? limit-cust29_0) (void) (raise-argument-error 'custodian-limit-memory "custodian?" - limit-cust21_0)) - (if (exact-nonnegative-integer? need-amt22_0) + limit-cust29_0)) + (if (exact-nonnegative-integer? need-amt30_0) (void) (raise-argument-error 'custodian-limit-memory "exact-nonnegative-integer?" - need-amt22_0)) + need-amt30_0)) (if (1/custodian? stop-cust_0) (void) (raise-argument-error @@ -6255,36 +6293,36 @@ (start-atomic/no-interrupts) (begin0 (if (let ((or-part_0 - (1/custodian-shut-down? limit-cust21_0))) + (1/custodian-shut-down? limit-cust29_0))) (if or-part_0 or-part_0 (1/custodian-shut-down? stop-cust_0))) (void) (begin (set-custodian-memory-limits! - limit-cust21_0 + limit-cust29_0 (let ((app_0 (cons - need-amt22_0 - (if (eq? limit-cust21_0 stop-cust_0) + need-amt30_0 + (if (eq? limit-cust29_0 stop-cust_0) #f stop-cust_0)))) (cons app_0 - (custodian-memory-limits limit-cust21_0)))) - (if (eq? stop-cust_0 limit-cust21_0) + (custodian-memory-limits limit-cust29_0)))) + (if (eq? stop-cust_0 limit-cust29_0) (let ((old-limit_0 - (custodian-immediate-limit limit-cust21_0))) + (custodian-immediate-limit limit-cust29_0))) (if (let ((or-part_0 (not old-limit_0))) (if or-part_0 or-part_0 - (> old-limit_0 need-amt22_0))) + (> old-limit_0 need-amt30_0))) (set-custodian-immediate-limit! - limit-cust21_0 - need-amt22_0) + limit-cust29_0 + need-amt30_0) (void))) (void)) - (check-limit-custodian limit-cust21_0))) + (check-limit-custodian limit-cust29_0))) (end-atomic/no-interrupts)) (void)))))))) (|#%name| @@ -6293,8 +6331,8 @@ ((limit-cust_0 need-amt_0) (begin (custodian-limit-memory_0 limit-cust_0 need-amt_0 unsafe-undefined))) - ((limit-cust_0 need-amt_0 stop-cust20_0) - (custodian-limit-memory_0 limit-cust_0 need-amt_0 stop-cust20_0)))))) + ((limit-cust_0 need-amt_0 stop-cust28_0) + (custodian-limit-memory_0 limit-cust_0 need-amt_0 stop-cust28_0)))))) (define custodians-with-limits (make-hasheq)) (define check-limit-custodian (lambda (limit-cust_0) @@ -6324,7 +6362,7 @@ (define 1/make-custodian-box (letrec ((procz1 (|#%name| - temp67 + temp76 (lambda (b_0) (begin (set-custodian-box-v! b_0 #f)))))) (|#%name| make-custodian-box @@ -6337,8 +6375,8 @@ (let ((b_0 (custodian-box1.1 v_0 (custodian-get-shutdown-sema c_0)))) (begin - (if (let ((temp67_0 procz1)) - (do-custodian-register.1 #f #t #t c_0 b_0 temp67_0)) + (if (let ((temp76_0 procz1)) + (do-custodian-register.1 #f #t #f #t c_0 b_0 temp76_0)) (void) (raise-arguments-error 'make-custodian-box diff --git a/racket/src/thread/custodian.rkt b/racket/src/thread/custodian.rkt index 5dc1c4452c..d8d69fd540 100644 --- a/racket/src/thread/custodian.rkt +++ b/racket/src/thread/custodian.rkt @@ -116,13 +116,19 @@ (define (do-custodian-register cust obj callback #:at-exit? [at-exit? #f] #:weak? [weak? #f] + #:late? [late? #f] #:gc-root? [gc-root? #f]) (atomically (cond [(custodian-shut-down? cust) #f] [else (define we (and (not weak?) - (host:make-will-executor void))) + (if late? + ;; caller is responsible for ensuring that a late + ;; executor makes sense for `obj` --- especially + ;; that it doesn't refer back to itself + (host:make-late-will-executor void) + (host:make-will-executor void)))) (hash-set! (custodian-children cust) obj (cond @@ -149,8 +155,8 @@ (set-custodian-self-reference! cust cref) cref))]))) -(define (unsafe-custodian-register cust obj callback at-exit? weak?) - (do-custodian-register cust obj callback #:at-exit? at-exit? #:weak? weak?)) +(define (unsafe-custodian-register cust obj callback at-exit? weak? [late? #f]) + (do-custodian-register cust obj callback #:at-exit? at-exit? #:weak? weak? #:late? late?)) (define (custodian-register-thread cust obj callback) (do-custodian-register cust obj callback #:weak? #t #:gc-root? #t))