summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--build-aux/cuirass/evaluate.scm53
1 files changed, 29 insertions, 24 deletions
diff --git a/build-aux/cuirass/evaluate.scm b/build-aux/cuirass/evaluate.scm
index 0bd9e2481f..5beac1b37c 100644
--- a/build-aux/cuirass/evaluate.scm
+++ b/build-aux/cuirass/evaluate.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2018, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
;;;
@@ -78,29 +78,34 @@
;; up the evaluation speed as the evaluations can be performed
;; concurrently. It also decreases the amount of memory needed per
;; evaluation process.
- (n-par-for-each
- (/ (current-processor-count) 2)
- (lambda (system)
- (with-store store
- (let ((inferior
- (open-inferior (derivation->output-path derivation)))
- (channels (map channel-instance->sexp instances)))
- (inferior-eval '(use-modules (gnu ci)) inferior)
- (let ((jobs
- (inferior-eval-with-store
- inferior store
- `(lambda (store)
- (cuirass-jobs store
- '((subset . all)
- (systems . ,(list system))
- (channels . ,channels))))))
- (file
- (string-append directory "/jobs-" system ".scm")))
- (close-inferior inferior)
- (call-with-output-file file
- (lambda (port)
- (write jobs port)))))))
- %cuirass-supported-systems))))))
+ ;;
+ ;; Fork inferior processes upfront before we have created any
+ ;; threads.
+ (let ((inferiors (map (lambda _
+ (open-inferior (derivation->output-path derivation)))
+ %cuirass-supported-systems)))
+ (n-par-for-each
+ (/ (current-processor-count) 2)
+ (lambda (system inferior)
+ (with-store store
+ (let ((channels (map channel-instance->sexp instances)))
+ (inferior-eval '(use-modules (gnu ci)) inferior)
+ (let ((jobs
+ (inferior-eval-with-store
+ inferior store
+ `(lambda (store)
+ (cuirass-jobs store
+ '((subset . all)
+ (systems . ,(list system))
+ (channels . ,channels))))))
+ (file
+ (string-append directory "/jobs-" system ".scm")))
+ (close-inferior inferior)
+ (call-with-output-file file
+ (lambda (port)
+ (write jobs port)))))))
+ %cuirass-supported-systems
+ inferiors)))))))
(x
(format (current-error-port) "Wrong command: ~a~%." x)
(exit 1)))