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

don't GC an eventspace with a visible frame, etc.

Browse Source
This commit is contained in:
Matthew Flatt 2010-11-29 12:35:25 -07:00
parent c81ad90161
commit 9f9e23f551
1 changed files with 9 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/mred/private/wx/common/queue.rkt
View File

@ -176,6 +176,11 @@
[(< am bm) -1] [(< am bm) -1]
[else 1])))) [else 1]))))
;; This table refers to handle threads of eventspaces
;; that have an open window, etc., so that the eventspace
;; isn't GCed
(define active-eventspaces (make-hasheq))
(define current-cb-box (make-parameter #f)) (define current-cb-box (make-parameter #f))
(define-mz scheme_add_managed (_fun _racket ; custodian (define-mz scheme_add_managed (_fun _racket ; custodian
@ -192,7 +197,8 @@
(set-eventspace-shutdown?! e #t) (set-eventspace-shutdown?! e #t)
(semaphore-post (eventspace-done-sema e)) (semaphore-post (eventspace-done-sema e))
(for ([f (in-list (get-top-level-windows e))]) (for ([f (in-list (get-top-level-windows e))])
(send f destroy)))) (send f destroy))
(hash-remove! active-eventspaces (eventspace-handler-thread e))))
(define (make-eventspace* th) (define (make-eventspace* th)
(let ([done-sema (make-semaphore 1)] (let ([done-sema (make-semaphore 1)]
@ -214,9 +220,11 @@
(positive? (hash-count frames)) (positive? (hash-count frames))
(not (null? (unbox timer)))) (not (null? (unbox timer))))
(when done-set? (when done-set?
(hash-set! active-eventspaces th #t)
(set! done-set? #f) (set! done-set? #f)
(semaphore-try-wait? done-sema)) (semaphore-try-wait? done-sema))
(unless done-set? (unless done-set?
(hash-remove! active-eventspaces th)
(set! done-set? #t) (set! done-set? #t)
(semaphore-post done-sema))))] (semaphore-post done-sema))))]
[enqueue (lambda (v q) [enqueue (lambda (v q)