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

cs: repairs for inaccessible custodians and custodian boxes

Browse Source 
Allows an inaccessible custodian to be GCed, promoting any values that
it manages to its parent custodian. Also repair memory accounting for
custodian boxes.

For values referenced by a custodian, the nature of the custodian's
weak references is slightly different on Racket CS. The reference is
weak enough that the value can be finalized via will (e.g., to close
an unused port), but it's not weak enough to allow weak boxes, weak
hash table keys, or ephemeron keys to be cleared. That's a consequence
of using ordered finalization instead of finalization/weakness levels.
This difference could be avoided at the cost of an extra wrapper for
any finalized value and a discipline of using such wrappers as the
user-visible reference for all custodian-managed values, but semi-weak
references so far appear to be practical and a better compromise.
This commit is contained in:
Matthew Flatt 2019-05-03 18:19:28 -06:00
parent 9951efc891
commit 151b5755c5
9 changed files with 131 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -97,14 +97,15 @@ A predicate for callback values that are created by @racket[ffi-callback].
Creates a ``late'' will executor that readies a will for a value
@scheme[_v] only if no normal will executor has a will registered for
@scheme[_v]. In addition, weak references to @scheme[_v] are cleared
before a will for @racket[_v] is readied by the late will
executor.
@scheme[_v]. In addition, for the @3m[] and @CGC[] variants of Racket,
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.
Unlike a normal will executor, if a late will executor becomes
inaccessible, the values for which it has pending wills are retained
within the late will executor's place.
A late will executor is intended for use only in the implementation of
@racket[register-finalizer]. See also @racket[make-late-weak-box] and
@racket[make-late-weak-hasheq].}
A late will executor is intended for use in the implementation of
@racket[register-finalizer].}

9
pkgs/racket-doc/scribblings/reference/eval-model.scrbl
View File

@ -1069,9 +1069,12 @@ has multiple custodians, it is not necessarily killed by a
from the thread's managing custodian set, and the thread is killed when its
managing set becomes empty.
The values managed by a custodian are only weakly held by the
custodian. As a result, a @techlink{will} can be executed for a value that
is managed by a custodian. In addition, a custodian only weakly
The values managed by a custodian are semi-weakly held by the
custodian: a @techlink{will} can be executed for a value that is
managed by a custodian; in addition, weak references via weak
@tech{hash tables}, @tech{ephemerons}, or @tech{weak box}es can be
dropped on the 3m or CGC variants of Racket, but not on the CS
variant. For all variants, a custodian only weakly
references its subordinate custodians; if a subordinate custodian is
unreferenced but has its own subordinates, then the custodian may be
garbage collected, at which point its subordinates become immediately

25
pkgs/racket-test-core/tests/racket/will.rktl
View File

