cs & thread: remove redundant internal atomically

This commit is contained in:
Matthew Flatt 2019-12-29 07:08:15 -06:00
parent e087059f21
commit c8f44d6597
2 changed files with 63 additions and 63 deletions

View File

@ -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)

View File

@ -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