ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

workers: 'pool-idle?' returns true only if the workers are idle.

Browse source 
Fixes <https://bugs.gnu.org/28779>.
Reported by Eric Bavier <bavier@cray.com>.

* guix/workers.scm (<pool>)[busy]: New field.
(worker-thunk): Add #:idle and #:busy and use them.
(make-pool): Pass #:busy and #:idle to 'worker-thunk'.  Pass a 'busy'
value to '%make-pool'.
* guix/workers.scm (pool-idle?): Check whether 'pool-busy' returns zero
and adjust docstring.
This commit is contained in:
Ludovic Courtès 2017-11-17 10:10:30 +01:00
parent ef2c6b4095
commit 232b3d3101
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 17 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
guix/workers.scm
View file

@ -45,12 +45,13 @@ (define-module (guix workers)
;;; Code:
(define-record-type <pool>
(%make-pool queue mutex condvar workers)
(%make-pool queue mutex condvar workers busy)
pool?
(queue pool-queue)
(mutex pool-mutex)
(condvar pool-condition-variable)
(workers pool-workers))
(workers pool-workers)
(busy pool-busy))
(define-syntax-rule (without-mutex mutex exp ...)
(dynamic-wind
@ -62,12 +63,14 @@ (define-syntax-rule (without-mutex mutex exp ...)
(lock-mutex mutex))))
(define* (worker-thunk mutex condvar pop-queue
#:key (thread-name "guix worker"))
#:key idle busy (thread-name "guix worker"))
"Return the thunk executed by worker threads."
(define (loop)
(match (pop-queue)
(#f ;empty queue
(wait-condition-variable condvar mutex))
(idle)
(wait-condition-variable condvar mutex)
(busy))
((? procedure? proc)
;; Release MUTEX while executing PROC.
(without-mutex mutex
@ -97,19 +100,24 @@ (define* (make-pool #:optional (count (current-processor-count))
(let* ((mutex (make-mutex))
(condvar (make-condition-variable))
(queue (make-q))
(busy count)
(procs (unfold (cut >= <> count)
(lambda (n)
(worker-thunk mutex condvar
(lambda ()
(and (not (q-empty? queue))
(q-pop! queue)))
#:busy (lambda ()
(set! busy (+ 1 busy)))
#:idle (lambda ()
(set! busy (- busy 1)))
#:thread-name thread-name))
1+
0))
(threads (map (lambda (proc)
(call-with-new-thread proc))
procs)))
(%make-pool queue mutex condvar threads)))
(%make-pool queue mutex condvar threads (lambda () busy))))
(define (pool-enqueue! pool thunk)
"Enqueue THUNK for future execution by POOL."
@ -118,9 +126,11 @@ (define (pool-enqueue! pool thunk)
(signal-condition-variable (pool-condition-variable pool))))
(define (pool-idle? pool)
"Return true if POOL doesn't have any task in its queue."
"Return true if POOL doesn't have any task in its queue and all the workers
are currently idle (i.e., waiting for a task)."
(with-mutex (pool-mutex pool)
(q-empty? (pool-queue pool))))
(and (q-empty? (pool-queue pool))
(zero? ((pool-busy pool))))))
(define-syntax-rule (eventually pool exp ...)
"Run EXP eventually on one of the workers of POOL."