Patchwork [02/11] gnu: cross-build: i686-w64-mingw32: new cross target.

login
register
mail settings
Submitter Jan Nieuwenhuizen
Date May 14, 2016, 8:27 p.m.
Message ID <87twi09yhg.fsf@drakenvlieg.flower>
Download mbox | patch
Permalink /patch/12258/
State New
Headers show

Comments

Jan Nieuwenhuizen - May 14, 2016, 8:27 p.m.
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
Andy Wingo - May 17, 2016, 7:43 a.m.
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

Patch

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(-)

diff --git a/gnu/packages/cross-base.scm b/gnu/packages/cross-base.scm
index 7ed4ae4..6efd748 100644
--- a/gnu/packages/cross-base.scm
+++ b/gnu/packages/cross-base.scm
@@ -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))))
diff --git a/guix/utils.scm b/guix/utils.scm
index d924e43..2109035 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -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