[bug#43516] [PATCH core-updates v2] packages: Enable multi-threaded xz compression when repacking source.

[Maxim Cournoyer <maxim.cournoyer@gmail.com>]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain; charset=yes, Size: 9730 bytes --]

The xz compression is slow; using multiple threads/cores yields a linear
performance improvement.

* guix/build/utils.scm (%xz-parallel-args): New procedure.
* guix/packages.scm (patch-and-repack): Specify the required above xz
arguments by setting the XZ_DEFAULTS environment variable.
* guix/scripts/pack.scm (%compressors, bootstrap-xz): Modify the commands
Gexps so they do not need to be quoted.  This allows lazily evaluating the
arguments on the builder's side.  Specify the required xz arguments.
(self-contained-tarball): Do not quote the compressor command value.
(docker-image): Likewise.
* guix/utils.scm (decompressed-port, compressed-port)
(compressed-output-port): Specify the required above xz arguments.
---
 guix/build/utils.scm  | 15 ++++++++++++++-
 guix/packages.scm     |  3 +++
 guix/scripts/pack.scm | 27 ++++++++++++++++++---------
 guix/utils.scm        | 10 ++++++----
 4 files changed, 41 insertions(+), 14 deletions(-)

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index e884c26a22..ff4241d088 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -112,7 +112,9 @@
 
             make-desktop-entry-file
 
-            locale-category->string))
+            locale-category->string
+
+            %xz-parallel-args))
 
 \f
 ;;;
@@ -1479,6 +1481,17 @@ returned."
              LC_NAME LC_NUMERIC LC_PAPER LC_TELEPHONE
              LC_TIME)))
 
