[jackhill/guix/guix.git] / gnu / packages / cross-base.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages cross-base)
  #:use-module (gnu packages)
  #:use-module (gnu packages gcc)
  #:use-module (gnu packages base)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages hurd)
  #:use-module (gnu packages mingw)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix utils)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system trivial)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:export (cross-binutils
            cross-libc
            cross-gcc
            cross-newlib?))

(define-syntax %xgcc
  ;; 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'.
  ;;
  ;; Note: This is a macro so that we do not refer to 'gcc' from the top
  ;; level, which would lead to circular-dependency issues.
  (identifier-syntax 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)
  (package (inherit p)
    (name (string-append (package-name p) "-cross-" target))
    (arguments
     (substitute-keyword-arguments (package-arguments p)
       ((#:configure-flags flags)
        `(cons ,(string-append "--target=" target)
               ,flags))))))

(define (package-with-patch original patch)
  "Return package ORIGINAL with PATCH applied."
  (package (inherit original)
    (source (origin (inherit (package-source original))
              (patches (list patch))))))

(define (cross-binutils target)
  "Return a cross-Binutils for TARGET."
  (let ((binutils (package (inherit binutils)
                    (arguments
                     (substitute-keyword-arguments (package-arguments
                                                    binutils)
                       ((#:configure-flags flags)
                        ;; Build with `--with-sysroot' so that ld honors
                        ;; DT_RUNPATH entries when searching for a needed
                        ;; library.  This works because as a side effect
                        ;; `genscripts.sh' sets `USE_LIBPATH=yes', which tells
                        ;; elf32.em to use DT_RUNPATH in its search list.
                        ;; See <http://sourceware.org/ml/binutils/2013-05/msg00312.html>.
                        ;;
                        ;; In theory choosing / as the sysroot could lead ld
                        ;; to pick up native libs instead of target ones.  In
                        ;; practice the RUNPATH of target libs only refers to
                        ;; target libs, not native libs, so this is safe.
                        `(cons "--with-sysroot=/" ,flags)))))))

    ;; For Xtensa, apply Qualcomm's patch.
    (cross (if (string-prefix? "xtensa-" target)
               (package-with-patch binutils
                                   (search-patch
                                    "ath9k-htc-firmware-binutils.patch"))
               binutils)
           target)))

(define (cross-gcc-arguments target xgcc libc)
  "Return build system arguments for a cross-gcc for TARGET, using XGCC as the
base compiler and using LIBC (which may be either a libc package or #f.)"
  ;; Set the current target system so that 'glibc-dynamic-linker' returns the
  ;; right name.
  (parameterize ((%current-target-system target))
    ;; Disable stripping as this can break binaries, with object files of
    ;; libgcc.a showing up as having an unknown architecture.  See
    ;; <http://lists.fedoraproject.org/pipermail/arm/2010-August/000663.html>
    ;; for instance.
    (let ((args `(#:strip-binaries? #f
                  ,@(package-arguments xgcc))))
     (substitute-keyword-arguments args
       ((#:configure-flags flags)
        `(append (list ,(string-append "--target=" target)
                       ,@(if libc
                             `( ;; Disable libcilkrts because it is not
                                ;; ported to GNU/Hurd.
                               "--disable-libcilkrts")
                             `( ;; Disable features not needed at this stage.
                               "--disable-shared" "--enable-static"
                               "--enable-languages=c,c++"

                               ;; libstdc++ cannot be built at this stage
                               ;; ("Link tests are not allowed after
                               ;; GCC_NO_EXECUTABLES.").
                               "--disable-libstdc++-v3"

                               "--disable-threads" ;libgcc, would need libc
                               "--disable-libatomic"
                               "--disable-libmudflap"
                               "--disable-libgomp"
                               "--disable-libssp"
                               "--disable-libquadmath"
                               "--disable-decimal-float" ;would need libc
                               "--disable-libcilkrts"

                               ;; When target is any OS other than 'none' these
                               ;; libraries will fail if there is no libc
                               ;; present. See
                               ;; <https://lists.gnu.org/archive/html/guix-devel/2016-02/msg01311.html>
                               "--disable-libitm"
                               "--disable-libvtv"
                               "--disable-libsanitizer"
                                ))

                       ;; For a newlib (non-glibc) target
                       ,@(if (cross-newlib? target)
                             '("--with-newlib")
                             '()))

                 ,(if libc
                      flags
                      `(remove (cut string-match "--enable-languages.*" <>)
                               ,flags))))
       ((#:make-flags flags)
        (if libc
            `(let ((libc (assoc-ref %build-inputs "libc")))
               ;; FLAGS_FOR_TARGET are needed for the target libraries to receive
               ;; the -Bxxx for the startfiles.
               (cons (string-append "FLAGS_FOR_TARGET=-B" libc "/lib")
                     ,flags))
            flags))
       ((#:phases phases)
        `(cross-gcc-build-phases ,target ,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"))
        ((target-mingw? target)
         (search-patches "gcc-4.9.3-mingw-gthr-default.patch"))
        (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
                    #:key
                    (xgcc %xgcc)
                    (xbinutils (cross-binutils target))
                    (libc #f))
  "Return a cross-compiler for TARGET, where TARGET is a GNU triplet.  Use
XGCC as the base compiler.  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."
  (package (inherit xgcc)
    (name (string-append "gcc-cross-"
                         (if libc "" "sans-libc-")
                         target))
    (source (origin (inherit (package-source xgcc))
              (patches
               (append
                (origin-patches (package-source xgcc))
                (cons (if (version>=? (package-version xgcc) "6.0")
                          (search-patch "gcc-6-cross-environment-variables.patch")
                          (search-patch "gcc-cross-environment-variables.patch"))
                      (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.
    (outputs '("out"))

    (arguments
     `(#:implicit-inputs? #f
       #:imported-modules ((gnu build cross-toolchain)
                           ,@%gnu-build-system-modules)
       #:modules ((guix build gnu-build-system)
                  (guix build utils)
                  (gnu build cross-toolchain)
                  (srfi srfi-1)
                  (srfi srfi-26)
                  (ice-9 regex))

       ,@(cross-gcc-arguments target xgcc libc)))

    (native-inputs
     `(("ld-wrapper-cross" ,(make-ld-wrapper
                             (string-append "ld-wrapper-" target)
                             #:target (const target)
                             #:binutils xbinutils))
       ("binutils-cross" ,xbinutils)

       ;; Call it differently so that the builder can check whether the "libc"
       ;; input is #f.
       ("libc-native" ,@(assoc-ref (%final-inputs) "libc"))

       ;; Remaining inputs.
       ,@(let ((inputs (append (package-inputs xgcc)
                               (alist-delete "libc" (%final-inputs)))))
           (cond
            ((target-mingw? target)
             (if libc
                 `(("libc" ,mingw-w64)
                   ,@inputs)
                 `(("mingw-source" ,(package-source mingw-w64))
                   ,@inputs)))
            (libc
             `(("libc" ,libc)
               ("libc:static" ,libc "static")
               ("xkernel-headers"                ;the target headers
                ,@(assoc-ref (package-propagated-inputs libc)
                             "kernel-headers"))
               ,@inputs))
            (else inputs)))))

    (inputs '())

    ;; Only search target inputs, not host inputs.
    (search-paths (cons (search-path-specification
                         (variable "CROSS_LIBRARY_PATH")
                         (files '("lib" "lib64")))
                        (map (lambda (variable)
                               (search-path-specification
                                (variable variable)
                                (files '("include"))))
                             %gcc-cross-include-paths)))
    (native-search-paths '())))

(define* (cross-kernel-headers target
                               #:optional
                               (xgcc (cross-gcc target))
                               (xbinutils (cross-binutils target)))
  "Return headers depending on TARGET."

  (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" ,(system->defconfig target)))
                   (zero? (system* "make" "mrproper" "headers_check"))))
            ,phases))))
      (native-inputs `(("cross-gcc" ,xgcc)
                       ("cross-binutils" ,xbinutils)
                       ,@(package-native-inputs linux-libre-headers)))))

  (define xgnumach-headers
    (package (inherit gnumach-headers)
      (name (string-append (package-name gnumach-headers)
                           "-cross-" target))

      (native-inputs `(("cross-gcc" ,xgcc)
                       ("cross-binutils" ,xbinutils)
                       ,@(package-native-inputs gnumach-headers)))))

  (define xmig
    (package (inherit mig)
      (name (string-append "mig-cross"))
      (arguments
       `(#:modules ((guix build gnu-build-system)
                    (guix build utils)
                    (srfi srfi-26))
         #:phases (alist-cons-before
                   'configure 'set-cross-headers-path
                   (lambda* (#:key inputs #:allow-other-keys)
                     (let* ((mach (assoc-ref inputs "cross-gnumach-headers"))
                            (cpath (string-append mach "/include")))
                       (for-each (cut setenv <> cpath)
                                 ',%gcc-cross-include-paths)))
                   %standard-phases)
         #:configure-flags (list ,(string-append "--target=" target))
         ,@(package-arguments mig)))

      (propagated-inputs `(("cross-gnumach-headers" ,xgnumach-headers)))
      (native-inputs `(("cross-gcc" ,xgcc)
                       ("cross-binutils" ,xbinutils)
                       ,@(package-native-inputs mig)))))

  (define xhurd-headers
    (package (inherit hurd-headers)
      (name (string-append (package-name hurd-headers)
                           "-cross-" target))

      (native-inputs `(("cross-gcc" ,xgcc)
                       ("cross-binutils" ,xbinutils)
                       ("cross-mig" ,xmig)
                       ,@(alist-delete "mig"(package-native-inputs hurd-headers))))))

   (define xglibc/hurd-headers
    (package (inherit glibc/hurd-headers)
      (name (string-append (package-name glibc/hurd-headers)
                           "-cross-" target))

      (arguments
       (substitute-keyword-arguments
           `(#:modules ((guix build gnu-build-system)
                        (guix build utils)
                        (srfi srfi-26))
             ,@(package-arguments glibc/hurd-headers))
         ((#:phases phases)
          `(alist-cons-before
            'pre-configure 'set-cross-headers-path
            (lambda* (#:key inputs #:allow-other-keys)
              (let* ((mach (assoc-ref inputs "gnumach-headers"))
                     (hurd (assoc-ref inputs "hurd-headers"))
                     (cpath (string-append mach "/include:"
                                           hurd "/include")))
                (for-each (cut setenv <> cpath)
                          ',%gcc-cross-include-paths)))
            ,phases))))

      (propagated-inputs `(("gnumach-headers" ,xgnumach-headers)
                           ("hurd-headers" ,xhurd-headers)))

      (native-inputs `(("cross-gcc" ,xgcc)
                       ("cross-binutils" ,xbinutils)
                       ("cross-mig" ,xmig)
                       ,@(alist-delete "mig"(package-native-inputs glibc/hurd-headers))))))

  (define xhurd-minimal
    (package (inherit hurd-minimal)
      (name (string-append (package-name hurd-minimal)
                           "-cross-" target))
      (arguments
       (substitute-keyword-arguments
         `(#:modules ((guix build gnu-build-system)
                      (guix build utils)
                      (srfi srfi-26))
           ,@(package-arguments hurd-minimal))
         ((#:phases phases)
          `(alist-cons-before
            'configure 'set-cross-headers-path
            (lambda* (#:key inputs #:allow-other-keys)
              (let* ((glibc-headers (assoc-ref inputs "cross-glibc-hurd-headers"))
                    (cpath (string-append glibc-headers "/include")))
                (for-each (cut setenv <> cpath)
                          ',%gcc-cross-include-paths)))
            ,phases))))

      (inputs `(("cross-glibc-hurd-headers" ,xglibc/hurd-headers)))

      (native-inputs `(("cross-gcc" ,xgcc)
                       ("cross-binutils" ,xbinutils)
                       ("cross-mig" ,xmig)
                       ,@(alist-delete "mig"(package-native-inputs hurd-minimal))))))

  (define xhurd-core-headers
    (package (inherit hurd-core-headers)
      (name (string-append (package-name hurd-core-headers)
                           "-cross-" target))

      (inputs `(("gnumach-headers" ,xgnumach-headers)
                ("hurd-headers" ,xhurd-headers)
                ("hurd-minimal" ,xhurd-minimal)))

      (native-inputs `(("cross-gcc" ,xgcc)
                       ("cross-binutils" ,xbinutils)
                       ("cross-mig" ,xmig)
                       ,@(package-native-inputs hurd-core-headers)))))

  (match target
    ((or "i586-pc-gnu" "i586-gnu") xhurd-core-headers)
    (_ xlinux-headers)))

(define* (cross-libc target
                     #:optional
                     (xgcc (cross-gcc target))
                     (xbinutils (cross-binutils target))
                     (xheaders (cross-kernel-headers target)))
  "Return a libc cross-built for TARGET, a GNU triplet.  Use XGCC and
XBINUTILS and the cross tool chain."
  (define (cross-libc-for-target target)
    "Return libc depending on TARGET."
    (match target
      ((or "i586-pc-gnu" "i586-gnu") glibc/hurd)
      (_ glibc/linux)))

  ;; Use (cross-libc-for-target ...) to determine the correct libc to use.

  (if (cross-newlib? target)
      (native-libc target)
      (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
                 ;; the usual cross-compilation inputs since that would include
                 ;; itself.
                 #:implicit-cross-inputs? #f

                 ;; We need SRFI 26.
                 #:modules ((guix build gnu-build-system)
                            (guix build utils)
                            (srfi srfi-26))

                 ,@(package-arguments libc))
             ((#:configure-flags flags)
              `(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)
                              ',%gcc-cross-include-paths)
                    (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
          ;; "kernel-headers" input to point to the right thing.
          (propagated-inputs `(("kernel-headers" ,xheaders)))

          ;; 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)
                           ,@(if (hurd-triplet? target)
                                 `(("cross-mig"
                                    ,@(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)))

\f
;;; Concrete cross tool chains are instantiated like this:
;;
;; (define-public xgcc-armhf
;;   (let ((triplet "arm-linux-gnueabihf"))
;;     (cross-gcc triplet
;;                #:xbinutils (cross-binutils triplet)
;;                #:libc (cross-libc triplet))))
;;
;;; We don't do that here because we'd be referring to bindings from (gnu
;;; packages gcc) from the top level, which doesn't play well with circular
;;; dependencies among modules.
Commit	Line	Data
827d2891	1	;;; GNU Guix --- Functional package management for GNU
be99170d	2	;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
3f00ff8b	3	;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
efc4eb14	4	;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
2d558e31	5	;;; Copyright © 2016 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
827d2891 LC	6	;;;
	7	;;; This file is part of GNU Guix.
	8	;;;
	9	;;; GNU Guix is free software; you can redistribute it and/or modify it
	10	;;; under the terms of the GNU General Public License as published by
	11	;;; the Free Software Foundation; either version 3 of the License, or (at
	12	;;; your option) any later version.
	13	;;;
	14	;;; GNU Guix is distributed in the hope that it will be useful, but
	15	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	16	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	17	;;; GNU General Public License for more details.
	18	;;;
	19	;;; You should have received a copy of the GNU General Public License
	20	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	21
	22	(define-module (gnu packages cross-base)
827d2891	23	#:use-module (gnu packages)
f594028a	24	#:use-module (gnu packages gcc)
827d2891 LC	25	#:use-module (gnu packages base)
827d2891 LC	26	#:use-module (gnu packages linux)
2d558e31	27	#:use-module (gnu packages hurd)
cba36e64	28	#:use-module (gnu packages mingw)
827d2891 LC	29	#:use-module (guix packages)
	30	#:use-module (guix download)
	31	#:use-module (guix utils)
	32	#:use-module (guix build-system gnu)
	33	#:use-module (guix build-system trivial)
	34	#:use-module (srfi srfi-1)
	35	#:use-module (srfi srfi-26)
264218a4	36	#:use-module (ice-9 match)
2d558e31	37	#:use-module (ice-9 regex)
264218a4 LC	38	#:export (cross-binutils
264218a4 LC	39	cross-libc
cba36e64 JN	40	cross-gcc
cba36e64 JN	41	cross-newlib?))
827d2891	42
be99170d	43	(define-syntax %xgcc
c92f1c0a LC	44	;; GCC package used as the basis for cross-compilation. It doesn't have to
c92f1c0a LC	45	;; be 'gcc' and can be a specific variant such as 'gcc-4.8'.
be99170d LC	46	;;
	47	;; Note: This is a macro so that we do not refer to 'gcc' from the top
	48	;; level, which would lead to circular-dependency issues.
	49	(identifier-syntax gcc))
c92f1c0a	50
cba36e64 JN	51	(define %gcc-include-paths
	52	;; Environment variables for header search paths.
	53	;; Note: See <http://bugs.gnu.org/22186> for why not 'CPATH'.
	54	'("C_INCLUDE_PATH"
	55	"CPLUS_INCLUDE_PATH"
	56	"OBJC_INCLUDE_PATH"
	57	"OBJCPLUS_INCLUDE_PATH"))
	58
	59	(define %gcc-cross-include-paths
	60	;; Search path for target headers when cross-compiling.
	61	(map (cut string-append "CROSS_" <>) %gcc-include-paths))
	62
827d2891 LC	63	(define (cross p target)
827d2891 LC	64	(package (inherit p)
827d2891 LC	65	(name (string-append (package-name p) "-cross-" target))
	66	(arguments
	67	(substitute-keyword-arguments (package-arguments p)
	68	((#:configure-flags flags)
	69	`(cons ,(string-append "--target=" target)
	70	,flags))))))
	71
1306b0b0 LC	72	(define (package-with-patch original patch)
	73	"Return package ORIGINAL with PATCH applied."
	74	(package (inherit original)
	75	(source (origin (inherit (package-source original))
	76	(patches (list patch))))))
	77
47e74d6e LC	78	(define (cross-binutils target)
	79	"Return a cross-Binutils for TARGET."
	80	(let ((binutils (package (inherit binutils)
	81	(arguments
	82	(substitute-keyword-arguments (package-arguments
	83	binutils)
	84	((#:configure-flags flags)
	85	;; Build with `--with-sysroot' so that ld honors
	86	;; DT_RUNPATH entries when searching for a needed
	87	;; library. This works because as a side effect
	88	;; `genscripts.sh' sets `USE_LIBPATH=yes', which tells
	89	;; elf32.em to use DT_RUNPATH in its search list.
c8fa51f2 LC	90	;; See <http://sourceware.org/ml/binutils/2013-05/msg00312.html>.
	91	;;
	92	;; In theory choosing / as the sysroot could lead ld
	93	;; to pick up native libs instead of target ones. In
	94	;; practice the RUNPATH of target libs only refers to
	95	;; target libs, not native libs, so this is safe.
	96	`(cons "--with-sysroot=/" ,flags)))))))
1306b0b0 LC	97
	98	;; For Xtensa, apply Qualcomm's patch.
	99	(cross (if (string-prefix? "xtensa-" target)
	100	(package-with-patch binutils
	101	(search-patch
	102	"ath9k-htc-firmware-binutils.patch"))
	103	binutils)
	104	target)))
827d2891	105
7b3318e3 RW	106	(define (cross-gcc-arguments target xgcc libc)
	107	"Return build system arguments for a cross-gcc for TARGET, using XGCC as the
	108	base compiler and using LIBC (which may be either a libc package or #f.)"
b4469d8c LC	109	;; Set the current target system so that 'glibc-dynamic-linker' returns the
	110	;; right name.
	111	(parameterize ((%current-target-system target))
2a1552c6 LC	112	;; Disable stripping as this can break binaries, with object files of
	113	;; libgcc.a showing up as having an unknown architecture. See
	114	;; <http://lists.fedoraproject.org/pipermail/arm/2010-August/000663.html>
	115	;; for instance.
	116	(let ((args `(#:strip-binaries? #f
7b3318e3	117	,@(package-arguments xgcc))))
2a1552c6 LC	118	(substitute-keyword-arguments args
	119	((#:configure-flags flags)
	120	`(append (list ,(string-append "--target=" target)
	121	,@(if libc
8fd857f5	122	`( ;; Disable libcilkrts because it is not
3009a9e4	123	;; ported to GNU/Hurd.
8fd857f5	124	"--disable-libcilkrts")
2a1552c6 LC	125	`( ;; Disable features not needed at this stage.
2a1552c6 LC	126	"--disable-shared" "--enable-static"
ca7ef4d4	127	"--enable-languages=c,c++"
cdb4b4b3	128
ca7ef4d4 RW	129	;; libstdc++ cannot be built at this stage
	130	;; ("Link tests are not allowed after
	131	;; GCC_NO_EXECUTABLES.").
	132	"--disable-libstdc++-v3"
cdb4b4b3	133
2a1552c6 LC	134	"--disable-threads" ;libgcc, would need libc
	135	"--disable-libatomic"
	136	"--disable-libmudflap"
	137	"--disable-libgomp"
	138	"--disable-libssp"
	139	"--disable-libquadmath"
	140	"--disable-decimal-float" ;would need libc
8fd857f5	141	"--disable-libcilkrts"
9a745d76 MR	142
	143	;; When target is any OS other than 'none' these
	144	;; libraries will fail if there is no libc
	145	;; present. See
	146	;; <https://lists.gnu.org/archive/html/guix-devel/2016-02/msg01311.html>
	147	"--disable-libitm"
	148	"--disable-libvtv"
	149	"--disable-libsanitizer"
cba36e64 JN	150	))
	151
	152	;; For a newlib (non-glibc) target
	153	,@(if (cross-newlib? target)
	154	'("--with-newlib")
	155	'()))
cdb4b4b3	156
2a1552c6 LC	157	,(if libc
	158	flags
	159	`(remove (cut string-match "--enable-languages.*" <>)
	160	,flags))))
	161	((#:make-flags flags)
	162	(if libc
	163	`(let ((libc (assoc-ref %build-inputs "libc")))
	164	;; FLAGS_FOR_TARGET are needed for the target libraries to receive
	165	;; the -Bxxx for the startfiles.
	166	(cons (string-append "FLAGS_FOR_TARGET=-B" libc "/lib")
	167	,flags))
	168	flags))
	169	((#:phases phases)
3593e5d5	170	`(cross-gcc-build-phases ,target ,phases))))))
cdb4b4b3	171
1306b0b0 LC	172	(define (cross-gcc-patches target)
	173	"Return GCC patches needed for TARGET."
	174	(cond ((string-prefix? "xtensa-" target)
	175	;; Patch by Qualcomm needed to build the ath9k-htc firmware.
fc1adab1	176	(search-patches "ath9k-htc-firmware-gcc.patch"))
cba36e64 JN	177	((target-mingw? target)
cba36e64 JN	178	(search-patches "gcc-4.9.3-mingw-gthr-default.patch"))
1306b0b0 LC	179	(else '())))
1306b0b0 LC	180
cba36e64 JN	181	(define (cross-gcc-snippet target)
	182	"Return GCC snippet needed for TARGET."
	183	(cond ((target-mingw? target)
	184	'(copy-recursively "libstdc++-v3/config/os/mingw32-w64"
	185	"libstdc++-v3/config/os/newlib"))
	186	(else #f)))
	187
827d2891	188	(define* (cross-gcc target
7b3318e3 RW	189	#:key
	190	(xgcc %xgcc)
	191	(xbinutils (cross-binutils target))
	192	(libc #f))
827d2891	193	"Return a cross-compiler for TARGET, where TARGET is a GNU triplet. Use
7b3318e3 RW	194	XGCC as the base compiler. Use XBINUTILS as the associated cross-Binutils.
	195	If LIBC is false, then build a GCC that does not target a libc; otherwise,
	196	target that libc."
	197	(package (inherit xgcc)
827d2891 LC	198	(name (string-append "gcc-cross-"
	199	(if libc "" "sans-libc-")
	200	target))
7b3318e3	201	(source (origin (inherit (package-source xgcc))
01eafd38	202	(patches
1421afa9	203	(append
7b3318e3	204	(origin-patches (package-source xgcc))
e32d3024 DM	205	(cons (if (version>=? (package-version xgcc) "6.0")
	206	(search-patch "gcc-6-cross-environment-variables.patch")
	207	(search-patch "gcc-cross-environment-variables.patch"))
cba36e64 JN	208	(cross-gcc-patches target))))
	209	(modules '((guix build utils)))
	210	(snippet
	211	(cross-gcc-snippet target))))
a49c57a7 LC	212
	213	;; For simplicity, use a single output. Otherwise libgcc_s & co. are not
	214	;; found by default, etc.
	215	(outputs '("out"))
	216
827d2891 LC	217	(arguments
827d2891 LC	218	`(#:implicit-inputs? #f
3593e5d5 LC	219	#:imported-modules ((gnu build cross-toolchain)
3593e5d5 LC	220	,@%gnu-build-system-modules)
827d2891 LC	221	#:modules ((guix build gnu-build-system)
827d2891 LC	222	(guix build utils)
3593e5d5	223	(gnu build cross-toolchain)
827d2891	224	(srfi srfi-1)
3593e5d5 LC	225	(srfi srfi-26)
3593e5d5 LC	226	(ice-9 regex))
827d2891	227
7b3318e3	228	,@(cross-gcc-arguments target xgcc libc)))
0de71c23 LC	229
0de71c23 LC	230	(native-inputs
4a740d0f LC	231	`(("ld-wrapper-cross" ,(make-ld-wrapper
4a740d0f LC	232	(string-append "ld-wrapper-" target)
5bde4503	233	#:target (const target)
4a740d0f LC	234	#:binutils xbinutils))
4a740d0f LC	235	("binutils-cross" ,xbinutils)
827d2891 LC	236
	237	;; Call it differently so that the builder can check whether the "libc"
	238	;; input is #f.
fb77c614	239	("libc-native" ,@(assoc-ref (%final-inputs) "libc"))
827d2891 LC	240
827d2891 LC	241	;; Remaining inputs.
7b3318e3	242	,@(let ((inputs (append (package-inputs xgcc)
fb77c614	243	(alist-delete "libc" (%final-inputs)))))
cba36e64 JN	244	(cond
	245	((target-mingw? target)
	246	(if libc
	247	`(("libc" ,mingw-w64)
	248	,@inputs)
	249	`(("mingw-source" ,(package-source mingw-w64))
	250	,@inputs)))
	251	(libc
	252	`(("libc" ,libc)
6dff905e	253	("libc:static" ,libc "static")
cba36e64 JN	254	("xkernel-headers" ;the target headers
	255	,@(assoc-ref (package-propagated-inputs libc)
	256	"kernel-headers"))
	257	,@inputs))
	258	(else inputs)))))
17bb886f	259
0de71c23 LC	260	(inputs '())
0de71c23 LC	261
17bb886f	262	;; Only search target inputs, not host inputs.
cba36e64 JN	263	(search-paths (cons (search-path-specification
	264	(variable "CROSS_LIBRARY_PATH")
	265	(files '("lib" "lib64")))
	266	(map (lambda (variable)
	267	(search-path-specification
	268	(variable variable)
	269	(files '("include"))))
	270	%gcc-cross-include-paths)))
17bb886f	271	(native-search-paths '())))
827d2891	272
2d558e31 MR	273	(define* (cross-kernel-headers target
	274	#:optional
	275	(xgcc (cross-gcc target))
	276	(xbinutils (cross-binutils target)))
	277	"Return headers depending on TARGET."
	278
827d2891 LC	279	(define xlinux-headers
	280	(package (inherit linux-libre-headers)
	281	(name (string-append (package-name linux-libre-headers)
	282	"-cross-" target))
	283	(arguments
0d5a559f LC	284	(substitute-keyword-arguments
	285	`(#:implicit-cross-inputs? #f
	286	,@(package-arguments linux-libre-headers))
827d2891 LC	287	((#:phases phases)
	288	`(alist-replace
	289	'build
	290	(lambda _
	291	(setenv "ARCH" ,(system->linux-architecture target))
	292	(format #t "`ARCH' set to `~a' (cross compiling)~%" (getenv "ARCH"))
	293
440a3143	294	(and (zero? (system* "make" ,(system->defconfig target)))
827d2891 LC	295	(zero? (system* "make" "mrproper" "headers_check"))))
827d2891 LC	296	,phases))))
0de71c23 LC	297	(native-inputs `(("cross-gcc" ,xgcc)
	298	("cross-binutils" ,xbinutils)
	299	,@(package-native-inputs linux-libre-headers)))))
827d2891	300
2d558e31 MR	301	(define xgnumach-headers
	302	(package (inherit gnumach-headers)
	303	(name (string-append (package-name gnumach-headers)
	304	"-cross-" target))
	305
	306	(native-inputs `(("cross-gcc" ,xgcc)
	307	("cross-binutils" ,xbinutils)
	308	,@(package-native-inputs gnumach-headers)))))
	309
	310	(define xmig
	311	(package (inherit mig)
	312	(name (string-append "mig-cross"))
	313	(arguments
	314	`(#:modules ((guix build gnu-build-system)
	315	(guix build utils)
	316	(srfi srfi-26))
	317	#:phases (alist-cons-before
	318	'configure 'set-cross-headers-path
	319	(lambda* (#:key inputs #:allow-other-keys)
	320	(let* ((mach (assoc-ref inputs "cross-gnumach-headers"))
	321	(cpath (string-append mach "/include")))
	322	(for-each (cut setenv <> cpath)
3009a9e4	323	',%gcc-cross-include-paths)))
2d558e31 MR	324	%standard-phases)
	325	#:configure-flags (list ,(string-append "--target=" target))
	326	,@(package-arguments mig)))
	327
	328	(propagated-inputs `(("cross-gnumach-headers" ,xgnumach-headers)))
	329	(native-inputs `(("cross-gcc" ,xgcc)
	330	("cross-binutils" ,xbinutils)
	331	,@(package-native-inputs mig)))))
	332
	333	(define xhurd-headers
	334	(package (inherit hurd-headers)
	335	(name (string-append (package-name hurd-headers)
	336	"-cross-" target))
	337
2d558e31 MR	338	(native-inputs `(("cross-gcc" ,xgcc)
	339	("cross-binutils" ,xbinutils)
	340	("cross-mig" ,xmig)
	341	,@(alist-delete "mig"(package-native-inputs hurd-headers))))))
	342
	343	(define xglibc/hurd-headers
	344	(package (inherit glibc/hurd-headers)
	345	(name (string-append (package-name glibc/hurd-headers)
	346	"-cross-" target))
	347
	348	(arguments
	349	(substitute-keyword-arguments
	350	`(#:modules ((guix build gnu-build-system)
	351	(guix build utils)
	352	(srfi srfi-26))
	353	,@(package-arguments glibc/hurd-headers))
	354	((#:phases phases)
	355	`(alist-cons-before
	356	'pre-configure 'set-cross-headers-path
	357	(lambda* (#:key inputs #:allow-other-keys)
	358	(let* ((mach (assoc-ref inputs "gnumach-headers"))
	359	(hurd (assoc-ref inputs "hurd-headers"))
	360	(cpath (string-append mach "/include:"
	361	hurd "/include")))
	362	(for-each (cut setenv <> cpath)
3009a9e4	363	',%gcc-cross-include-paths)))
2d558e31 MR	364	,phases))))
	365
	366	(propagated-inputs `(("gnumach-headers" ,xgnumach-headers)
	367	("hurd-headers" ,xhurd-headers)))
	368
	369	(native-inputs `(("cross-gcc" ,xgcc)
	370	("cross-binutils" ,xbinutils)
	371	("cross-mig" ,xmig)
	372	,@(alist-delete "mig"(package-native-inputs glibc/hurd-headers))))))
	373
	374	(define xhurd-minimal
	375	(package (inherit hurd-minimal)
	376	(name (string-append (package-name hurd-minimal)
	377	"-cross-" target))
	378	(arguments
	379	(substitute-keyword-arguments
	380	`(#:modules ((guix build gnu-build-system)
	381	(guix build utils)
	382	(srfi srfi-26))
	383	,@(package-arguments hurd-minimal))
	384	((#:phases phases)
	385	`(alist-cons-before
	386	'configure 'set-cross-headers-path
	387	(lambda* (#:key inputs #:allow-other-keys)
	388	(let* ((glibc-headers (assoc-ref inputs "cross-glibc-hurd-headers"))
	389	(cpath (string-append glibc-headers "/include")))
	390	(for-each (cut setenv <> cpath)
3009a9e4	391	',%gcc-cross-include-paths)))
2d558e31 MR	392	,phases))))
	393
	394	(inputs `(("cross-glibc-hurd-headers" ,xglibc/hurd-headers)))
	395
	396	(native-inputs `(("cross-gcc" ,xgcc)
	397	("cross-binutils" ,xbinutils)
	398	("cross-mig" ,xmig)
	399	,@(alist-delete "mig"(package-native-inputs hurd-minimal))))))
	400
	401	(define xhurd-core-headers
	402	(package (inherit hurd-core-headers)
	403	(name (string-append (package-name hurd-core-headers)
	404	"-cross-" target))
	405
	406	(inputs `(("gnumach-headers" ,xgnumach-headers)
	407	("hurd-headers" ,xhurd-headers)
	408	("hurd-minimal" ,xhurd-minimal)))
	409
	410	(native-inputs `(("cross-gcc" ,xgcc)
	411	("cross-binutils" ,xbinutils)
	412	("cross-mig" ,xmig)
	413	,@(package-native-inputs hurd-core-headers)))))
	414
	415	(match target
	416	((or "i586-pc-gnu" "i586-gnu") xhurd-core-headers)
	417	(_ xlinux-headers)))
	418
	419	(define* (cross-libc target
	420	#:optional
	421	(xgcc (cross-gcc target))
	422	(xbinutils (cross-binutils target))
	423	(xheaders (cross-kernel-headers target)))
	424	"Return a libc cross-built for TARGET, a GNU triplet. Use XGCC and
	425	XBINUTILS and the cross tool chain."
	426	(define (cross-libc-for-target target)
	427	"Return libc depending on TARGET."
	428	(match target
	429	((or "i586-pc-gnu" "i586-gnu") glibc/hurd)
	430	(_ glibc/linux)))
	431
d76181a7	432	;; Use (cross-libc-for-target ...) to determine the correct libc to use.
0158ca7f	433
cba36e64 JN	434	(if (cross-newlib? target)
	435	(native-libc target)
	436	(let ((libc (cross-libc-for-target target)))
	437	(package (inherit libc)
	438	(name (string-append "glibc-cross-" target))
	439	(arguments
	440	(substitute-keyword-arguments
	441	`(;; Disable stripping (see above.)
	442	#:strip-binaries? #f
	443
	444	;; This package is used as a target input, but it should not have
	445	;; the usual cross-compilation inputs since that would include
	446	;; itself.
	447	#:implicit-cross-inputs? #f
	448
	449	;; We need SRFI 26.
	450	#:modules ((guix build gnu-build-system)
	451	(guix build utils)
	452	(srfi srfi-26))
	453
	454	,@(package-arguments libc))
	455	((#:configure-flags flags)
	456	`(cons ,(string-append "--host=" target)
	457	,flags))
	458	((#:phases phases)
	459	`(alist-cons-before
	460	'configure 'set-cross-kernel-headers-path
	461	(lambda* (#:key inputs #:allow-other-keys)
	462	(let* ((kernel (assoc-ref inputs "kernel-headers"))
	463	(cpath (string-append kernel "/include")))
	464	(for-each (cut setenv <> cpath)
3009a9e4	465	',%gcc-cross-include-paths)
cba36e64 JN	466	(setenv "CROSS_LIBRARY_PATH"
	467	(string-append kernel "/lib")) ;for Hurd's libihash
	468	#t))
	469	,phases))))
	470
	471	;; Shadow the native "kernel-headers" because glibc's recipe expects the
	472	;; "kernel-headers" input to point to the right thing.
	473	(propagated-inputs `(("kernel-headers" ,xheaders)))
	474
	475	;; FIXME: 'static-bash' should really be an input, not a native input, but
	476	;; to do that will require building an intermediate cross libc.
	477	(inputs '())
	478
	479	(native-inputs `(("cross-gcc" ,xgcc)
	480	("cross-binutils" ,xbinutils)
62596a15	481	,@(if (hurd-triplet? target)
cba36e64 JN	482	`(("cross-mig"
	483	,@(assoc-ref (package-native-inputs xheaders)
	484	"cross-mig")))
	485	'())
	486	,@(package-inputs libc) ;FIXME: static-bash
	487	,@(package-native-inputs libc)))))))
	488
	489	(define (native-libc target)
	490	(if (target-mingw? target)
	491	mingw-w64
	492	glibc))
	493
	494	(define (cross-newlib? target)
	495	(not (eq? (native-libc target) glibc)))
827d2891 LC	496
827d2891 LC	497	\f
bd2e1a8c LC	498	;;; Concrete cross tool chains are instantiated like this:
	499	;;
	500	;; (define-public xgcc-armhf
	501	;; (let ((triplet "arm-linux-gnueabihf"))
827d2891	502	;; (cross-gcc triplet
e0775d2a MW	503	;; #:xbinutils (cross-binutils triplet)
e0775d2a MW	504	;; #:libc (cross-libc triplet))))
bd2e1a8c LC	505	;;
	506	;;; We don't do that here because we'd be referring to bindings from (gnu
	507	;;; packages gcc) from the top level, which doesn't play well with circular
	508	;;; dependencies among modules.