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 | |
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.
-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))) |