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

fix leak in `racket/draw' instantiation

Browse Source
This commit is contained in:
Matthew Flatt 2011-11-11 14:42:51 -07:00
parent 2de0a853dd
commit 75dd61ebc3
2 changed files with 40 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/ffi/unsafe.rkt
View File

@ -1577,22 +1577,26 @@
regexp-replace regexp-replace*) regexp-replace regexp-replace*)
(caar rs) str (cadar rs)) (cdr rs))))) (caar rs) str (cadar rs)) (cdr rs)))))
;; A facility for running finalizers using executors. The "stubborn" kind
;; of will executor is provided by '#%foreign, and it doesn't get GC'ed if
;; any finalizers are attached to it (while the normal kind can get GCed
;; even if a thread that is otherwise inaccessible is blocked on the executor).
;; Also it registers level-2 finalizers (which are run after non-late weak
;; boxes are cleared).
(define killer-executor (make-stubborn-will-executor))
(define killer-thread #f) (define killer-thread #f)
(define* (register-finalizer obj finalizer) (define* register-finalizer
(unless killer-thread ;; We bind `killer-executor' as a location variable, instead of a module
(let ([priviledged-custodian ((get-ffi-obj 'scheme_make_custodian #f (_fun _pointer -> _scheme)) #f)]) ;; variable, so that the loop for `killer-thread' doesn't have a namespace
(set! killer-thread ;; (via a prefix) in its continuation:
(parameterize ([current-custodian priviledged-custodian] (let ([killer-executor (make-stubborn-will-executor)])
;; don't hold onto the namespace in the finalizer thread: ;; The "stubborn" kind of will executor (for `killer-executor') is
[current-namespace (make-base-empty-namespace)]) ;; provided by '#%foreign, and it doesn't get GC'ed if any
(thread (lambda () ;; finalizers are attached to it (while the normal kind can get
(let loop () (will-execute killer-executor) (loop)))))))) ;; GCed even if a thread that is otherwise inaccessible is blocked
(will-register killer-executor obj finalizer)) ;; on the executor). Also it registers level-2 finalizers (which
;; are run after non-late weak boxes are cleared).
(lambda (obj finalizer)
(unless killer-thread
(let ([priviledged-custodian ((get-ffi-obj 'scheme_make_custodian #f (_fun _pointer -> _scheme)) #f)])
(set! killer-thread
(parameterize ([current-custodian priviledged-custodian]
;; don't hold onto the namespace in the finalizer thread:
[current-namespace (make-base-empty-namespace)])
(thread (lambda ()
(let loop () (will-execute killer-executor) (loop))))))))
(will-register killer-executor obj finalizer))))

19
collects/tests/gracket/draw-mem.rkt Normal file
View File

@ -0,0 +1,19 @@
#lang racket
;; Check for a leak via multiple `racket/draw' instantiations.
(define-values (incs m)
(for/fold ([incs 0] [prev-mem 0]) ([i 10])
(parameterize ([current-namespace (make-base-namespace)])
(dynamic-require 'racket/draw #f))
(collect-garbage)
(sync (system-idle-evt))
(collect-garbage)
(let ([m (current-memory-use)])
(if (m . > . (+ prev-mem (* 100 1024)))
(values (add1 incs) m)
(values incs m)))))
(unless (incs . < . 5)
(error "multiple `racket/draw' instantiations seem to accumulate memory"))