guix
/
guix-cuirass
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git
2
0
Fork 0
Code Issues Releases Wiki Activity

remote-worker: Correctly compute parallelism per worker. 

Fixes <https://issues.guix.gnu.org/67502>.

Since ‘run-fibers’ binds each thread to one core by default,
‘current-processor-count’ when called from within ‘run-fibers’ on a
machine with 4 or fewer cores would always return 1.

* src/cuirass/scripts/remote-worker.scm (worker-management-thunk): Add
‘cpu-count’ parameter and use it instead of calling
‘current-processor-count’.
(cuirass-remote-worker): Call ‘current-processor-count’ outside
‘run-fibers’ and pass the result to ‘worker-management-thunk’.
This commit is contained in:
Ludovic Courtès 2023-11-28 15:51:38 +01:00
parent 3a6abc17f9
commit 87a6d6ea7a
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/cuirass/scripts/remote-worker.scm
View File

@ -406,16 +406,15 @@ process can use up to PARALLELISM cores."
(loop))))))) (loop)))))))
(define (worker-management-thunk channel systems) (define (worker-management-thunk channel systems cpu-count)
"Return a thunk that reads from CHANNEL requests to start new workers for "Return a thunk that reads from CHANNEL requests to start new workers for
SYSTEMS." SYSTEMS. CPU-COUNT is the total number of CPU cores available on the system,
to be distributed among all the workers."
(lambda () (lambda ()
(let loop () (let loop ()
(match (get-message channel) (match (get-message channel)
(`(start-workers ,count ,server ,local-address) (`(start-workers ,count ,server ,local-address)
(let ((parallelism (max (ceiling-quotient (current-processor-count) (let ((parallelism (max (ceiling-quotient cpu-count count) 1)))
count)
1)))
(log-info (log-info
"starting ~a workers (parallelism: ~a cores) for server at ~a" "starting ~a workers (parallelism: ~a cores) for server at ~a"
count parallelism (server-address server)) count parallelism (server-address server))
@ -469,6 +468,7 @@ exiting."
(server-address (assoc-ref opts 'server)) (server-address (assoc-ref opts 'server))
(systems (assoc-ref opts 'systems)) (systems (assoc-ref opts 'systems))
(urls (assoc-ref opts 'substitute-urls)) (urls (assoc-ref opts 'substitute-urls))
(cpu-count (current-processor-count)) ;call it before 'run-fibers'
(user (assoc-ref opts 'user)) (user (assoc-ref opts 'user))
(public-key (public-key
(read-file-sexp (read-file-sexp
@ -532,7 +532,8 @@ exiting."
(lambda () (lambda ()
;; Spawn the fiber that'll actually create workers as it receives ;; Spawn the fiber that'll actually create workers as it receives
;; requests on MANAGEMENT-CHANNEL. ;; requests on MANAGEMENT-CHANNEL.
(spawn-fiber (worker-management-thunk management-channel systems)) (spawn-fiber
(worker-management-thunk management-channel systems cpu-count))
;; This program registers roots for successful build results. ;; This program registers roots for successful build results.
;; Normally these build results are sent right away to 'cuirass ;; Normally these build results are sent right away to 'cuirass