[no subject]

[Ludovic Courtès]

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

    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’.
---
 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