Toggle diff (386 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 7b1a64deb9..b3207e125a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11014,6 +11014,67 @@ available options and a synopsis (these options are not shown in the
@table @code
+@cindex performance, tuning code
+@cindex optimization, of package code
+@cindex tuning, of package code
+@cindex SIMD support
+@cindex tunable packages
+@cindex package multi-versioning
+@item --tune[=@var{cpu}]
+Use versions of the packages marked as ``tunable'' optimized for
+@var{cpu}. When @var{cpu} is @code{native}, or when it is omitted, tune
+for the CPU on which the @command{guix} command is running.
+
+Valid @var{cpu} names are those recognized by the underlying compiler,
+by default the GNU Compiler Collection. On x86_64 processors, this
+includes CPU names such as @code{nehalem}, @code{haswell}, and
+@code{skylake} (@pxref{x86 Options, @code{-march},, gcc, Using the GNU
+Compiler Collection (GCC)}).
+
+As new generations of CPUs come out, they augment the standard
+instruction set architecture (ISA) with additional instructions, in
+particular instructions for single-instruction/multiple-data (SIMD)
+parallel processing. For example, while Core2 and Skylake CPUs both
+implement the x86_64 ISA, only the latter supports AVX2 SIMD
+instructions.
+
+The primary gain one can expect from @option{--tune} is for programs
+that can make use of those SIMD capabilities @emph{and} that do not
+already have a mechanism to select the right optimized code at run time.
+Packages that have the @code{tunable?} property set are considered
+@dfn{tunable packages} by the @option{--tune} option; a package
+definition with the property set looks like this:
+
+@lisp
+(package
+ (name "hello-simd")
+ ;; ...
+
+ ;; This package may benefit from SIMD extensions so
+ ;; mark it as "tunable".
+ (properties '((tunable? . #t))))
+@end lisp
+
+Other packages are not considered tunable. This allows Guix to use
+generic binaries in the cases where tuning for a specific CPU is
+unlikely to provide any gain.
+
+Tuned packages are built with @code{-march=@var{CPU}}; under the hood,
+the @option{-march} option is passed to the actual wrapper by a compiler
+wrapper. Since the build machine may not be able to run code for the
+target CPU micro-architecture, the test suite is not run when building a
+tuned package.
+
+To reduce rebuilds to the minimum, tuned packages are @emph{grafted}
+onto packages that depend on them (@pxref{Security Updates, grafts}).
+Thus, using @option{--no-grafts} cancels the effect of @option{--tune}.
+
+We call this technique @dfn{package multi-versioning}: several variants
+of tunable packages may be built, one for each CPU variant. It is the
+coarse-grain counterpart of @dfn{function multi-versioning} as
+implemented by the GNU tool chain (@pxref{Function Multiversioning,,,
+gcc, Using the GNU Compiler Collection (GCC)}).
+
@item --with-source=@var{source}
@itemx --with-source=@var{package}=@var{source}
@itemx --with-source=@var{package}@@@var{version}=@var{source}
diff --git a/guix/transformations.scm b/guix/transformations.scm
index 5ae1977cb2..c43c00cdd3 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -18,9 +18,11 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix transformations)
+ #:use-module ((guix config) #:select (%system))
#:use-module (guix i18n)
#:use-module (guix store)
#:use-module (guix packages)
+ #:use-module (guix build-system)
#:use-module (guix profiles)
#:use-module (guix diagnostics)
#:autoload (guix download) (download-to-store)
@@ -29,6 +31,7 @@ (define-module (guix transformations)
#:autoload (guix upstream) (package-latest-release
upstream-source-version
upstream-source-signature-urls)
+ #:autoload (guix cpu) (current-cpu cpu->gcc-architecture)
#:use-module (guix utils)
#:use-module (guix memoization)
#:use-module (guix gexp)
@@ -49,6 +52,9 @@ (define-module (guix transformations)
#:export (options->transformation
manifest-entry-with-transformations
+ tunable-package?
+ tuned-package
+
show-transformation-options-help
%transformation-options))
@@ -419,6 +425,181 @@ (define replacements
obj)
obj)))
+(define tuning-compiler
+ (mlambda (micro-architecture)
+ "Return a compiler wrapper that passes '-march=MICRO-ARCHITECTURE' to the
+actual compiler."
+ (define wrapper
+ #~(begin
+ (use-modules (ice-9 match))
+
+ (define* (search-next command
+ #:optional
+ (path (string-split (getenv "PATH")
+ #\:)))
+ ;; Search the next COMMAND on PATH, a list of
+ ;; directories representing the executable search path.
+ (define this
+ (stat (car (command-line))))
+
+ (let loop ((path path))
+ (match path
+ (()
+ (match command
+ ("cc" (search-next "gcc"))
+ (_ #f)))
+ ((directory rest ...)
+ (let* ((file (string-append
+ directory "/" command))
+ (st (stat file #f)))
+ (if (and st (not (equal? this st)))
+ file
+ (loop rest)))))))
+
+ (match (command-line)
+ ((command arguments ...)
+ (match (search-next (basename command))
+ (#f (exit 127))
+ (next
+ (apply execl next
+ (append (cons next arguments)
+ (list (string-append "-march="
+ #$micro-architecture))))))))))
+
+ (define program
+ (program-file (string-append "tuning-compiler-wrapper-" micro-architecture)
+ wrapper))
+
+ (computed-file (string-append "tuning-compiler-" micro-architecture)
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (define bin (string-append #$output "/bin"))
+ (mkdir-p bin)
+
+ (for-each (lambda (program)
+ (symlink #$program
+ (string-append bin "/" program)))
+ '("cc" "gcc" "clang" "g++" "c++" "clang++")))))))
+
+(define (build-system-with-tuning-compiler bs micro-architecture)
+ "Return a variant of BS, a build system, that ensures that the compiler that
+BS uses (usually an implicit input) can generate code for MICRO-ARCHITECTURE,
+which names a specific CPU of the target architecture--e.g., when targeting
+86_64 MICRO-ARCHITECTURE might be \"skylake\". If it does, return a build
+system that builds code for MICRO-ARCHITECTURE; otherwise raise an error."
+ (define %not-hyphen
+ (char-set-complement (char-set #\-)))
+
+ (define lower
+ (build-system-lower bs))
+
+ (define (lower* . args)
+ ;; The list of CPU names supported by the '-march' option of C/C++
+ ;; compilers is specific to each compiler and version thereof. Rather
+ ;; than pass '-march=MICRO-ARCHITECTURE' as is to the compiler, possibly
+ ;; leading to an obscure build error, check whether the compiler is known
+ ;; to support MICRO-ARCHITECTURE. If not, bail out.
+ (let* ((lowered (apply lower args))
+ (architecture (match (string-tokenize (bag-system lowered)
+ %not-hyphen)
+ ((arch _ ...) arch)))
+ (compiler (any (match-lambda
+ ((label (? package? p) . _)
+ (and (assoc-ref (package-properties p)
+ 'compiler-cpu-architectures)
+ p))
+ (_ #f))
+ (bag-build-inputs lowered))))
+ (unless compiler
+ (raise (formatted-message
+ (G_ "failed to determine which compiler is used"))))
+
+ (let ((lst (assoc-ref (package-properties compiler)
+ 'compiler-cpu-architectures)))
+ (unless lst
+ (raise (formatted-message
+ (G_ "failed to determine whether ~a supports ~a")
+ (package-full-name compiler)
+ micro-architecture)))
+ (unless (member micro-architecture
+ (or (assoc-ref lst architecture) '()))
+ (raise (formatted-message
+ (G_ "compiler ~a does not support micro-architecture ~a")
+ (package-full-name compiler)
+ micro-architecture))))
+
+ (bag
+ (inherit lowered)
+ (build-inputs
+ ;; Arrange so that the compiler wrapper comes first in $PATH.
+ `(("tuning-compiler" ,(tuning-compiler micro-architecture))
+ ,@(bag-build-inputs lowered))))))
+
+ (build-system
+ (inherit bs)
+ (lower lower*)))
+
+(define (tuned-package p micro-architecture)
+ "Return package P tuned for MICRO-ARCHITECTURE."
+ (package
+ (inherit p)
+ (build-system
+ (build-system-with-tuning-compiler (package-build-system p)
+ micro-architecture))
+ (arguments
+ ;; The machine building this package may or may not be able to run code
+ ;; for MICRO-ARCHITECTURE. Because of that, skip tests; they are run for
+ ;; the "baseline" variant anyway.
+ (substitute-keyword-arguments (package-arguments p)
+ ((#:tests? _ #f) #f)))
+
+ (properties
+ `((cpu-tuning . ,micro-architecture)
+
+ ;; Remove the 'tunable?' property so that 'package-tuning' does not
+ ;; call 'tuned-package' again on this one.
+ ,@(alist-delete 'tunable? (package-properties p))))))
+
+(define (tunable-package? package)
+ "Return true if package PACKAGE is \"tunable\"--i.e., if tuning it for the
+host CPU is worthwhile."
+ (assq 'tunable? (package-properties package)))
+
+(define package-tuning
+ (mlambda (micro-architecture)
+ "Return a procedure that maps the given package to its counterpart tuned
+for MICRO-ARCHITECTURE, a string suitable for GCC's '-march'."
+ (define rewriting-property
+ (gensym " package-tuning"))
+
+ (package-mapping (lambda (p)
+ (cond ((assq rewriting-property (package-properties p))
+ p)
+ ((assq 'tunable? (package-properties p))
+ (info (G_ "tuning ~a for CPU ~a~%")
+ (package-full-name p) micro-architecture)
+ (package/inherit p
+ (replacement (tuned-package p micro-architecture))
+ (properties `((,rewriting-property . #t)
+ ,@(package-properties p)))))
+ (else
+ p)))
+ (lambda (p)
+ (assq rewriting-property (package-properties p)))
+ #:deep? #t)))
+
+(define (transform-package-tuning micro-architectures)
+ "Return a procedure that, when "
+ (match micro-architectures
+ ((micro-architecture _ ...)
+ (let ((rewrite (package-tuning micro-architecture)))
+ (lambda (obj)
+ (if (package? obj)
+ (rewrite obj)
+ obj))))))
+
(define (transform-package-with-debug-info specs)
"Return a procedure that, when passed a package, set its 'replacement' field
to the same package but with #:strip-binaries? #f in its 'arguments' field."
@@ -601,6 +782,7 @@ (define %transformations
(with-commit . ,transform-package-source-commit)
(with-git-url . ,transform-package-source-git-url)
(with-c-toolchain . ,transform-package-toolchain)
+ (tune . ,transform-package-tuning)
(with-debug-info . ,transform-package-with-debug-info)
(without-tests . ,transform-package-tests)
(with-patch . ,transform-package-patches)
@@ -640,6 +822,28 @@ (define %transformation-options
(parser 'with-git-url))
(option '("with-c-toolchain") #t #f
(parser 'with-c-toolchain))
+ (option '("tune") #f #t
+ (lambda (opt name arg result . rest)
+ (define micro-architecture
+ (match arg
+ ((or #f "native")
+ (unless (string=? (or (assoc-ref result 'system)
+ (%current-system))
+ %system)
+ (leave (G_ "\
+building for ~a instead of ~a, so tuning cannot be guessed~%")
+ (assoc-ref result 'system) %system))
+
+ (cpu->gcc-architecture (current-cpu)))
+ ("generic" #f)
+ (_ arg)))
+
+ (apply values
+ (if micro-architecture
+ (alist-cons 'tune micro-architecture
+ result)
+ (alist-delete 'tune result))
+ rest)))
(option '("with-debug-info") #t #f
(parser 'with-debug-info))
(option '("without-tests") #t #f
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 09839dc1c5..8db85b4305 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -38,12 +38,14 @@ (define-module (test-transformations)
#:use-module (guix utils)
#:use-module (guix git)
#:use-module (guix upstream)
+ #:use-module (guix diagnostics)
#:use-module (gnu packages)
#:use-module (gnu packages base)
#:use-module (gnu packages busybox)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
#:use-module (srfi srfi-64))
@@ -465,6 +467,39 @@ (define (package-name* obj)
`((with-latest . "foo")))))
(package-version (t p)))))
+(test-equal "options->transformation, tune"
+ '(cpu-tuning . "superfast")
+ (let* ((p0 (dummy-package "p0"))
+ (p1 (dummy-package "p1"
+ (inputs `(("p0" ,p0)))
+ (properties '((tunable? . #t)))))
+ (p2 (dummy-package "p2"
+ (inputs `(("p1" ,p1)))))
+ (t (options->transformation '((tune . "superfast"))))
+ (p3 (t p2)))
+ (and (not (package-replacement p3))
+ (match (package-inputs p3)
+ ((("p1" tuned))
+ (match (package-inputs tuned)
+ ((("p0" p0))
+ (and (not (package-replacement p0))
+ (assq 'cpu-tuning
+ (package-properties
+ (package-replacement tuned)))))))))))
+
+(test-assert "options->transformations, tune, wrong micro-architecture"
+ (let ((p (dummy-package "tunable"
+ (properties '((tunable? . #t)))))
+ (t (options->transformation '((tune . "nonexistent-superfast")))))
+ ;; Because GCC used by P's build system does not support
+ ;; '-march=nonexistent-superfast', we should see an error when lowering
+ ;; the tuned package.
+ (guard (c ((formatted-message? c)
+ (member "nonexistent-superfast"
+ (formatted-message-arguments c))))
+ (package->bag (t p))
+ #f)))
+
(test-equal "options->transformation + package->manifest-entry"
'((transformations . ((without-tests . "foo"))))
(let* ((p (dummy-package "foo"))
--
2.33.0
