Re: [PATCH] build: pull: Compile .scm files in one process.

[Taylan Ulrich Bayırlı/Kammer]

address@hidden (Ludovic Courtès) writes:

> address@hidden (Taylan Ulrich "Bayırlı/Kammer") skribis:
>
>> From 78be6d09d2d4c0a563be14c66ac2a1a345ff9b1d Mon Sep 17 00:00:00 2001
>> From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?=
>>  <address@hidden>
>> Date: Thu, 5 Nov 2015 23:43:20 +0100
>> Subject: [PATCH] build: pull: Compile .scm files in one process.
>>
>> * guix/build/pull.scm (call-with-process, report-build-progress)
>> (p-for-each): Remove.
>> (thread-safe-port): New procedure.
>> (build-guix): Load and compile files in one process.
>
> Just tried this patch without the ‘thread-safe-port’ procedure, but I
> got this (current master):
>
> loading...     95.4% of 474 filesBacktrace:
> In ice-9/boot-9.scm:
>  157: 14 [catch #t #<catch-closure 8c9580> ...]
> In unknown file:
>    ?: 13 [apply-smob/1 #<catch-closure 8c9580>]
> In ice-9/boot-9.scm:
>   63: 12 [call-with-prompt prompt0 ...]
> In ice-9/eval.scm:
>  432: 11 [eval # #]
> In ice-9/boot-9.scm:
> 2401: 10 [save-module-excursion #<procedure 8e6800 at ice-9/boot-9.scm:4045:3 
> ()>]
> 4050: 9 [#<procedure 8e6800 at ice-9/boot-9.scm:4045:3 ()>]
> 1724: 8 [%start-stack load-stack #<procedure 8f9600 at 
> ice-9/boot-9.scm:4041:10 ()>]
> 1729: 7 [#<procedure 8fc9c0 ()>]
> In unknown file:
>    ?: 6 [primitive-load 
> "/gnu/store/hx0jk73cx50f3vpi0yyrbn0pd8ws8m0v-guix-latest-builder"]
> In ./guix/build/pull.scm:
>   47: 5 [build-guix "/gnu/store/d51z2xkwp1vh0dh6gqadyyzv21m0b772-guix-latest" 
> ...]
>   91: 4 [#<procedure c5e2c0 at ./guix/build/pull.scm:47:2 ()>]
> In ice-9/boot-9.scm:
> 2401: 3 [save-module-excursion #<procedure 62e1140 at 
> ./guix/build/pull.scm:92:14 ()>]
> In unknown file:
>    ?: 2 [primitive-load 
> "/gnu/store/d51z2xkwp1vh0dh6gqadyyzv21m0b772-guix-latest/guix/scripts/import/hackage.scm"]
> In ice-9/eval.scm:
>  453: 1 Exception thrown while printing backtrace:
> ERROR: In procedure package-location: Wrong type argument: Error while 
> printing exception.
>
> ice-9/eval.scm:387:11: In procedure eval:
> ice-9/eval.scm:387:11: In procedure package-version: Wrong type argument: 
> Error while printing exception.
> builder for `/gnu/store/pc1i5s6vx9yx97prhskx178gj5swxw4k-guix-latest.drv' 
> failed with exit code 1
> guix pull: error: build failed: build of 
> `/gnu/store/pc1i5s6vx9yx97prhskx178gj5swxw4k-guix-latest.drv' failed
>
> Any idea?
>
> To me it sounds like there are two <package> record type descriptors in
> the wild, which is why ‘package-location’ in the package record printer
> bails out.

That's one of the errors that result from a "bad" order of compiling the
files and when the 'load' hack isn't used to work around it, which isn't
the case in that patch...  Indeed I can't seem to reproduce the issue.

The attached patch below also builds on the quoted patch, removes the
thread-safe-port procedure, and just sets the warning port to a void
port.  Applied on top of the current master, it works for me.

Maybe you applied a different patch by accident?

Thanks for picking this up and sorry that I couldn't finish it. :-)

>From 4cb8ad8006ba359e984f4b6e765be082b7d5f9c0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?=
 <address@hidden>
Date: Fri, 27 Nov 2015 09:27:55 +0100
Subject: [PATCH] build: pull: Compile .scm files in one process.

* guix/build/pull.scm (call-with-process, report-build-progress)
(p-for-each): Remove.
(build-guix): Load and compile files in one process.
---
 guix/build/pull.scm | 142 ++++++++++++++++++----------------------------------
 1 file changed, 48 insertions(+), 94 deletions(-)

diff --git a/guix/build/pull.scm b/guix/build/pull.scm
index 281be23..e77a582 100644
--- a/guix/build/pull.scm
+++ b/guix/build/pull.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014 Ludovic Courtès <address@hidden>
+;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,6 +23,7 @@
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 threads)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -33,75 +35,10 @@
 ;;;
 ;;; Code:
 
-(define (call-with-process thunk)
-  "Run THUNK in a separate process that will return 0 if THUNK terminates
-normally, and 1 if an exception is raised."
-  (match (primitive-fork)
-    (0
-     (catch #t
-       (lambda ()
-         (thunk)
-         (primitive-exit 0))
-       (lambda (key . args)
-         (print-exception (current-error-port) #f key args)
-         (primitive-exit 1))))
-    (pid
-     #t)))
-
-(define* (report-build-progress total completed cont
-                                #:optional (log-port (current-error-port)))
-  "Report that COMPLETED out of TOTAL files have been completed, and call
-CONT."
-  (display #\cr log-port)
-  (format log-port "compiling...\t~5,1f% of ~d files" ;FIXME: i18n
-          (* 100. (/ completed total)) total)
-  (force-output log-port)
-  (cont))
-
-(define* (p-for-each proc lst
-                     #:optional (max-processes (current-processor-count))
-                     #:key (progress report-build-progress))
-  "Invoke PROC for each element of LST in a separate process, using up to
-MAX-PROCESSES processes in parallel.  Call PROGRESS at each step, passing it
-the continuation.  Raise an error if one of the processes exit with non-zero."
-  (define total
-    (length lst))
-
-  (define (wait-for-one-process)
-    (match (waitpid WAIT_ANY)
-      ((_ . status)
-       (unless (zero? (status:exit-val status))
-         (error "process failed" proc status)))))
-
-  (let loop ((lst       lst)
-             (running   0)
-             (completed 0))
-    (match lst
-      (()
-       (or (zero? running)
-           (let ((running   (- running 1))
-                 (completed (+ completed 1)))
-             (wait-for-one-process)
-             (progress total completed
-                       (lambda ()
-                         (loop lst running completed))))))
-      ((head . tail)
-       (if (< running max-processes)
-           (let ((running (+ 1 running)))
-             (call-with-process (cut proc head))
-             (progress total completed
-                       (lambda ()
-                         (loop tail running completed))))
-           (let ((running   (- running 1))
-                 (completed (+ completed 1)))
-             (wait-for-one-process)
-             (progress total completed
-                       (lambda ()
-                         (loop lst running completed)))))))))
-
 (define* (build-guix out source
                      #:key gcrypt
-                     (debug-port (%make-void-port "w")))
+                     (debug-port (%make-void-port "w"))
+                     (log-port (current-error-port)))
   "Build and install Guix in directory OUT using SOURCE, a directory
 containing the source code.  Write any debugging output to DEBUG-PORT."
   (setvbuf (current-output-port) _IOLBF)
@@ -130,33 +67,50 @@ containing the source code.  Write any debugging output to 
DEBUG-PORT."
     (set! %load-path (cons out %load-path))
     (set! %load-compiled-path (cons out %load-compiled-path))
 
-    ;; Compile the .scm files.  Do that in independent processes, à la
-    ;; 'make -j', to work around <http://bugs.gnu.org/15602> (FIXME).
-    ;; This ensures correctness, but is overly conservative and slow.
-    ;; The solution initially implemented (and described in the bug
-    ;; above) was slightly faster but consumed memory proportional to the
-    ;; number of modules, which quickly became unacceptable.
-    (p-for-each (lambda (file)
-                  (let ((go (string-append (string-drop-right file 4)
-                                           ".go")))
-                    (format debug-port "~%compiling '~a'...~%" file)
-                    (parameterize ((current-warning-port debug-port))
-                      (compile-file file
-                                    #:output-file go
-                                    #:opts
-                                    %auto-compilation-options))))
-
-                (filter (cut string-suffix? ".scm" <>)
-
-                        ;; Build guix/*.scm before gnu/*.scm to speed
-                        ;; things up.
-                        (sort (find-files out "\\.scm")
-                              (let ((guix (string-append out "/guix"))
-                                    (gnu  (string-append out "/gnu")))
-                                (lambda (a b)
-                                  (or (and (string-prefix? guix a)
-                                           (string-prefix? gnu b))
-                                      (string<? a b))))))))
+    ;; Compile the .scm files.  Load all the files before compiling them to
+    ;; work around <http://bugs.gnu.org/15602> (FIXME).
+    (let* ((files
+            ;; gnu.scm depends on many other modules, so to avoid an early
+            ;; progress report stall, we move it to the end.
+            (sort (filter (cut string-suffix? ".scm" <>)
+                          (find-files out "\\.scm"))
+                  (lambda (a b)
+                    (or (string-prefix? (string-append out "/gnu.scm") b)
+                        (string<? a b)))))
+           (total (length files)))
+      (let loop ((files files)
+                 (completed 0))
+        (match files
+          (() *unspecified*)
+          ((file . files)
+           (display #\cr log-port)
+           (format log-port "loading...\t~5,1f% of ~d files" ;FIXME: i18n
+                   (* 100. (/ completed total)) total)
+           (force-output log-port)
+           (format debug-port "~%loading '~a'...~%" file)
+           (parameterize ((current-warning-port debug-port))
+             (save-module-excursion
+              (lambda () (primitive-load file))))
+           (loop files (+ 1 completed)))))
+      (newline)
+      (let ((mutex (make-mutex))
+            (completed 0))
+        (par-for-each
+         (lambda (file)
+           (with-mutex mutex
+             (display #\cr log-port)
+             (format log-port "compiling...\t~5,1f% of ~d files" ;FIXME: i18n
+                     (* 100. (/ completed total)) total)
+             (force-output log-port)
+             (format debug-port "~%compiling '~a'...~%" file))
+           (let ((go (string-append (string-drop-right file 4) ".go")))
+             (parameterize ((current-warning-port (%make-void-port "w")))
+               (compile-file file
+                             #:output-file go
+                             #:opts %auto-compilation-options)))
+           (with-mutex mutex
+             (set! completed (+ 1 completed))))
+         files))))
 
   ;; Remove the "fake" (guix config).
   (delete-file (string-append out "/guix/config.scm"))
-- 
2.6.3