gnu/packages/cross-base.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org>
   4 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
   5 ;;; Copyright © 2016 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
   6 ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
   7 ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
   8 ;;;
   9 ;;; This file is part of GNU Guix.
  10 ;;;
  11 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  12 ;;; under the terms of the GNU General Public License as published by
  13 ;;; the Free Software Foundation; either version 3 of the License, or (at
  14 ;;; your option) any later version.
  15 ;;;
  16 ;;; GNU Guix is distributed in the hope that it will be useful, but
  17 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;;; GNU General Public License for more details.
  20 ;;;
  21 ;;; You should have received a copy of the GNU General Public License
  22 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 (define-module (gnu packages cross-base)
  25   #:use-module (gnu packages)
  26   #:use-module (gnu packages gcc)
  27   #:use-module (gnu packages base)
  28   #:use-module (gnu packages linux)
  29   #:use-module (gnu packages hurd)
  30   #:use-module (gnu packages mingw)
  31   #:use-module (guix packages)
  32   #:use-module (guix download)
  33   #:use-module (guix utils)
  34   #:use-module (guix build-system gnu)
  35   #:use-module (guix build-system trivial)
  36   #:use-module (srfi srfi-1)
  37   #:use-module (srfi srfi-26)
  38   #:use-module (ice-9 match)
  39   #:use-module (ice-9 regex)
  40   #:export (cross-binutils
  41             cross-libc
  42             cross-gcc
  43             cross-newlib?
  44             cross-kernel-headers))
  45
  46 (define-syntax %xgcc
  47   ;; GCC package used as the basis for cross-compilation.  It doesn't have to
  48   ;; be 'gcc' and can be a specific variant such as 'gcc-4.8'.
  49   ;;
  50   ;; Note: This is a macro so that we do not refer to 'gcc' from the top
  51   ;; level, which would lead to circular-dependency issues.
  52   (identifier-syntax gcc))
  53
  54 (define %gcc-include-paths
  55   ;; Environment variables for header search paths.
  56   ;; Note: See <http://bugs.gnu.org/30756> for why not 'C_INCLUDE_PATH' & co.
  57   '("CPATH"))
  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
  63 (define (cross p target)
  64   (package (inherit p)
  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
  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
  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.
  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)))))))
  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)))
 105
 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.)"
 109   ;; Set the current target system so that 'glibc-dynamic-linker' returns the
 110   ;; right name.
 111   (parameterize ((%current-target-system target))
 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
 117                   ,@(package-arguments xgcc))))
 118      (substitute-keyword-arguments args
 119        ((#:configure-flags flags)
 120         `(append (list ,(string-append "--target=" target)
 121                        ,@(if libc
 122                              `( ;; Disable libcilkrts because it is not
 123                                 ;; ported to GNU/Hurd.
 124                                "--disable-libcilkrts"
 125                                ;; When building a cross compiler, --with-sysroot is
 126                                ;; implicitly set to "$gcc_tooldir/sys-root".  This does
 127                                ;; not work for us, because --with-native-system-header-dir
 128                                ;; is searched for relative to this location.  Thus, we set
 129                                ;; it to "/" so GCC is able to find the target libc headers.
 130                                ;; This is safe because in practice GCC uses CROSS_CPATH
 131                                ;; & co to separate target and host libraries.
 132                                "--with-sysroot=/")
 133                              `( ;; Disable features not needed at this stage.
 134                                "--disable-shared" "--enable-static"
 135                                "--enable-languages=c,c++"
 136
 137                                ;; libstdc++ cannot be built at this stage
 138                                ;; ("Link tests are not allowed after
 139                                ;; GCC_NO_EXECUTABLES.").
 140                                "--disable-libstdc++-v3"
 141
 142                                "--disable-threads" ;libgcc, would need libc
 143                                "--disable-libatomic"
 144                                "--disable-libmudflap"
 145                                "--disable-libgomp"
 146                                "--disable-libssp"
 147                                "--disable-libquadmath"
 148                                "--disable-decimal-float" ;would need libc
 149                                "--disable-libcilkrts"
 150
 151                                ;; When target is any OS other than 'none' these
 152                                ;; libraries will fail if there is no libc
 153                                ;; present. See
 154                                ;; <https://lists.gnu.org/archive/html/guix-devel/2016-02/msg01311.html>
 155                                "--disable-libitm"
 156                                "--disable-libvtv"
 157                                "--disable-libsanitizer"
 158                                 ))
 159
 160                        ;; For a newlib (non-glibc) target
 161                        ,@(if (cross-newlib? target)
 162                              '("--with-newlib")
 163                              '()))
 164
 165                  ,(if libc
 166                       flags
 167                       `(remove (cut string-match "--enable-languages.*" <>)
 168                                ,flags))))
 169        ((#:make-flags flags)
 170         (if libc
 171             `(let ((libc (assoc-ref %build-inputs "libc")))
 172                ;; FLAGS_FOR_TARGET are needed for the target libraries to receive
 173                ;; the -Bxxx for the startfiles.
 174                (cons (string-append "FLAGS_FOR_TARGET=-B" libc "/lib")
 175                      ,flags))
 176             flags))
 177        ((#:phases phases)
 178         `(cross-gcc-build-phases
 179           ,target
 180           (modify-phases ,phases
 181             (add-before 'configure 'treat-glibc-as-system-header
 182               (lambda* (#:key inputs #:allow-other-keys)
 183                 (let ((libc (assoc-ref inputs "libc")))
 184                   (when libc
 185                     ;; For GCC6 and later, make sure Glibc is treated as a "system
 186                     ;; header" such that #include_next does the right thing.
 187                     (for-each (lambda (var)
 188                                 (setenv var (string-append libc "/include")))
 189                               '("CROSS_C_INCLUDE_PATH" "CROSS_CPLUS_INCLUDE_PATH")))
 190                   #t))))))))))
 191
 192 (define (cross-gcc-patches target)
 193   "Return GCC patches needed for TARGET."
 194   (cond ((string-prefix? "xtensa-" target)
 195          ;; Patch by Qualcomm needed to build the ath9k-htc firmware.
 196          (search-patches "ath9k-htc-firmware-gcc.patch"))
 197         ((target-mingw? target)
 198          (search-patches "gcc-4.9.3-mingw-gthr-default.patch"))
 199         (else '())))
 200
 201 (define (cross-gcc-snippet target)
 202   "Return GCC snippet needed for TARGET."
 203   (cond ((target-mingw? target)
 204          '(begin
 205             (copy-recursively "libstdc++-v3/config/os/mingw32-w64"
 206                               "libstdc++-v3/config/os/newlib")
 207             #t))
 208         (else #f)))
 209
 210 (define* (cross-gcc target
 211                     #:key
 212                     (xgcc %xgcc)
 213                     (xbinutils (cross-binutils target))
 214                     (libc #f))
 215   "Return a cross-compiler for TARGET, where TARGET is a GNU triplet.  Use
 216 XGCC as the base compiler.  Use XBINUTILS as the associated cross-Binutils.
 217 If LIBC is false, then build a GCC that does not target a libc; otherwise,
 218 target that libc."
 219   (package (inherit xgcc)
 220     (name (string-append "gcc-cross-"
 221                          (if libc "" "sans-libc-")
 222                          target))
 223     (source (origin (inherit (package-source xgcc))
 224               (patches
 225                (append
 226                 (origin-patches (package-source xgcc))
 227                 (cons (cond
 228                        ((version>=? (package-version xgcc) "8.0") (search-patch "gcc-8-cross-environment-variables.patch"))
 229                        ((version>=? (package-version xgcc) "6.0") (search-patch "gcc-6-cross-environment-variables.patch"))
 230                        (else  (search-patch "gcc-cross-environment-variables.patch")))
 231                       (cross-gcc-patches target))))
 232               (modules '((guix build utils)))
 233               (snippet
 234                (cross-gcc-snippet target))))
 235
 236     ;; For simplicity, use a single output.  Otherwise libgcc_s & co. are not
 237     ;; found by default, etc.
 238     (outputs '("out"))
 239
 240     (arguments
 241      `(#:implicit-inputs? #f
 242        #:imported-modules ((gnu build cross-toolchain)
 243                            ,@%gnu-build-system-modules)
 244        #:modules ((guix build gnu-build-system)
 245                   (guix build utils)
 246                   (gnu build cross-toolchain)
 247                   (srfi srfi-1)
 248                   (srfi srfi-26)
 249                   (ice-9 regex))
 250
 251        ,@(cross-gcc-arguments target xgcc 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            (cond
 268             ((target-mingw? target)
 269              (if libc
 270                  `(("libc" ,mingw-w64)
 271                    ,@inputs)
 272                  `(("mingw-source" ,(package-source mingw-w64))
 273                    ,@inputs)))
 274             (libc
 275              `(("libc" ,libc)
 276                ("libc:static" ,libc "static")
 277                ("xkernel-headers"                ;the target headers
 278                 ,@(assoc-ref (package-propagated-inputs libc)
 279                              "kernel-headers"))
 280                ,@inputs))
 281             (else inputs)))))
 282
 283     (inputs '())
 284
 285     ;; Only search target inputs, not host inputs.
 286     (search-paths (cons (search-path-specification
 287                          (variable "CROSS_LIBRARY_PATH")
 288                          (files '("lib" "lib64")))
 289                         (map (lambda (variable)
 290                                (search-path-specification
 291                                 (variable variable)
 292                                 (files '("include"))))
 293                              %gcc-cross-include-paths)))
 294     (native-search-paths '())))
 295
 296 (define* (cross-kernel-headers target
 297                                #:optional
 298                                (linux-headers linux-libre-headers)
 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-headers)
 305       (name (string-append (package-name linux-headers)
 306                            "-cross-" target))
 307       (arguments
 308        (substitute-keyword-arguments
 309            `(#:implicit-cross-inputs? #f
 310              ,@(package-arguments linux-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               (invoke "make" ,(system->defconfig target))
 319               (invoke "make" "mrproper" "headers_check"))
 320             ,phases))))
 321       (native-inputs `(("cross-gcc" ,xgcc)
 322                        ("cross-binutils" ,xbinutils)
 323                        ,@(package-native-inputs linux-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 (modify-phases %standard-phases
 342                     (add-before '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                                     ',%gcc-cross-include-paths)
 348                           #t))))
 349          #:configure-flags (list ,(string-append "--target=" target))
 350          ,@(package-arguments mig)))
 351
 352       (propagated-inputs `(("cross-gnumach-headers" ,xgnumach-headers)))
 353       (native-inputs `(("cross-gcc" ,xgcc)
 354                        ("cross-binutils" ,xbinutils)
 355                        ,@(package-native-inputs mig)))))
 356
 357   (define xhurd-headers
 358     (package (inherit hurd-headers)
 359       (name (string-append (package-name hurd-headers)
 360                            "-cross-" target))
 361
 362       (native-inputs `(("cross-gcc" ,xgcc)
 363                        ("cross-binutils" ,xbinutils)
 364                        ("cross-mig" ,xmig)
 365                        ,@(alist-delete "mig"(package-native-inputs hurd-headers))))))
 366
 367    (define xglibc/hurd-headers
 368     (package (inherit glibc/hurd-headers)
 369       (name (string-append (package-name glibc/hurd-headers)
 370                            "-cross-" target))
 371
 372       (arguments
 373        (substitute-keyword-arguments
 374            `(#:modules ((guix build gnu-build-system)
 375                         (guix build utils)
 376                         (srfi srfi-26))
 377              ,@(package-arguments glibc/hurd-headers))
 378          ((#:phases phases)
 379           `(modify-phases ,phases
 380              (add-after 'unpack 'set-cross-headers-path
 381                (lambda* (#:key inputs #:allow-other-keys)
 382                  (let* ((mach (assoc-ref inputs "gnumach-headers"))
 383                         (hurd (assoc-ref inputs "hurd-headers"))
 384                         (cpath (string-append mach "/include:"
 385                                               hurd "/include")))
 386                    (for-each (cut setenv <> cpath)
 387                              ',%gcc-cross-include-paths)
 388                    #t)))))))
 389
 390       (propagated-inputs `(("gnumach-headers" ,xgnumach-headers)
 391                            ("hurd-headers" ,xhurd-headers)))
 392
 393       (native-inputs `(("cross-gcc" ,xgcc)
 394                        ("cross-binutils" ,xbinutils)
 395                        ("cross-mig" ,xmig)
 396                        ,@(alist-delete "mig"(package-native-inputs glibc/hurd-headers))))))
 397
 398   (define xhurd-minimal
 399     (package (inherit hurd-minimal)
 400       (name (string-append (package-name hurd-minimal)
 401                            "-cross-" target))
 402       (arguments
 403        (substitute-keyword-arguments
 404          `(#:modules ((guix build gnu-build-system)
 405                       (guix build utils)
 406                       (srfi srfi-26))
 407            ,@(package-arguments hurd-minimal))
 408          ((#:phases phases)
 409           `(modify-phases ,phases
 410              (add-before 'configure 'set-cross-headers-path
 411                (lambda* (#:key inputs #:allow-other-keys)
 412                  (let* ((glibc-headers (assoc-ref inputs "cross-glibc-hurd-headers"))
 413                         (cpath (string-append glibc-headers "/include")))
 414                    (for-each (cut setenv <> cpath)
 415                              ',%gcc-cross-include-paths)
 416                    #t)))))))
 417
 418       (inputs `(("cross-glibc-hurd-headers" ,xglibc/hurd-headers)))
 419
 420       (native-inputs `(("cross-gcc" ,xgcc)
 421                        ("cross-binutils" ,xbinutils)
 422                        ("cross-mig" ,xmig)
 423                        ,@(alist-delete "mig"(package-native-inputs hurd-minimal))))))
 424
 425   (define xhurd-core-headers
 426     (package (inherit hurd-core-headers)
 427       (name (string-append (package-name hurd-core-headers)
 428                            "-cross-" target))
 429
 430       (inputs `(("gnumach-headers" ,xgnumach-headers)
 431                 ("hurd-headers" ,xhurd-headers)
 432                 ("hurd-minimal" ,xhurd-minimal)))
 433
 434       (native-inputs `(("cross-gcc" ,xgcc)
 435                        ("cross-binutils" ,xbinutils)
 436                        ("cross-mig" ,xmig)
 437                        ,@(package-native-inputs hurd-core-headers)))))
 438
 439   (match target
 440     ((or "i586-pc-gnu" "i586-gnu") xhurd-core-headers)
 441     (_ xlinux-headers)))
 442
 443 (define* (cross-libc target
 444                      #:optional
 445                      (libc glibc)
 446                      (xgcc (cross-gcc target))
 447                      (xbinutils (cross-binutils target))
 448                      (xheaders (cross-kernel-headers target)))
 449   "Return LIBC cross-built for TARGET, a GNU triplet. Use XGCC and XBINUTILS
 450 and the cross tool chain."
 451   (if (cross-newlib? target libc)
 452       (native-libc target libc)
 453       (let ((libc libc))
 454         (package (inherit libc)
 455           (name (string-append "glibc-cross-" target))
 456           (arguments
 457            (substitute-keyword-arguments
 458                `(;; Disable stripping (see above.)
 459                  #:strip-binaries? #f
 460
 461                  ;; This package is used as a target input, but it should not have
 462                  ;; the usual cross-compilation inputs since that would include
 463                  ;; itself.
 464                  #:implicit-cross-inputs? #f
 465
 466                  ;; We need SRFI 26.
 467                  #:modules ((guix build gnu-build-system)
 468                             (guix build utils)
 469                             (srfi srfi-26))
 470
 471                  ,@(package-arguments libc))
 472              ((#:configure-flags flags)
 473               `(cons ,(string-append "--host=" target)
 474                      ,(if (hurd-triplet? target)
 475                           `(cons "--disable-werror" ,flags)
 476                           flags)))
 477              ((#:phases phases)
 478               `(modify-phases ,phases
 479                  (add-before 'configure 'set-cross-kernel-headers-path
 480                    (lambda* (#:key inputs #:allow-other-keys)
 481                      (let* ((kernel (assoc-ref inputs "kernel-headers"))
 482                             (cpath (string-append kernel "/include")))
 483                        (for-each (cut setenv <> cpath)
 484                                  ',%gcc-cross-include-paths)
 485                        (setenv "CROSS_LIBRARY_PATH"
 486                                (string-append kernel "/lib")) ; for Hurd's libihash
 487                        #t)))))))
 488
 489           ;; Shadow the native "kernel-headers" because glibc's recipe expects the
 490           ;; "kernel-headers" input to point to the right thing.
 491           (propagated-inputs `(("kernel-headers" ,xheaders)))
 492
 493           ;; FIXME: 'static-bash' should really be an input, not a native input, but
 494           ;; to do that will require building an intermediate cross libc.
 495           (inputs '())
 496
 497           (native-inputs `(("cross-gcc" ,xgcc)
 498                            ("cross-binutils" ,xbinutils)
 499                            ,@(if (hurd-triplet? target)
 500                                  `(("cross-mig"
 501                                     ,@(assoc-ref (package-native-inputs xheaders)
 502                                                  "cross-mig")))
 503                                  '())
 504                            ,@(package-inputs libc)     ;FIXME: static-bash
 505                            ,@(package-native-inputs libc)))))))
 506
 507 (define* (native-libc target
 508                      #:optional
 509                      (libc glibc))
 510   (if (target-mingw? target)
 511       mingw-w64
 512       libc))
 513
 514 (define* (cross-newlib? target
 515                        #:optional
 516                        (libc glibc))
 517   (not (eq? (native-libc target libc) libc)))
 518
 519 \f
 520 ;;; Concrete cross tool chains are instantiated like this:
 521 ;;
 522 ;; (define-public xgcc-armhf
 523 ;;   (let ((triplet "arm-linux-gnueabihf"))
 524 ;;     (cross-gcc triplet
 525 ;;                #:xbinutils (cross-binutils triplet)
 526 ;;                #:libc (cross-libc triplet))))
 527 ;;
 528 ;;; We don't do that here because we'd be referring to bindings from (gnu
 529 ;;; packages gcc) from the top level, which doesn't play well with circular
 530 ;;; dependencies among modules.