summaryrefslogtreecommitdiff
path: root/guix/build-system
diff options
context:
space:
mode:
authorJakub Kądziołka <kuba@kadziolka.net>2020-03-29 00:38:13 +0100
committerJakub Kądziołka <kuba@kadziolka.net>2020-03-29 00:38:13 +0100
commit44fb8cf84107bf2baa207216fda0ee5476bafb74 (patch)
treeccfe580739e308a604fea9b05943294e2f2e9e69 /guix/build-system
parent87bc9f022cdd3487e85cf83cf82222315246abf9 (diff)
parent62b9ad19e3a6638f8e077753454fdf08ba586146 (diff)
Merge branch 'master' into staging
Diffstat (limited to 'guix/build-system')
-rw-r--r--guix/build-system/linux-module.scm161
1 files changed, 125 insertions, 36 deletions
diff --git a/guix/build-system/linux-module.scm b/guix/build-system/linux-module.scm
index ba76ab85c3..ca104f7c75 100644
--- a/guix/build-system/linux-module.scm
+++ b/guix/build-system/linux-module.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -45,27 +46,16 @@
(let ((module (resolve-interface '(gnu packages linux))))
(module-ref module 'linux-libre)))
-(define (default-kmod)
- "Return the default kmod package."
-
- ;; Do not use `@' to avoid introducing circular dependencies.
+(define (system->arch system)
(let ((module (resolve-interface '(gnu packages linux))))
- (module-ref module 'kmod)))
-
-(define (default-gcc)
- "Return the default gcc package."
-
- ;; Do not use `@' to avoid introducing circular dependencies.
- (let ((module (resolve-interface '(gnu packages gcc))))
- (module-ref module 'gcc-7)))
+ ((module-ref module 'system->linux-architecture) system)))
(define (make-linux-module-builder linux)
(package
(inherit linux)
(name (string-append (package-name linux) "-module-builder"))
- (native-inputs
- `(("linux" ,linux)
- ,@(package-native-inputs linux)))
+ (inputs
+ `(("linux" ,linux)))
(arguments
(substitute-keyword-arguments (package-arguments linux)
((#:phases phases)
@@ -78,7 +68,8 @@
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(out-lib-build (string-append out "/lib/modules/build")))
- ; TODO: Only preserve the minimum, i.e. [Kbuild], Kconfig, scripts, include, ".config".
+ ;; TODO: Only preserve the minimum, i.e. [Kbuild], Kconfig,
+ ;; scripts, include, ".config".
(copy-recursively "." out-lib-build)
(let* ((linux (assoc-ref inputs "linux")))
(install-file (string-append linux "/System.map")
@@ -96,29 +87,43 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
- '(#:source #:target #:gcc #:kmod #:linux #:inputs #:native-inputs))
-
- (and (not target) ;XXX: no cross-compilation
- (bag
- (name name)
- (system system)
- (host-inputs `(,@(if source
- `(("source" ,source))
- '())
- ,@inputs
- ,@(standard-packages)))
- (build-inputs `(("linux" ,linux) ; for "Module.symvers".
- ("linux-module-builder"
- ,(make-linux-module-builder linux))
- ,@native-inputs
- ;; TODO: Remove "gmp", "mpfr", "mpc" since they are only needed to compile the gcc plugins. Maybe remove "flex", "bison", "elfutils", "perl", "openssl". That leaves very little ("bc", "gcc", "kmod").
- ,@(package-native-inputs linux)))
- (outputs outputs)
- (build linux-module-build)
- (arguments (strip-keyword-arguments private-keywords arguments)))))
+ `(#:source #:target #:gcc #:kmod #:linux #:inputs #:native-inputs
+ ,@(if target '() '(#:target))))
+
+ (bag
+ (name name)
+ (system system) (target target)
+ (build-inputs `(,@(if source
+ `(("source" ,source))
+ '())
+ ,@native-inputs
+ ;; TODO: Remove "gmp", "mpfr", "mpc" since they are
+ ;; only needed to compile the gcc plugins. Maybe
+ ;; remove "flex", "bison", "elfutils", "perl",
+ ;; "openssl". That leaves very little ("bc", "gcc",
+ ;; "kmod").
+ ,@(package-native-inputs linux)
+ ,@(if target
+ ;; Use the standard cross inputs of
+ ;; 'gnu-build-system'.
+ (standard-cross-packages target 'host)
+ '())
+ ;; Keep the standard inputs of 'gnu-build-system'.
+ ,@(standard-packages)))
+ (host-inputs `(,@inputs
+ ("linux" ,linux)
+ ("linux-module-builder"
+ ,(make-linux-module-builder linux))))
+ (target-inputs (if target
+ (standard-cross-packages target 'target)
+ '()))
+ (outputs outputs)
+ (build (if target linux-module-build-cross linux-module-build))
+ (arguments (strip-keyword-arguments private-keywords arguments))))
(define* (linux-module-build store name inputs
#:key
+ target
(search-paths '())
(tests? #t)
(phases '(@ (guix build linux-module-build-system)
@@ -147,6 +152,8 @@
search-paths)
#:phases ,phases
#:system ,system
+ #:target ,target
+ #:arch ,(system->arch (or target system))
#:tests? ,tests?
#:outputs %outputs
#:inputs %build-inputs)))
@@ -168,6 +175,88 @@
#:guile-for-build guile-for-build
#:substitutable? substitutable?))
+(define* (linux-module-build-cross
+ store name
+ #:key
+ target native-drvs target-drvs
+ (guile #f)
+ (outputs '("out"))
+ (search-paths '())
+ (native-search-paths '())
+ (tests? #f)
+ (phases '(@ (guix build linux-module-build-system)
+ %standard-phases))
+ (system (%current-system))
+ (substitutable? #t)
+ (imported-modules
+ %linux-module-build-system-modules)
+ (modules '((guix build linux-module-build-system)
+ (guix build utils))))
+ (define builder
+ `(begin
+ (use-modules ,@modules)
+ (let ()
+ (define %build-host-inputs
+ ',(map (match-lambda
+ ((name (? derivation? drv) sub ...)
+ `(,name . ,(apply derivation->output-path drv sub)))
+ ((name path)
+ `(,name . ,path)))
+ native-drvs))
+
+ (define %build-target-inputs
+ ',(map (match-lambda
+ ((name (? derivation? drv) sub ...)
+ `(,name . ,(apply derivation->output-path drv sub)))
+ ((name (? package? pkg) sub ...)
+ (let ((drv (package-cross-derivation store pkg
+ target system)))
+ `(,name . ,(apply derivation->output-path drv sub))))
+ ((name path)
+ `(,name . ,path)))
+ target-drvs))
+
+ (linux-module-build #:name ,name
+ #:source ,(match (assoc-ref native-drvs "source")
+ (((? derivation? source))
+ (derivation->output-path source))
+ ((source)
+ source)
+ (source
+ source))
+ #:system ,system
+ #:target ,target
+ #:arch ,(system->arch (or target system))
+ #:outputs %outputs
+ #:inputs %build-target-inputs
+ #:native-inputs %build-host-inputs
+ #:search-paths
+ ',(map search-path-specification->sexp
+ search-paths)
+ #:native-search-paths
+ ',(map
+ search-path-specification->sexp
+ native-search-paths)
+ #:phases ,phases
+ #:tests? ,tests?))))
+
+ (define guile-for-build
+ (match guile
+ ((? package?)
+ (package-derivation store guile system #:graft? #f))
+ (#f ; the default
+ (let* ((distro (resolve-interface '(gnu packages commencement)))
+ (guile (module-ref distro 'guile-final)))
+ (package-derivation store guile system #:graft? #f)))))
+
+ (build-expression->derivation store name builder
+ #:system system
+ #:inputs (append native-drvs target-drvs)
+ #:outputs outputs
+ #:modules imported-modules
+ #:guile-for-build guile-for-build
+ #:substitutable? substitutable?))
+
(define linux-module-build-system
(build-system
(name 'linux-module)