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

cs & thread: memory accounting corrections

Browse Source 
Repair trigger of a GC when using `current-memory-use`
on a custodian when a limit was just installed.
This commit is contained in:
Matthew Flatt 2020-03-28 08:38:02 -06:00
parent 7621ccbb7b
commit 9cb6debf44
2 changed files with 20 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
racket/src/thread/Makefile
View File

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

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

@ -443,6 +443,7 @@
;; If non-zero, the custodian memory sizes are gathered after a GC. ;; If non-zero, the custodian memory sizes are gathered after a GC.
;; The value decays ;; The value decays
(define compute-memory-sizes 0) (define compute-memory-sizes 0)
(define computed-memory-sizes? #f)
(void (set-reachable-size-increments-callback! (void (set-reachable-size-increments-callback!
;; Called in an arbitrary host thread, with interrupts off and all other threads suspended: ;; Called in an arbitrary host thread, with interrupts off and all other threads suspended:
@ -498,14 +499,21 @@
(define more-local-roots (define more-local-roots
(cond (cond
[(eq? root (place-current-thread pl)) [(eq? root (place-current-thread pl))
(define k-root (define more-local-roots (cons (place-host-thread pl)
new-local-roots))
(if (eq? pl current-place) ; assuming host thread is place main thread (if (eq? pl current-place) ; assuming host thread is place main thread
starting-k (cons starting-k more-local-roots)
(place-host-thread pl))) more-local-roots)]
(cons k-root new-local-roots)]
[else new-local-roots])) [else new-local-roots]))
(loop (cdr roots) more-local-roots accum-roots accum-custs)])))) (loop (cdr roots) more-local-roots accum-roots accum-custs)]))))
(define sizes (compute-size-increments roots)) (define sizes (compute-size-increments roots
;; 'static is more accurrate, because it will
;; hit parameters more reliably; but there's
;; currently a significant cost, and the
;; approximation of using the oldest non-static
;; generation works well enough for many
;; purposes
#;'static))
(for ([size (in-list sizes)] (for ([size (in-list sizes)]
[c (in-list custs)]) [c (in-list custs)])
(set-custodian-memory-use! c (+ size (custodian-memory-use c)))) (set-custodian-memory-use! c (+ size (custodian-memory-use c))))
@ -546,7 +554,8 @@
(or any-limits? (pair? new-limits)))) (or any-limits? (pair? new-limits))))
;; If no limits are installed, decay demand for memory counts: ;; If no limits are installed, decay demand for memory counts:
(unless any-limits? (unless any-limits?
(set! compute-memory-sizes (sub1 compute-memory-sizes))))))))) (set! compute-memory-sizes (sub1 compute-memory-sizes)))
(set! computed-memory-sizes? #t)))))))
(void (set-custodian-memory-use-proc! (void (set-custodian-memory-use-proc!
;; Get memory use for a custodian; the second argument is ;; Get memory use for a custodian; the second argument is
@ -566,12 +575,14 @@
;; should be about 1/2 the cost of a full GC, so a ;; should be about 1/2 the cost of a full GC, so a
;; value of 2 hedges future demands versus ;; value of 2 hedges future demands versus
;; no future demands: ;; no future demands:
(set! computed-memory-sizes? #f)
(set! compute-memory-sizes 2) (set! compute-memory-sizes 2)
(host:mutex-release memory-limit-lock) (host:mutex-release memory-limit-lock)
#t] #t]
[else [else
(define done? computed-memory-sizes?)
(host:mutex-release memory-limit-lock) (host:mutex-release memory-limit-lock)
#f])) (not done?)]))
(collect-garbage)) (collect-garbage))
(custodian-memory-use c)])))) (custodian-memory-use c)]))))