cs & thread: remove redundant internal atomically
This commit is contained in:
parent
e087059f21
commit
c8f44d6597
|
@ -242,7 +242,7 @@
|
|||
|
||||
;; ----------------------------------------
|
||||
|
||||
;; Have we tried all threads without since most recently making
|
||||
;; Have we tried all threads since most recently making
|
||||
;; progress on some thread?
|
||||
(define (all-threads-poll-done?)
|
||||
(= (hash-count poll-done-threads)
|
||||
|
|
|
@ -72,9 +72,9 @@
|
|||
(set-thread-group-chain! tg (node-next n))
|
||||
(node-child n)]))
|
||||
|
||||
;; In atomic mode:
|
||||
(define (thread-group-add! parent child)
|
||||
(atomically
|
||||
(let loop ([parent parent] [child child])
|
||||
(assert-atomic-mode)
|
||||
;; Adding to the start of the group tends to reverse the schedule
|
||||
;; order, but it also avoids a problem where two threads that
|
||||
;; both loop and `sleep` (which deschedules and reschedules) take
|
||||
|
@ -97,11 +97,11 @@
|
|||
;; added child to formerly empty parent => add the parent
|
||||
(define parent-parent (thread-group-parent parent))
|
||||
(when parent-parent
|
||||
(loop parent-parent parent))))))
|
||||
(thread-group-add! parent-parent parent))))
|
||||
|
||||
;; In atomic mode:
|
||||
(define (thread-group-remove! parent child)
|
||||
(atomically
|
||||
(let loop ([parent parent] [child child])
|
||||
(assert-atomic-mode)
|
||||
(define n (child-node child))
|
||||
(when (or (eq? (node-prev n) 'none)
|
||||
(eq? (node-next n) 'none))
|
||||
|
@ -122,7 +122,7 @@
|
|||
;; parent thread group is now empty, so remove it, too
|
||||
(define parent-parent (thread-group-parent parent))
|
||||
(when parent-parent
|
||||
(loop parent-parent parent))))))
|
||||
(thread-group-remove! parent-parent parent))))
|
||||
|
||||
(define (thread-group-all-threads parent accum)
|
||||
(cond
|
||||
|
|
Loading…
Reference in New Issue
Block a user