+\f
+;;;
+;;; Others.
+;;;
+
+(define (%xz-parallel-args)
+  "The xz arguments required to enable bit-reproducible, multi-threaded
+compression."
+  (list "--memlimit=50%"
+        (format #f "--threads=~a" (max 2 (parallel-job-count)))))
+
 ;;; Local Variables:
 ;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1)
 ;;; eval: (put 'call-with-ascii-input-file 'scheme-indent-function 1)
diff --git a/guix/packages.scm b/guix/packages.scm
index 6598bd3149..865cb81929 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017, 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -693,6 +694,8 @@ specifies modules in scope when evaluating SNIPPET."
             (setenv "PATH" (string-append #+xz "/bin" ":"
                                           #+decomp "/bin"))
 
+            (setenv "XZ_DEFAULTS" (string-join (%xz-parallel-args)))
+
             ;; SOURCE may be either a directory or a tarball.
             (if (file-is-directory? #+source)
                 (let* ((store     (%store-directory))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 379e6a3ac6..a0112162e3 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,6 +26,7 @@
   #:use-module (guix scripts)
   #:use-module (guix ui)
   #:use-module (guix gexp)
+  #:use-module ((guix build utils) #:select (%xz-parallel-args))
   #:use-module (guix utils)
   #:use-module (guix store)
   #:use-module ((guix status) #:select (with-status-verbosity))
@@ -70,29 +72,34 @@
   compressor?
   (name       compressor-name)      ;string (e.g., "gzip")
   (extension  compressor-extension) ;string (e.g., ".lz")
-  (command    compressor-command))  ;gexp (e.g., #~("/gnu/store/…/gzip" "-9n"))
+  (command    compressor-command))  ;gexp (e.g., #~(list "/gnu/store/…/gzip"
+                                    ;                    "-9n" ))
 
 (define %compressors
   ;; Available compression tools.
   (list (compressor "gzip"  ".gz"
-                    #~(#+(file-append gzip "/bin/gzip") "-9n"))
+                    #~(list #+(file-append gzip "/bin/gzip") "-9n"))
         (compressor "lzip"  ".lz"
-                    #~(#+(file-append lzip "/bin/lzip") "-9"))
+                    #~(list #+(file-append lzip "/bin/lzip") "-9"))
         (compressor "xz"    ".xz"
-                    #~(#+(file-append xz "/bin/xz") "-e"))
+                    #~(append (list #+(file-append xz "/bin/xz")
+                                    "-e")
+                              (%xz-parallel-args)))
         (compressor "bzip2" ".bz2"
-                    #~(#+(file-append bzip2 "/bin/bzip2") "-9"))
+                    #~(list #+(file-append bzip2 "/bin/bzip2") "-9"))
         (compressor "zstd" ".zst"
                     ;; The default level 3 compresses better than gzip in a
                     ;; fraction of the time, while the highest level 19
                     ;; (de)compresses more slowly and worse than xz.
-                    #~(#+(file-append zstd "/bin/zstd") "-3"))
+                    #~(list #+(file-append zstd "/bin/zstd") "-3"))
         (compressor "none" "" #f)))
 
 ;; This one is only for use in this module, so don't put it in %compressors.
 (define bootstrap-xz
   (compressor "bootstrap-xz" ".xz"
-              #~(#+(file-append %bootstrap-coreutils&co "/bin/xz") "-e")))
+              #~(append (list #+(file-append %bootstrap-coreutils&co "/bin/xz")
+                              "-e")
+                        (%xz-parallel-args))))
 
 (define (lookup-compressor name)
   "Return the compressor object called NAME.  Error out if it could not be
@@ -269,7 +276,7 @@ added to the pack."
                            #+@(if (compressor-command compressor)
                                   #~("-I"
                                      (string-join
-                                      '#+(compressor-command compressor)))
+                                      #+(compressor-command compressor)))
                                   #~())
                            "--format=gnu"
 
@@ -541,11 +548,13 @@ the image."
                                ,@(source-module-closure
                                   `((guix docker)
                                     (guix build store-copy)
+                                    (guix build utils) ;for %xz-parallel-args
                                     (guix profiles)
                                     (guix search-paths))
                                   #:select? not-config?))
         #~(begin
             (use-modules (guix docker) (guix build store-copy)
+                         (guix build utils)
                          (guix profiles) (guix search-paths)
                          (srfi srfi-1) (srfi srfi-19)
                          (ice-9 match))
@@ -602,7 +611,7 @@ the image."
                                        #~(list (string-append #$profile "/"
                                                               #$entry-point)))
                                 #:extra-files directives
-                                #:compressor '#+(compressor-command compressor)
+                                #:compressor #+(compressor-command compressor)
                                 #:creation-time (make-time time-utc 0 1))))))
 
   (gexp->derivation (string-append name ".tar"
diff --git a/guix/utils.scm b/guix/utils.scm
index 7cc321205e..ba896623f4 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018, 2020 Marius Bakke <marius@gnu.org>
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,7 +38,7 @@
   #:use-module (guix memoization)
   #:use-module ((guix build utils)
                 #:select (dump-port mkdir-p delete-file-recursively
-                          call-with-temporary-output-file))
+                          call-with-temporary-output-file %xz-parallel-args))
   #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
   #:use-module (guix diagnostics)           ;<location>, &error-location, etc.
   #:use-module (ice-9 format)
@@ -220,7 +221,7 @@ a symbol such as 'xz."
   (match compression
     ((or #f 'none) (values input '()))
     ('bzip2        (filtered-port `(,%bzip2 "-dc") input))
-    ('xz           (filtered-port `(,%xz "-dc") input))
+    ('xz           (filtered-port `(,%xz "-dc" ,@(%xz-parallel-args)) input))
     ('gzip         (filtered-port `(,%gzip "-dc") input))
     ('lzip         (values (lzip-port 'make-lzip-input-port input)
                            '()))
@@ -232,7 +233,7 @@ a symbol such as 'xz."
   (match compression
     ((or #f 'none) (values input '()))
     ('bzip2        (filtered-port `(,%bzip2 "-c") input))
-    ('xz           (filtered-port `(,%xz "-c") input))
+    ('xz           (filtered-port `(,%xz "-c" ,@(%xz-parallel-args)) input))
     ('gzip         (filtered-port `(,%gzip "-c") input))
     ('lzip         (values (lzip-port 'make-lzip-input-port/compressed input)
                            '()))
@@ -291,7 +292,8 @@ program--e.g., '(\"--fast\")."
   (match compression
     ((or #f 'none) (values output '()))
     ('bzip2        (filtered-output-port `(,%bzip2 "-c" ,@options) output))
-    ('xz           (filtered-output-port `(,%xz "-c" ,@options) output))
+    ('xz           (filtered-output-port `(,%xz "-c" ,@(%xz-parallel-args)
+                                                ,@options) output))
     ('gzip         (filtered-output-port `(,%gzip "-c" ,@options) output))
     ('lzip         (values (lzip-port 'make-lzip-output-port output)
                            '()))
-- 
2.28.0