diff options
| author | Christopher Baines <mail@cbaines.net> | 2020-12-31 19:01:28 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2020-12-31 19:01:28 +0000 |
| commit | 735060cfb521d856c6db221103e04eb4c96ab7f1 (patch) | |
| tree | 30352a80eaa09da086c7d6964d32ff5cf1da09aa | |
| parent | c5b0372fd99c609da1d018bc4ee092428ec5605b (diff) | |
| download | build-coordinator-735060cfb521d856c6db221103e04eb4c96ab7f1.tar build-coordinator-735060cfb521d856c6db221103e04eb4c96ab7f1.tar.gz | |
Rate limit the agent starting threads to process builds
Allow rate limiting new worker threads starting in the agent. Currently if the
running jobs is limited by system load, lots of jobs start, the load goes up,
then the jobs gradually finish, and once the load decreases, lots of jobs
start again, and the cycle repeats.
Rate limiting the starting of new threads might help to soften the jobs all
starting at once.
| -rw-r--r-- | guix-build-coordinator/agent.scm | 7 | ||||
| -rw-r--r-- | guix-build-coordinator/utils.scm | 45 |
2 files changed, 32 insertions, 20 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index d5c2031..efa61f6 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -21,6 +21,7 @@ (define-module (guix-build-coordinator agent) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-19) #:use-module (ice-9 match) #:use-module (ice-9 format) #:use-module (ice-9 futures) @@ -123,7 +124,7 @@ #:log (build-log-procedure lgr build-id)) (let* ((result (perform-build lgr store build-id derivation-name)) ;; TODO Check this handles timezones right - (end-time (localtime (current-time) "UTC"))) + (end-time (localtime (time-second (current-time)) "UTC"))) (agent-submit-log-file lgr uuid coordinator-uri password build-id derivation-name) @@ -160,7 +161,9 @@ (log-msg lgr 'INFO "connecting to coordinator " coordinator-uri) (let-values (((process-job-with-queue count-jobs list-jobs) (create-work-queue current-max-builds - process-job))) + process-job + #:thread-start-delay + (make-time time-duration 0 60)))) (let ((details (submit-status coordinator-uri uuid password 'idle #:log (build-log-procedure lgr diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index 697c6e5..8e42d02 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -571,7 +571,8 @@ References: ~a~%" "Log under NAME the time taken to evaluate EXP." (call-with-time-logging name (lambda () exp ...))) -(define (create-work-queue thread-count-parameter proc) +(define* (create-work-queue thread-count-parameter proc + #:key thread-start-delay) (let ((queue (make-q)) (queue-mutex (make-mutex)) (job-available (make-condition-variable)) @@ -670,24 +671,32 @@ References: ~a~%" (thread-process-job thread-index) (loop)))))))) - (define (start-new-threads-if-necessary desired-count) - (with-mutex queue-mutex - (let* ((thread-count - (hash-count (const #t) running-job-args)) - (threads-to-start - (- desired-count thread-count))) - (when (> threads-to-start 0) - (for-each - (lambda (thread-index) - (when (eq? (hash-ref running-job-args + (define start-new-threads-if-necessary + (let ((previous-thread-started-at (make-time time-monotonic 0 0))) + (lambda (desired-count) + (with-mutex queue-mutex + (let* ((thread-count + (hash-count (const #t) running-job-args)) + (threads-to-start + (- desired-count thread-count))) + (when (> threads-to-start 0) + (for-each + (lambda (thread-index) + (when (eq? (hash-ref running-job-args + thread-index + 'slot-free) + 'slot-free) + (let* ((now (current-time time-monotonic)) + (elapsed (time-difference now + previous-thread-started-at))) + (when (or (eq? #f thread-start-delay) + (time>=? elapsed thread-start-delay)) + (set! previous-thread-started-at now) + (hash-set! running-job-args thread-index - 'slot-free) - 'slot-free) - (hash-set! running-job-args - thread-index - #f) - (start-thread thread-index))) - (iota desired-count)))))) + #f) + (start-thread thread-index))))) + (iota desired-count)))))))) (when (procedure? thread-count-parameter) (call-with-new-thread |