ffi/unsafe/custodian: add success callback to receive unregister function

Also, correct some information in the documentation of
`register-custodian-shutdown`.

Closes #3841

pkgs/racket-doc/scribblings/foreign/custodian.scrbl

@@ -26,11 +26,15 @@ 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
-if @racket[v] is determined to be unreachable during garbage
+@racket[v] is determined to be unreachable during garbage collection.
-collection.  The value @racket[v] is always weakly held by the
+The value @racket[v] is initially weakly held by the custodian, even
-custodian, even if @racket[weak?] is @racket[#f]; see
+if @racket[weak?] is @racket[#f]. A value associated with a custodian
-@cpp{scheme_add_managed} for more information.
+can therefore be finalized via will executors, at least through will
+registrations and @racket[register-finalizer] uses @emph{after}
+calling @racket[register-custodian-shutdown], but the value becomes
+strongly held when no there are no other strong references and no
+later-registered finalizers or wills apply.
 
 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]
@@ -39,7 +43,7 @@ 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
-and cancel the shutdown action via
+to check that the custodian shutdown has not happened and then cancel the shutdown action via
 @racket[unregister-custodian-shutdown]. If @racket[weak?] is true or
 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
@@ -48,7 +52,7 @@ be no longer registered to the custodian, while the finalizer for
 @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[ordered?] as true; if @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
@@ -71,7 +75,8 @@ is taken.}
                  [callback (any/c . -> . any)]
                  [custodian custodian? (current-custodian)]
                  [#:at-exit? at-exit? any/c #f]
-                 [#:custodian-unavailable unavailable-callback ((-> void?) -> any) (lambda (reg-fnl) (reg-fnl))])
+                 [#:custodian-available available-callback ((any/c -> void?) -> any) (lambda (_unreg) (void))]
+                 [#:custodian-unavailable unavailable-callback ((-> void?) -> any) (lambda (_reg-fnl) (_reg-fnl))])
          any]{
 
 Registers @racket[callback] to be applied (in atomic mode) to
@@ -82,14 +87,25 @@ 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.
 
+When @racket[v] is successfully registered with @racket[custodian] and
+a finalizer is registered, then @racket[available-callback] is called
+with a function @racket[_unreg] that unregisters the @racket[v] and
+disables the use of @racket[callback] through the custodian or a
+finalizer. The value @racket[v] must be provided to @racket[_unreg]
+(otherwise it would be in @racket[_unreg]'s closure, possibly
+preventing the value from being finalized). The
+@racket[available-callback] function is called in tail position, so
+its result is the result of
+@racket[register-finalizer-and-custodian-shutdown].
+
 If @racket[custodian] is already shut down, then
 @racket[unavailable-callback] is applied in tail position to a
-function that registers a finalizer. By default, a finalizer is
+function @racket[reg-fnl] that registers a finalizer. By default, a
-registered anyway, but usually a better choice is to report an error.
+finalizer is registered anyway, but usually a better choice is to
-If @racket[custodian] is not already shut down, then the result
+report an error.
-from @racket[register-finalizer-and-custodian-shutdown] is @|void-const|.
 
-@history[#:added "6.1.1.6"]}
+@history[#:added "6.1.1.6"
+         #:changed "8.1.0.6" @elem{Added the @racket[#:custodian-available] argument.}]}
 
 
 @defproc[(make-custodian-at-root) custodian?]{

pkgs/racket-test/tests/racket/ffi-custodian.rkt

@@ -77,3 +77,39 @@
   (error "custodian-shutdown callback wasn't called"))
 
 (unregister-custodian-shutdown 'anything #f)
+
+;; ----------------------------------------
+;; Check unregistration callback after successful register
+
+(let ([c2 (make-custodian)]
+      [val (gensym)]
+      [ran? #f])
+  (define unreg
+    (register-finalizer-and-custodian-shutdown
+     val (lambda (v) (set! ran? #t)) c2
+     #:custodian-available (lambda (unreg) unreg)))
+  (unless (and (procedure? unreg)
+               (procedure-arity-includes? unreg 1))
+    (error "custodian-shutdown unregister is not a suitable procedure"))
+  (unreg val)
+  (custodian-shutdown-all c2)
+  (when ran?
+    (error "custodian-shutdown unregister did not work")))
+
+;; check that the unregister function doesn't retain the value:
+(let ([c2 (make-custodian)]
+      [val (gensym)])
+  (define unreg
+    (register-finalizer-and-custodian-shutdown
+     val void c2
+     #:custodian-available (lambda (unreg) unreg)))
+  (unless (eq? 'cgc (system-type 'gc))
+    (let ([we (make-will-executor)]
+          [done? #f])
+      (will-register we val (lambda (val)
+                              (unreg val)
+                              (set! done? #t)))
+      (collect-garbage)
+      (unless (and (will-try-execute we)
+                   done?)
+        (error "will wasn't ready")))))

racket/collects/ffi/unsafe/custodian.rkt

@@ -27,7 +27,8 @@
 (define (register-finalizer-and-custodian-shutdown value callback
                                                    [custodian (current-custodian)]
                                                    #:at-exit? [at-exit? #f]
-                                                   #:custodian-unavailable [custodian-unavailable (lambda (r) (r))])
+                                                   #:custodian-unavailable [custodian-unavailable (lambda (r) (r))]
+                                                   #:custodian-available [success-k (lambda (unregister) (void))])
   (define done? #f)
   (define (do-callback obj) ; called in atomic mode
     (unless done?
@@ -43,6 +44,13 @@
         (lambda ()
           (unregister-custodian-shutdown obj registration)
           (do-callback obj))))))
-  (if registration
+  (cond
-      (do-finalizer)
+    [registration
-      (custodian-unavailable do-finalizer)))
+     (do-finalizer)
+     (success-k (lambda (obj)
+                  (call-as-atomic
+                   (lambda ()
+                     (set! done? #t)
+                     (unregister-custodian-shutdown obj registration)))))]
+    [else
+     (custodian-unavailable do-finalizer)]))