You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

275 lines
12 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  6. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 3 of the License, or (at
  9. ;;; your option) any later version.
  10. ;;;
  11. ;;; GNU Guix is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (gnu packages cross-base)
  19. #:use-module (guix licenses)
  20. #:use-module (gnu packages)
  21. #:use-module (gnu packages gcc)
  22. #:use-module (gnu packages base)
  23. #:use-module (gnu packages linux)
  24. #:use-module (guix packages)
  25. #:use-module (guix download)
  26. #:use-module (guix utils)
  27. #:use-module (guix build-system gnu)
  28. #:use-module (guix build-system trivial)
  29. #:use-module (srfi srfi-1)
  30. #:use-module (srfi srfi-26)
  31. #:use-module (ice-9 match)
  32. #:export (cross-binutils
  33. cross-libc
  34. cross-gcc))
  35. (define (cross p target)
  36. (package (inherit p)
  37. (location (source-properties->location (current-source-location)))
  38. (name (string-append (package-name p) "-cross-" target))
  39. (arguments
  40. (substitute-keyword-arguments (package-arguments p)
  41. ((#:configure-flags flags)
  42. `(cons ,(string-append "--target=" target)
  43. ,flags))))))
  44. (define (cross-binutils target)
  45. "Return a cross-Binutils for TARGET."
  46. (let ((binutils (package (inherit binutils)
  47. (arguments
  48. (substitute-keyword-arguments (package-arguments
  49. binutils)
  50. ((#:configure-flags flags)
  51. ;; Build with `--with-sysroot' so that ld honors
  52. ;; DT_RUNPATH entries when searching for a needed
  53. ;; library. This works because as a side effect
  54. ;; `genscripts.sh' sets `USE_LIBPATH=yes', which tells
  55. ;; elf32.em to use DT_RUNPATH in its search list.
  56. ;; See <http://sourceware.org/ml/binutils/2013-05/msg00312.html>.
  57. ;;
  58. ;; In theory choosing / as the sysroot could lead ld
  59. ;; to pick up native libs instead of target ones. In
  60. ;; practice the RUNPATH of target libs only refers to
  61. ;; target libs, not native libs, so this is safe.
  62. `(cons "--with-sysroot=/" ,flags)))))))
  63. (cross binutils target)))
  64. (define* (cross-gcc target
  65. #:optional (xbinutils (cross-binutils target)) libc)
  66. "Return a cross-compiler for TARGET, where TARGET is a GNU triplet. Use
  67. XBINUTILS as the associated cross-Binutils. If LIBC is false, then build a
  68. GCC that does not target a libc; otherwise, target that libc."
  69. (package (inherit gcc-4.8)
  70. (name (string-append "gcc-cross-"
  71. (if libc "" "sans-libc-")
  72. target))
  73. (source (origin (inherit (package-source gcc-4.8))
  74. (patches
  75. (list (search-patch "gcc-cross-environment-variables.patch")))))
  76. (arguments
  77. `(#:implicit-inputs? #f
  78. #:modules ((guix build gnu-build-system)
  79. (guix build utils)
  80. (ice-9 regex)
  81. (srfi srfi-1)
  82. (srfi srfi-26))
  83. ,@(substitute-keyword-arguments (package-arguments gcc-4.8)
  84. ((#:configure-flags flags)
  85. `(append (list ,(string-append "--target=" target)
  86. ,@(gcc-configure-flags-for-triplet target)
  87. ,@(if libc
  88. '()
  89. `( ;; Disable features not needed at this stage.
  90. "--disable-shared" "--enable-static"
  91. ;; Disable C++ because libstdc++'s
  92. ;; configure script otherwise fails with
  93. ;; "Link tests are not allowed after
  94. ;; GCC_NO_EXECUTABLES."
  95. "--enable-languages=c"
  96. "--disable-threads" ; libgcc, would need libc
  97. "--disable-libatomic"
  98. "--disable-libmudflap"
  99. "--disable-libgomp"
  100. "--disable-libssp"
  101. "--disable-libquadmath"
  102. "--disable-decimal-float" ; would need libc
  103. )))
  104. ,(if libc
  105. flags
  106. `(remove (cut string-match "--enable-languages.*" <>)
  107. ,flags))))
  108. ((#:make-flags flags)
  109. (if libc
  110. `(let ((libc (assoc-ref %build-inputs "libc")))
  111. ;; FLAGS_FOR_TARGET are needed for the target libraries to
  112. ;; receive the -Bxxx for the startfiles.
  113. (cons (string-append "FLAGS_FOR_TARGET=-B" libc "/lib")
  114. ,flags))
  115. flags))
  116. ((#:phases phases)
  117. (let ((phases
  118. `(alist-cons-after
  119. 'install 'make-cross-binutils-visible
  120. (lambda* (#:key outputs inputs #:allow-other-keys)
  121. (let* ((out (assoc-ref outputs "out"))
  122. (libexec (string-append out "/libexec/gcc/"
  123. ,target))
  124. (binutils (string-append
  125. (assoc-ref inputs "binutils-cross")
  126. "/bin/" ,target "-")))
  127. (for-each (lambda (file)
  128. (symlink (string-append binutils file)
  129. (string-append libexec "/"
  130. file)))
  131. '("as" "ld" "nm"))
  132. #t))
  133. ,phases)))
  134. (if libc
  135. `(alist-cons-before
  136. 'configure 'set-cross-path
  137. (lambda* (#:key inputs #:allow-other-keys)
  138. ;; Add the cross Linux headers to CROSS_CPATH, and remove
  139. ;; them from CPATH.
  140. (let ((libc (assoc-ref inputs "libc"))
  141. (linux (assoc-ref inputs
  142. "libc/cross-linux-headers")))
  143. (define (cross? x)
  144. ;; Return #t if X is a cross-libc or cross Linux.
  145. (or (string-prefix? libc x)
  146. (string-prefix? linux x)))
  147. (setenv "CROSS_CPATH"
  148. (string-append libc "/include:"
  149. linux "/include"))
  150. (setenv "CROSS_LIBRARY_PATH"
  151. (string-append libc "/lib"))
  152. (let ((cpath (search-path-as-string->list
  153. (getenv "CPATH")))
  154. (libpath (search-path-as-string->list
  155. (getenv "LIBRARY_PATH"))))
  156. (setenv "CPATH"
  157. (list->search-path-as-string
  158. (remove cross? cpath) ":"))
  159. (setenv "LIBRARY_PATH"
  160. (list->search-path-as-string
  161. (remove cross? libpath) ":"))
  162. #t)))
  163. ,phases)
  164. phases)))
  165. ((#:strip-binaries? _)
  166. ;; Disable stripping as this can break binaries, with object files
  167. ;; of libgcc.a showing up as having an unknown architecture. See
  168. ;; <http://lists.fedoraproject.org/pipermail/arm/2010-August/000663.html>
  169. ;; for instance.
  170. #f))))
  171. (native-inputs
  172. `(("binutils-cross" ,xbinutils)
  173. ;; Call it differently so that the builder can check whether the "libc"
  174. ;; input is #f.
  175. ("libc-native" ,@(assoc-ref %final-inputs "libc"))
  176. ;; Remaining inputs.
  177. ,@(let ((inputs (append (package-inputs gcc-4.8)
  178. (alist-delete "libc" %final-inputs))))
  179. (if libc
  180. `(("libc" ,libc)
  181. ,@inputs)
  182. inputs))))
  183. (inputs '())
  184. ;; Only search target inputs, not host inputs.
  185. (search-paths
  186. (list (search-path-specification
  187. (variable "CROSS_CPATH")
  188. (directories '("include")))
  189. (search-path-specification
  190. (variable "CROSS_LIBRARY_PATH")
  191. (directories '("lib" "lib64")))))
  192. (native-search-paths '())))
  193. (define* (cross-libc target
  194. #:optional
  195. (xgcc (cross-gcc target))
  196. (xbinutils (cross-binutils target)))
  197. "Return a libc cross-built for TARGET, a GNU triplet. Use XGCC and
  198. XBINUTILS and the cross tool chain."
  199. (define xlinux-headers
  200. (package (inherit linux-libre-headers)
  201. (name (string-append (package-name linux-libre-headers)
  202. "-cross-" target))
  203. (arguments
  204. (substitute-keyword-arguments (package-arguments linux-libre-headers)
  205. ((#:phases phases)
  206. `(alist-replace
  207. 'build
  208. (lambda _
  209. (setenv "ARCH" ,(system->linux-architecture target))
  210. (format #t "`ARCH' set to `~a' (cross compiling)~%" (getenv "ARCH"))
  211. (and (zero? (system* "make" "defconfig"))
  212. (zero? (system* "make" "mrproper" "headers_check"))))
  213. ,phases))))
  214. (native-inputs `(("cross-gcc" ,xgcc)
  215. ("cross-binutils" ,xbinutils)
  216. ,@(package-native-inputs linux-libre-headers)))))
  217. (package (inherit glibc)
  218. (name (string-append "glibc-cross-" target))
  219. (arguments
  220. (substitute-keyword-arguments
  221. `(#:strip-binaries? #f ; disable stripping (see above)
  222. ,@(package-arguments glibc))
  223. ((#:configure-flags flags)
  224. `(cons ,(string-append "--host=" target)
  225. ,flags))
  226. ((#:phases phases)
  227. `(alist-cons-before
  228. 'configure 'set-cross-linux-headers-path
  229. (lambda* (#:key inputs #:allow-other-keys)
  230. (let ((linux (assoc-ref inputs "cross-linux-headers")))
  231. (setenv "CROSS_CPATH"
  232. (string-append linux "/include"))
  233. #t))
  234. ,phases))))
  235. (propagated-inputs `(("cross-linux-headers" ,xlinux-headers)))
  236. (native-inputs `(("cross-gcc" ,xgcc)
  237. ("cross-binutils" ,xbinutils)
  238. ,@(package-native-inputs glibc)))))
  239. ;;;
  240. ;;; Concrete cross toolchains.
  241. ;;;
  242. (define-public xgcc-mips64el
  243. (let ((triplet "mips64el-linux-gnuabi64")) ; N64 ABI
  244. (cross-gcc triplet
  245. (cross-binutils triplet)
  246. (cross-libc triplet))))
  247. ;; (define-public xgcc-armel
  248. ;; (let ((triplet "armel-linux-gnueabi"))
  249. ;; (cross-gcc triplet
  250. ;; (cross-binutils triplet)
  251. ;; (cross-libc triplet))))