build-system: linux-module: Fix cross compilation.
* guix/build-system/linux-module.scm (default-kmod, default-gcc): Delete procedures. (system->arch): New procedure. (make-linux-module-builder)[native-inputs]: Move linux... [inputs]: ...to here. (linux-module-build-cross): New procedure. (linux-module-build): Add TARGET. Pass TARGET and ARCH to build side. (lower): Allow cross-compilation. Move "linux" and "linux-module-builder" to host-inputs. Add target-inputs. Call linux-module-build-cross if TARGET is set, linux-module-build otherwise. * guix/build/linux-module-build-system.scm (configure): Add ARCH argument. (linux-module-build): Adjust comment. Signed-off-by: Danny Milosavljevic <dannym@scratchpost.org>master
Mathieu Othacehe
Danny Milosavljevic
parent
5c79f23863
commit
c086c5af1c
|
|
@ -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)
|
||||
|
|
@ -97,33 +87,43 @@
|
|||
#:rest arguments)
|
||||
"Return a bag for NAME."
|
||||
(define private-keywords
|
||||
'(#:source #:target #:gcc #:kmod #:linux #:inputs #:native-inputs))
|
||||
`(#:source #:target #:gcc #:kmod #:linux #:inputs #:native-inputs
|
||||
,@(if target '() '(#:target))))
|
||||
|
||||
(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)))))
|
||||
(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)
|
||||
|
|
@ -152,6 +152,8 @@
|
|||
search-paths)
|
||||
#:phases ,phases
|
||||
#:system ,system
|
||||
#:target ,target
|
||||
#:arch ,(system->arch (or target system))
|
||||
#:tests? ,tests?
|
||||
#:outputs %outputs
|
||||
#:inputs %build-inputs)))
|
||||
|
|
@ -173,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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
;;;
|
||||
|
|
@ -33,14 +34,13 @@
|
|||
;; Code:
|
||||
|
||||
;; Copied from make-linux-libre's "configure" phase.
|
||||
(define* (configure #:key inputs target #:allow-other-keys)
|
||||
(define* (configure #:key inputs target arch #:allow-other-keys)
|
||||
(setenv "KCONFIG_NOTIMESTAMP" "1")
|
||||
(setenv "KBUILD_BUILD_TIMESTAMP" (getenv "SOURCE_DATE_EPOCH"))
|
||||
;(let ((arch ,(system->linux-architecture
|
||||
; (or (%current-target-system)
|
||||
; (%current-system)))))
|
||||
; (setenv "ARCH" arch)
|
||||
; (format #t "`ARCH' set to `~a'~%" (getenv "ARCH")))
|
||||
|
||||
(setenv "ARCH" arch)
|
||||
(format #t "`ARCH' set to `~a'~%" (getenv "ARCH"))
|
||||
|
||||
(when target
|
||||
(setenv "CROSS_COMPILE" (string-append target "-"))
|
||||
(format #t "`CROSS_COMPILE' set to `~a'~%"
|
||||
|
|
@ -85,8 +85,9 @@
|
|||
(replace 'install install)))
|
||||
|
||||
(define* (linux-module-build #:key inputs (phases %standard-phases)
|
||||
#:allow-other-keys #:rest args)
|
||||
"Build the given package, applying all of PHASES in order, with a Linux kernel in attendance."
|
||||
#:allow-other-keys #:rest args)
|
||||
"Build the given package, applying all of PHASES in order, with a Linux
|
||||
kernel in attendance."
|
||||
(apply gnu:gnu-build
|
||||
#:inputs inputs #:phases phases
|
||||
args))
|
||||
|
|
|
|||
Reference in New Issue