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

cs: correct and imprrove heuristics for force a major GC

Browse Source 
Use `current-memory-bytes` instead of `bytes-allocated` to determine
major GCs, because the latter doesn't include enough (perhaps missing
finalized values). For example, the repair avoids unbounded memory use
from

  (let loop ([i 0])
    (malloc 6400 'atomic-interior)
    (loop))

due to finalizers that pile up faster than they are run.
This commit is contained in:
Matthew Flatt 2019-08-29 20:36:14 -06:00
parent dd5e517e88
commit 1811193285
3 changed files with 21 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/racket-test-core/tests/racket/number.rktl
View File

@ -2691,6 +2691,10 @@
(apply append (for/list ([i 10000])
(random-sample (range 10) 100)))))))
(parameterize ([current-pseudo-random-generator (make-pseudo-random-generator)])
(random-seed 2)
(test '#(1062645402 3593208522 3838676319 2291995347 179540564 3081399108)
pseudo-random-generator->vector (current-pseudo-random-generator)))
(test #t = 0 0)
(test #f = 0 (expt 2 32))

6
racket/src/cs/rumble/foreign.ss
View File

@ -1402,7 +1402,7 @@
(let* ([bstr (make-bytevector size 0)]
[p (make-cpointer bstr #f)])
(lock-object bstr)
(with-global-lock (the-foreign-guardian p (lambda () (unlock-object bstr))))
(unsafe-add-global-finalizer p (lambda () (unlock-object bstr)))
p)]
[else
(raise-unsupported-error 'malloc
@ -1464,7 +1464,7 @@
(poll-foreign-guardian))))
(define (unsafe-add-global-finalizer v proc)
(the-foreign-guardian v proc))
(with-global-lock (the-foreign-guardian v proc)))
;; ----------------------------------------
@ -1973,7 +1973,7 @@
(let* ([code (make-code proc)]
[cb (create-callback code)])
(lock-object code)
(with-global-lock (the-foreign-guardian cb (lambda () (unlock-object code))))
(unsafe-add-global-finalizer cb (lambda () (unlock-object code)))
cb)))]))
;; ----------------------------------------

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

@ -34,7 +34,8 @@
(define gc-counter 1)
(define log-collect-generation-radix 2)
(define collect-generation-radix-mask (sub1 (bitwise-arithmetic-shift 1 log-collect-generation-radix)))
(define allocated-after-major (* 32 1024 1024))
(define allocated+overhead-after-major (* 32 1024 1024))
(define non-full-gc-counter 0)
;; Called in any thread with all other threads paused. The Racket
;; thread scheduler may be in atomic mode. In fact, the engine
@ -51,7 +52,8 @@
(set! gc-counter (add1 this-counter)))
(let ([gen (cond
[(and (not g)
(>= pre-allocated (* 2 allocated-after-major)))
(or (>= pre-allocated+overhead (* 2 allocated+overhead-after-major))
(>= non-full-gc-counter 10000)))
;; Force a major collection if memory use has doubled
(collect-maximum-generation)]
[else
@ -63,12 +65,13 @@
[else gen]))])])
(run-collect-callbacks car)
(collect gen)
(let ([post-allocated (bytes-allocated)])
(let ([post-allocated (bytes-allocated)]
[post-allocated+overhead (current-memory-bytes)])
(when (= gen (collect-maximum-generation))
(set! allocated-after-major post-allocated))
(set! allocated+overhead-after-major post-allocated+overhead))
(garbage-collect-notify gen
pre-allocated pre-allocated+overhead pre-time pre-cpu-time
post-allocated (current-memory-bytes) (real-time) (cpu-time)))
post-allocated post-allocated+overhead (real-time) (cpu-time)))
(update-eq-hash-code-table-size!)
(poll-foreign-guardian)
(run-collect-callbacks cdr)
@ -80,6 +83,11 @@
;; This `set-timer` doesn't necessarily penalize the right thread,
;; but it's likely to penalize a thread that is allocating quickly:
(set-timer 1))
(cond
[(= gen (collect-maximum-generation))
(set! non-full-gc-counter 0)]
[else
(set! non-full-gc-counter (add1 non-full-gc-counter))])
(void))))
(define collect-garbage
@ -349,7 +357,7 @@
(define/who (make-phantom-bytes k)
(check who exact-nonnegative-integer? k)
(let ([ph (create-phantom-bytes (make-phantom-bytevector k))])
(when (>= (bytes-allocated) (* 2 allocated-after-major))
(when (>= (current-memory-bytes) (* 2 allocated+overhead-after-major))
(collect-garbage))
ph))