diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-09-20 12:10:28 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-09-20 12:10:28 +0200 |
| commit | b1fea30339f071e8751039fd0e6ef2aa3e6f44fb (patch) | |
| tree | e641b19019598d87bb5169d31f6a3257220ab8c1 | |
| parent | 4359378a2c83afd9f511fb3fbf8c81f236d0a9b9 (diff) | |
| download | guix-b1fea30339f071e8751039fd0e6ef2aa3e6f44fb.tar guix-b1fea30339f071e8751039fd0e6ef2aa3e6f44fb.tar.gz | |
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.
| -rw-r--r-- | guix/scripts/offload.scm | 25 |
1 files changed, 14 insertions, 11 deletions
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index b3b502425c..e7cba1380e 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -610,22 +610,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 |