diff options
Diffstat (limited to 'guix-build-coordinator/build-allocator.scm')
| -rw-r--r-- | guix-build-coordinator/build-allocator.scm | 62 |
1 files changed, 30 insertions, 32 deletions
diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm index 62e9bc9..2591494 100644 --- a/guix-build-coordinator/build-allocator.scm +++ b/guix-build-coordinator/build-allocator.scm @@ -485,19 +485,8 @@ (setup-failures-hash (datastore-fetch-setup-failures datastore))) - (define (limit-planned-builds build-ids) - (if planned-builds-for-agent-limit - (if (> (length build-ids) planned-builds-for-agent-limit) - (take build-ids planned-builds-for-agent-limit) - build-ids) - build-ids)) - - (let-values - (((derived-build-priorities-hash - build-ids-for-unprocessed-builds-with-built-inputs) - (datastore-fetch-build-ids-and-propagated-priorities-for-unprocessed-builds - datastore - builds-created-after))) + (let ((prioritised-builds + (datastore-fetch-prioritised-unprocessed-builds datastore))) (define systems-for-builds (map (lambda (build-id) @@ -505,7 +494,7 @@ (datastore-find-build-derivation-system datastore build-id))) - build-ids-for-unprocessed-builds-with-built-inputs)) + prioritised-builds)) (define tags-for-build (let ((build-tags (make-hash-table))) @@ -564,36 +553,45 @@ #t #f))))) - (define (build-sorting-function-for-agent agent-id) - (lambda (a b) - (let ((a-priority (hash-ref derived-build-priorities-hash a)) - (b-priority (hash-ref derived-build-priorities-hash b))) - (< b-priority a-priority)))) - (when metrics-registry (metric-set allocator-considered-builds-metric - (length build-ids-for-unprocessed-builds-with-built-inputs))) + (length prioritised-builds))) (let ((result (append-map (lambda (agent-id) (log "considering builds for" agent-id) - (let ((build-ids-sorted-by-derived-priority - (sort - (filter (filter-builds-for-agent agent-id) - build-ids-for-unprocessed-builds-with-built-inputs) - (build-sorting-function-for-agent agent-id)))) - (if (null? build-ids-sorted-by-derived-priority) + (let* ((filter-proc + (filter-builds-for-agent agent-id)) + (build-ids + (let loop ((count 0) + (build-ids '()) + (potential-build-ids prioritised-builds)) + (if (or (and planned-builds-for-agent-limit + (>= count planned-builds-for-agent-limit)) + (null? potential-build-ids)) + build-ids ;; highest priority last + (let ((potential-build (first potential-build-ids))) + (if (filter-proc potential-build) + (loop (+ 1 count) + (cons potential-build + build-ids) + (cdr potential-build-ids)) + (loop count + build-ids + (cdr potential-build-ids)))))))) + (if (null? build-ids) '() - (let ((builds-for-agent - (limit-planned-builds - build-ids-sorted-by-derived-priority))) + (let ((build-ids-count + (length build-ids))) (map (lambda (build-id ordering) (list build-id agent-id ordering)) - builds-for-agent - (iota (length builds-for-agent))))))) + build-ids + (iota build-ids-count + build-ids-count + -1)))))) (map (lambda (agent) (assq-ref agent 'uuid)) agents)))) |