From 77023aeaba48e1987be3c994bd886bf42b871094 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 18 Oct 2019 22:31:35 -0600 Subject: [PATCH] fix custodian weak reference and memory-limit unregistration For Racket CS, weaken references from managed objects to managing custodians. Otherwise, a custodian with any managed values cannot be GCed. Also, fix `collect-garbage` call that is triggered by a memory-limit shutdown to happen after the current thread (likely shutdown) is swapped out. For traditional Racket, fix custodian shutdown on a memory-limited custodian so that it is unregistered as having a limit. --- .../tests/racket/stress/custodian.rkt | 24 ++++++ racket/src/racket/src/thread.c | 6 +- racket/src/thread/custodian.rkt | 86 ++++++++++++------- 3 files changed, 82 insertions(+), 34 deletions(-) create mode 100644 pkgs/racket-test/tests/racket/stress/custodian.rkt diff --git a/pkgs/racket-test/tests/racket/stress/custodian.rkt b/pkgs/racket-test/tests/racket/stress/custodian.rkt new file mode 100644 index 0000000000..727489cc05 --- /dev/null +++ b/pkgs/racket-test/tests/racket/stress/custodian.rkt @@ -0,0 +1,24 @@ +#lang racket/base + +(define (go n) + (for ([i n]) + (define c (make-custodian)) + (custodian-limit-memory c (* 1024 1024 100) c) + (parameterize ([current-custodian c]) + (thread (lambda () (sync (make-semaphore))))) + (sync (system-idle-evt)) + (custodian-shutdown-all c))) + +(define (get-use) + (sync (system-idle-evt)) + (collect-garbage) + (current-memory-use)) + +(go 1000) +(define start-use (current-memory-use)) + +(go 100000) +(define end-use (current-memory-use)) + +(unless (end-use . < . (* 2 start-use)) + (error "something accumulated too much: " start-use end-use)) diff --git a/racket/src/racket/src/thread.c b/racket/src/racket/src/thread.c index 500e49132c..9aa5c7e148 100644 --- a/racket/src/racket/src/thread.c +++ b/racket/src/racket/src/thread.c @@ -855,7 +855,7 @@ static void adjust_limit_table(Scheme_Custodian *c) { /* If a custodian has a limit and any object or children, then it must not be collected and merged with its parent. To prevent - collection, we register the custodian in the `limite_custodians' + collection, we register the custodian in the `limited_custodians' table. */ if (c->has_limit) { if (c->elems || CUSTODIAN_FAM(c->children)) { @@ -1576,8 +1576,10 @@ Scheme_Thread *scheme_do_close_managed(Scheme_Custodian *m, Scheme_Exit_Closer_F m->mrefs = NULL; m->shut_down = 1; - if (SAME_OBJ(m, start)) + if (SAME_OBJ(m, start)) { + adjust_limit_table(m); break; + } next_m = CUSTODIAN_FAM(m->global_prev); /* Remove this custodian from its parent */ diff --git a/racket/src/thread/custodian.rkt b/racket/src/thread/custodian.rkt index ed68a49f3e..2ffbad90d8 100644 --- a/racket/src/thread/custodian.rkt +++ b/racket/src/thread/custodian.rkt @@ -65,8 +65,8 @@ ;; Reporting registration in a custodian through this indirection ;; enables GCing custodians that aren't directly referenced, merging ;; the managed objects into the parent. To support multiple moves, -;; `c` can be another reference -(struct custodian-reference ([c #:mutable]) +;; `weak-c` can be another reference. +(struct custodian-reference ([weak-c #:mutable]) #:authentic) (define-place-local custodian-will-executor (host:make-late-will-executor void #f)) @@ -82,8 +82,7 @@ (define (set-root-custodian! c) (set! root-custodian c) (current-custodian c) - (set! custodian-will-executor (host:make-late-will-executor void #f)) - (set! custodians-with-limits (make-hasheq))) + (set! custodian-will-executor (host:make-late-will-executor void #f))) (define/who (make-custodian [parent (current-custodian)]) (check who custodian? parent) @@ -95,6 +94,7 @@ (lambda (c) (reference-sink children) (do-custodian-shutdown-all c))) + #:weak? #t #:at-exit? #t #:gc-root? #t)) (set-custodian-parent-reference! c cref) @@ -141,7 +141,7 @@ (hash-set! (custodian-gc-roots cust) obj #t) (host:enable-interrupts)) (or (custodian-self-reference cust) - (let ([cref (custodian-reference cust)]) + (let ([cref (custodian-reference (make-weak-box cust))]) (set-custodian-self-reference! cust cref) cref))]))) @@ -174,19 +174,20 @@ (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?)])) + (for ([(child callback) (in-hash (custodian-children c) #f)]) + (when child + (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))) + (set-custodian-reference-weak-c! self-ref (custodian-self-reference parent))) (hash-clear! (custodian-children c)) (set-custodian-post-shutdown! parent (append (custodian-post-shutdown c) @@ -236,6 +237,9 @@ ;; Called in atomic mode by the scheduler (define (check-queued-custodian-shutdown) + (when gc-on-check-queue? + (set! gc-on-check-queue? #f) + (collect-garbage)) (cond [(null? queued-shutdowns) #f] [else @@ -260,10 +264,16 @@ ;; major GC to clean up and reset the expected heap size. ;; Otherwise, if another limit is put in place, it will be ;; checked (on a major GC) even later, which will set the - ;; major-GC trigger even higher, and so on. - (collect-garbage) + ;; major-GC trigger even higher, and so on. Since the + ;; scheduler is likely working in the context of a thread + ;; that was shut down by the custodian, defer the GC to + ;; the scheduler's next time around. + (set! gc-on-check-queue? #t) #t])) +;; Pending GC due to memory-limit custodian shutdown? +(define-place-local gc-on-check-queue? #f) + (define place-ensure-wakeup! (lambda () #f)) ; call before enabling shutdowns (define place-wakeup-initial void) (define place-wakeup void) @@ -281,10 +291,11 @@ (set-custodian-shut-down! c) (when (custodian-sync-futures? c) (futures-sync-for-custodian-shutdown)) - (for ([(child callback) (in-hash (custodian-children c))]) - (if (procedure-arity-includes? callback 2) - (callback child c) - (callback child))) + (for ([(child callback) (in-hash (custodian-children c) #f)]) + (when child + (if (procedure-arity-includes? callback 2) + (callback child c) + (callback child)))) (hash-clear! (custodian-children c)) (for ([proc (in-list (custodian-post-shutdown c))]) (proc)) @@ -295,7 +306,8 @@ (define p-cref (custodian-parent-reference c)) (when p-cref (unsafe-custodian-unregister c p-cref)) - (hash-remove! custodians-with-limits c))) + (set-custodian-memory-limits! c null) + (remove-limit-custodian! c))) (define (custodian-get-shutdown-sema c) (atomically @@ -329,17 +341,17 @@ (custodian-subordinate? ref-c c))) (define (custodian-reference->custodian cref) - (define c (custodian-reference-c cref)) + (define c (custodian-reference-weak-c cref)) (cond [(custodian-reference? c) - (define next-c (custodian-reference-c c)) + (define next-c (custodian-reference-weak-c c)) (cond [(custodian-reference? next-c) ;; shrink the chain - (set-custodian-reference-c! cref next-c) + (set-custodian-reference-weak-c! cref next-c) (custodian-reference->custodian cref)] - [else next-c])] - [else c])) + [else (weak-box-value next-c)])] + [else (weak-box-value c)])) (define/who (custodian-managed-list c super-c) (check who custodian? c) @@ -374,14 +386,24 @@ (define old-limit (custodian-immediate-limit limit-cust)) (when (or (not old-limit) (old-limit . > . need-amt)) (set-custodian-immediate-limit! limit-cust need-amt))) - (hash-set! custodians-with-limits limit-cust #t) + (host:disable-interrupts) (host:mutex-acquire memory-limit-lock) + (hash-set! custodians-with-limits limit-cust #t) (set! compute-memory-sizes (max compute-memory-sizes 1)) - (host:mutex-release memory-limit-lock))) + (host:mutex-release memory-limit-lock) + (host:enable-interrupts))) ;; Ensures that custodians with memory limits are not treated as -;; inaccessible and merged: -(define-place-local custodians-with-limits (make-hasheq)) +;; inaccessible and merged; use only while holding the memory-limit +;; lock and with interrupts disabled (or be in a GC) +(define custodians-with-limits (make-hasheq)) + +(define (remove-limit-custodian! c) + (host:disable-interrupts) + (host:mutex-acquire memory-limit-lock) + (hash-remove! custodians-with-limits c) + (host:mutex-release memory-limit-lock) + (host:enable-interrupts)) ;; ----------------------------------------