nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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:
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 @@
;;; 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 @@
(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 @@ threads as reported by the operating system."
(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 @@ threads as reported by the operating system."
(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."