summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-12-07 21:49:25 +0100
committerLudovic Courtès <ludo@gnu.org>2016-12-07 21:52:26 +0100
commit3593e5d5c50b08cf69739aac98cd7c89247fa6da (patch)
tree4b6ef97613890e50ad2a85ca5a7d9d19da6a92d0
parent3009a9e451baf13f9d9fe138e13fe00844355878 (diff)
downloadpatches-3593e5d5c50b08cf69739aac98cd7c89247fa6da.tar
patches-3593e5d5c50b08cf69739aac98cd7c89247fa6da.tar.gz
gnu: cross-base: Move phases to (gnu build cross-toolchain).
* gnu/packages/cross-base.scm (cross-gcc-arguments) <#:phases>: Use 'cross-gcc-build-phases', and move body cross-toolchain.scm. (cross-gcc): Add #:imported-modules. Add (gnu build cross-toolchain) to #:modules. * gnu/build/cross-toolchain.scm: New file, with code from 'cross-gcc-arguments'. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
-rw-r--r--gnu/build/cross-toolchain.scm178
-rw-r--r--gnu/local.mk1
-rw-r--r--gnu/packages/cross-base.scm140
3 files changed, 185 insertions, 134 deletions
diff --git a/gnu/build/cross-toolchain.scm b/gnu/build/cross-toolchain.scm
new file mode 100644
index 0000000000..450443ca63
--- /dev/null
+++ b/gnu/build/cross-toolchain.scm
@@ -0,0 +1,178 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013, 2014, 2015, 2016 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 build cross-toolchain)
+ #:use-module (guix build utils)
+ #:use-module (guix build gnu-build-system)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 ftw)
+ #:export (cross-gcc-build-phases))
+
+;;; Commentary:
+;;;
+;;; This module provides tools to build a cross-compiler.
+;;;
+;;; Code:
+
+(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* (make-cross-binutils-visible #:key outputs inputs target
+ #:allow-other-keys)
+ "Create symlinks for 'as', 'nm', and 'ld' in the \"out\" output, under
+libexec/gcc, so that the cross-GCC can find them."
+ (let* ((out (assoc-ref outputs "out"))
+ (libexec (string-append out "/libexec/gcc/" target))
+ (binutils (string-append (assoc-ref inputs "binutils-cross")
+ "/bin/" target "-"))
+ (wrapper (string-append (assoc-ref inputs "ld-wrapper-cross")
+ "/bin/" target "-ld")))
+ (for-each (lambda (file)
+ (symlink (string-append binutils file)
+ (string-append libexec "/" file)))
+ '("as" "nm"))
+ (symlink wrapper (string-append libexec "/ld"))
+ #t))
+
+(define* (set-cross-path #:key inputs #:allow-other-keys)
+ "Add the cross kernel headers to CROSS_CPATH, and remove them from
+C_INCLUDE_PATH et al."
+ (match (assoc-ref inputs "libc")
+ ((? string? libc)
+ (let ((kernel (assoc-ref inputs "xkernel-headers")))
+ (define (cross? x)
+ ;; Return #t if X is a cross-libc or cross Linux.
+ (or (string-prefix? libc x)
+ (string-prefix? kernel x)))
+
+ (let ((cpath (string-append libc "/include"
+ ":" kernel "/include")))
+ (for-each (cut setenv <> cpath)
+ %gcc-cross-include-paths))
+
+ (setenv "CROSS_LIBRARY_PATH"
+ (string-append libc "/lib:" kernel "/lib")) ;for Hurd's libihash
+
+ (for-each (lambda (var)
+ (and=> (getenv var)
+ (lambda (value)
+ (let* ((path (search-path-as-string->list value))
+ (native-path (list->search-path-as-string
+ (remove cross? path) ":")))
+ (setenv var native-path)))))
+ (cons "LIBRARY_PATH" %gcc-include-paths))
+ #t))
+ (#f
+ ;; We're building the sans-libc cross-compiler, so nothing to do.
+ #t)))
+
+(define* (set-cross-path/mingw #:key inputs #:allow-other-keys)
+ "Add the cross MinGW headers to CROSS_C_*_INCLUDE_PATH, and remove them from
+C_*INCLUDE_PATH."
+ (let ((libc (assoc-ref inputs "libc"))
+ (gcc (assoc-ref inputs "gcc")))
+ (define (cross? x)
+ (and libc (string-prefix? libc x)))
+
+ (define (unpacked-mingw-dir)
+ (match (scandir "." (lambda (name)
+ (string-contains name "mingw-w64")))
+ ((mingw-dir)
+ (string-append
+ (getcwd) "/" mingw-dir "/mingw-w64-headers"))))
+
+ (if libc
+ (let ((cpath (string-append libc "/include"
+ ":" libc "/i686-w64-mingw32/include")))
+ (for-each (cut setenv <> cpath)
+ %gcc-cross-include-paths))
+
+ ;; libc is false, so we are building xgcc-sans-libc.
+ ;; Add essential headers from mingw-w64.
+ (let ((mingw-source (assoc-ref inputs "mingw-source")))
+ (system* "tar" "xvf" mingw-source)
+ (let ((mingw-headers (unpacked-mingw-dir)))
+ ;; We need _mingw.h which will gets built from _mingw.h.in by
+ ;; mingw-w64's configure. We cannot configure mingw-w64 until we
+ ;; have xgcc-sans-libc; substitute to the rescue.
+ (copy-file (string-append mingw-headers "/crt/_mingw.h.in")
+ (string-append mingw-headers "/crt/_mingw.h"))
+
+ (substitute* (string-append mingw-headers "/crt/_mingw.h")
+ (("@MINGW_HAS_SECURE_API@")
+ "#define MINGW_HAS_SECURE_API 1"))
+
+ (let ((cpath (string-append mingw-headers "/include"
+ ":" mingw-headers "/crt"
+ ":" mingw-headers
+ "/defaults/include")))
+ (for-each (cut setenv <> cpath)
+ (cons "CROSS_LIBRARY_PATH"
+ %gcc-cross-include-paths))))))
+
+ (when libc
+ (setenv "CROSS_LIBRARY_PATH"
+ (string-append libc "/lib"
+ ":" libc "/i686-w64-mingw32/lib")))
+
+ (setenv "CPP" (string-append gcc "/bin/cpp"))
+ (for-each (lambda (var)
+ (and=> (getenv var)
+ (lambda (value)
+ (let* ((path (search-path-as-string->list
+ value))
+ (native-path (list->search-path-as-string
+ (remove cross? path) ":")))
+ (setenv var native-path)))))
+ (cons "LIBRARY_PATH" %gcc-include-paths))
+ #t))
+
+(define (install-strip . _)
+ "Install a stripped GCC."
+ ;; Unlike our 'strip' phase, this will do the right thing for
+ ;; cross-compilers.
+ (zero? (system* "make" "install-strip")))
+
+(define* (cross-gcc-build-phases target
+ #:optional (phases %standard-phases))
+ "Modify PHASES to include everything needed to build a cross-GCC for TARGET,
+a target triplet."
+ (modify-phases phases
+ (add-before 'configure 'set-cross-path
+ (if (string-contains target "mingw")
+ set-cross-path/mingw
+ set-cross-path))
+ (add-after 'install 'make-cross-binutils-visible
+ (cut make-cross-binutils-visible #:target target <...>))
+ (replace 'install install-strip)))
+
+;;; cross-toolchain.scm ends here
diff --git a/gnu/local.mk b/gnu/local.mk
index 1f98513ca3..eec0e018b5 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -436,6 +436,7 @@ GNU_SYSTEM_MODULES = \
%D%/system/vm.scm \
\
%D%/build/activation.scm \
+ %D%/build/cross-toolchain.scm \
%D%/build/file-systems.scm \
%D%/build/install.scm \
%D%/build/linux-boot.scm \
diff --git a/gnu/packages/cross-base.scm b/gnu/packages/cross-base.scm
index 7917e9fd0a..763bbf50e2 100644
--- a/gnu/packages/cross-base.scm
+++ b/gnu/packages/cross-base.scm
@@ -164,136 +164,7 @@ may be either a libc package or #f.)"
,flags))
flags))
((#:phases phases)
- (let ((phases
- `(alist-cons-after
- 'install 'make-cross-binutils-visible
- (lambda* (#:key outputs inputs #:allow-other-keys)
- (let* ((out (assoc-ref outputs "out"))
- (libexec (string-append out "/libexec/gcc/"
- ,target))
- (binutils (string-append
- (assoc-ref inputs "binutils-cross")
- "/bin/" ,target "-"))
- (wrapper (string-append
- (assoc-ref inputs "ld-wrapper-cross")
- "/bin/" ,target "-ld")))
- (for-each (lambda (file)
- (symlink (string-append binutils file)
- (string-append libexec "/"
- file)))
- '("as" "nm"))
- (symlink wrapper (string-append libexec "/ld"))
- #t))
- (alist-replace
- 'install
- (lambda _
- ;; Unlike our 'strip' phase, this will do the right thing
- ;; for cross-compilers.
- (zero? (system* "make" "install-strip")))
- ,phases))))
- (cond
- ((target-mingw? target)
- `(modify-phases ,phases
- (add-before
- 'configure 'set-cross-path
- (lambda* (#:key inputs #:allow-other-keys)
- ;; Add the cross mingw headers to CROSS_C_*_INCLUDE_PATH,
- ;; and remove them from C_*INCLUDE_PATH.
- (let ((libc (assoc-ref inputs "libc"))
- (gcc (assoc-ref inputs "gcc")))
- (define (cross? x)
- (and libc (string-prefix? libc x)))
- (define (unpacked-mingw-dir)
- (match
- (scandir
- "."
- (lambda (name) (string-contains name "mingw-w64")))
- ((mingw-dir)
- (string-append
- (getcwd) "/" mingw-dir "/mingw-w64-headers"))))
- (if libc
- (let ((cpath (string-append
- libc "/include"
- ":" libc "/i686-w64-mingw32/include")))
- (for-each (cut setenv <> cpath)
- ',%gcc-cross-include-paths))
- ;; libc is false, so we are building xgcc-sans-libc
- ;; Add essential headers from mingw-w64.
- (let ((mingw-source (assoc-ref inputs "mingw-source")))
- (system* "tar" "xf" mingw-source)
- (let ((mingw-headers (unpacked-mingw-dir)))
- ;; We need _mingw.h which will gets built from
- ;; _mingw.h.in by mingw-w64's configure. We
- ;; cannot configure mingw-w64 until we have
- ;; xgcc-sans-libc; substitute to the rescue.
- (copy-file (string-append mingw-headers
- "/crt/_mingw.h.in")
- (string-append mingw-headers
- "/crt/_mingw.h"))
- (substitute* (string-append mingw-headers
- "/crt/_mingw.h")
- (("@MINGW_HAS_SECURE_API@")
- "#define MINGW_HAS_SECURE_API 1"))
- (let ((cpath
- (string-append
- mingw-headers "/include"
- ":" mingw-headers "/crt"
- ":" mingw-headers "/defaults/include")))
- (for-each (cut setenv <> cpath)
- (cons
- "CROSS_LIBRARY_PATH"
- ',%gcc-cross-include-paths))))
- (when libc
- (setenv "CROSS_LIBRARY_PATH"
- (string-append
- libc "/lib"
- ":" libc "/i686-w64-mingw32/lib")))))
- (setenv "CPP" (string-append gcc "/bin/cpp"))
- (for-each
- (lambda (var)
- (and=>
- (getenv var)
- (lambda (value)
- (let* ((path (search-path-as-string->list
- value))
- (native-path (list->search-path-as-string
- (remove cross? path) ":")))
- (setenv var native-path)))))
- (cons "LIBRARY_PATH" ',%gcc-include-paths))
- #t)))))
- (libc
- `(alist-cons-before
- 'configure 'set-cross-path
- (lambda* (#:key inputs #:allow-other-keys)
- ;; Add the cross kernel headers to CROSS_CPATH, and remove
- ;; them from CPATH.
- (let ((libc (assoc-ref inputs "libc"))
- (kernel (assoc-ref inputs "xkernel-headers")))
- (define (cross? x)
- ;; Return #t if X is a cross-libc or cross Linux.
- (or (string-prefix? libc x)
- (string-prefix? kernel x)))
- (let ((cpath (string-append
- libc "/include"
- ":" kernel "/include")))
- (for-each (cut setenv <> cpath)
- ',%gcc-cross-include-paths))
- (setenv "CROSS_LIBRARY_PATH"
- (string-append libc "/lib:"
- kernel "/lib")) ;for Hurd's libihash
- (for-each
- (lambda (var)
- (and=>
- (getenv var)
- (lambda (value)
- (let* ((path (search-path-as-string->list value))
- (native-path (list->search-path-as-string
- (remove cross? path) ":")))
- (setenv var native-path)))))
- (cons "LIBRARY_PATH" ',%gcc-include-paths))
- #t))
- ,phases))
- (else phases))))))))
+ `(cross-gcc-build-phases ,target ,phases))))))
(define (cross-gcc-patches target)
"Return GCC patches needed for TARGET."
@@ -336,13 +207,14 @@ GCC that does not target a libc; otherwise, target that libc."
(arguments
`(#:implicit-inputs? #f
+ #:imported-modules ((gnu build cross-toolchain)
+ ,@%gnu-build-system-modules)
#:modules ((guix build gnu-build-system)
(guix build utils)
- (ice-9 ftw)
- (ice-9 match)
- (ice-9 regex)
+ (gnu build cross-toolchain)
(srfi srfi-1)
- (srfi srfi-26))
+ (srfi srfi-26)
+ (ice-9 regex))
,@(cross-gcc-arguments target libc)))