diff options
Diffstat (limited to 'guix-build-coordinator/utils.scm')
-rw-r--r-- | guix-build-coordinator/utils.scm | 33 |
1 files changed, 22 insertions, 11 deletions
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index 7504559..c619a12 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -677,7 +677,9 @@ References: ~a~%" (call-with-time-logging name (lambda () exp ...))) (define* (create-work-queue thread-count-parameter proc - #:key thread-start-delay) + #:key thread-start-delay + (thread-stop-delay + (make-time time-duration 0 0))) (let ((queue (make-q)) (queue-mutex (make-mutex)) (job-available (make-condition-variable)) @@ -748,13 +750,16 @@ References: ~a~%" (hash-count (lambda (index val) (list? val)) running-job-args)) - (idle-thread-count - (hash-count (lambda (index val) - (eq? #f val)) - running-job-args)) (desired-thread-count (get-thread-count))) - (or (>= running-jobs-count desired-thread-count) - (> idle-thread-count 2)))) + + (>= running-jobs-count + desired-thread-count))) + + (define (thread-idle-for-too-long? last-job-finished-at) + (time>=? + (time-difference (current-time time-monotonic) + last-job-finished-at) + thread-stop-delay)) (define (stop-thread) (hash-remove! running-job-args @@ -763,7 +768,7 @@ References: ~a~%" (call-with-new-thread (lambda () - (let loop () + (let loop ((last-job-finished-at (current-time time-monotonic))) (lock-mutex queue-mutex) (if (too-many-threads?) @@ -795,10 +800,16 @@ References: ~a~%" (with-mutex queue-mutex (hash-set! running-job-args thread-index - #f))) - (unlock-mutex queue-mutex)) + #f)) + + (loop (current-time time-monotonic))) + (if (thread-idle-for-too-long? last-job-finished-at) + (stop-thread) + (begin + (unlock-mutex queue-mutex) + + (loop last-job-finished-at)))))))))) - (loop))))))) (define start-new-threads-if-necessary (let ((previous-thread-started-at (make-time time-monotonic 0 0))) |