cs & thread: fix shared hash table

An `eq?`-based hash table in the implementation of custodians was
still shared across threads.

Also, taking the global lock at the Rumble level did not disable
interrupts. Since sometimes the lock is taken with interrupts
disabled, threads could potentially deadlock by not having an order.
Fix the problem by disabling interrupts before taking the lock.
This commit is contained in:
Matthew Flatt 2019-10-07 19:05:45 -06:00
parent 5f3ab00351
commit 4ea09bf731
2 changed files with 20 additions and 7 deletions

View File

@ -9,16 +9,23 @@
(set! scheduler-lock-acquire acquire)
(set! scheduler-lock-release release))
;; Use `with-global-lock` to guard against both engine-based
;; concurrency and Scheme thread concurrency.
;; Use `with-global-lock*` when no guard against engine-based
;; concurrency is needed (because some operation is already atomic at
;; that level).
;; Taking the global lock disables GC, as does even waiting on the
;; lock. So, of course, make sure all globally-locked actions are
;; short.
(meta-cond
[(not (threaded?))
;; Using a Chez Scheme build without thread support,
;; but we need to cooperate with engine-based threads.
;; Use `with-global-lock*` when no lock is needed absent threads
(define-syntax-rule (with-global-lock* e ...)
(begin e ...))
;; Use `with-global-lock` when a lock is needed to prevent
;; engine-based concurrency
(define-syntax-rule (with-global-lock e ...)
(with-interrupts-disabled
e ...))]
@ -30,11 +37,16 @@
(define-syntax-rule (with-global-lock* e ...)
(with-global-lock e ...))
(define-syntax-rule (with-global-lock e ...)
;; Disable interrupts before taking the lock, because some threads
;; may have interrupts disabled when they take the lock (which
;; blocks GCs), so always disabling interrupts imposes an order.
(begin
(disable-interrupts)
(mutex-acquire global-lock)
(begin0
(begin e ...)
(mutex-release global-lock))))])
(mutex-release global-lock)
(enable-interrupts))))])
;; ------------------------------------------------------------
;; Locks used for hash tables

View File

@ -82,7 +82,8 @@
(define (set-root-custodian! c)
(set! root-custodian c)
(current-custodian c)
(set! custodian-will-executor (host:make-late-will-executor void #f)))
(set! custodian-will-executor (host:make-late-will-executor void #f))
(set! custodians-with-limits (make-hasheq)))
(define/who (make-custodian [parent (current-custodian)])
(check who custodian? parent)
@ -374,7 +375,7 @@
;; Ensures that custodians with memory limits are not treated as
;; inaccessible and merged:
(define custodians-with-limits (make-hasheq))
(define-place-local custodians-with-limits (make-hasheq))
;; ----------------------------------------