diff --git a/pkgs/racket-doc/scribblings/foreign/custodian.scrbl b/pkgs/racket-doc/scribblings/foreign/custodian.scrbl index 0e1a516e6e..9305af75c7 100644 --- a/pkgs/racket-doc/scribblings/foreign/custodian.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/custodian.scrbl @@ -38,7 +38,8 @@ 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.} +@racket[v] might be still running or merely queued to run. See also +@racket[register-finalizer-and-custodian-shutdown].} @defproc[(unregister-custodian-shutdown [v any/c] @@ -48,3 +49,18 @@ be no longer registered to the custodian, while the finalizer for Cancels a custodian-shutdown registration, where @racket[registration] is a previous result from @racket[register-custodian-shutdown] applied to @racket[v].} + +@defproc[(register-finalizer-and-custodian-shutdown + [v any/c] + [callback (any/c . -> . any)] + [custodian custodian? (current-custodian)] + [#:at-exit? at-exit? any/c #f] + [#:weak? weak? any/c #f]) + void?]{ + +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. + +@history[#:added "6.1.1.6"]} diff --git a/racket/collects/ffi/unsafe/custodian.rkt b/racket/collects/ffi/unsafe/custodian.rkt index 1db4dead5a..bc9e74d29c 100644 --- a/racket/collects/ffi/unsafe/custodian.rkt +++ b/racket/collects/ffi/unsafe/custodian.rkt @@ -1,7 +1,9 @@ #lang racket/base -(require ffi/unsafe) +(require ffi/unsafe + ffi/unsafe/atomic) (provide (protect-out register-custodian-shutdown + register-finalizer-and-custodian-shutdown unregister-custodian-shutdown)) (define _Scheme_Custodian_Reference-pointer @@ -41,3 +43,20 @@ (define (unregister-custodian-shutdown obj mref) (scheme_remove_managed mref obj)) + +(define (register-finalizer-and-custodian-shutdown value callback + [custodian (current-custodian)] + #:at-exit? [at-exit? #f]) + (define done? #f) + (define (do-callback obj) ; called in atomic mode + (unless done? + (set! done? #t) + (callback obj))) + (define registration + (register-custodian-shutdown value do-callback custodian #:at-exit? at-exit?)) + (register-finalizer value + (lambda (obj) + (call-as-atomic + (lambda () + (unregister-custodian-shutdown obj registration) + (do-callback obj))))))