diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-12-06 15:34:24 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-12-06 15:42:45 +0000 |
| commit | 71422515ecc05bb67a715050bc1a5ff27e51f0f0 (patch) | |
| tree | 4f1b012d323b67f8c9fdf63eb09f880bf6083044 | |
| parent | fedc052e90e68b522f4912088673ebc53517452a (diff) | |
| download | build-coordinator-71422515ecc05bb67a715050bc1a5ff27e51f0f0.tar build-coordinator-71422515ecc05bb67a715050bc1a5ff27e51f0f0.tar.gz | |
Don't check too-many-threads? in the thread pool for each job
As this is excessive. Instead just check this when there are no jobs
available.
| -rw-r--r-- | guix-build-coordinator/utils.scm | 45 |
1 files changed, 22 insertions, 23 deletions
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index d19f390..7fe0470 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -1136,32 +1136,31 @@ References: ~a~%" thread-index #f) - (if (too-many-threads?) - (stop-thread) - (let ((job-args - (or (get-job (list-jobs)) - ;; #f from wait-condition-variable indicates a timeout - (if (wait-condition-variable - job-available - pool-mutex) - (get-job (list-jobs)) - #f)))) - (if job-args + (let ((job-args + (or (get-job (list-jobs)) + ;; #f from wait-condition-variable indicates a timeout + (if (wait-condition-variable + job-available + pool-mutex) + (get-job (list-jobs)) + #f)))) + (if job-args + (begin + (hash-set! running-job-args + thread-index + job-args) + + (unlock-mutex pool-mutex) + (thread-process-job job-args) + + (loop (current-time time-monotonic))) + (if (or (thread-idle-for-too-long? last-job-finished-at) + (too-many-threads?)) + (stop-thread) (begin - (hash-set! running-job-args - thread-index - job-args) - (unlock-mutex pool-mutex) - (thread-process-job job-args) - (loop (current-time time-monotonic))) - (if (thread-idle-for-too-long? last-job-finished-at) - (stop-thread) - (begin - (unlock-mutex pool-mutex) - - (loop last-job-finished-at)))))))))) + (loop last-job-finished-at))))))))) (define start-new-threads-if-necessary (let ((previous-thread-started-at (make-time time-monotonic 0 0))) |