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

io: fix retention of blocked log receiver

Browse Source 
Don't GC a log receiver that is blocked on a logger that
might receiver relevant events.
This commit is contained in:
Matthew Flatt 2018-09-11 12:14:07 -06:00
parent 862c05d64a
commit 9cf9be60b0
4 changed files with 59 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
pkgs/racket-test-core/tests/racket/logger.rktl
View File

@ -274,6 +274,22 @@
warning-counter))
(test 2 test-intercepted-logging2)
; --------------------
;; Check that a blocked log receiver is not GCed if
;; if might receiver something
(let ()
(define s (make-semaphore))
(let ([lr (make-log-receiver (current-logger)
'info)])
(thread (lambda ()
(semaphore-post s))))
(sync (system-idle-evt))
(collect-garbage)
(log-message (current-logger) 'info "" 'c)
;; If receiver is GCed, then this will block
(sync s))
; --------------------
(report-errs)

12
racket/src/io/logger/logger.rkt
View File

@ -9,7 +9,7 @@
(struct logger (topic ; symbol or #f
parent ; logger or #f
propagate-filters
[receiver-boxes #:mutable] ; list of weak boxes
[receiver-box+backrefs #:mutable] ; list of (cons weak-box any)
[prune-counter #:mutable] ; number of adds before checking empied boxes
[permanent-receivers #:mutable] ; receivers to retain strongly
[max-receiver-level #:mutable] ; up-to-date if `local-level-timestamp` = `(unbox root-level-timestamp-box)`
@ -26,7 +26,7 @@
(logger topic
parent
propagate-filters
null ; receiver-boxes
null ; receiver-box+backrefs
8 ; prune-counter
null ; permanent-receivers
'none ; max-receiver-level
@ -40,7 +40,7 @@
;; Get log receivers, dropping any boxes made empty due to a weak
;; reference:
(define (logger-receivers logger)
(for*/list ([rb (in-list (logger-receiver-boxes logger))]
[b (in-value (weak-box-value rb))]
#:when b)
b))
(for*/list ([b+r (in-list (logger-receiver-box+backrefs logger))]
[lr (in-value (weak-box-value (car b+r)))]
#:when lr)
lr))

3
racket/src/io/logger/main.rkt
View File

@ -76,7 +76,8 @@
=> (lambda (s) s)]
[else
(define s (make-semaphore))
(set-logger-level-sema! logger s)])))
(set-logger-level-sema! logger s)
s])))
(semaphore-peek-evt s))
;; Can be called in any host Scheme thread and in interrupt handler,

49
racket/src/io/logger/receiver.rkt
View File

@ -21,7 +21,8 @@
;; ----------------------------------------
(struct queue-log-receiver log-receiver (msgs ; queue of messages ready for `sync` [if `waiters` is null]
waiters) ; queue of (box callback) to receive ready messages [if `msgs` is null]
waiters ; queue of (box callback) to receive ready messages [if `msgs` is null]
backref) ; box to make a self reference to avoid GC of a waiting receiver
#:reflection-name 'log-receiver
#:property
prop:receiver-send
@ -33,6 +34,7 @@
(define b (queue-remove! (queue-log-receiver-waiters lr)))
(cond
[b
(decrement-receiever-waiters! lr)
(define select! (unbox b))
(set-box! b msg)
(select!)]
@ -47,11 +49,14 @@
(values (list msg) #f)]
[else
(define b (box (poll-ctx-select-proc ctx)))
(define n (atomically/no-interrupts/no-wind (queue-add! (queue-log-receiver-waiters lr) b)))
(define n (atomically/no-interrupts/no-wind
(increment-receiever-waiters! lr)
(queue-add! (queue-log-receiver-waiters lr) b)))
(values #f (control-state-evt
(wrap-evt async-evt (lambda (e) (unbox b)))
(lambda () (atomically/no-interrupts/no-wind
(queue-remove-node! (queue-log-receiver-waiters lr) n)))
(queue-remove-node! (queue-log-receiver-waiters lr) n)
(decrement-receiever-waiters! lr)))
void
(lambda ()
(atomically/no-interrupts/no-wind
@ -61,17 +66,31 @@
(set-box! b msg)
(values msg #t)]
[else
(increment-receiever-waiters! lr)
(set! n (queue-add! (queue-log-receiver-waiters lr) b))
(values #f #f)])))))]))))
(define/who (make-log-receiver logger level . args)
(check who logger? logger)
(define backref (box #f))
(define lr (queue-log-receiver (parse-filters 'make-log-receiver (cons level args) #:default-level 'none)
(make-queue)
(make-queue)))
(add-log-receiver! logger lr)
(make-queue)
backref))
(add-log-receiver! logger lr backref)
lr)
;; In atomic mode
(define (decrement-receiever-waiters! lr)
(when (queue-empty? (queue-log-receiver-waiters lr))
(set-box! (queue-log-receiver-backref lr) #f)))
;; In atomic mode
(define (increment-receiever-waiters! lr)
(when (queue-empty? (queue-log-receiver-waiters lr))
(set-box! (queue-log-receiver-backref lr) lr)))
;; ----------------------------------------
(struct stdio-log-receiver log-receiver (which)
@ -95,7 +114,7 @@
(define lr (stdio-log-receiver (parse-filters parse-who args #:default-level 'none)
which))
(atomically
(add-log-receiver! logger lr)
(add-log-receiver! logger lr #f)
(set-logger-permanent-receivers! logger (cons lr (logger-permanent-receivers logger)))))
(define/who (add-stderr-log-receiver! logger . args)
@ -106,19 +125,21 @@
;; ----------------------------------------
(define (add-log-receiver! logger lr)
(define (add-log-receiver! logger lr backref)
(atomically/no-interrupts/no-wind
;; Add receiver to the logger's list, purning empty boxes
;; Add receiver to the logger's list, pruning empty boxes
;; every time the list length doubles (roughly):
(cond
[(zero? (logger-prune-counter logger))
(set-logger-receiver-boxes! logger (cons (make-weak-box lr)
(for/list ([b (in-list (logger-receiver-boxes logger))]
#:when (weak-box-value b))
b)))
(set-logger-prune-counter! logger (max 8 (length (logger-receiver-boxes logger))))]
(set-logger-receiver-box+backrefs! logger
(cons (cons (make-weak-box lr) backref)
(for/list ([b+r (in-list (logger-receiver-box+backrefs logger))]
#:when (weak-box-value (car b+r)))
b+r)))
(set-logger-prune-counter! logger (max 8 (length (logger-receiver-box+backrefs logger))))]
[else
(set-logger-receiver-boxes! logger (cons (make-weak-box lr) (logger-receiver-boxes logger)))
(set-logger-receiver-box+backrefs! logger (cons (cons (make-weak-box lr) backref)
(logger-receiver-box+backrefs logger)))
(set-logger-prune-counter! logger (sub1 (logger-prune-counter logger)))])
;; Increment the timestamp, so that wanted levels will be
;; recomputed on demand: