summaryrefslogtreecommitdiff
path: root/guix/scripts/offload.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/scripts/offload.scm')
-rw-r--r--guix/scripts/offload.scm43
1 files changed, 22 insertions, 21 deletions
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index b3b502425c..391906ff79 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -534,10 +534,6 @@ success, #f otherwise."
(build-requirements-features requirements)
(build-machine-features machine))))
-(define (machine-faster? m1 m2)
- "Return #t if M1 is faster than M2."
- (> (build-machine-speed m1) (build-machine-speed m2)))
-
(define (machine-load machine)
"Return the load of MACHINE, divided by the number of parallel builds
allowed on MACHINE."
@@ -558,14 +554,16 @@ allowed on MACHINE."
(_
+inf.0))))) ;something's fishy about MACHINE, so avoid it
-(define (machine-less-loaded? m1 m2)
- "Return #t if the load on M1 is lower than that on M2."
- (< (machine-load m1) (machine-load m2)))
+(define (machine-power-factor m)
+ "Return a factor that aggregates the speed and load of M. The higher the
+better."
+ (/ (build-machine-speed m)
+ (+ 1 (machine-load m))))
(define (machine-less-loaded-or-faster? m1 m2)
- "Return #t if M1 is either less loaded or faster than M2."
- (or (machine-less-loaded? m1 m2)
- (machine-faster? m1 m2)))
+ "Return #t if M1 is either less loaded or faster than M2. (This relation
+defines a total order on machines.)"
+ (> (machine-power-factor m1) (machine-power-factor m2)))
(define (machine-lock-file machine hint)
"Return the name of MACHINE's lock file for HINT."
@@ -610,22 +608,25 @@ allowed on MACHINE."
(list machine1 slot1)
(list machine2 slot2))))))))
- (let ((machines+slots (sort machines+slots
- (undecorate machine-less-loaded-or-faster?))))
+ (let loop ((machines+slots
+ (sort machines+slots
+ (undecorate machine-less-loaded-or-faster?))))
(match machines+slots
- (((best slot) (others slots) ...)
- ;; Release slots from the uninteresting machines.
- (for-each release-build-slot slots)
-
+ (((best slot) others ...)
;; Return the best machine unless it's already overloaded.
(if (< (machine-load best) 2.)
+ (match others
+ (((machines slots) ...)
+ ;; Release slots from the uninteresting machines.
+ (for-each release-build-slot slots)
+
+ ;; Prevent SLOT from being GC'd.
+ (set! %slots (cons slot %slots))
+ best))
(begin
- ;; Prevent SLOT from being GC'd.
- (set! %slots (cons slot %slots))
- best)
- (begin
+ ;; BEST is overloaded, so try the next one.
(release-build-slot slot)
- #f)))
+ (loop others))))
(() #f)))))
(define* (process-request wants-local? system drv features