Andy Wingo writes:
>> + (system* "tar" "xf" mingw-source)
>> + (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"))
>
> What's this last bit about? You would think that GCC's configure was
> meant to handle this. It could be the right thing but a comment is
> necessary.
I have added these comments
;; libc is false, so we are building xgcc-sans-libc
;; Add essential headers from mingw-w64.
(let ((mingw-source (assoc-ref inputs "mingw-source"))
(mingw-headers
(string-append (getcwd) "/mingw-w64-v5.0-rc2/mingw-w64-headers")))
(system* "tar" "xf" mingw-source)
;; 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"))
>> (define* (cross-gcc target
>> - #:optional (xbinutils (cross-binutils target)) libc)
>> + #:optional (xbinutils (cross-binutils target)) (libc #f))
>
> FWIW this change doesn't change anything -- if a default isn't given to
> an optional or keyword argument, the default is #f. It is equally good
> both ways, so no feedback to you other than to make sure you know this
> is the case :)
Thanks! Removed, masking hide my previous ignorance about this :)
>> - (if libc
>> + (cond
>> + ((mingw-target? target)
>> + (if libc
>> + `(("libc" ,mingw-w64)
>> + ,@inputs)
>> + `(("mingw-source" ,(package-source mingw-w64))
>> + ,@inputs)))
>> + (libc
>> `(("libc" ,libc)
>
> Please fix indentation here.
Ok. In my own code base I always just do indent-region on the whole
file, but that makes for lots of changes in Guix...
>> + (cond
>> + ((cross-newlib? target)
>> + (cross-newlib? target))
>
> Also (cond (x x)) is the same as (cond (x)).
Ah, nice. Changed now to (as a response to your remarks below)
(cond
((cross-newlib? target)
(native-libc target))
> But what's this about? I thought this procedure should return a
> package, not a boolean.
...
>> +(define (native-libc target)
>> + (if (mingw-target? target)
>> + mingw-w64
>> + glibc))
>> +
>> +(define (cross-newlib? target)
>> + (and (not (eq? (native-libc target) glibc))
>> + (native-libc target)))
>
> Aaaah I was confused because cross-newlib? was written as if it returned
> a boolean. Please rename the function to, for example,
> `maybe-cross-newlib' or something. Other names welcome but please,
> nothing ending in '?' :)
...Ah, okay... Changed to
(define (native-libc target)
(if (mingw-target? target)
mingw-w64
glibc))
(define (cross-newlib? target)
(not (eq? (native-libc target) glibc)))
I have adopted the meme in my own code to have any function? always
return the thing itself; that's also always true (as long as you don't
do things like (eq? (function?) #t). That allows code like
(or (foo?) bar)
Something I wanted to ask and I guess now why don't we let functions
like pair?, null?, string-prefix? not return the thing itself?
I guess doing that for new code is frowned up because it breaks the
principle of least surprise.
Thanks!
Greetings, Jan
On Sat 14 May 2016 22:27, Jan Nieuwenhuizen <janneke@gnu.org> writes:
> Andy Wingo writes:
>
> Something I wanted to ask and I guess now why don't we let functions
> like pair?, null?, string-prefix? not return the thing itself?
So many possible answers, none of them great ;) For example, why have #t
as a value at all -- I don't know :)
But more directly: pair? only returns a boolean because the standard
convention is that a function with a ? on the end returns a boolean. A
counter example is `assoc': it returns a pair or #f, and has no trailing
`?'.
As to why have predicates -- well the idea is that a predicate doesn't
do lookup and doesnt' retrieve a value, it just partitions its domain.
You don't need to return the value because you already have the value --
you passed it as the argument. Also consider boolean? -- what should
(boolean? #f) return? Anyway that's how predicates are understood by
most other Scheme programmers.
> diff --git a/gnu/packages/cross-base.scm b/gnu/packages/cross-base.scm
> (define* (cross-gcc target
> #:optional (xbinutils (cross-binutils target)) libc)
> "Return a cross-compiler for TARGET, where TARGET is a GNU triplet. Use
> @@ -223,7 +309,10 @@ GCC that does not target a libc; otherwise, target that libc."
> (append
> (origin-patches (package-source %xgcc))
> (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
> ;; found by default, etc.
> @@ -245,6 +334,7 @@ GCC that does not target a libc; otherwise, target that libc."
> #:target target
> #:binutils xbinutils))
> ("binutils-cross" ,xbinutils)
> + ("gcc" ,gcc)
>
> ;; Call it differently so that the builder can check whether the "libc"
> ;; input is #f.
Why did you add GCC here? Why was it not needed before?
Other than this nit, LGTM.
Andy
From c587c6d9c635380cc8053e5293de091ada787607 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Tue, 3 May 2016 20:08:40 +0200
Subject: [PATCH 02/11] gnu: cross-build: i686-w64-mingw32: new cross target.
* guix/utils.scm (mingw-target?): New function.
* gnu/packages/cross-base.scm (cross-gcc-snippet): New function for mingw.
(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.
(xbinutils-i686-w64-mingw32, xgcc-sans-libc-i686-w64-mingw32,
xgcc-i686-w64-mingw32): New variables.
---
gnu/packages/cross-base.scm | 292 +++++++++++++++++++++++++++++++-------------
guix/utils.scm | 5 +
2 files changed, 213 insertions(+), 84 deletions(-)
@@ -19,12 +19,17 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages cross-base)
- #:use-module (guix licenses)
+ #:use-module ((guix licenses) #:prefix license:)
#:use-module (gnu packages)
- #:use-module (gnu packages gcc)
#:use-module (gnu packages base)
+ #:use-module (gnu packages bash)
+ #:use-module (gnu packages gawk)
+ #:use-module (gnu packages gcc)
#:use-module (gnu packages commencement)
+ #:use-module (gnu packages compression)
#:use-module (gnu packages linux)
+ #:use-module (gnu packages mingw)
+ #:use-module (gnu packages multiprecision)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix utils)
@@ -35,7 +40,8 @@
#:use-module (ice-9 match)
#:export (cross-binutils
cross-libc
- cross-gcc))
+ cross-gcc
+ cross-newlib?))
(define %xgcc
;; GCC package used as the basis for cross-compilation. It doesn't have to
@@ -121,7 +127,12 @@ may be either a libc package or #f.)"
"--disable-libquadmath"
"--disable-decimal-float" ;would need libc
"--disable-libcilkrts"
- )))
+ ))
+
+ ;; For a newlib (non-glibc) target
+ ,@(if (cross-newlib? target)
+ '("--with-newlib")
+ '()))
,(if libc
flags
@@ -163,7 +174,73 @@ may be either a libc package or #f.)"
;; for cross-compilers.
(zero? (system* "make" "install-strip")))
,phases))))
- (if libc
+ (cond
+ ((mingw-target? 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)))
+ (if libc
+ (let ((cpath (string-append
+ libc "/include"
+ ":" libc "/i686-w64-mingw32/include")))
+ (for-each (cut setenv <> cpath)
+ '("CROSS_C_INCLUDE_PATH"
+ "CROSS_CPLUS_INCLUDE_PATH"
+ "CROSS_OBJC_INCLUDE_PATH"
+ "CROSS_OBJCPLUS_INCLUDE_PATH")))
+ ;; libc is false, so we are building xgcc-sans-libc
+ ;; Add essential headers from mingw-w64.
+ (let ((mingw-source (assoc-ref inputs "mingw-source"))
+ (mingw-headers
+ (string-append (getcwd) "/mingw-w64-v5.0-rc2/mingw-w64-headers")))
+ (system* "tar" "xf" mingw-source)
+ ;; 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)
+ '("CROSS_C_INCLUDE_PATH"
+ "CROSS_CPLUS_INCLUDE_PATH"
+ "CROSS_OBJC_INCLUDE_PATH"
+ "CROSS_OBJCPLUS_INCLUDE_PATH"
+ "CROSS_LIBRARY_PATH")))))
+ (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)))))
+ '("C_INCLUDE_PATH"
+ "CPLUS_INCLUDE_PATH"
+ "OBJC_INCLUDE_PATH"
+ "OBJCPLUS_INCLUDE_PATH"
+ "LIBRARY_PATH"))
+ #t)))))
+ (libc
`(alist-cons-before
'configure 'set-cross-path
(lambda* (#:key inputs #:allow-other-keys)
@@ -199,16 +276,25 @@ may be either a libc package or #f.)"
"OBJCPLUS_INCLUDE_PATH"
"LIBRARY_PATH"))
#t))
- ,phases)
- phases)))))))
+ ,phases))
+ (else phases))))))))
(define (cross-gcc-patches target)
"Return GCC patches needed for TARGET."
(cond ((string-prefix? "xtensa-" target)
;; Patch by Qualcomm needed to build the ath9k-htc firmware.
(search-patches "ath9k-htc-firmware-gcc.patch"))
+ ((mingw-target? target)
+ (search-patches "gcc-4.9.3-mingw-gthr-default.patch"))
(else '())))
+(define (cross-gcc-snippet target)
+ "Return GCC snippet needed for TARGET."
+ (cond ((mingw-target? target)
+ '(copy-recursively "libstdc++-v3/config/os/mingw32-w64"
+ "libstdc++-v3/config/os/newlib"))
+ (else #f)))
+
(define* (cross-gcc target
#:optional (xbinutils (cross-binutils target)) libc)
"Return a cross-compiler for TARGET, where TARGET is a GNU triplet. Use
@@ -223,7 +309,10 @@ GCC that does not target a libc; otherwise, target that libc."
(append
(origin-patches (package-source %xgcc))
(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
;; found by default, etc.
@@ -245,6 +334,7 @@ GCC that does not target a libc; otherwise, target that libc."
#:target target
#:binutils xbinutils))
("binutils-cross" ,xbinutils)
+ ("gcc" ,gcc)
;; Call it differently so that the builder can check whether the "libc"
;; input is #f.
@@ -253,13 +343,20 @@ GCC that does not target a libc; otherwise, target that libc."
;; Remaining inputs.
,@(let ((inputs (append (package-inputs %xgcc)
(alist-delete "libc" %final-inputs))))
- (if libc
- `(("libc" ,libc)
- ("xlinux-headers" ;the target headers
- ,@(assoc-ref (package-propagated-inputs libc)
- "linux-headers"))
- ,@inputs)
- inputs))))
+ (cond
+ ((mingw-target? target)
+ (if libc
+ `(("libc" ,mingw-w64)
+ ,@inputs)
+ `(("mingw-source" ,(package-source mingw-w64))
+ ,@inputs)))
+ (libc
+ `(("libc" ,libc)
+ ("xlinux-headers" ;the target headers
+ ,@(assoc-ref (package-propagated-inputs libc)
+ "linux-headers"))
+ ,@inputs))
+ (else inputs)))))
(inputs '())
@@ -289,75 +386,87 @@ GCC that does not target a libc; otherwise, target that libc."
(xbinutils (cross-binutils target)))
"Return a libc cross-built for TARGET, a GNU triplet. Use XGCC and
XBINUTILS and the cross tool chain."
- (define xlinux-headers
- (package (inherit linux-libre-headers)
- (name (string-append (package-name linux-libre-headers)
- "-cross-" target))
- (arguments
- (substitute-keyword-arguments
- `(#:implicit-cross-inputs? #f
- ,@(package-arguments linux-libre-headers))
- ((#:phases phases)
- `(alist-replace
- 'build
- (lambda _
- (setenv "ARCH" ,(system->linux-architecture target))
- (format #t "`ARCH' set to `~a' (cross compiling)~%" (getenv "ARCH"))
-
- (and (zero? (system* "make" "defconfig"))
- (zero? (system* "make" "mrproper" "headers_check"))))
- ,phases))))
- (native-inputs `(("cross-gcc" ,xgcc)
- ("cross-binutils" ,xbinutils)
- ,@(package-native-inputs linux-libre-headers)))))
-
- (package (inherit glibc)
- (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
- ;; the usual cross-compilation inputs since that would include
- ;; itself.
- #:implicit-cross-inputs? #f
-
- ;; We need cut from srfi-26
- #:modules ((guix build gnu-build-system)
- (guix build utils)
- (srfi srfi-26))
-
- ,@(package-arguments glibc))
- ((#:configure-flags flags)
- `(cons ,(string-append "--host=" target)
- ,flags))
- ((#:phases phases)
- `(alist-cons-before
- 'configure 'set-cross-linux-headers-path
- (lambda* (#:key inputs #:allow-other-keys)
- (let* ((linux (assoc-ref inputs "linux-headers"))
- (cpath (string-append linux "/include")))
- (for-each (cut setenv <> cpath)
- '("CROSS_C_INCLUDE_PATH"
- "CROSS_CPLUS_INCLUDE_PATH"
- "CROSS_OBJC_INCLUDE_PATH"
- "CROSS_OBJCPLUS_INCLUDE_PATH"))
- #t))
- ,phases))))
-
- ;; Shadow the native "linux-headers" because glibc's recipe expects the
- ;; "linux-headers" input to point to the right thing.
- (propagated-inputs `(("linux-headers" ,xlinux-headers)))
-
- ;; FIXME: 'static-bash' should really be an input, not a native input, but
- ;; to do that will require building an intermediate cross libc.
- (inputs '())
-
- (native-inputs `(("cross-gcc" ,xgcc)
- ("cross-binutils" ,xbinutils)
- ,@(package-inputs glibc) ;FIXME: static-bash
- ,@(package-native-inputs glibc)))))
+ (cond
+ ((cross-newlib? target)
+ (native-libc target))
+ (else
+ (let ((xlinux-headers
+ (package (inherit linux-libre-headers)
+ (name (string-append (package-name linux-libre-headers)
+ "-cross-" target))
+ (arguments
+ (substitute-keyword-arguments
+ `(#:implicit-cross-inputs? #f
+ ,@(package-arguments linux-libre-headers))
+ ((#:phases phases)
+ `(alist-replace
+ 'build
+ (lambda _
+ (setenv "ARCH" ,(system->linux-architecture target))
+ (format #t "`ARCH' set to `~a' (cross compiling)~%"
+ (getenv "ARCH"))
+
+ (and (zero? (system* "make" "defconfig"))
+ (zero? (system* "make" "mrproper" "headers_check"))))
+ ,phases))))
+ (native-inputs `(("cross-gcc" ,xgcc)
+ ("cross-binutils" ,xbinutils)
+ ,@(package-native-inputs linux-libre-headers))))))
+ (package (inherit glibc)
+ (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
+ ;; the usual cross-compilation inputs since that would include
+ ;; itself.
+ #:implicit-cross-inputs? #f
+
+ ;; We need cut from srfi-26
+ #:modules ((guix build gnu-build-system)
+ (guix build utils)
+ (srfi srfi-26))
+
+ ,@(package-arguments glibc))
+ ((#:configure-flags flags)
+ `(cons ,(string-append "--host=" target)
+ ,flags))
+ ((#:phases phases)
+ `(alist-cons-before
+ 'configure 'set-cross-linux-headers-path
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let* ((linux (assoc-ref inputs "linux-headers"))
+ (cpath (string-append linux "/include")))
+ (for-each (cut setenv <> cpath)
+ '("CROSS_C_INCLUDE_PATH"
+ "CROSS_CPLUS_INCLUDE_PATH"
+ "CROSS_OBJC_INCLUDE_PATH"
+ "CROSS_OBJCPLUS_INCLUDE_PATH"))
+ #t))
+ ,phases))))
+
+ ;; Shadow the native "linux-headers" because glibc's recipe expects the
+ ;; "linux-headers" input to point to the right thing.
+ (propagated-inputs `(("linux-headers" ,xlinux-headers)))
+
+ ;; FIXME: 'static-bash' should really be an input, not a native input,
+ ;; but to do that will require building an intermediate cross libc.
+ (inputs '())
+
+ (native-inputs `(("cross-gcc" ,xgcc)
+ ("cross-binutils" ,xbinutils)
+ ,@(package-inputs glibc) ;FIXME: static-bash
+ ,@(package-native-inputs glibc))))))))
+
+(define (native-libc target)
+ (if (mingw-target? target)
+ mingw-w64
+ glibc))
+
+(define (cross-newlib? target)
+ (not (eq? (native-libc target) glibc)))
;;;
@@ -399,3 +508,18 @@ XBINUTILS and the cross tool chain."
;; (cross-gcc triplet
;; (cross-binutils triplet)
;; (cross-libc triplet))))
+
+(define-public xgcc-sans-libc-i686-w64-mingw32
+ (let ((triplet "i686-w64-mingw32"))
+ (cross-gcc triplet
+ (cross-binutils triplet))))
+
+(define-public xbinutils-i686-w64-mingw32
+ (let ((triplet "i686-w64-mingw32"))
+ (cross-binutils triplet)))
+
+(define-public xgcc-i686-w64-mingw32
+ (let ((triplet "i686-w64-mingw32"))
+ (cross-gcc triplet
+ (cross-binutils triplet)
+ (cross-newlib? triplet))))
@@ -65,6 +65,7 @@
gnu-triplet->nix-system
%current-system
%current-target-system
+ mingw-target?
package-name->name+version
version-compare
version>?
@@ -483,6 +484,10 @@ returned by `config.guess'."
;; cross-building to.
(make-parameter #f))
+(define* (mingw-target? #:optional (target (%current-target-system)))
+ (and target
+ (string-suffix? "-mingw32" target)))
+
(define (package-name->name+version spec)
"Given SPEC, a package name like \"foo@0.9.1b\", return two values: \"foo\"
and \"0.9.1b\". When the version part is unavailable, SPEC and #f are
--
2.7.3