gnu/build/cross-toolchain.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2020 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 © 2019 Marius Bakke <mbakke@fastmail.com>
   7 ;;; Copyright © 2019 Carl Dong <contact@carldong.me>
   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 build cross-toolchain)
  25   #:use-module (guix build utils)
  26   #:use-module (guix build gnu-build-system)
  27   #:use-module (srfi srfi-1)
  28   #:use-module (srfi srfi-26)
  29   #:use-module (ice-9 match)
  30   #:use-module (ice-9 ftw)
  31   #:export (cross-gcc-build-phases))
  32
  33 ;;; Commentary:
  34 ;;;
  35 ;;; This module provides tools to build a cross-compiler.
  36 ;;;
  37 ;;; Code:
  38
  39 (define %gcc-include-paths
  40   ;; Environment variables for header search paths.
  41   ;; Note: See <http://bugs.gnu.org/22186> for why not 'CPATH'.
  42   '("C_INCLUDE_PATH"
  43     "CPLUS_INCLUDE_PATH"
  44     "OBJC_INCLUDE_PATH"
  45     "OBJCPLUS_INCLUDE_PATH"))
  46
  47 (define %gcc-cross-include-paths
  48   ;; Search path for target headers when cross-compiling.
  49   (map (cut string-append "CROSS_" <>) %gcc-include-paths))
  50
  51 (define* (make-cross-binutils-visible #:key outputs inputs target
  52                                       #:allow-other-keys)
  53   "Create symlinks for 'as', 'nm', and 'ld' in the \"out\" output, under
  54 libexec/gcc, so that the cross-GCC can find them."
  55   (let* ((out      (assoc-ref outputs "out"))
  56          (libexec  (string-append out "/libexec/gcc/" target))
  57          (binutils (string-append (assoc-ref inputs "binutils-cross")
  58                                   "/bin/" target "-"))
  59          (wrapper  (string-append (assoc-ref inputs "ld-wrapper-cross")
  60                                   "/bin/" target "-ld")))
  61     (for-each (lambda (file)
  62                 (symlink (string-append binutils file)
  63                          (string-append libexec "/" file)))
  64               '("as" "nm"))
  65     (symlink wrapper (string-append libexec "/ld"))
  66     #t))
  67
  68 (define* (set-cross-path #:key inputs #:allow-other-keys)
  69   "Add the cross kernel headers to CROSS_CPATH, and remove them from
  70 C_INCLUDE_PATH et al."
  71   (match (assoc-ref inputs "libc")
  72     ((? string? libc)
  73      (let ((kernel (assoc-ref inputs "xkernel-headers")))
  74        (define (cross? x)
  75          ;; Return #t if X is a cross-libc or cross Linux.
  76          (or (string-prefix? libc x)
  77              (string-prefix? kernel x)))
  78
  79        (let ((cpath (string-append libc "/include"
  80                                    ":" kernel "/include")))
  81          (for-each (cut setenv <> cpath)
  82                    %gcc-cross-include-paths))
  83
  84        (setenv "CROSS_LIBRARY_PATH"
  85                (string-append libc "/lib:" kernel "/lib")) ;for Hurd's libihash
  86
  87        (for-each (lambda (var)
  88                    (and=> (getenv var)
  89                           (lambda (value)
  90                             (let* ((path (search-path-as-string->list value))
  91                                    (native-path (list->search-path-as-string
  92                                                  (remove cross? path) ":")))
  93                               (setenv var native-path)))))
  94                  (cons "LIBRARY_PATH" %gcc-include-paths))
  95        #t))
  96     (#f
  97      ;; We're building the sans-libc cross-compiler, so nothing to do.
  98      #t)))
  99
 100 (define* (set-cross-path/mingw #:key inputs target #:allow-other-keys)
 101   "Add the cross MinGW headers to CROSS_C_*_INCLUDE_PATH, and remove them from
 102 C_*INCLUDE_PATH."
 103   (let ((libc (assoc-ref inputs "libc"))
 104         (gcc (assoc-ref inputs "gcc")))
 105     (define (cross? x)
 106       (and libc (string-prefix? libc x)))
 107
 108     (define (unpacked-mingw-dir)
 109       (match (scandir "." (lambda (name)
 110                             (string-contains name "mingw-w64")))
 111         ((mingw-dir)
 112          (string-append
 113           (getcwd) "/" mingw-dir "/mingw-w64-headers"))))
 114
 115     (if libc
 116         (let ((cpath (string-append libc "/include"
 117                                     ":" libc "/" target "/include")))
 118           (for-each (cut setenv <> cpath)
 119                     %gcc-cross-include-paths))
 120
 121         ;; libc is false, so we are building xgcc-sans-libc.
 122         ;; Add essential headers from mingw-w64.
 123         (let ((mingw-source (assoc-ref inputs "mingw-source")))
 124           (invoke "tar" "xvf" mingw-source)
 125           (let ((mingw-headers (unpacked-mingw-dir)))
 126             ;; We need _mingw.h which will gets built from _mingw.h.in by
 127             ;; mingw-w64's configure.  We cannot configure mingw-w64 until we
 128             ;; have xgcc-sans-libc; substitute to the rescue.
 129             (copy-file (string-append mingw-headers "/crt/_mingw.h.in")
 130                        (string-append mingw-headers "/crt/_mingw.h"))
 131
 132             (substitute* (string-append mingw-headers "/crt/_mingw.h")
 133               (("@MINGW_HAS_SECURE_API@")
 134                "#define MINGW_HAS_SECURE_API 1")
 135               (("@DEFAULT_WIN32_WINNT@")
 136                "0x502")
 137               (("@DEFAULT_MSVCRT_VERSION@")
 138                "0x700"))
 139
 140             (let ((cpath (string-append mingw-headers "/include"
 141                                         ":" mingw-headers "/crt"
 142                                         ":" mingw-headers
 143                                         "/defaults/include")))
 144               (for-each (cut setenv <> cpath)
 145                         (cons "CROSS_LIBRARY_PATH"
 146                               %gcc-cross-include-paths))))))
 147
 148     (when libc
 149       (setenv "CROSS_LIBRARY_PATH"
 150               (string-append libc "/lib"
 151                              ":" libc "/" target "/lib")))
 152
 153     (setenv "CPP" (string-append gcc "/bin/cpp"))
 154     (for-each (lambda (var)
 155                 (and=> (getenv var)
 156                        (lambda (value)
 157                          (let* ((path (search-path-as-string->list
 158                                        value))
 159                                 (native-path (list->search-path-as-string
 160                                               (remove cross? path) ":")))
 161                            (setenv var native-path)))))
 162               (cons "LIBRARY_PATH" %gcc-include-paths))
 163     #t))
 164
 165 (define (install-strip . _)
 166   "Install a stripped GCC."
 167   ;; Unlike our 'strip' phase, this will do the right thing for
 168   ;; cross-compilers.
 169   (invoke "make" "install-strip"))
 170
 171 (define* (cross-gcc-build-phases target
 172                                  #:optional (phases %standard-phases))
 173   "Modify PHASES to include everything needed to build a cross-GCC for TARGET,
 174 a target triplet."
 175   (modify-phases phases
 176     (add-before 'configure 'set-cross-path
 177       ;; This mingw32 target checking logic should match that of target-mingw?
 178       ;; in (guix utils), but (guix utils) is too large too copy over to the
 179       ;; build side entirely and for now we have no way to select variables to
 180       ;; copy over. See (gnu packages cross-base) for more details.
 181       (if (string-suffix? "-mingw32" target)
 182           (cut set-cross-path/mingw #:target target <...>)
 183           set-cross-path))
 184     (add-after 'install 'make-cross-binutils-visible
 185       (cut make-cross-binutils-visible #:target target <...>))
 186     (replace 'install install-strip)))
 187
 188 ;;; cross-toolchain.scm ends here