mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
workers: 'pool-idle?' returns true only if the workers are idle.
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:
parent
ef2c6b4095
commit
232b3d3101
1 changed files with 17 additions and 7 deletions
|
@ -45,12 +45,13 @@ (define-module (guix workers)
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(define-record-type <pool>
|
(define-record-type <pool>
|
||||||
(%make-pool queue mutex condvar workers)
|
(%make-pool queue mutex condvar workers busy)
|
||||||
pool?
|
pool?
|
||||||
(queue pool-queue)
|
(queue pool-queue)
|
||||||
(mutex pool-mutex)
|
(mutex pool-mutex)
|
||||||
(condvar pool-condition-variable)
|
(condvar pool-condition-variable)
|
||||||
(workers pool-workers))
|
(workers pool-workers)
|
||||||
|
(busy pool-busy))
|
||||||
|
|
||||||
(define-syntax-rule (without-mutex mutex exp ...)
|
(define-syntax-rule (without-mutex mutex exp ...)
|
||||||
(dynamic-wind
|
(dynamic-wind
|
||||||
|
@ -62,12 +63,14 @@ (define-syntax-rule (without-mutex mutex exp ...)
|
||||||
(lock-mutex mutex))))
|
(lock-mutex mutex))))
|
||||||
|
|
||||||
(define* (worker-thunk mutex condvar pop-queue
|
(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."
|
"Return the thunk executed by worker threads."
|
||||||
(define (loop)
|
(define (loop)
|
||||||
(match (pop-queue)
|
(match (pop-queue)
|
||||||
(#f ;empty queue
|
(#f ;empty queue
|
||||||
(wait-condition-variable condvar mutex))
|
(idle)
|
||||||
|
(wait-condition-variable condvar mutex)
|
||||||
|
(busy))
|
||||||
((? procedure? proc)
|
((? procedure? proc)
|
||||||
;; Release MUTEX while executing PROC.
|
;; Release MUTEX while executing PROC.
|
||||||
(without-mutex mutex
|
(without-mutex mutex
|
||||||
|
@ -97,19 +100,24 @@ (define* (make-pool #:optional (count (current-processor-count))
|
||||||
(let* ((mutex (make-mutex))
|
(let* ((mutex (make-mutex))
|
||||||
(condvar (make-condition-variable))
|
(condvar (make-condition-variable))
|
||||||
(queue (make-q))
|
(queue (make-q))
|
||||||
|
(busy count)
|
||||||
(procs (unfold (cut >= <> count)
|
(procs (unfold (cut >= <> count)
|
||||||
(lambda (n)
|
(lambda (n)
|
||||||
(worker-thunk mutex condvar
|
(worker-thunk mutex condvar
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(and (not (q-empty? queue))
|
(and (not (q-empty? queue))
|
||||||
(q-pop! queue)))
|
(q-pop! queue)))
|
||||||
|
#:busy (lambda ()
|
||||||
|
(set! busy (+ 1 busy)))
|
||||||
|
#:idle (lambda ()
|
||||||
|
(set! busy (- busy 1)))
|
||||||
#:thread-name thread-name))
|
#:thread-name thread-name))
|
||||||
1+
|
1+
|
||||||
0))
|
0))
|
||||||
(threads (map (lambda (proc)
|
(threads (map (lambda (proc)
|
||||||
(call-with-new-thread proc))
|
(call-with-new-thread proc))
|
||||||
procs)))
|
procs)))
|
||||||
(%make-pool queue mutex condvar threads)))
|
(%make-pool queue mutex condvar threads (lambda () busy))))
|
||||||
|
|
||||||
(define (pool-enqueue! pool thunk)
|
(define (pool-enqueue! pool thunk)
|
||||||
"Enqueue THUNK for future execution by POOL."
|
"Enqueue THUNK for future execution by POOL."
|
||||||
|
@ -118,9 +126,11 @@ (define (pool-enqueue! pool thunk)
|
||||||
(signal-condition-variable (pool-condition-variable pool))))
|
(signal-condition-variable (pool-condition-variable pool))))
|
||||||
|
|
||||||
(define (pool-idle? 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)
|
(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 ...)
|
(define-syntax-rule (eventually pool exp ...)
|
||||||
"Run EXP eventually on one of the workers of POOL."
|
"Run EXP eventually on one of the workers of POOL."
|
||||||
|
|
Loading…
Reference in a new issue