GNU bug report logs - #34982
[PATCH] guile-build-system: Support building in parallel.

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 34982 in the body.
You can then email your comments to 34982 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: guix-patches <at> gnu.org
Subject: [PATCH] guile-build-system: Support building in parallel.
Date: Sun, 24 Mar 2019 21:23:45 +0000

* guix/build/guile-build-system.scm (build): Use n-par-for-each, instead of
for-each, to use multiple cores if available.
---
 guix/build/guile-build-system.scm | 43 +++++++++++++++++++------------
 1 file changed, 26 insertions(+), 17 deletions(-)

diff --git a/guix/build/guile-build-system.scm b/guix/build/guile-build-system.scm
index 0bed049436..a5741081bf 100644
--- a/guix/build/guile-build-system.scm
+++ b/guix/build/guile-build-system.scm
@@ -23,6 +23,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 threads)
   #:use-module (guix build utils)
   #:export (target-guile-effective-version
             %standard-phases
@@ -101,24 +102,32 @@ Return #false if it cannot be determined."
                            (match (getenv "GUILE_LOAD_COMPILED_PATH")
                              (#f "")
                              (path (string-append ":" path)))))
-    (for-each (lambda (file)
-                (let* ((go (string-append go-dir
-                                          (file-sans-extension file)
-                                          ".go")))
-                  ;; Install source module.
-                  (install-file (string-append source-directory "/" file)
-                                (string-append module-dir
-                                               "/" (dirname file)))
+    (n-par-for-each
+     (parallel-job-count)
+     (lambda (file)
+       (catch #t
+         (lambda ()
+           (let* ((go (string-append go-dir
+                                     (file-sans-extension file)
+                                     ".go")))
+             ;; Install source module.
+             (install-file (string-append source-directory "/" file)
+                           (string-append module-dir
+                                          "/" (dirname file)))
 
-                  ;; Install and compile module.
-                  (apply invoke guild "compile" "-L" source-directory
-                         "-o" go
-                         (string-append source-directory "/" file)
-                         flags)))
-
-              ;; Arrange to strip SOURCE-DIRECTORY from file names.
-              (with-directory-excursion source-directory
-                (find-files "." scheme-file-regexp)))
+             ;; Install and compile module.
+             (apply invoke guild "compile" "-L" source-directory
+                    "-o" go
+                    (string-append source-directory "/" file)
+                    flags)))
+         (lambda (key . args)
+           ;; Since ports are not thread-safe as of Guile 2.0, reopen stderr.
+           (let ((port (fdopen 2 "w0")))
+             (print-exception port #f key args)
+             (primitive-exit 1)))))
+     ;; Arrange to strip SOURCE-DIRECTORY from file names.
+     (with-directory-excursion source-directory
+       (find-files "." scheme-file-regexp)))
     #t))
 
 (define* (install-documentation #:key outputs
-- 
2.20.1

Message #8 received at 34982 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Christopher Baines <mail <at> cbaines.net>
Cc: 34982 <at> debbugs.gnu.org
Subject: Re: [bug#34982] [PATCH] guile-build-system: Support building in
 parallel.
Date: Sat, 30 Mar 2019 11:56:33 +0100

Hi,

Christopher Baines <mail <at> cbaines.net> skribis:

> * guix/build/guile-build-system.scm (build): Use n-par-for-each, instead of
> for-each, to use multiple cores if available.

[...]

> +    (n-par-for-each
> +     (parallel-job-count)
> +     (lambda (file)
> +       (catch #t
> +         (lambda ()
> +           (let* ((go (string-append go-dir
> +                                     (file-sans-extension file)
> +                                     ".go")))
> +             ;; Install source module.
> +             (install-file (string-append source-directory "/" file)
> +                           (string-append module-dir
> +                                          "/" (dirname file)))
>  
> -                  ;; Install and compile module.
> -                  (apply invoke guild "compile" "-L" source-directory

It probably doesn’t matter that much, but it feels wrong to create
threads that do nothing but call ‘waitpid’, essentially.

Commit f07041f7d25badb7d74b8fad6ee446a12af04f63 removed a ‘p-for-each’
procedure that could be useful here since it directly creates N
processes and then does (waitpid WAITPID_ANY).  Would it make sense to
paste it here and use it in lieu of ‘n-par-for-each’?

Thanks,
Ludo’.

Message #11 received at 34982 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 34982 <at> debbugs.gnu.org
Subject: Re: [bug#34982] [PATCH] guile-build-system: Support building in
 parallel.
Date: Sat, 06 Apr 2019 00:50:48 +0100

[Message part 1 (text/plain, inline)]

Ludovic Courtès <ludo <at> gnu.org> writes:

> Hi,
>
> Christopher Baines <mail <at> cbaines.net> skribis:
>
>> * guix/build/guile-build-system.scm (build): Use n-par-for-each, instead of
>> for-each, to use multiple cores if available.
>
> [...]
>
>> +    (n-par-for-each
>> +     (parallel-job-count)
>> +     (lambda (file)
>> +       (catch #t
>> +         (lambda ()
>> +           (let* ((go (string-append go-dir
>> +                                     (file-sans-extension file)
>> +                                     ".go")))
>> +             ;; Install source module.
>> +             (install-file (string-append source-directory "/" file)
>> +                           (string-append module-dir
>> +                                          "/" (dirname file)))
>>
>> -                  ;; Install and compile module.
>> -                  (apply invoke guild "compile" "-L" source-directory
>
> It probably doesn’t matter that much, but it feels wrong to create
> threads that do nothing but call ‘waitpid’, essentially.
>
> Commit f07041f7d25badb7d74b8fad6ee446a12af04f63 removed a ‘p-for-each’
> procedure that could be useful here since it directly creates N
> processes and then does (waitpid WAITPID_ANY).  Would it make sense to
> paste it here and use it in lieu of ‘n-par-for-each’?

I've sent a new patch with an updated approach now, I started with the
n-par-for-each procedure, and adapted it. It seems to work, let me know
what you think :)

Chris

[signature.asc (application/pgp-signature, inline)]

Message #14 received at 34982 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Christopher Baines <mail <at> cbaines.net>
Cc: 34982 <at> debbugs.gnu.org
Subject: Re: [bug#34982] [PATCH] guile-build-system: Support building in
 parallel.
Date: Tue, 16 Apr 2019 19:06:04 +0200

Hello Christopher!

Christopher Baines <mail <at> cbaines.net> skribis:

> I've sent a new patch with an updated approach now, I started with the
> n-par-for-each procedure, and adapted it. It seems to work, let me know
> what you think :)

Sorry for the delay, but… where’s the new patch?

Ludo’.

Message #17 received at 34982 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: 34982 <at> debbugs.gnu.org
Subject: [PATCH] guile-build-system: Support building in parallel.
Date: Tue, 16 Apr 2019 19:13:26 +0100

* guix/build/guile-build-system.scm (build): Use invoke-each, instead of
for-each, to use multiple cores if available.
(invoke-each, report-build-process): New procedures.
---
 guix/build/guile-build-system.scm | 96 +++++++++++++++++++++++++------
 1 file changed, 78 insertions(+), 18 deletions(-)

diff --git a/guix/build/guile-build-system.scm b/guix/build/guile-build-system.scm
index 0bed049436..5ad728361a 100644
--- a/guix/build/guile-build-system.scm
+++ b/guix/build/guile-build-system.scm
@@ -23,6 +23,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 threads)
   #:use-module (guix build utils)
   #:export (target-guile-effective-version
             %standard-phases
@@ -65,6 +66,59 @@ Return #false if it cannot be determined."
      (setenv "GUIX_LOCPATH" (string-append locales "/lib/locale"))
      #t)))
 
+(define* (invoke-each commands
+                      #:key (max-processes (current-processor-count))
+                      report-progress)
+  "Run each command in COMMANDS in a separate process, using up to
+MAX-PROCESSES processes in parallel.  Call REPORT-PROGRESS at each step.
+Raise an error if one of the processes exit with non-zero."
+  (define total
+    (length commands))
+
+  (define (wait-for-one-process)
+    (match (waitpid WAIT_ANY)
+      ((_ . status)
+       (unless (zero? (status:exit-val status))
+         (error "process failed" status)))))
+
+  (define (fork-and-run-command command)
+    (match (primitive-fork)
+      (0
+       (apply execlp command))
+      (pid
+       #t)))
+
+  (let loop ((commands  commands)
+             (running   0)
+             (completed 0))
+    (match commands
+      (()
+       (or (zero? running)
+           (let ((running   (- running 1))
+                 (completed (+ completed 1)))
+             (wait-for-one-process)
+             (report-progress total completed)
+             (loop commands running completed))))
+      ((command . rest)
+       (if (< running max-processes)
+           (let ((running (+ 1 running)))
+             (fork-and-run-command command)
+             (report-progress total completed)
+             (loop rest running completed))
+           (let ((running   (- running 1))
+                 (completed (+ completed 1)))
+             (wait-for-one-process)
+             (report-progress total completed)
+             (loop commands running completed)))))))
+
+(define* (report-build-progress total completed
+                                #:optional (log-port (current-error-port)))
+  "Report that COMPLETED out of TOTAL files have been completed."
+  (display #\cr log-port)
+  (format log-port "compiling...\t~5,1f% of ~d files" ;FIXME: i18n
+          (* 100. (/ completed total)) total)
+  (force-output log-port))
+
 (define* (build #:key outputs inputs native-inputs
                 (source-directory ".")
                 (compile-flags '())
@@ -101,24 +155,30 @@ Return #false if it cannot be determined."
                            (match (getenv "GUILE_LOAD_COMPILED_PATH")
                              (#f "")
                              (path (string-append ":" path)))))
-    (for-each (lambda (file)
-                (let* ((go (string-append go-dir
-                                          (file-sans-extension file)
-                                          ".go")))
-                  ;; Install source module.
-                  (install-file (string-append source-directory "/" file)
-                                (string-append module-dir
-                                               "/" (dirname file)))
-
-                  ;; Install and compile module.
-                  (apply invoke guild "compile" "-L" source-directory
-                         "-o" go
-                         (string-append source-directory "/" file)
-                         flags)))
-
-              ;; Arrange to strip SOURCE-DIRECTORY from file names.
-              (with-directory-excursion source-directory
-                (find-files "." scheme-file-regexp)))
+
+  (let ((source-files
+           (with-directory-excursion source-directory
+             (find-files "." scheme-file-regexp))))
+    (invoke-each
+     (map (lambda (file)
+            (cons* guild
+                   "guild" "compile"
+                   "-L" source-directory
+                   "-o" (string-append go-dir
+                                       (file-sans-extension file)
+                                       ".go")
+                   (string-append source-directory "/" file)
+                   flags))
+          source-files)
+     #:max-processes (parallel-job-count)
+     #:report-progress report-build-progress)
+
+    (for-each
+     (lambda (file)
+         (install-file (string-append source-directory "/" file)
+                       (string-append module-dir
+                                      "/" (dirname file))))
+     source-files))
     #t))
 
 (define* (install-documentation #:key outputs
-- 
2.21.0

Message #20 received at 34982 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 34982 <at> debbugs.gnu.org
Subject: Re: [bug#34982] [PATCH] guile-build-system: Support building in
 parallel.
Date: Tue, 16 Apr 2019 19:25:56 +0100

[Message part 1 (text/plain, inline)]

Ludovic Courtès <ludo <at> gnu.org> writes:

> Hello Christopher!
>
> Christopher Baines <mail <at> cbaines.net> skribis:
>
>> I've sent a new patch with an updated approach now, I started with the
>> n-par-for-each procedure, and adapted it. It seems to work, let me know
>> what you think :)
>
> Sorry for the delay, but… where’s the new patch?

Hmm, I'm not sure. I thought I sent it, but seemingly not.

I've just sent the updated patch, and it's definately arrived now.

Thanks,

Chris

[signature.asc (application/pgp-signature, inline)]

Message #23 received at 34982 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Christopher Baines <mail <at> cbaines.net>
Cc: 34982 <at> debbugs.gnu.org
Subject: Re: [bug#34982] [PATCH] guile-build-system: Support building in
 parallel.
Date: Tue, 16 Apr 2019 21:30:21 +0200

Christopher Baines <mail <at> cbaines.net> skribis:

> * guix/build/guile-build-system.scm (build): Use invoke-each, instead of
> for-each, to use multiple cores if available.
> (invoke-each, report-build-process): New procedures.

[...]

> +  (define (fork-and-run-command command)
> +    (match (primitive-fork)
> +      (0
> +       (apply execlp command))
> +      (pid
> +       #t)))

To be on the safe side, you should probably wrap the ‘execlp’ call like
this:

  (dynamic-wind
    (const #t)
    (lambda ()
      (apply execlp command))
    (lambda ()
      (primitive-exit 127)))

This ensures that the child process exits immediately if something goes
wrong (e.g., ‘execlp’ raises an exception because the executable could
not be found.)

Otherwise LGTM, thank you!

Ludo’.

Message #28 received at 34982-done <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 34982-done <at> debbugs.gnu.org
Subject: Re: [bug#34982] [PATCH] guile-build-system: Support building in
 parallel.
Date: Fri, 19 Apr 2019 08:43:39 +0100

[Message part 1 (text/plain, inline)]

Ludovic Courtès <ludo <at> gnu.org> writes:

> Christopher Baines <mail <at> cbaines.net> skribis:
>
>> * guix/build/guile-build-system.scm (build): Use invoke-each, instead of
>> for-each, to use multiple cores if available.
>> (invoke-each, report-build-process): New procedures.
>
> [...]
>
>> +  (define (fork-and-run-command command)
>> +    (match (primitive-fork)
>> +      (0
>> +       (apply execlp command))
>> +      (pid
>> +       #t)))
>
> To be on the safe side, you should probably wrap the ‘execlp’ call like
> this:
>
>   (dynamic-wind
>     (const #t)
>     (lambda ()
>       (apply execlp command))
>     (lambda ()
>       (primitive-exit 127)))
>
> This ensures that the child process exits immediately if something goes
> wrong (e.g., ‘execlp’ raises an exception because the executable could
> not be found.)
>
> Otherwise LGTM, thank you!

Great, I've added in dynamic-wind, made some minor tweaks to the output,
and pushed this as 3fdb9a375f1cee7dd302349a9527437df20b3f61.

Thanks for taking a look :)

Chris

[signature.asc (application/pgp-signature, inline)]

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.