gnu: cross-base: Add i686-w64-mingw32 target.

* guix/utils.scm (mingw-target?): New function.
* gnu/packages/cross-base.scm (cross-gcc-snippet): New procedure
(cross-gcc): Use it.
(cross-gcc-arguments, cross-gcc-patches, cross-gcc): Support MinGW.
(native-libc, cross-newlib?): New functions.
(cross-libc): Use cross-newlib? to support MinGW.
(%gcc-include-paths, %gcc-cross-include-paths): New variables.
This commit is contained in:
Jan Nieuwenhuizen 2016-05-28 17:32:04 +02:00 committed by Ludovic Courtès
parent cf0ef075c4
commit cba36e6482
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 207 additions and 97 deletions

View File

@ -20,12 +20,12 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages cross-base) (define-module (gnu packages cross-base)
#:use-module (guix licenses)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages gcc) #:use-module (gnu packages gcc)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages hurd) #:use-module (gnu packages hurd)
#:use-module (gnu packages mingw)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix utils) #:use-module (guix utils)
@ -37,13 +37,26 @@
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:export (cross-binutils #:export (cross-binutils
cross-libc cross-libc
cross-gcc)) cross-gcc
cross-newlib?))
(define %xgcc (define %xgcc
;; GCC package used as the basis for cross-compilation. It doesn't have to ;; GCC package used as the basis for cross-compilation. It doesn't have to
;; be 'gcc' and can be a specific variant such as 'gcc-4.8'. ;; be 'gcc' and can be a specific variant such as 'gcc-4.8'.
gcc) gcc)
(define %gcc-include-paths
;; Environment variables for header search paths.
;; Note: See <http://bugs.gnu.org/22186> for why not 'CPATH'.
'("C_INCLUDE_PATH"
"CPLUS_INCLUDE_PATH"
"OBJC_INCLUDE_PATH"
"OBJCPLUS_INCLUDE_PATH"))
(define %gcc-cross-include-paths
;; Search path for target headers when cross-compiling.
(map (cut string-append "CROSS_" <>) %gcc-include-paths))
(define (cross p target) (define (cross p target)
(package (inherit p) (package (inherit p)
(name (string-append (package-name p) "-cross-" target)) (name (string-append (package-name p) "-cross-" target))
@ -131,7 +144,12 @@ may be either a libc package or #f.)"
"--disable-libitm" "--disable-libitm"
"--disable-libvtv" "--disable-libvtv"
"--disable-libsanitizer" "--disable-libsanitizer"
))) ))
;; For a newlib (non-glibc) target
,@(if (cross-newlib? target)
'("--with-newlib")
'()))
,(if libc ,(if libc
flags flags
@ -173,12 +191,82 @@ may be either a libc package or #f.)"
;; for cross-compilers. ;; for cross-compilers.
(zero? (system* "make" "install-strip"))) (zero? (system* "make" "install-strip")))
,phases)))) ,phases))))
(if libc (cond
((target-mingw? target)
`(modify-phases ,phases
(add-before
'configure 'set-cross-path
(lambda* (#:key inputs #:allow-other-keys)
;; Add the cross mingw headers to CROSS_C_*_INCLUDE_PATH,
;; and remove them from C_*INCLUDE_PATH.
(let ((libc (assoc-ref inputs "libc"))
(gcc (assoc-ref inputs "gcc")))
(define (cross? x)
(and libc (string-prefix? libc x)))
(define (unpacked-mingw-dir)
(match
(scandir
"."
(lambda (name) (string-contains name "mingw-w64")))
((mingw-dir)
(string-append
(getcwd) "/" mingw-dir "/mingw-w64-headers"))))
(if libc
(let ((cpath (string-append
libc "/include"
":" libc "/i686-w64-mingw32/include")))
(for-each (cut setenv <> cpath)
',%gcc-cross-include-paths))
;; libc is false, so we are building xgcc-sans-libc
;; Add essential headers from mingw-w64.
(let ((mingw-source (assoc-ref inputs "mingw-source")))
(system* "tar" "xf" mingw-source)
(let ((mingw-headers (unpacked-mingw-dir)))
;; We need _mingw.h which will gets built from
;; _mingw.h.in by mingw-w64's configure. We
;; cannot configure mingw-w64 until we have
;; xgcc-sans-libc; substitute to the rescue.
(copy-file (string-append mingw-headers
"/crt/_mingw.h.in")
(string-append mingw-headers
"/crt/_mingw.h"))
(substitute* (string-append mingw-headers
"/crt/_mingw.h")
(("@MINGW_HAS_SECURE_API@")
"#define MINGW_HAS_SECURE_API 1"))
(let ((cpath
(string-append
mingw-headers "/include"
":" mingw-headers "/crt"
":" mingw-headers "/defaults/include")))
(for-each (cut setenv <> cpath)
(cons
"CROSS_LIBRARY_PATH"
',%gcc-cross-include-paths))))
(when libc
(setenv "CROSS_LIBRARY_PATH"
(string-append
libc "/lib"
":" libc "/i686-w64-mingw32/lib")))))
(setenv "CPP" (string-append gcc "/bin/cpp"))
(for-each
(lambda (var)
(and=>
(getenv var)
(lambda (value)
(let* ((path (search-path-as-string->list
value))
(native-path (list->search-path-as-string
(remove cross? path) ":")))
(setenv var native-path)))))
(cons "LIBRARY_PATH" ',%gcc-include-paths))
#t)))))
(libc
`(alist-cons-before `(alist-cons-before
'configure 'set-cross-path 'configure 'set-cross-path
(lambda* (#:key inputs #:allow-other-keys) (lambda* (#:key inputs #:allow-other-keys)
;; Add the cross kernel headers to CROSS_CPATH, and remove them ;; Add the cross kernel headers to CROSS_CPATH, and remove
;; from CPATH. ;; them from CPATH.
(let ((libc (assoc-ref inputs "libc")) (let ((libc (assoc-ref inputs "libc"))
(kernel (assoc-ref inputs "xkernel-headers"))) (kernel (assoc-ref inputs "xkernel-headers")))
(define (cross? x) (define (cross? x)
@ -189,37 +277,40 @@ may be either a libc package or #f.)"
libc "/include" libc "/include"
":" kernel "/include"))) ":" kernel "/include")))
(for-each (cut setenv <> cpath) (for-each (cut setenv <> cpath)
'("CROSS_C_INCLUDE_PATH" ',%gcc-cross-include-paths))
"CROSS_CPLUS_INCLUDE_PATH"
"CROSS_OBJC_INCLUDE_PATH"
"CROSS_OBJCPLUS_INCLUDE_PATH")))
(setenv "CROSS_LIBRARY_PATH" (setenv "CROSS_LIBRARY_PATH"
(string-append libc "/lib:" (string-append libc "/lib:"
kernel "/lib")) ;for Hurd's libihash kernel "/lib")) ;for Hurd's libihash
(for-each (for-each
(lambda (var) (lambda (var)
(and=> (getenv var) (and=>
(lambda (value) (getenv var)
(let* ((path (search-path-as-string->list value)) (lambda (value)
(native-path (list->search-path-as-string (let* ((path (search-path-as-string->list value))
(remove cross? path) ":"))) (native-path (list->search-path-as-string
(setenv var native-path))))) (remove cross? path) ":")))
'("C_INCLUDE_PATH" (setenv var native-path)))))
"CPLUS_INCLUDE_PATH" (cons "LIBRARY_PATH" ',%gcc-include-paths))
"OBJC_INCLUDE_PATH"
"OBJCPLUS_INCLUDE_PATH"
"LIBRARY_PATH"))
#t)) #t))
,phases) ,phases))
phases))))))) (else phases))))))))
(define (cross-gcc-patches target) (define (cross-gcc-patches target)
"Return GCC patches needed for TARGET." "Return GCC patches needed for TARGET."
(cond ((string-prefix? "xtensa-" target) (cond ((string-prefix? "xtensa-" target)
;; Patch by Qualcomm needed to build the ath9k-htc firmware. ;; Patch by Qualcomm needed to build the ath9k-htc firmware.
(search-patches "ath9k-htc-firmware-gcc.patch")) (search-patches "ath9k-htc-firmware-gcc.patch"))
((target-mingw? target)
(search-patches "gcc-4.9.3-mingw-gthr-default.patch"))
(else '()))) (else '())))
(define (cross-gcc-snippet target)
"Return GCC snippet needed for TARGET."
(cond ((target-mingw? target)
'(copy-recursively "libstdc++-v3/config/os/mingw32-w64"
"libstdc++-v3/config/os/newlib"))
(else #f)))
(define* (cross-gcc target (define* (cross-gcc target
#:optional (xbinutils (cross-binutils target)) libc) #:optional (xbinutils (cross-binutils target)) libc)
"Return a cross-compiler for TARGET, where TARGET is a GNU triplet. Use "Return a cross-compiler for TARGET, where TARGET is a GNU triplet. Use
@ -234,7 +325,10 @@ GCC that does not target a libc; otherwise, target that libc."
(append (append
(origin-patches (package-source %xgcc)) (origin-patches (package-source %xgcc))
(cons (search-patch "gcc-cross-environment-variables.patch") (cons (search-patch "gcc-cross-environment-variables.patch")
(cross-gcc-patches target)))))) (cross-gcc-patches target))))
(modules '((guix build utils)))
(snippet
(cross-gcc-snippet target))))
;; For simplicity, use a single output. Otherwise libgcc_s & co. are not ;; For simplicity, use a single output. Otherwise libgcc_s & co. are not
;; found by default, etc. ;; found by default, etc.
@ -244,6 +338,8 @@ GCC that does not target a libc; otherwise, target that libc."
`(#:implicit-inputs? #f `(#:implicit-inputs? #f
#:modules ((guix build gnu-build-system) #:modules ((guix build gnu-build-system)
(guix build utils) (guix build utils)
(ice-9 ftw)
(ice-9 match)
(ice-9 regex) (ice-9 regex)
(srfi srfi-1) (srfi srfi-1)
(srfi srfi-26)) (srfi srfi-26))
@ -264,34 +360,32 @@ GCC that does not target a libc; otherwise, target that libc."
;; Remaining inputs. ;; Remaining inputs.
,@(let ((inputs (append (package-inputs %xgcc) ,@(let ((inputs (append (package-inputs %xgcc)
(alist-delete "libc" (%final-inputs))))) (alist-delete "libc" (%final-inputs)))))
(if libc (cond
`(("libc" ,libc) ((target-mingw? target)
("xkernel-headers" ;the target headers (if libc
,@(assoc-ref (package-propagated-inputs libc) `(("libc" ,mingw-w64)
"kernel-headers")) ,@inputs)
,@inputs) `(("mingw-source" ,(package-source mingw-w64))
inputs)))) ,@inputs)))
(libc
`(("libc" ,libc)
("xkernel-headers" ;the target headers
,@(assoc-ref (package-propagated-inputs libc)
"kernel-headers"))
,@inputs))
(else inputs)))))
(inputs '()) (inputs '())
;; Only search target inputs, not host inputs. ;; Only search target inputs, not host inputs.
;; Note: See <http://bugs.gnu.org/22186> for why not 'CPATH'. (search-paths (cons (search-path-specification
(search-paths (variable "CROSS_LIBRARY_PATH")
(list (search-path-specification (files '("lib" "lib64")))
(variable "CROSS_C_INCLUDE_PATH") (map (lambda (variable)
(files '("include"))) (search-path-specification
(search-path-specification (variable variable)
(variable "CROSS_CPLUS_INCLUDE_PATH") (files '("include"))))
(files '("include"))) %gcc-cross-include-paths)))
(search-path-specification
(variable "CROSS_OBJC_INCLUDE_PATH")
(files '("include")))
(search-path-specification
(variable "CROSS_OBJCPLUS_INCLUDE_PATH")
(files '("include")))
(search-path-specification
(variable "CROSS_LIBRARY_PATH")
(files '("lib" "lib64")))))
(native-search-paths '()))) (native-search-paths '())))
(define* (cross-kernel-headers target (define* (cross-kernel-headers target
@ -464,61 +558,72 @@ XBINUTILS and the cross tool chain."
(_ glibc/linux))) (_ glibc/linux)))
;; Use (cross-libc-for-target ...) to determine the correct libc to use. ;; Use (cross-libc-for-target ...) to determine the correct libc to use.
(let ((libc (cross-libc-for-target target)))
(package (inherit libc)
(name (string-append "glibc-cross-" target))
(arguments
(substitute-keyword-arguments
`(;; Disable stripping (see above.)
#:strip-binaries? #f
;; This package is used as a target input, but it should not have (if (cross-newlib? target)
;; the usual cross-compilation inputs since that would include (native-libc target)
;; itself. (let ((libc (cross-libc-for-target target)))
#:implicit-cross-inputs? #f (package (inherit libc)
(name (string-append "glibc-cross-" target))
(arguments
(substitute-keyword-arguments
`(;; Disable stripping (see above.)
#:strip-binaries? #f
;; We need SRFI 26. ;; This package is used as a target input, but it should not have
#:modules ((guix build gnu-build-system) ;; the usual cross-compilation inputs since that would include
(guix build utils) ;; itself.
(srfi srfi-26)) #:implicit-cross-inputs? #f
,@(package-arguments libc)) ;; We need SRFI 26.
((#:configure-flags flags) #:modules ((guix build gnu-build-system)
`(cons ,(string-append "--host=" target) (guix build utils)
,flags)) (srfi srfi-26))
((#:phases phases)
`(alist-cons-before
'configure 'set-cross-kernel-headers-path
(lambda* (#:key inputs #:allow-other-keys)
(let* ((kernel (assoc-ref inputs "kernel-headers"))
(cpath (string-append kernel "/include")))
(for-each (cut setenv <> cpath)
'("CROSS_C_INCLUDE_PATH"
"CROSS_CPLUS_INCLUDE_PATH"
"CROSS_OBJC_INCLUDE_PATH"
"CROSS_OBJCPLUS_INCLUDE_PATH"))
(setenv "CROSS_LIBRARY_PATH"
(string-append kernel "/lib")) ;for Hurd's libihash
#t))
,phases))))
;; Shadow the native "kernel-headers" because glibc's recipe expects the ,@(package-arguments libc))
;; "kernel-headers" input to point to the right thing. ((#:configure-flags flags)
(propagated-inputs `(("kernel-headers" ,xheaders))) `(cons ,(string-append "--host=" target)
,flags))
((#:phases phases)
`(alist-cons-before
'configure 'set-cross-kernel-headers-path
(lambda* (#:key inputs #:allow-other-keys)
(let* ((kernel (assoc-ref inputs "kernel-headers"))
(cpath (string-append kernel "/include")))
(for-each (cut setenv <> cpath)
'("CROSS_C_INCLUDE_PATH"
"CROSS_CPLUS_INCLUDE_PATH"
"CROSS_OBJC_INCLUDE_PATH"
"CROSS_OBJCPLUS_INCLUDE_PATH"))
(setenv "CROSS_LIBRARY_PATH"
(string-append kernel "/lib")) ;for Hurd's libihash
#t))
,phases))))
;; FIXME: 'static-bash' should really be an input, not a native input, but ;; Shadow the native "kernel-headers" because glibc's recipe expects the
;; to do that will require building an intermediate cross libc. ;; "kernel-headers" input to point to the right thing.
(inputs '()) (propagated-inputs `(("kernel-headers" ,xheaders)))
(native-inputs `(("cross-gcc" ,xgcc) ;; FIXME: 'static-bash' should really be an input, not a native input, but
("cross-binutils" ,xbinutils) ;; to do that will require building an intermediate cross libc.
,@(if (string-match (or "i586-pc-gnu" "i586-gnu") target) (inputs '())
`(("cross-mig"
,@(assoc-ref (package-native-inputs xheaders) (native-inputs `(("cross-gcc" ,xgcc)
"cross-mig"))) ("cross-binutils" ,xbinutils)
'()) ,@(if (string-match (or "i586-pc-gnu" "i586-gnu") target)
,@(package-inputs libc) ;FIXME: static-bash `(("cross-mig"
,@(package-native-inputs libc)))))) ,@(assoc-ref (package-native-inputs xheaders)
"cross-mig")))
'())
,@(package-inputs libc) ;FIXME: static-bash
,@(package-native-inputs libc)))))))
(define (native-libc target)
(if (target-mingw? target)
mingw-w64
glibc))
(define (cross-newlib? target)
(not (eq? (native-libc target) glibc)))
;;; Concrete cross tool chains are instantiated like this: ;;; Concrete cross tool chains are instantiated like this:

View File

@ -70,6 +70,7 @@
%current-system %current-system
%current-target-system %current-target-system
package-name->name+version package-name->name+version
target-mingw?
version-compare version-compare
version>? version>?
version>=? version>=?
@ -508,6 +509,10 @@ returned. Both parts must not contain any '@'."
(idx (values (substring spec 0 idx) (idx (values (substring spec 0 idx)
(substring spec (1+ idx)))))) (substring spec (1+ idx))))))
(define* (target-mingw? #:optional (target (%current-target-system)))
(and target
(string-suffix? "-mingw32" target)))
(define version-compare (define version-compare
(let ((strverscmp (let ((strverscmp
(let ((sym (or (dynamic-func "strverscmp" (dynamic-link)) (let ((sym (or (dynamic-func "strverscmp" (dynamic-link))