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

cs: fix interaction of places and 'GC log receivers

Browse Source 
Related to #3174
This commit is contained in:
Matthew Flatt 2020-05-11 09:45:52 -06:00
parent 0e6415899b
commit 9ab5ba0fbc
2 changed files with 41 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
pkgs/racket-test/tests/racket/place-gc-logger.rkt Normal file
View File

@ -0,0 +1,25 @@
#lang racket/base
(require racket/place)
(define (churn n)
(let loop ([l (cons "" 0)])
(if (equal? (cdr l) n)
(string-length (car l))
(loop (cons (make-string 512 #\x)
(add1 (cdr l)))))))
(define (go)
(place pch
(churn 100000)))
(module+ main
(go)
(define receiver
(make-log-receiver (current-logger) 'debug 'GC))
(void
(thread
(lambda ()
(let loop ()
(sync receiver)
(loop)))))
(churn 100000))

28
racket/src/thread/pre-poll.rkt
View File

@ -1,26 +1,30 @@
#lang racket/base #lang racket/base
(require "atomic.rkt" (require "atomic.rkt"
"host.rkt") "host.rkt"
"place-object.rkt")
(provide unsafe-add-pre-poll-callback! (provide unsafe-add-pre-poll-callback!
call-pre-poll-external-callbacks) call-pre-poll-external-callbacks)
;; Callbacks for the original place only:
(define pre-poll-callbacks null) (define pre-poll-callbacks null)
;; called in atomic mode in an arbitrary host thread, but ;; Called in atomic mode in an arbitrary host thread, but
;; with all other host threads paused; the given procedure ;; with all other host threads paused; the given procedure
;; will be called in atomic mode, possibly in the schduler ;; will be called in atomic mode, possibly in the schduler,
;; in the original place
(define (unsafe-add-pre-poll-callback! proc) (define (unsafe-add-pre-poll-callback! proc)
(set! pre-poll-callbacks (cons proc pre-poll-callbacks))) (set! pre-poll-callbacks (cons proc pre-poll-callbacks)))
;; in atomic mode ;; in atomic mode
(define (call-pre-poll-external-callbacks) (define (call-pre-poll-external-callbacks)
(unless (null? pre-poll-callbacks) (when (eq? current-place initial-place)
;; disable interrupts to avoid a case with `unsafe-add-pre-poll-callback!` (unless (null? pre-poll-callbacks)
(host:disable-interrupts) ;; disable interrupts to avoid a case with `unsafe-add-pre-poll-callback!`
(define l pre-poll-callbacks) (host:disable-interrupts)
(set! pre-poll-callbacks null) (define l pre-poll-callbacks)
(host:enable-interrupts) (set! pre-poll-callbacks null)
;; Call the callbacks (host:enable-interrupts)
(for ([cb (in-list (reverse l))]) ;; Call the callbacks
(cb)))) (for ([cb (in-list (reverse l))])
(cb)))))