nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

offload: Try another machine when the "best" machine is overloaded. 

* guix/scripts/offload.scm (choose-build-machine): When BEST is
  overloaded, try the other machines.
This commit is contained in:
Ludovic Courtès 2014-09-20 12:10:28 +02:00
parent 4359378a2c
commit b1fea30339
1 changed files with 14 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
guix/scripts/offload.scm
View File

@ -610,22 +610,25 @@ allowed on MACHINE."
(list machine1 slot1) (list machine1 slot1)
(list machine2 slot2)))))))) (list machine2 slot2))))))))
(let ((machines+slots (sort machines+slots (let loop ((machines+slots
(undecorate machine-less-loaded-or-faster?)))) (sort machines+slots
(undecorate machine-less-loaded-or-faster?))))
(match machines+slots (match machines+slots
(((best slot) (others slots) ...) (((best slot) others ...)
;; Release slots from the uninteresting machines.
(for-each release-build-slot slots)
;; Return the best machine unless it's already overloaded. ;; Return the best machine unless it's already overloaded.
(if (< (machine-load best) 2.) (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 (begin
;; Prevent SLOT from being GC'd. ;; BEST is overloaded, so try the next one.
(set! %slots (cons slot %slots))
best)
(begin
(release-build-slot slot) (release-build-slot slot)
#f))) (loop others))))
(() #f))))) (() #f)))))
(define* (process-request wants-local? system drv features (define* (process-request wants-local? system drv features