diff options
author | Christopher Baines <mail@cbaines.net> | 2021-06-20 20:39:44 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2021-06-20 20:39:44 +0100 |
commit | c2f0c5b36f8294bb4c699806f9e8c576ae9b9f90 (patch) | |
tree | 9e6e8b96cdfc110d2126a5eb08e147bacef8e185 /guix-build-coordinator | |
parent | 33777e9cd5e14cfe38af38651768be0948dbb949 (diff) | |
download | build-coordinator-c2f0c5b36f8294bb4c699806f9e8c576ae9b9f90.tar build-coordinator-c2f0c5b36f8294bb4c699806f9e8c576ae9b9f90.tar.gz |
Support thread-stop-delay for the work queues
This is useful when builds finish quickly since there could be more than 2
idle threads, and then threads start stopping. This way, each thread waits 20
seconds before stopping, which should be enough time for new builds to be
fetched.
Diffstat (limited to 'guix-build-coordinator')
-rw-r--r-- | guix-build-coordinator/agent.scm | 7 | ||||
-rw-r--r-- | guix-build-coordinator/utils.scm | 33 |
2 files changed, 28 insertions, 12 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index 7966020..a89e5d7 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -321,7 +321,12 @@ (max 5 (- 135 (* 120 - (/ max-parallel-builds 64)))))))) + (/ max-parallel-builds 64))))) + #:thread-stop-delay + (make-time + time-duration + 0 + 20)))) (define (display-info) (display (simple-format 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))) |