@ -125,9 +125,9 @@
c)])
;; Each custodian must be charged at least 100000 bytes:
(collect-garbage)
(test #t andmap (lambda (c)
((current-memory-use c) . >= . 100000))
c)))
(test #t andmap (lambda (v)
(v . >= . 100000))
(map current-memory-use c))))
(let ()
(define c1 (make-custodian (current-custodian)))
@ -146,6 +146,25 @@
(custodian-shutdown-all c)
(test #f ormap (lambda (b) (number? (custodian-box-value b))) l))))
;; Check chain of unreachable custodians:
(let ()
(define start-c (make-custodian))
(define wbs+cbs
(let loop ([i 20] [parent start-c])
(if (zero? i)
null
(let ([c (make-custodian parent)])
(cons (cons (make-weak-box c)
(make-custodian-box c 'on))
(loop (sub1 i) c))))))
(collect-garbage)
(test #t < 10 (for/sum ([wb+cb (in-list wbs+cbs)])
(if (weak-box-value (car wb+cb)) 1 0)))
(custodian-shutdown-all start-c)
(test #t andmap
(lambda (wb+cb) (not (custodian-box-value (cdr wb+cb))))
wbs+cbs))
;; check synchronization again:
(let ()
(define done #f)

4
racket/src/cs/rumble/memory.ss
View File

@ -286,6 +286,10 @@
#%procedure?]
[(eq? 'ephemeron (car args))
ephemeron-pair?]
[(eq? '<ffi-lib> (car args))
ffi-lib?]
[(eq? '<will-executor> (car args))
will-executor?]
[(eq? 'metacontinuation-frame (car args))
metacontinuation-frame?]
[(symbol? (car args))

8
racket/src/thread/bootstrap.rkt
View File

@ -1,7 +1,7 @@
#lang racket/base
(require '#%linklet
(only-in '#%foreign
make-stubborn-will-executor)
make-late-will-executor)
"../common/queue.rkt")
;; Simulate engines by using the host system's threads.
@ -122,8 +122,8 @@
(define (make-will-executor/notify notify)
(do-make-will-executor/notify make-will-executor notify))
(define (make-stubborn-will-executor/notify notify)
(do-make-will-executor/notify make-stubborn-will-executor notify))
(define (make-late-will-executor/notify notify [keep? #t])
(do-make-will-executor/notify make-late-will-executor notify))
(define (will-register/notify we/n v proc)
(will-register (will-executor/notify-we we/n)
@ -239,7 +239,7 @@
'continuation-marks continuation-marks ; doesn't work on engines
'poll-will-executors poll-will-executors
'make-will-executor make-will-executor/notify
'make-stubborn-will-executor make-stubborn-will-executor/notify
'make-late-will-executor make-late-will-executor/notify
'will-executor? will-executor/notify?
'will-register will-register/notify
'will-try-execute will-try-execute/notify

6
racket/src/thread/custodian-object.rkt
View File

@ -11,6 +11,7 @@
[shutdown-sema #:mutable]
[need-shutdown #:mutable] ; queued asynchronous shutdown: #f, 'needed, or 'needed/sent-wakeup
[parent-reference #:mutable]
[self-reference #:mutable]
[place #:mutable] ; place containing the custodian
[memory-use #:mutable] ; set after a major GC
[gc-roots #:mutable] ; weak references to charge to custodian; access without interrupts
@ -18,18 +19,19 @@
[immediate-limit #:mutable]) ; limit on immediate allocation
#:authentic)
(define (create-custodian)
(define (create-custodian parent)
(custodian (make-weak-hasheq)
#f ; shut-down?
#f ; shutdown semaphore
#f ; need shutdown?
#f ; parent reference
#f ; self reference
#f ; place
0 ; memory use
#f ; GC roots
null ; memory limits
#f)) ; immediate limit
(define initial-place-root-custodian (create-custodian))
(define initial-place-root-custodian (create-custodian #f))
(define-place-local root-custodian initial-place-root-custodian)

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

@ -1,6 +1,7 @@
#lang racket/base
(require "custodian-object.rkt"
"place-object.rkt"
"place-local.rkt"
"check.rkt"
"atomic.rkt"
"host.rkt"
@ -39,7 +40,8 @@
(module+ scheduling
(provide do-custodian-shutdown-all
set-root-custodian!
create-custodian))
create-custodian
poll-custodian-will-executor))
;; For `(struct custodian ...)`, see "custodian-object.rkt"
@ -57,11 +59,13 @@
;; Reporting registration in a custodian through this indirection
;; enables GCing custodians that aren't directly referenced, merging
;; the managed objects into the parent, although that posisbility is
;; not currently implemented
(struct custodian-reference (c)
;; the managed objects into the parent. To support multiple moves,
;; `c` can be another reference
(struct custodian-reference ([c #:mutable])
#:authentic)
(define-place-local custodian-will-executor (host:make-late-will-executor void #f))
(define/who current-custodian
(make-parameter root-custodian
(lambda (v)
@ -71,11 +75,12 @@
;; To initialize a new place:
(define (set-root-custodian! c)
(set! root-custodian c)
(current-custodian c))
(current-custodian c)
(set! custodian-will-executor (host:make-late-will-executor void #f)))
(define/who (make-custodian [parent (current-custodian)])
(check who custodian? parent)
(define c (create-custodian))
(define c (create-custodian parent))
(set-custodian-place! c (custodian-place parent))
(define cref (do-custodian-register parent c
;; Retain children procs as long as proc for `c`
@ -83,9 +88,11 @@
(lambda (c)
(reference-sink children)
(do-custodian-shutdown-all c)))
#f #f #t))
#:at-exit? #t
#:gc-root? #t))
(set-custodian-parent-reference! c cref)
(unless cref (raise-custodian-is-shut-down who parent))
(host:will-register custodian-will-executor c merge-custodian-into-parent)
c)
(define (unsafe-make-custodian-at-root)
@ -93,10 +100,13 @@
;; The given `callback` will be run in atomic mode.
;; Unless `weak?` is true, the given `obj` is registered with an ordered
;; finalizer, so don't supply an `obj` that is exposed to safe code
;; that might see `obj` after finalization through a weak reference
;; (and detect that `obj` is thereafter retained strongly).
(define (do-custodian-register cust obj callback at-exit? weak? gc-root?)
;; finalizer; in that case, if `obj` is exposed to safe code, it can
;; have its own finalizers, but weak boxes or hashtable references will
;; not be cleared until the value is explicitly shut down.
(define (do-custodian-register cust obj callback
#:at-exit? [at-exit? #f]
#:weak? [weak? #f]
#:gc-root? [gc-root? #f])
(atomically
(cond
[(custodian-shut-down? cust) #f]
@ -110,9 +120,10 @@
[at-exit? (at-exit-callback callback we)]
[else (willed-callback callback we)]))
(when we
;; Registering with a will executor that we never poll has the
;; effect of turning a weak reference into a strong one when
;; there are no other references:
;; Registering with a will executor that we retain but never
;; poll has the effect of turning a semi-weak reference
;; (allows other finalizers, but doesn't clear weak boxes)
;; into a strong one when there are no other references:
(host:will-register we obj void))
(when gc-root?
(host:disable-interrupts)
@ -120,21 +131,24 @@
(set-custodian-gc-roots! cust (make-weak-hasheq)))
(hash-set! (custodian-gc-roots cust) obj #t)
(host:enable-interrupts))
(custodian-reference cust)])))
(or (custodian-self-reference cust)
(let ([cref (custodian-reference cust)])
(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? weak? #f))
(do-custodian-register cust obj callback #:at-exit? at-exit? #:weak? weak?))
(define (custodian-register-thread cust obj callback)
(do-custodian-register cust obj callback #f #t #t))
(do-custodian-register cust obj callback #:weak? #t #:gc-root? #t))
(define (custodian-register-place cust obj callback)
(do-custodian-register cust obj callback #f #t #t))
(do-custodian-register cust obj callback #:weak? #t #:gc-root? #t))
(define (unsafe-custodian-unregister obj cref)
(when cref
(atomically
(define c (custodian-reference-c cref))
(define c (custodian-reference->custodian cref))
(unless (custodian-shut-down? c)
(hash-remove! (custodian-children c) obj))
(host:disable-interrupts)
@ -144,6 +158,37 @@
(host:enable-interrupts))
(void)))
;; Called by scheduler (so atomic) when `c` is unreachable
(define (merge-custodian-into-parent c)
(unless (custodian-shut-down? c)
(define p-cref (custodian-parent-reference c))
(define parent (custodian-reference->custodian p-cref))
(define gc-roots (custodian-gc-roots c))
(unsafe-custodian-unregister c p-cref)
(for ([(child callback) (in-hash (custodian-children c))])
(define gc-root? (and gc-roots (hash-ref gc-roots child #f) #t))
(cond
[(willed-callback? callback)
(do-custodian-register parent child (willed-callback-proc callback)
#:at-exit? (at-exit-callback? callback)
#:gc-root? gc-root?)]
[else
(do-custodian-register parent child callback
#:gc-root? gc-root?)]))
(define self-ref (custodian-self-reference c))
(when self-ref
(set-custodian-reference-c! self-ref (custodian-self-reference parent)))
(hash-clear! (custodian-children c))
(when gc-roots (hash-clear! gc-roots))))
;; Called in scheduler thread:
(define (poll-custodian-will-executor)
(cond
[(host:will-try-execute custodian-will-executor)
=> (lambda (p)
((car p) (cdr p))
(poll-custodian-will-executor))]))
;; Hook for thread scheduling:
(define post-shutdown-action void)
(define (set-post-shutdown-action! proc)
@ -219,7 +264,10 @@
(hash-clear! (custodian-children c))
(let ([sema (custodian-shutdown-sema c)])
(when sema
(semaphore-post-all sema)))))
(semaphore-post-all sema)))
(define p-cref (custodian-parent-reference c))
(when p-cref
(unsafe-custodian-unregister c p-cref))))
(define (custodian-get-shutdown-sema c)
(atomically
@ -232,19 +280,29 @@
(define (custodian-subordinate? c super-c)
(let loop ([p-cref (custodian-parent-reference c)])
(define p (and p-cref (custodian-reference-c p-cref)))
(define p (and p-cref (custodian-reference->custodian p-cref)))
(cond
[(eq? p super-c) #t]
[(not p) #f]
[else (loop (custodian-parent-reference p))])))
(define (custodian-manages-reference? c cref)
(define ref-c (custodian-reference-c cref))
(define ref-c (custodian-reference->custodian cref))
(or (eq? c ref-c)
(custodian-subordinate? ref-c c)))
(define (custodian-reference->custodian cref)
(custodian-reference-c cref))
(define c (custodian-reference-c cref))
(cond
[(custodian-reference? c)
(define next-c (custodian-reference-c c))
(cond
[(custodian-reference? next-c)
;; shrink the chain
(set-custodian-reference-c! cref next-c)
(custodian-reference->custodian cref)]
[else next-c])]
[else c]))
(define/who (custodian-managed-list c super-c)
(check who custodian? c)
@ -288,7 +346,7 @@
(define/who (make-custodian-box c v)
(check who custodian? c)
(define b (custodian-box v (custodian-get-shutdown-sema c)))
(unless (unsafe-custodian-register c b (lambda (b) (set-custodian-box-v! b #f)) #f #t)
(unless (do-custodian-register c b (lambda (b) (set-custodian-box-v! b #f)) #:weak? #t #:gc-root? #t)
(raise-custodian-is-shut-down who c))
b)

2
racket/src/thread/place.rkt
View File

@ -43,7 +43,7 @@
(when (eq? initial-place current-place)
;; needed by custodian GC callback for memory limits:
(atomically (ensure-wakeup-handle!)))
(define orig-cust (create-custodian))
(define orig-cust (create-custodian #f))
(define lock (host:make-mutex))
(define started (host:make-condition))
(define-values (place-pch child-pch) (place-channel))

1
racket/src/thread/schedule.rkt
View File

@ -60,6 +60,7 @@
(host:poll-async-callbacks)
pending-callbacks))
(host:poll-will-executors)
(poll-custodian-will-executor)
(check-external-events 'fast)
(call-pre-poll-external-callbacks)
(check-place-activity)