From 58812c13b03085ad320195887a114bca9520856a Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 1 May 2020 18:24:45 +0100 Subject: Try to better order the builds As well as sorting by priority, this now looks at which builds are missing outputs, and which builds will provide those outputs and tries to order the builds providing the outputs before the builds that need them. --- guix-build-coordinator/build-allocator.scm | 117 +++++++++++++++++++++++++---- 1 file changed, 103 insertions(+), 14 deletions(-) diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm index 02af0b4..7e1b578 100644 --- a/guix-build-coordinator/build-allocator.scm +++ b/guix-build-coordinator/build-allocator.scm @@ -53,7 +53,12 @@ (assq-ref build 'uuid) (assq-ref build 'priority))) builds) - table))) + table)) + ;; build_id -> (list build_id ...) indicating that for the build_id + ;; used as the key, the build_ids given as the value should happen + ;; first. + (build-ordering-hints-hash + (make-hash-table))) (define (filter-builds-for-agent agent-id) (define (relevant-setup-failure? setup-failure) @@ -102,6 +107,72 @@ builds) builds)) + (define (break-builds-in-to-priority-sublists all-builds) + (define (build-priority build) + (hash-ref derived-build-priorities-hash + (assq-ref build 'uuid))) + + (let loop ((result '()) + (builds all-builds) + (current-priority-builds '()) + (current-priority (build-priority (first all-builds)))) + (if (null? builds) + (reverse (cons current-priority-builds result)) + (let ((build (car builds))) + (if (= (build-priority build) + current-priority) + (loop result + (cdr builds) + (cons build current-priority-builds) + current-priority) + (loop (cons current-priority-builds result) + (cdr builds) + (list build) + (build-priority build))))))) + + (define (sort-priority-sublist builds-list) + (define (build-id build) + (assq-ref build 'uuid)) + + (define (builds-that-should-happen-first build-id) + (hash-ref build-ordering-hints-hash + build-id + '())) + + (define seen-builds-hash + (make-hash-table)) + + (define deferred-builds-last-count 0) + + (let loop ((result '()) + (builds builds-list) + (builds-to-defer '())) + (if (null? builds) + (if (null? builds-to-defer) + result + (if (= (length builds-to-defer) + deferred-builds-last-count) + ;; There can be loops in the graph of missing inputs, so + ;; give up if the ordering doesn't seem to end + (append result builds-to-defer) + (begin (set! deferred-builds-last-count + (length builds-to-defer)) + (loop result + builds-to-defer + '())))) + (let ((build (car builds))) + (if (every (lambda (required-build-id) + (hash-ref seen-builds-hash required-build-id)) + (builds-that-should-happen-first (build-id build))) + (begin + (hash-set! seen-builds-hash (build-id build) #t) + (loop (cons build result) + (cdr builds) + builds-to-defer)) + (loop result + (cdr builds) + (cons build builds-to-defer))))))) + ;; Go through the setup failures and look specifically at the ;; missing_inputs ones. Eliminate any missing_inputs failures if all the ;; missing inputs appear to have been built successfully, and update the @@ -140,6 +211,16 @@ (missing-input-build-derived-priority (hash-ref derived-build-priorities-hash missing-input-build-id))) + ;; Add an entry to the build-ordering-hints-hash + ;; to indicate that missing-input-build-id + ;; should happen prior to setup-failure-build-id + (hash-set! + build-ordering-hints-hash + setup-failure-build-id + (hash-ref build-ordering-hints-hash + setup-failure-build-id + '())) + (when (> setup-failure-build-derived-priority missing-input-build-derived-priority) ;; Bump the priority of the build @@ -160,19 +241,27 @@ (append-map (lambda (agent-id) (log "considering builds for" agent-id) - (let ((builds-for-agent - (limit-planned-builds - (sort (filter (filter-builds-for-agent agent-id) - builds) - (build-sorting-function-for-agent agent-id))))) - (map (lambda (build-id ordering) - (list build-id - agent-id - ordering)) - (map (lambda (build) - (assq-ref build 'uuid)) - builds-for-agent) - (iota (length builds-for-agent))))) + (let ((builds-sorted-by-derived-priority + (sort (filter (filter-builds-for-agent agent-id) + builds) + (build-sorting-function-for-agent agent-id)))) + (if (null? builds-sorted-by-derived-priority) + '() + (let ((final-ordered-builds + (concatenate + (map sort-priority-sublist + (break-builds-in-to-priority-sublists + builds-sorted-by-derived-priority))))) + (let ((builds-for-agent + (limit-planned-builds final-ordered-builds))) + (map (lambda (build-id ordering) + (list build-id + agent-id + ordering)) + (map (lambda (build) + (assq-ref build 'uuid)) + builds-for-agent) + (iota (length builds-for-agent)))))))) (map (lambda (agent) (assq-ref agent 'uuid)) agents)))) -- cgit v1.2.3