me
/
guix
Archived
1
0
Fork 0
Code

packages, scripts, utils: Enable multi-threaded xz compression. 

xz compression is slow; using the multi-thread mode of xz can make it more
than 6 times faster, for example when compressing the large linux-libre
source.

* 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.
master
Maxim Cournoyer 2020-09-19 00:20:47 -04:00
parent 7102c18678
commit 5a0997ef7f
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
4 changed files with 41 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
guix/build/utils.scm
View File

@ -113,7 +113,9 @@
make-desktop-entry-file make-desktop-entry-file
locale-category->string)) locale-category->string
%xz-parallel-args))
;;; ;;;
@ -1484,6 +1486,17 @@ returned."
LC_NAME LC_NUMERIC LC_PAPER LC_TELEPHONE LC_NAME LC_NUMERIC LC_PAPER LC_TELEPHONE
LC_TIME))) LC_TIME)))
;;;
;;; 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: ;;; Local Variables:
;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1) ;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1)
;;; eval: (put 'call-with-ascii-input-file 'scheme-indent-function 1) ;;; eval: (put 'call-with-ascii-input-file 'scheme-indent-function 1)

3
guix/packages.scm
View File

@ -5,6 +5,7 @@
;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2017, 2019, 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2017, 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -693,6 +694,8 @@ specifies modules in scope when evaluating SNIPPET."
(setenv "PATH" (string-append #+xz "/bin" ":" (setenv "PATH" (string-append #+xz "/bin" ":"
#+decomp "/bin")) #+decomp "/bin"))
(setenv "XZ_DEFAULTS" (string-join (%xz-parallel-args)))
;; SOURCE may be either a directory or a tarball. ;; SOURCE may be either a directory or a tarball.
(if (file-is-directory? #+source) (if (file-is-directory? #+source)
(let* ((store (%store-directory)) (let* ((store (%store-directory))

27
guix/scripts/pack.scm
View File

@ -5,6 +5,7 @@
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -25,6 +26,7 @@
#:use-module (guix scripts) #:use-module (guix scripts)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module ((guix build utils) #:select (%xz-parallel-args))
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix store) #:use-module (guix store)
#:use-module ((guix status) #:select (with-status-verbosity)) #:use-module ((guix status) #:select (with-status-verbosity))
@ -70,29 +72,34 @@
compressor? compressor?
(name compressor-name) ;string (e.g., "gzip") (name compressor-name) ;string (e.g., "gzip")
(extension compressor-extension) ;string (e.g., ".lz") (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 (define %compressors
;; Available compression tools. ;; Available compression tools.
(list (compressor "gzip" ".gz" (list (compressor "gzip" ".gz"
#~(#+(file-append gzip "/bin/gzip") "-9n")) #~(list #+(file-append gzip "/bin/gzip") "-9n"))
(compressor "lzip" ".lz" (compressor "lzip" ".lz"
#~(#+(file-append lzip "/bin/lzip") "-9")) #~(list #+(file-append lzip "/bin/lzip") "-9"))
(compressor "xz" ".xz" (compressor "xz" ".xz"
#~(#+(file-append xz "/bin/xz") "-e")) #~(append (list #+(file-append xz "/bin/xz")
"-e")
(%xz-parallel-args)))
(compressor "bzip2" ".bz2" (compressor "bzip2" ".bz2"
#~(#+(file-append bzip2 "/bin/bzip2") "-9")) #~(list #+(file-append bzip2 "/bin/bzip2") "-9"))
(compressor "zstd" ".zst" (compressor "zstd" ".zst"
;; The default level 3 compresses better than gzip in a ;; The default level 3 compresses better than gzip in a
;; fraction of the time, while the highest level 19 ;; fraction of the time, while the highest level 19
;; (de)compresses more slowly and worse than xz. ;; (de)compresses more slowly and worse than xz.
#~(#+(file-append zstd "/bin/zstd") "-3")) #~(list #+(file-append zstd "/bin/zstd") "-3"))
(compressor "none" "" #f))) (compressor "none" "" #f)))
;; This one is only for use in this module, so don't put it in %compressors. ;; This one is only for use in this module, so don't put it in %compressors.
(define bootstrap-xz (define bootstrap-xz
(compressor "bootstrap-xz" ".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) (define (lookup-compressor name)
"Return the compressor object called NAME. Error out if it could not be "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) #+@(if (compressor-command compressor)
#~("-I" #~("-I"
(string-join (string-join
'#+(compressor-command compressor))) #+(compressor-command compressor)))
#~()) #~())
"--format=gnu" "--format=gnu"
@ -541,11 +548,13 @@ the image."
,@(source-module-closure ,@(source-module-closure
`((guix docker) `((guix docker)
(guix build store-copy) (guix build store-copy)
(guix build utils) ;for %xz-parallel-args
(guix profiles) (guix profiles)
(guix search-paths)) (guix search-paths))
#:select? not-config?)) #:select? not-config?))
#~(begin #~(begin
(use-modules (guix docker) (guix build store-copy) (use-modules (guix docker) (guix build store-copy)
(guix build utils)
(guix profiles) (guix search-paths) (guix profiles) (guix search-paths)
(srfi srfi-1) (srfi srfi-19) (srfi srfi-1) (srfi srfi-19)
(ice-9 match)) (ice-9 match))
@ -602,7 +611,7 @@ the image."
#~(list (string-append #$profile "/" #~(list (string-append #$profile "/"
#$entry-point))) #$entry-point)))
#:extra-files directives #:extra-files directives
#:compressor '#+(compressor-command compressor) #:compressor #+(compressor-command compressor)
#:creation-time (make-time time-utc 0 1)))))) #:creation-time (make-time time-utc 0 1))))))
(gexp->derivation (string-append name ".tar" (gexp->derivation (string-append name ".tar"

10
guix/utils.scm
View File

@ -8,6 +8,7 @@
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018, 2020 Marius Bakke <marius@gnu.org> ;;; Copyright © 2018, 2020 Marius Bakke <marius@gnu.org>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -37,7 +38,7 @@
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module ((guix build utils) #:use-module ((guix build utils)
#:select (dump-port mkdir-p delete-file-recursively #: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 build syscalls) #:select (mkdtemp! fdatasync))
#:use-module (guix diagnostics) ;<location>, &error-location, etc. #:use-module (guix diagnostics) ;<location>, &error-location, etc.
#:use-module (ice-9 format) #:use-module (ice-9 format)
@ -220,7 +221,7 @@ a symbol such as 'xz."
(match compression (match compression
((or #f 'none) (values input '())) ((or #f 'none) (values input '()))
('bzip2 (filtered-port `(,%bzip2 "-dc") 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)) ('gzip (filtered-port `(,%gzip "-dc") input))
('lzip (values (lzip-port 'make-lzip-input-port input) ('lzip (values (lzip-port 'make-lzip-input-port input)
'())) '()))
@ -232,7 +233,7 @@ a symbol such as 'xz."
(match compression (match compression
((or #f 'none) (values input '())) ((or #f 'none) (values input '()))
('bzip2 (filtered-port `(,%bzip2 "-c") 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)) ('gzip (filtered-port `(,%gzip "-c") input))
('lzip (values (lzip-port 'make-lzip-input-port/compressed input) ('lzip (values (lzip-port 'make-lzip-input-port/compressed input)
'())) '()))
@ -291,7 +292,8 @@ program--e.g., '(\"--fast\")."
(match compression (match compression
((or #f 'none) (values output '())) ((or #f 'none) (values output '()))
('bzip2 (filtered-output-port `(,%bzip2 "-c" ,@options) 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)) ('gzip (filtered-output-port `(,%gzip "-c" ,@options) output))
('lzip (values (lzip-port 'make-lzip-output-port output) ('lzip (values (lzip-port 'make-lzip-output-port output)
'())) '()))