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