[PATCH] guile-build-system: Support building in parallel.

Done

Details

2 participants

Ludovic Courtès
Christopher Baines

Owner: unassigned

Submitted by: Christopher Baines

Severity: normal

Debbugs page

Christopher Baines wrote 6 years ago

Recipients:(address . guix-patches@gnu.org)

Message-ID:20190324212345.4697-1-mail@cbaines.net

* 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(-)

Toggle diff (64 lines)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

Ludovic Courtès wrote 6 years ago

Recipients:(name . Christopher Baines)(address . mail@cbaines.net)(address . 34982@debbugs.gnu.org)

Message-ID:87lg0w4om6.fsf@gnu.org

Hi,

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (3 lines)

> * guix/build/guile-build-system.scm (build): Use n-par-for-each, instead of

> for-each, to use multiple cores if available.

[...]

Toggle quote (16 lines)> +    (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’.

Christopher Baines wrote 6 years ago

Recipients:(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 34982@debbugs.gnu.org)

Message-ID:87o95km2p3.fsf@cbaines.net

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

Toggle quote (33 lines)> Hi,
>
> Christopher Baines <mail@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

Ludovic Courtès wrote 6 years ago

Recipients:(name . Christopher Baines)(address . mail@cbaines.net)(address . 34982@debbugs.gnu.org)

Message-ID:87o955ev7n.fsf@gnu.org

Hello Christopher!

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (4 lines)

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

Christopher Baines wrote 6 years ago

[PATCH] guile-build-system: Support building in parallel.

Recipients:(address . 34982@debbugs.gnu.org)

Message-ID:20190416181326.2416-1-mail@cbaines.net

* 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(-)

Toggle diff (123 lines)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

Christopher Baines wrote 6 years ago

Recipients:(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 34982@debbugs.gnu.org)

Message-ID:87y349dcy3.fsf@cbaines.net

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

Toggle quote (10 lines)> Hello Christopher!
>
> Christopher Baines <mail@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

Ludovic Courtès wrote 6 years ago

Recipients:(name . Christopher Baines)(address . mail@cbaines.net)(address . 34982@debbugs.gnu.org)

Message-ID:87ftqheoj6.fsf@gnu.org

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (4 lines)

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

[...]

Toggle quote (7 lines)

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

Christopher Baines wrote 6 years ago

Recipients:(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 34982-done@debbugs.gnu.org)

Message-ID:87y346tp78.fsf@cbaines.net

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

Toggle quote (31 lines)> Christopher Baines <mail@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

Closed

Your comment

This issue is archived.

To comment on this conversation send an email to 34982@debbugs.gnu.org

To respond to this issue using the mumi CLI, first switch to it

mumi current 34982

Then, you may apply the latest patchset in this issue (with sign off)

mumi am -- -s

Or, compose a reply to this issue

mumi compose

Or, send patches to this issue

mumi send-email *.patch

You may also tag this issue. See list of standard tags. For example, to set the confirmed and easy tags

mumi command -t +confirmed -t +easy

Or, remove the moreinfo tag and set the help tag

mumi command -t -moreinfo -t +help

is:open	open issues
is:done	closed issues
submitter:<who>	search issue submitter
author:<who>	search by message author
date:yesterday..now	search by issue date
mdate:3m..2d	search by message date