gnu/packages/cross-base.scm

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