From 87a6d6ea7ae79fdf487bbcfd44bb3dce2d7c6e82 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 28 Nov 2023 15:51:38 +0100 Subject: [PATCH] remote-worker: Correctly compute parallelism per worker. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . 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’. --- src/cuirass/scripts/remote-worker.scm | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/cuirass/scripts/remote-worker.scm b/src/cuirass/scripts/remote-worker.scm index c34456c..83f458a 100644 --- a/src/cuirass/scripts/remote-worker.scm +++ b/src/cuirass/scripts/remote-worker.scm @@ -406,16 +406,15 @@ process can use up to PARALLELISM cores." (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 -SYSTEMS." +SYSTEMS. CPU-COUNT is the total number of CPU cores available on the system, +to be distributed among all the workers." (lambda () (let loop () (match (get-message channel) (`(start-workers ,count ,server ,local-address) - (let ((parallelism (max (ceiling-quotient (current-processor-count) - count) - 1))) + (let ((parallelism (max (ceiling-quotient cpu-count count) 1))) (log-info "starting ~a workers (parallelism: ~a cores) for server at ~a" count parallelism (server-address server)) @@ -469,6 +468,7 @@ exiting." (server-address (assoc-ref opts 'server)) (systems (assoc-ref opts 'systems)) (urls (assoc-ref opts 'substitute-urls)) + (cpu-count (current-processor-count)) ;call it before 'run-fibers' (user (assoc-ref opts 'user)) (public-key (read-file-sexp @@ -532,7 +532,8 @@ exiting." (lambda () ;; Spawn the fiber that'll actually create workers as it receives ;; 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. ;; Normally these build results are sent right away to 'cuirass