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

cs & thread: fix problem with place initialization

Browse Source 
The `current-place` place-local variable was initialized relatively
late in the set of place-creation steps. It was possible for the
thread scheduler to get involved before `current-place` was set ---
and in that case, it was possible for semaphores and Racket threads to
end up being used in the wrong place.
This commit is contained in:
Matthew Flatt 2021-03-15 13:51:16 -06:00
parent c0cfd32bcb
commit a484cd76e5
3 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
racket/src/cs/schemified/thread.scm
View File

@ -13861,13 +13861,13 @@
(|#%app| (|#%app|
host:fork-place host:fork-place
(lambda () (lambda ()
(call-in-another-main-thread (begin
orig-cust_0 (unsafe-place-local-set!
(lambda () cell.1$2
(begin new-place_0)
(unsafe-place-local-set! (call-in-another-main-thread
cell.1$2 orig-cust_0
new-place_0) (lambda ()
(begin (begin
(set-place-id! (set-place-id!
new-place_0 new-place_0
@ -14448,7 +14448,7 @@
(define make-message-queue (define make-message-queue
(lambda () (lambda ()
(let ((app_0 (|#%app| host:make-mutex))) (let ((app_0 (|#%app| host:make-mutex)))
(message-queue4.1 app_0 '() '() (box #f) hash2725 (box #f))))) (message-queue4.1 app_0 '() '() (box #f) hash2610 (box #f)))))
(define enqueue! (define enqueue!
(lambda (mq_0 msg_0 wk_0) (lambda (mq_0 msg_0 wk_0)
(let ((lock_0 (message-queue-lock mq_0))) (let ((lock_0 (message-queue-lock mq_0)))
@ -14463,7 +14463,7 @@
(cons msg_0 (message-queue-rev-q mq_0))) (cons msg_0 (message-queue-rev-q mq_0)))
(let ((waiters_0 (message-queue-waiters mq_0))) (let ((waiters_0 (message-queue-waiters mq_0)))
(begin (begin
(set-message-queue-waiters! mq_0 hash2725) (set-message-queue-waiters! mq_0 hash2610)
(set-box! (message-queue-out-key-box mq_0) wk_0) (set-box! (message-queue-out-key-box mq_0) wk_0)
(set-box! (message-queue-in-key-box mq_0) #f) (set-box! (message-queue-in-key-box mq_0) #f)
(|#%app| host:mutex-release lock_0) (|#%app| host:mutex-release lock_0)

7
racket/src/thread/place.rkt
View File

@ -90,11 +90,11 @@
(define host-thread (define host-thread
(host:fork-place (host:fork-place
(lambda () (lambda ()
(set! current-place new-place)
(start-implicit-atomic-mode) (start-implicit-atomic-mode)
(call-in-another-main-thread (call-in-another-main-thread
orig-cust orig-cust
(lambda () (lambda ()
(set! current-place new-place)
(set-place-id! new-place (get-pthread-id)) (set-place-id! new-place (get-pthread-id))
(set-place-host-roots! new-place (host:current-place-roots)) (set-place-host-roots! new-place (host:current-place-roots))
(current-thread-group root-thread-group) (current-thread-group root-thread-group)
@ -155,6 +155,7 @@
(place-has-activity! p)) (place-has-activity! p))
(host:mutex-release (place-lock p)))) (host:mutex-release (place-lock p))))
;; called with place's lock held or for the current place
(define (place-has-activity! p) (define (place-has-activity! p)
(set-box! (place-activity-canary p) #t) (set-box! (place-activity-canary p) #t)
(sandman-wakeup (place-wakeup-handle p))) (sandman-wakeup (place-wakeup-handle p)))
@ -277,7 +278,7 @@
'() '()
'() '()
(box #f) (box #f)
#hash() #hasheq()
(box #f))) (box #f)))
(define (enqueue! mq msg wk) (define (enqueue! mq msg wk)
@ -286,7 +287,7 @@
(host:mutex-acquire lock) (host:mutex-acquire lock)
(set-message-queue-rev-q! mq (cons msg (message-queue-rev-q mq))) (set-message-queue-rev-q! mq (cons msg (message-queue-rev-q mq)))
(define waiters (message-queue-waiters mq)) (define waiters (message-queue-waiters mq))
(set-message-queue-waiters! mq '#hash()) (set-message-queue-waiters! mq '#hasheq())
(set-box! (message-queue-out-key-box mq) wk) (set-box! (message-queue-out-key-box mq) wk)
(set-box! (message-queue-in-key-box mq) #f) (set-box! (message-queue-in-key-box mq) #f)
(host:mutex-release lock) (host:mutex-release lock)

1
racket/src/thread/semaphore.rkt
View File

@ -97,6 +97,7 @@
;; In atomic mode ;; In atomic mode
(define (semaphore-post-all/atomic s) (define (semaphore-post-all/atomic s)
(assert-atomic-mode)
(set-semaphore-count! s +inf.0) (set-semaphore-count! s +inf.0)
(queue-remove-all! (queue-remove-all!
s s