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

cs & thread: repairs for memory accounting and places

Browse Source
This commit is contained in:
Matthew Flatt 2019-06-26 13:26:44 -06:00
parent 8985a409b8
commit cbaddd2164
3 changed files with 23 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -135,7 +135,7 @@
(let-values ([(backtrace-predicate use-prev? max-path-length) (parse-dump-memory-stats-arguments args)])
(enable-object-counts #t)
(enable-object-backreferences (and backtrace-predicate #t))
(collect (collect-maximum-generation))
(collect-garbage)
(let* ([counts (object-counts)]
[backreferences (object-backreferences)]
[extract (lambda (static? cxr)

1
racket/src/thread/Makefile
View File

@ -25,6 +25,7 @@ GLOBALS = --no-global \
++global-ok pre-poll-callbacks \
++global-ok queued-shutdowns \
++global-ok compute-memory-sizes \
++global-ok custodians-with-limits \
++global-ok make-place-ports+fds \
++global-ok pthread-count \
++global-ok "logging-future-events?" \

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

@ -278,7 +278,8 @@
(semaphore-post-all sema)))
(define p-cref (custodian-parent-reference c))
(when p-cref
(unsafe-custodian-unregister c p-cref))))
(unsafe-custodian-unregister c p-cref))
(hash-remove! custodians-with-limits c)))
(define (custodian-get-shutdown-sema c)
(atomically
@ -348,10 +349,15 @@
(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:mutex-acquire memory-limit-lock)
(set! compute-memory-sizes (max compute-memory-sizes 1))
(host:mutex-release memory-limit-lock)))
;; Ensures that custodians with memory limits are not treated as
;; inaccessible and merged:
(define custodians-with-limits (make-hasheq))
;; ----------------------------------------
(define/who (make-custodian-box c v)
@ -457,7 +463,7 @@
(set-custodian-memory-use! c (+ size (custodian-memory-use c))))
;; Merge child counts to parents:
(define any-limits?
(let c-loop ([c root-custodian])
(let c-loop ([c initial-place-root-custodian])
(define gc-roots (custodian-gc-roots c))
(define roots (append
(hash-ref custodian-future-threads c null)
@ -466,14 +472,19 @@
null)))
(define any-limits?
(for/fold ([any-limits? #f]) ([root (in-list roots)]
#:when (custodian? root))
(define root-any-limits? (c-loop root))
(set-custodian-memory-use! c (+ (custodian-memory-use root)
#:when (or (custodian? root)
(place? root)))
(define next-c (if (custodian? root)
root
(place-custodian root)))
(define root-any-limits? (c-loop next-c))
(set-custodian-memory-use! c (+ (custodian-memory-use next-c)
(custodian-memory-use c)))
(or root-any-limits? any-limits?)))
(define use (custodian-memory-use c))
(define old-limits (custodian-memory-limits c))
(define new-limits
(for/list ([limit (in-list (custodian-memory-limits c))]
(for/list ([limit (in-list old-limits)]
#:when (cond
[((car limit) . <= . use)
(queue-custodian-shutdown! (cdr limit))
@ -481,6 +492,9 @@
[else #t]))
limit))
(set-custodian-memory-limits! c new-limits)
(when (and (pair? old-limits)
(null? new-limits))
(hash-remove! custodians-with-limits c))
(or any-limits? (pair? new-limits))))
;; If no limits are installed, decay demand for memory counts:
(unless any-limits?
@ -494,7 +508,7 @@
(unless (custodian? c)
(raise-argument-error 'current-memory-use "(or/c #f 'cumulative custodian?)" c))
(cond
[(eq? c root-custodian) all]
[(eq? c initial-place-root-custodian) all]
[else
(when (atomically/no-interrupts
(host:mutex-acquire memory-limit-lock)