gnu: Add cross tool chain.

* gnu/packages/cross-base.scm: New file.
* gnu/packages/patches/gcc-cross-environment-variables.patch: New file.
* Makefile.am (MODULES): Add cross-base.scm.
  (dist_patch_DATA): Add gcc-cross-environment-variables.patch.
* gnu/packages/base.scm (gcc-4.7): Use `LDFLAGS_FOR_TARGET' instead of
  `LDFLAGS_FOR_BUILD', and use `-B' instead of `-L'.
* gnu/packages/bootstrap.scm (glibc-dynamic-linker): Add case for
  "mips64el-linux".

4 files changed, 270 insertions, 2 deletions

diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index 5c39ec3db8..5aeb050863 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -412,8 +412,8 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
         #:make-flags
         (let ((libc (assoc-ref %build-inputs "libc")))
           `(,@(if libc
-                  (list (string-append "LDFLAGS_FOR_BUILD="
-                                       "-L" libc "/lib "
+                  (list (string-append "LDFLAGS_FOR_TARGET="
+                                       "-B" libc "/lib "
                                        "-Wl,-dynamic-linker "
                                        "-Wl," libc
                                        ,(glibc-dynamic-linker)))
diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index 22ee98879a..809eb84295 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -134,6 +134,7 @@ check whether everything is alright."
   "Return the name of Glibc's dynamic linker for SYSTEM."
   (cond ((string=? system "x86_64-linux") "/lib/ld-linux-x86-64.so.2")
         ((string=? system "i686-linux") "/lib/ld-linux.so.2")
+        ((string=? system "mips64el-linux") "/lib/ld.so.1")
         (else (error "dynamic linker name not known for this system"
                      system))))
 
diff --git a/gnu/packages/cross-base.scm b/gnu/packages/cross-base.scm
new file mode 100644
index 0000000000..69dc9f5b0b
--- /dev/null
+++ b/gnu/packages/cross-base.scm
@@ -0,0 +1,243 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 packages cross-base)
+  #:use-module (guix licenses)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages linux)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix utils)
+  #:use-module (guix build-system gnu)
+  #:use-module (guix build-system trivial)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match))
+
+(define (cross p target)
+  (package (inherit p)
+    (location (source-properties->location (current-source-location)))
+    (name (string-append (package-name p) "-cross-" target))
+    (arguments
+     (substitute-keyword-arguments (package-arguments p)
+       ((#:configure-flags flags)
+        `(cons ,(string-append "--target=" target)
+               ,flags))))))
+
+(define cross-binutils
+  (cut cross binutils <>))
+
+(define* (cross-gcc target
+                    #:optional (xbinutils (cross-binutils target)) libc)
+  "Return a cross-compiler for TARGET, where TARGET is a GNU triplet.  Use
+XBINUTILS as the associated cross-Binutils.  If LIBC is false, then build a
+GCC that does not target a libc; otherwise, target that libc."
+  (define args
+    ;; Get the arguments as if we were building for TARGET.  In particular, we
+    ;; want `glibc-dynamic-linker' to return the right thing.
+    (parameterize ((%current-system (gnu-triplet->nix-system target)))
+      (package-arguments gcc-4.7)))
+
+  (package (inherit gcc-4.7)
+    (name (string-append "gcc-cross-"
+                         (if libc "" "sans-libc-")
+                         target))
+    (arguments
+     `(#:implicit-inputs? #f
+       #:modules ((guix build gnu-build-system)
+                  (guix build utils)
+                  (ice-9 regex)
+                  (srfi srfi-1)
+                  (srfi srfi-26))
+       #:patches (list (assoc-ref %build-inputs "patch/cross-env-vars"))
+
+       ,@(substitute-keyword-arguments args
+           ((#:configure-flags flags)
+            `(append (list ,(string-append "--target=" target)
+                           ,@(if libc
+                                 '()
+                                 `( ;; Disable features not needed at this stage.
+                                   "--disable-shared" "--enable-static"
+
+                                   ;; Disable C++ because libstdc++'s
+                                   ;; configure script otherwise fails with
+                                   ;; "Link tests are not allowed after
+                                   ;; GCC_NO_EXECUTABLES."
+                                   "--enable-languages=c"
+
+                                   "--disable-threads" ; libgcc, would need libc
+                                   "--disable-libmudflap"
+                                   "--disable-libgomp"
+                                   "--disable-libssp"
+                                   "--disable-libquadmath"
+                                   "--disable-decimal-float" ; would need libc
+                                   )))
+
+                     ,(if libc
+                          flags
+                          `(remove (cut string-match "--enable-languages.*" <>)
+                                   ,flags))))
+           ((#:make-flags flags)
+            (if libc
+                `(let ((libc (assoc-ref %build-inputs "libc")))
+                   ;; FLAGS_FOR_TARGET are needed for the target libraries to
+                   ;; receive the -Bxxx for the startfiles.
+                   (cons (string-append "FLAGS_FOR_TARGET=-B" libc "/lib")
+                         ,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 "-")))
+                         (for-each (lambda (file)
+                                     (symlink (string-append binutils file)
+                                              (string-append libexec "/"
+                                                             file)))
+                                   '("as" "ld" "nm"))
+                         #t))
+                     ,phases)))
+             (if libc
+                 `(alist-cons-before
+                   'configure 'set-cross-path
+                   (lambda* (#:key inputs #:allow-other-keys)
+                     ;; Add the cross Linux headers to CROSS_CPATH, and remove
+                     ;; them from CPATH.
+                     (let ((libc  (assoc-ref inputs "libc"))
+                           (linux (assoc-ref inputs
+                                             "libc/cross-linux-headers")))
+                       (define (cross? x)
+                         ;; Return #t if X is a cross-libc or cross Linux.
+                         (or (string-prefix? libc x)
+                             (string-prefix? linux x)))
+
+                       (setenv "CROSS_CPATH"
+                               (string-append libc "/include:"
+                                              linux "/include"))
+                       (setenv "CROSS_LIBRARY_PATH"
+                               (string-append libc "/lib"))
+
+                       (let ((cpath   (search-path-as-string->list
+                                       (getenv "CPATH")))
+                             (libpath (search-path-as-string->list
+                                       (getenv "LIBRARY_PATH"))))
+                         (setenv "CPATH"
+                                 (list->search-path-as-string
+                                  (remove cross? cpath) ":"))
+                         (setenv "LIBRARY_PATH"
+                                 (list->search-path-as-string
+                                  (remove cross? libpath) ":"))
+                         #t)))
+                   ,phases)
+                 phases)))
+           ((#:strip-binaries? _)
+            ;; Disable stripping as this can break binaries, with object files
+            ;; of libgcc.a showing up as having an unknown architecture.  See
+            ;; <http://lists.fedoraproject.org/pipermail/arm/2010-August/000663.html>
+            ;; for instance.
+            #f))))
+    (inputs
+     `(("patch/cross-env-vars"
+        ,(search-patch "gcc-cross-environment-variables.patch"))
+
+       ("binutils-cross" ,xbinutils)
+
+       ;; Call it differently so that the builder can check whether the "libc"
+       ;; input is #f.
+       ("libc-native" ,@(assoc-ref %final-inputs "libc"))
+
+       ;; Remaining inputs.
+       ,@(let ((inputs (append (package-inputs gcc-4.7)
+                               (alist-delete "libc" %final-inputs))))
+           (if libc
+               `(("libc" ,libc)
+                 ,@inputs)
+               inputs))))))
+
+(define* (cross-libc target
+                     #:optional
+                     (xgcc (cross-gcc target))
+                     (xbinutils (cross-binutils target)))
+  "Return a libc cross-built for TARGET, a GNU triplet.  Use XGCC and
+XBINUTILS and the cross tool chain."
+  (define xlinux-headers
+    (package (inherit linux-libre-headers)
+      (name (string-append (package-name linux-libre-headers)
+                           "-cross-" target))
+      (arguments
+       (substitute-keyword-arguments (package-arguments linux-libre-headers)
+         ((#:phases phases)
+          `(alist-replace
+            'build
+            (lambda _
+              (setenv "ARCH" ,(system->linux-architecture target))
+              (format #t "`ARCH' set to `~a' (cross compiling)~%" (getenv "ARCH"))
+
+              (and (zero? (system* "make" "defconfig"))
+                   (zero? (system* "make" "mrproper" "headers_check"))))
+            ,phases))))
+      (inputs `(("cross-gcc" ,xgcc)
+                ("cross-binutils" ,xbinutils)
+                ,@(package-inputs linux-libre-headers)))))
+
+  (package (inherit glibc)
+    (name (string-append "glibc-cross-" target))
+    (arguments
+     (substitute-keyword-arguments
+         `(#:strip-binaries? #f                ; disable stripping (see above)
+           ,@(package-arguments glibc))
+       ((#:configure-flags flags)
+        `(cons ,(string-append "--host=" target)
+               ,flags))
+       ((#:phases phases)
+        `(alist-cons-before
+          'configure 'set-cross-linux-headers-path
+          (lambda* (#:key inputs #:allow-other-keys)
+            (let ((linux (assoc-ref inputs "cross-linux-headers")))
+              (setenv "CROSS_CPATH"
+                      (string-append linux "/include"))
+              #t))
+          ,phases))))
+    (propagated-inputs `(("cross-linux-headers" ,xlinux-headers)))
+    (inputs `(("cross-gcc" ,xgcc)
+              ("cross-binutils" ,xbinutils)
+              ,@(package-inputs glibc)))))
+
+
+;;;
+;;; Concrete cross toolchains.
+;;;
+
+(define-public xgcc-mips64el
+  (let ((triplet "mips64el-linux-gnu"))
+    (cross-gcc triplet
+               (cross-binutils triplet)
+               (cross-libc triplet))))
+
+;; (define-public xgcc-armel
+;;   (let ((triplet "armel-linux-gnueabi"))
+;;     (cross-gcc triplet
+;;                (cross-binutils triplet)
+;;                (cross-libc triplet))))
diff --git a/gnu/packages/patches/gcc-cross-environment-variables.patch b/gnu/packages/patches/gcc-cross-environment-variables.patch
new file mode 100644
index 0000000000..30a07ec3db
--- /dev/null
+++ b/gnu/packages/patches/gcc-cross-environment-variables.patch
@@ -0,0 +1,24 @@
+Search path environment variables for cross-compilers.  See the discussion
+at <http://gcc.gnu.org/ml/gcc/2013-02/msg00124.html>.
+
+--- gcc-4.7.2/gcc/incpath.c	2012-01-27 00:34:58.000000000 +0100
++++ gcc-4.7.2/gcc/incpath.c	2013-02-12 10:11:27.000000000 +0100
+@@ -452,7 +452,7 @@ register_include_chains (cpp_reader *pfi
+ 
+   /* CPATH and language-dependent environment variables may add to the
+      include chain.  */
+-  add_env_var_paths ("CPATH", BRACKET);
++  add_env_var_paths ("CROSS_CPATH", BRACKET);
+   add_env_var_paths (lang_env_vars[idx], SYSTEM);
+ 
+   target_c_incpath.extra_pre_includes (sysroot, iprefix, stdinc);
+
+--- gcc-4.7.2/gcc/system.h	2012-02-17 00:16:28.000000000 +0100
++++ gcc-4.7.2/gcc/system.h	2013-02-12 10:22:17.000000000 +0100
+@@ -1023,4 +1023,6 @@ helper_const_non_const_cast (const char
+ #define DEBUG_VARIABLE
+ #endif
+ 
++#define LIBRARY_PATH_ENV "CROSS_LIBRARY_PATH"
++
+ #endif /* ! GCC_SYSTEM_H */