On Sun 08 May 2016 22:42, Jan Nieuwenhuizen <jann...@gnu.org> writes:

> * 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 | 271 
> +++++++++++++++++++++++++++++++-------------
>  guix/utils.scm              |   5 +
>  2 files changed, 200 insertions(+), 76 deletions(-)
>
> diff --git a/gnu/packages/cross-base.scm b/gnu/packages/cross-base.scm
> @@ -163,7 +174,67 @@ 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")))
> +                         (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)
> +                           (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.

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

>    "Return a cross-compiler for TARGET, where TARGET is a GNU triplet.  Use
>  XBINUTILS as the associated cross-Binutils.  If LIBC is false, then build a
>  GCC that does not target a libc; otherwise, target that libc."
> @@ -223,7 +303,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 +328,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 +337,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
> +           (cond
> +            ((mingw-target? target)
> +             (if libc
> +                 `(("libc" ,mingw-w64)
> +                   ,@inputs)
> +                 `(("mingw-source" ,(package-source mingw-w64))
> +                   ,@inputs)))
> +            (libc
>                 `(("libc" ,libc)

Please fix indentation here.

> @@ -289,70 +380,83 @@ 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
> -
> -           ,@(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)
> +    (cross-newlib? target))

Also (cond (x x)) is the same as (cond (x)).  But what's this about?  I
thought this procedure should return a package, not a boolean.


> +   (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
> +
> +               ,@(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)
> +  (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 '?' :)


Reply via email to