suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: repair register-finalizer-and-custodian-shutdown

Browse Source 
Refine the approach in 91abd020d1 so that it's only used when needed
to work for the combination of custodian management and unsafe
finalization.

Also, improve the documentation to clarify the constraints on
`register-finalize` due to its implementation in CS by ordered
finalization. This constraint is also reflected in a new `#:ordered?`
argument to `register-custodian-shutdown`. Any existing code that uses
`register-custodian-shutdown` plus `register-finalizer` directly
instead of `register-finalizer-and-custodian-shutdown` would need to
be updated for Racket CS, but code like that should be rare to
nonexistent.

Closes #3352
This commit is contained in:
Matthew Flatt 2020-08-16 07:37:22 -06:00
parent bf06162210
commit 4a4e12bc8c
7 changed files with 172 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
pkgs/racket-doc/scribblings/foreign/custodian.scrbl
View File

@ -12,7 +12,8 @@ registering shutdown callbacks with custodians.}
[callback (any/c . -> . any)] [callback (any/c . -> . any)]
[custodian custodian? (current-custodian)] [custodian custodian? (current-custodian)]
[#:at-exit? at-exit? any/c #f] [#:at-exit? at-exit? any/c #f]
[#:weak? weak? any/c #f]) [#:weak? weak? any/c #f]
[#:ordered? ordered? any/c #f])
cpointer?]{ cpointer?]{
Registers @racket[callback] to be applied (in atomic mode and an 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 If @racket[at-exit?] is true, then @racket[callback] is applied when
Racket exits, even if the custodian is not explicitly shut down. 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 if @racket[v] is determined to be unreachable during garbage
collection. The value @racket[v] is always weakly held by the collection. The value @racket[v] is always weakly held by the
custodian, even if @racket[weak?] is @racket[#f]; see custodian, even if @racket[weak?] is @racket[#f]; see
@cpp{scheme_add_managed} for more information. @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 Normally, @racket[weak?] should be false. To trigger actions based on
finalization or custodian shutdown---whichever happens first---leave finalization or custodian shutdown---whichever happens first---leave
@racket[weak?] as @racket[#f] and have a finalizer run in atomic mode @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 that either of the custodian or finalizer callbacks has completed by
the time that the custodian shutdown has completed; @racket[v] might the time that the custodian shutdown has completed; @racket[v] might
be no longer registered to the custodian, while the finalizer for 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[v] might be still running or merely queued to run.
@racket[register-finalizer-and-custodian-shutdown].} 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] @defproc[(unregister-custodian-shutdown [v any/c]
@ -64,7 +77,10 @@ is taken.}
Registers @racket[callback] to be applied (in atomic mode) to Registers @racket[callback] to be applied (in atomic mode) to
@racket[v] when @racket[custodian] is shutdown or when @racket[v] is @racket[v] when @racket[custodian] is shutdown or when @racket[v] is
about to be collected by the garbage collector, whichever happens 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 If @racket[custodian] is already shut down, then
@racket[unavailable-callback] is applied in tail position to a @racket[unavailable-callback] is applied in tail position to a

2
pkgs/racket-doc/scribblings/foreign/pointers.scrbl
View File

@ -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 normal @tech[#:doc reference.scrbl]{will executor} has a will ready
for the value. The finalizer is invoked when the will for @racket[obj] for the value. The finalizer is invoked when the will for @racket[obj]
becomes ready in the ``late'' will executor, which means that the 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 The finalizer is invoked in a thread that is in charge of triggering
will executors for @racket[register-finalizer]. The given will executors for @racket[register-finalizer]. The given

7
pkgs/racket-doc/scribblings/foreign/unexported.scrbl
View File

@ -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 normal weak references to @scheme[_v] are cleared before a will for
@racket[_v] is readied by the late will executor, but late weak @racket[_v] is readied by the late will executor, but late weak
references created by @racket[make-late-weak-box] and 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 Unlike a normal will executor, if a late will executor becomes
inaccessible, the values for which it has pending wills are retained inaccessible, the values for which it has pending wills are retained

7
racket/collects/ffi/unsafe/custodian.rkt
View File

@ -16,8 +16,9 @@
(define (register-custodian-shutdown obj proc [custodian (current-custodian)] (define (register-custodian-shutdown obj proc [custodian (current-custodian)]
#:at-exit? [at-exit? #f] #:at-exit? [at-exit? #f]
#:weak? [weak? #f]) #:weak? [weak? #f]
(unsafe-custodian-register custodian obj proc at-exit? weak?)) #:ordered? [late? #f])
(unsafe-custodian-register custodian obj proc at-exit? weak? late?))
(define (unregister-custodian-shutdown obj mref) (define (unregister-custodian-shutdown obj mref)
(when mref (when mref
@ -33,7 +34,7 @@
(set! done? #t) (set! done? #t)
(callback obj))) (callback obj)))
(define registration (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) (define (do-finalizer)
(register-finalizer (register-finalizer
value value

3
racket/src/bc/src/thread.c
View File

@ -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-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-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-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); 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]; Scheme_Object *callback = argv[2];
int at_exit = SCHEME_TRUEP(argv[3]); int at_exit = SCHEME_TRUEP(argv[3]);
int init_weak = SCHEME_TRUEP(argv[4]); int init_weak = SCHEME_TRUEP(argv[4]);
/* optional `late?` sixth argument is not used */
/* Some checks, just to be polite */ /* Some checks, just to be polite */
if (!SCHEME_CUSTODIANP(argv[0])) if (!SCHEME_CUSTODIANP(argv[0]))

220
racket/src/cs/schemified/thread.scm
View File

@ -5625,11 +5625,11 @@
(begin (begin
(set-custodian-place! c_0 (custodian-place parent_0)) (set-custodian-place! c_0 (custodian-place parent_0))
(let ((cref_0 (let ((cref_0
(let ((temp31_0 (let ((temp39_0
(let ((children_0 (let ((children_0
(custodian-children c_0))) (custodian-children c_0)))
(|#%name| (|#%name|
temp31 temp39
(lambda (c_1) (lambda (c_1)
(begin (begin
(begin (begin
@ -5639,10 +5639,11 @@
(do-custodian-register.1 (do-custodian-register.1
#t #t
#t #t
#f
#t #t
parent_0 parent_0
c_0 c_0
temp31_0)))) temp39_0))))
(begin (begin
(set-custodian-parent-reference! c_0 cref_0) (set-custodian-parent-reference! c_0 cref_0)
(if cref_0 (if cref_0
@ -5670,67 +5671,102 @@
(define do-custodian-register.1 (define do-custodian-register.1
(|#%name| (|#%name|
do-custodian-register 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
(begin (begin
(start-atomic) (start-atomic)
(begin0 (begin0
(if (1/custodian-shut-down? cust12_0) (if (1/custodian-shut-down? cust14_0)
#f #f
(let ((we_0 (let ((we_0
(if (not weak?7_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))) #f)))
(begin (begin
(let ((app_0 (custodian-children cust12_0))) (let ((app_0 (custodian-children cust14_0)))
(hash-set! (hash-set!
app_0 app_0
obj13_0 obj15_0
(if weak?7_0 (if weak?7_0
callback14_0 callback16_0
(if at-exit?6_0 (if at-exit?6_0
(at-exit-callback3.1 callback14_0 we_0) (at-exit-callback3.1 callback16_0 we_0)
(willed-callback2.1 callback14_0 we_0))))) (willed-callback2.1 callback16_0 we_0)))))
(if we_0 (if we_0
(|#%app| host:will-register we_0 obj13_0 void) (|#%app| host:will-register we_0 obj15_0 void)
(void)) (void))
(if gc-root?8_0 (if gc-root?9_0
(begin (begin
(|#%app| host:disable-interrupts) (|#%app| host:disable-interrupts)
(if (custodian-gc-roots cust12_0) (if (custodian-gc-roots cust14_0)
(void) (void)
(set-custodian-gc-roots! cust12_0 (make-weak-hasheq))) (set-custodian-gc-roots! cust14_0 (make-weak-hasheq)))
(hash-set! (custodian-gc-roots cust12_0) obj13_0 #t) (hash-set! (custodian-gc-roots cust14_0) obj15_0 #t)
(check-limit-custodian cust12_0) (check-limit-custodian cust14_0)
(|#%app| host:enable-interrupts)) (|#%app| host:enable-interrupts))
(void)) (void))
(let ((or-part_0 (custodian-self-reference cust12_0))) (let ((or-part_0 (custodian-self-reference cust14_0)))
(if or-part_0 (if or-part_0
or-part_0 or-part_0
(let ((cref_0 (let ((cref_0
(custodian-reference4.1 (make-weak-box cust12_0)))) (custodian-reference4.1 (make-weak-box cust14_0))))
(begin (begin
(set-custodian-self-reference! cust12_0 cref_0) (set-custodian-self-reference! cust14_0 cref_0)
cref_0))))))) cref_0)))))))
(end-atomic))))))) (end-atomic)))))))
(define 1/unsafe-custodian-register (define 1/unsafe-custodian-register
(|#%name| (let ((unsafe-custodian-register_0
unsafe-custodian-register (|#%name|
(lambda (cust_0 obj_0 callback_0 at-exit?_0 weak?_0) unsafe-custodian-register
(begin (lambda (cust19_0
(do-custodian-register.1 obj20_0
at-exit?_0 callback21_0
#f at-exit?22_0
weak?_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 cust_0
obj_0 obj_0
callback_0))))) callback_0
at-exit?_0
weak?_0
late?18_0))))))
(define custodian-register-thread (define custodian-register-thread
(lambda (cust_0 obj_0 callback_0) (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 (define custodian-register-place
(lambda (cust_0 obj_0 callback_0) (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 (define 1/unsafe-custodian-unregister
(|#%name| (|#%name|
unsafe-custodian-unregister unsafe-custodian-unregister
@ -5795,24 +5831,26 @@
#f) #f)
#f))) #f)))
(if (willed-callback? callback_0) (if (willed-callback? callback_0)
(let ((temp52_0 (let ((temp61_0
(willed-callback-proc (willed-callback-proc
callback_0))) callback_0)))
(let ((temp53_0 (let ((temp62_0
(at-exit-callback? (at-exit-callback?
callback_0))) callback_0)))
(let ((temp52_1 temp52_0)) (let ((temp61_1 temp61_0))
(do-custodian-register.1 (do-custodian-register.1
temp53_0 temp62_0
gc-root?_0 gc-root?_0
#f #f
#f
parent_0 parent_0
child_0 child_0
temp52_1)))) temp61_1))))
(do-custodian-register.1 (do-custodian-register.1
#f #f
gc-root?_0 gc-root?_0
#f #f
#f
parent_0 parent_0
child_0 child_0
callback_0))) callback_0)))
@ -5976,18 +6014,18 @@
(let ((do-custodian-shutdown-all_0 (let ((do-custodian-shutdown-all_0
(|#%name| (|#%name|
do-custodian-shutdown-all do-custodian-shutdown-all
(lambda (c17_0 only-at-exit?16_0) (lambda (c25_0 only-at-exit?24_0)
(begin (begin
(if (1/custodian-shut-down? c17_0) (if (1/custodian-shut-down? c25_0)
(void) (void)
(begin (begin
(set-custodian-shut-down! c17_0) (set-custodian-shut-down! c25_0)
(begin (begin
(if (custodian-sync-futures? c17_0) (if (custodian-sync-futures? c25_0)
(|#%app| futures-sync-for-custodian-shutdown) (|#%app| futures-sync-for-custodian-shutdown)
(void)) (void))
(begin (begin
(let ((ht_0 (custodian-children c17_0))) (let ((ht_0 (custodian-children c25_0)))
(begin (begin
(letrec* (letrec*
((for-loop_0 ((for-loop_0
@ -6004,7 +6042,7 @@
(begin (begin
(if (if child_0 (if (if child_0
(let ((or-part_0 (let ((or-part_0
(not only-at-exit?16_0))) (not only-at-exit?24_0)))
(if or-part_0 (if or-part_0
or-part_0 or-part_0
(at-exit-callback? (at-exit-callback?
@ -6013,7 +6051,7 @@
(if (procedure-arity-includes? (if (procedure-arity-includes?
callback_0 callback_0
2) 2)
(|#%app| callback_0 child_0 c17_0) (|#%app| callback_0 child_0 c25_0)
(|#%app| callback_0 child_0)) (|#%app| callback_0 child_0))
(void)) (void))
(for-loop_0 (for-loop_0
@ -6025,13 +6063,13 @@
(values))))))) (values)))))))
(for-loop_0 (hash-iterate-first ht_0))))) (for-loop_0 (hash-iterate-first ht_0)))))
(begin (begin
(hash-clear! (custodian-children c17_0)) (hash-clear! (custodian-children c25_0))
(begin (begin
(if (custodian-gc-roots c17_0) (if (custodian-gc-roots c25_0)
(hash-clear! (custodian-gc-roots c17_0)) (hash-clear! (custodian-gc-roots c25_0))
(void)) (void))
(begin (begin
(let ((lst_0 (custodian-post-shutdown c17_0))) (let ((lst_0 (custodian-post-shutdown c25_0)))
(begin (begin
(letrec* (letrec*
((for-loop_0 ((for-loop_0
@ -6048,28 +6086,28 @@
(values))))))) (values)))))))
(for-loop_0 lst_0)))) (for-loop_0 lst_0))))
(begin (begin
(set-custodian-post-shutdown! c17_0 null) (set-custodian-post-shutdown! c25_0 null)
(begin (begin
(let ((sema_0 (custodian-shutdown-sema c17_0))) (let ((sema_0 (custodian-shutdown-sema c25_0)))
(if sema_0 (if sema_0
(semaphore-post-all sema_0) (semaphore-post-all sema_0)
(void))) (void)))
(let ((p-cref_0 (let ((p-cref_0
(custodian-parent-reference c17_0))) (custodian-parent-reference c25_0)))
(begin (begin
(if p-cref_0 (if p-cref_0
(1/unsafe-custodian-unregister (1/unsafe-custodian-unregister
c17_0 c25_0
p-cref_0) p-cref_0)
(void)) (void))
(remove-limit-custodian! c17_0) (remove-limit-custodian! c25_0)
(set-custodian-memory-limits! (set-custodian-memory-limits!
c17_0 c25_0
null))))))))))))))))) null)))))))))))))))))
(case-lambda (case-lambda
((c_0) (do-custodian-shutdown-all_0 c_0 #f)) ((c_0) (do-custodian-shutdown-all_0 c_0 #f))
((c_0 only-at-exit?16_0) ((c_0 only-at-exit?24_0)
(do-custodian-shutdown-all_0 c_0 only-at-exit?16_0))))) (do-custodian-shutdown-all_0 c_0 only-at-exit?24_0)))))
(define custodian-get-shutdown-sema (define custodian-get-shutdown-sema
(lambda (c_0) (lambda (c_0)
(begin (begin
@ -6090,28 +6128,28 @@
(let ((unsafe-add-post-custodian-shutdown_0 (let ((unsafe-add-post-custodian-shutdown_0
(|#%name| (|#%name|
unsafe-add-post-custodian-shutdown unsafe-add-post-custodian-shutdown
(lambda (proc19_0 custodian18_0) (lambda (proc27_0 custodian26_0)
(begin (begin
(begin (begin
(if (if (procedure? proc19_0) (if (if (procedure? proc27_0)
(procedure-arity-includes? proc19_0 0) (procedure-arity-includes? proc27_0 0)
#f) #f)
(void) (void)
(raise-argument-error (raise-argument-error
'unsafe-add-post-custodian-shutdown 'unsafe-add-post-custodian-shutdown
"(procedure-arity-includes/c 0)" "(procedure-arity-includes/c 0)"
proc19_0)) proc27_0))
(begin (begin
(if (let ((or-part_0 (not custodian18_0))) (if (let ((or-part_0 (not custodian26_0)))
(if or-part_0 or-part_0 (1/custodian? custodian18_0))) (if or-part_0 or-part_0 (1/custodian? custodian26_0)))
(void) (void)
(raise-argument-error (raise-argument-error
'unsafe-add-post-custodian-shutdown 'unsafe-add-post-custodian-shutdown
"(or/c custodian? #f)" "(or/c custodian? #f)"
custodian18_0)) custodian26_0))
(let ((c_0 (let ((c_0
(if custodian18_0 (if custodian26_0
custodian18_0 custodian26_0
(place-custodian (place-custodian
(unsafe-place-local-ref cell.1$2))))) (unsafe-place-local-ref cell.1$2)))))
(if (if (not (if (if (not
@ -6126,14 +6164,14 @@
(begin0 (begin0
(set-custodian-post-shutdown! (set-custodian-post-shutdown!
c_0 c_0
(cons proc19_0 (custodian-post-shutdown c_0))) (cons proc27_0 (custodian-post-shutdown c_0)))
(end-atomic)))))))))))) (end-atomic))))))))))))
(|#%name| (|#%name|
unsafe-add-post-custodian-shutdown unsafe-add-post-custodian-shutdown
(case-lambda (case-lambda
((proc_0) (begin (unsafe-add-post-custodian-shutdown_0 proc_0 #f))) ((proc_0) (begin (unsafe-add-post-custodian-shutdown_0 proc_0 #f)))
((proc_0 custodian18_0) ((proc_0 custodian26_0)
(unsafe-add-post-custodian-shutdown_0 proc_0 custodian18_0)))))) (unsafe-add-post-custodian-shutdown_0 proc_0 custodian26_0))))))
(define custodian-subordinate? (define custodian-subordinate?
(lambda (c_0 super-c_0) (lambda (c_0 super-c_0)
(letrec* (letrec*
@ -6226,25 +6264,25 @@
(let ((custodian-limit-memory_0 (let ((custodian-limit-memory_0
(|#%name| (|#%name|
custodian-limit-memory custodian-limit-memory
(lambda (limit-cust21_0 need-amt22_0 stop-cust20_0) (lambda (limit-cust29_0 need-amt30_0 stop-cust28_0)
(begin (begin
(let ((stop-cust_0 (let ((stop-cust_0
(if (eq? stop-cust20_0 unsafe-undefined) (if (eq? stop-cust28_0 unsafe-undefined)
limit-cust21_0 limit-cust29_0
stop-cust20_0))) stop-cust28_0)))
(begin (begin
(if (1/custodian? limit-cust21_0) (if (1/custodian? limit-cust29_0)
(void) (void)
(raise-argument-error (raise-argument-error
'custodian-limit-memory 'custodian-limit-memory
"custodian?" "custodian?"
limit-cust21_0)) limit-cust29_0))
(if (exact-nonnegative-integer? need-amt22_0) (if (exact-nonnegative-integer? need-amt30_0)
(void) (void)
(raise-argument-error (raise-argument-error
'custodian-limit-memory 'custodian-limit-memory
"exact-nonnegative-integer?" "exact-nonnegative-integer?"
need-amt22_0)) need-amt30_0))
(if (1/custodian? stop-cust_0) (if (1/custodian? stop-cust_0)
(void) (void)
(raise-argument-error (raise-argument-error
@ -6255,36 +6293,36 @@
(start-atomic/no-interrupts) (start-atomic/no-interrupts)
(begin0 (begin0
(if (let ((or-part_0 (if (let ((or-part_0
(1/custodian-shut-down? limit-cust21_0))) (1/custodian-shut-down? limit-cust29_0)))
(if or-part_0 (if or-part_0
or-part_0 or-part_0
(1/custodian-shut-down? stop-cust_0))) (1/custodian-shut-down? stop-cust_0)))
(void) (void)
(begin (begin
(set-custodian-memory-limits! (set-custodian-memory-limits!
limit-cust21_0 limit-cust29_0
(let ((app_0 (let ((app_0
(cons (cons
need-amt22_0 need-amt30_0
(if (eq? limit-cust21_0 stop-cust_0) (if (eq? limit-cust29_0 stop-cust_0)
#f #f
stop-cust_0)))) stop-cust_0))))
(cons (cons
app_0 app_0
(custodian-memory-limits limit-cust21_0)))) (custodian-memory-limits limit-cust29_0))))
(if (eq? stop-cust_0 limit-cust21_0) (if (eq? stop-cust_0 limit-cust29_0)
(let ((old-limit_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 (let ((or-part_0 (not old-limit_0)))
(if or-part_0 (if or-part_0
or-part_0 or-part_0
(> old-limit_0 need-amt22_0))) (> old-limit_0 need-amt30_0)))
(set-custodian-immediate-limit! (set-custodian-immediate-limit!
limit-cust21_0 limit-cust29_0
need-amt22_0) need-amt30_0)
(void))) (void)))
(void)) (void))
(check-limit-custodian limit-cust21_0))) (check-limit-custodian limit-cust29_0)))
(end-atomic/no-interrupts)) (end-atomic/no-interrupts))
(void)))))))) (void))))))))
(|#%name| (|#%name|
@ -6293,8 +6331,8 @@
((limit-cust_0 need-amt_0) ((limit-cust_0 need-amt_0)
(begin (begin
(custodian-limit-memory_0 limit-cust_0 need-amt_0 unsafe-undefined))) (custodian-limit-memory_0 limit-cust_0 need-amt_0 unsafe-undefined)))
((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-cust20_0)))))) (custodian-limit-memory_0 limit-cust_0 need-amt_0 stop-cust28_0))))))
(define custodians-with-limits (make-hasheq)) (define custodians-with-limits (make-hasheq))
(define check-limit-custodian (define check-limit-custodian
(lambda (limit-cust_0) (lambda (limit-cust_0)
@ -6324,7 +6362,7 @@
(define 1/make-custodian-box (define 1/make-custodian-box
(letrec ((procz1 (letrec ((procz1
(|#%name| (|#%name|
temp67 temp76
(lambda (b_0) (begin (set-custodian-box-v! b_0 #f)))))) (lambda (b_0) (begin (set-custodian-box-v! b_0 #f))))))
(|#%name| (|#%name|
make-custodian-box make-custodian-box
@ -6337,8 +6375,8 @@
(let ((b_0 (let ((b_0
(custodian-box1.1 v_0 (custodian-get-shutdown-sema c_0)))) (custodian-box1.1 v_0 (custodian-get-shutdown-sema c_0))))
(begin (begin
(if (let ((temp67_0 procz1)) (if (let ((temp76_0 procz1))
(do-custodian-register.1 #f #t #t c_0 b_0 temp67_0)) (do-custodian-register.1 #f #t #f #t c_0 b_0 temp76_0))
(void) (void)
(raise-arguments-error (raise-arguments-error
'make-custodian-box 'make-custodian-box

12
racket/src/thread/custodian.rkt
View File

@ -116,13 +116,19 @@
(define (do-custodian-register cust obj callback (define (do-custodian-register cust obj callback
#:at-exit? [at-exit? #f] #:at-exit? [at-exit? #f]
#:weak? [weak? #f] #:weak? [weak? #f]
#:late? [late? #f]
#:gc-root? [gc-root? #f]) #:gc-root? [gc-root? #f])
(atomically (atomically
(cond (cond
[(custodian-shut-down? cust) #f] [(custodian-shut-down? cust) #f]
[else [else
(define we (and (not weak?) (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) (hash-set! (custodian-children cust)
obj obj
(cond (cond
@ -149,8 +155,8 @@
(set-custodian-self-reference! cust cref) (set-custodian-self-reference! cust cref)
cref))]))) cref))])))
(define (unsafe-custodian-register cust obj callback at-exit? 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?)) (do-custodian-register cust obj callback #:at-exit? at-exit? #:weak? weak? #:late? late?))
(define (custodian-register-thread cust obj callback) (define (custodian-register-thread cust obj callback)
(do-custodian-register cust obj callback #:weak? #t #:gc-root? #t)) (do-custodian-register cust obj callback #:weak? #t #:gc-root? #t))