[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[no subject]

From: Ludovic Courtès
Date: Tue, 28 Nov 2023 10:26:20 -0500 (EST)

branch: master
commit 87a6d6ea7ae79fdf487bbcfd44bb3dce2d7c6e82
Author: Ludovic Courtès <>
AuthorDate: Tue Nov 28 15:51:38 2023 +0100

    remote-worker: Correctly compute parallelism per worker.
    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
    (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 
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."
-(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.  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)))
             "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))
@@ -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

reply via email to

[Prev in Thread] Current Thread [Next in Thread]