futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

offload: Call 'machine-load' only once per machine.

Browse Source 
This fixes a longstanding issue where 'choose-build-machine' would make
on average O(N log(N)) calls to 'machine-load', plus an extra call for
the selected machine, instead of N calls.

* guix/scripts/offload.scm (machine-load): Add comment.
(machine-power-factor, machine-less-loaded-or-faster?): Remove.
(choose-build-machine)[machines+slots]: Rename to...
[machines+slots+loads]: ... this.
[undecorate]: Adjust accordingly.
[machine-less-loaded-or-faster?]: New procedure.
Remove extra 'machine-load' call in body.
This commit is contained in:
Ludovic Courtès 2016-11-26 23:00:36 +01:00
parent c3e2a2471c
commit 1cd1d8a7ea
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 22 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
guix/scripts/offload.scm
View File

@ -490,6 +490,7 @@ be read."
(define (machine-load machine)
"Return the load of MACHINE, divided by the number of parallel builds
allowed on MACHINE."
;; Note: This procedure is costly since it creates a new SSH session.
(let* ((session (open-ssh-session machine))
(pipe (open-remote-pipe* session OPEN_READ
"cat" "/proc/loadavg"))
@ -510,17 +511,6 @@ allowed on MACHINE."
(_
+inf.0))))) ;something's fishy about MACHINE, so avoid it
(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. (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."
(string-append %state-directory "/offload/"
@ -548,29 +538,39 @@ defines a total order on machines.)"
;; 5. Release the global machine-choice lock.
(with-file-lock (machine-choice-lock-file)
(define machines+slots
(define machines+slots+loads
(filter-map (lambda (machine)
;; Call 'machine-load' from here to make sure it is called
;; only once per machine (it is expensive).
(let ((slot (acquire-build-slot machine)))
(and slot (list machine slot))))
(and slot
(list machine slot (machine-load machine)))))
machines))
(define (undecorate pred)
(lambda (a b)
(match a
((machine1 slot1)
((machine1 slot1 load1)
(match b
((machine2 slot2)
(pred machine1 machine2)))))))
((machine2 slot2 load2)
(pred machine1 load1 machine2 load2)))))))
(let loop ((machines+slots
(sort machines+slots
(define (machine-less-loaded-or-faster? m1 l1 m2 l2)
;; Return #t if M1 is either less loaded or faster than M2, with L1
;; being the load of M1 and L2 the load of M2. (This relation defines a
;; total order on machines.)
(> (/ (build-machine-speed m1) (+ 1 l1))
(/ (build-machine-speed m2) (+ 1 l2))))
(let loop ((machines+slots+loads
(sort machines+slots+loads
(undecorate machine-less-loaded-or-faster?))))
(match machines+slots
(((best slot) others ...)
(match machines+slots+loads
(((best slot load) others ...)
;; Return the best machine unless it's already overloaded.
(if (< (machine-load best) 2.)
(if (< load 2.)
(match others
(((machines slots) ...)
(((machines slots loads) ...)
;; Release slots from the uninteresting machines.
(for-each release-build-slot slots)