Commit | Line | Data |
---|---|---|
827d2891 LC |
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 | ||
19 | (define-module (gnu packages cross-base) | |
20 | #:use-module (guix licenses) | |
21 | #:use-module (gnu packages) | |
f594028a | 22 | #:use-module (gnu packages gcc) |
827d2891 LC |
23 | #:use-module (gnu packages base) |
24 | #:use-module (gnu packages linux) | |
25 | #:use-module (guix packages) | |
26 | #:use-module (guix download) | |
27 | #:use-module (guix utils) | |
28 | #:use-module (guix build-system gnu) | |
29 | #:use-module (guix build-system trivial) | |
30 | #:use-module (srfi srfi-1) | |
31 | #:use-module (srfi srfi-26) | |
264218a4 LC |
32 | #:use-module (ice-9 match) |
33 | #:export (cross-binutils | |
34 | cross-libc | |
35 | cross-gcc)) | |
827d2891 LC |
36 | |
37 | (define (cross p target) | |
38 | (package (inherit p) | |
39 | (location (source-properties->location (current-source-location))) | |
40 | (name (string-append (package-name p) "-cross-" target)) | |
41 | (arguments | |
42 | (substitute-keyword-arguments (package-arguments p) | |
43 | ((#:configure-flags flags) | |
44 | `(cons ,(string-append "--target=" target) | |
45 | ,flags)))))) | |
46 | ||
47e74d6e LC |
47 | (define (cross-binutils target) |
48 | "Return a cross-Binutils for TARGET." | |
49 | (let ((binutils (package (inherit binutils) | |
50 | (arguments | |
51 | (substitute-keyword-arguments (package-arguments | |
52 | binutils) | |
53 | ((#:configure-flags flags) | |
54 | ;; Build with `--with-sysroot' so that ld honors | |
55 | ;; DT_RUNPATH entries when searching for a needed | |
56 | ;; library. This works because as a side effect | |
57 | ;; `genscripts.sh' sets `USE_LIBPATH=yes', which tells | |
58 | ;; elf32.em to use DT_RUNPATH in its search list. | |
59 | `(cons "--with-sysroot=/no-such-path" | |
60 | ,flags))))))) | |
61 | (cross binutils target))) | |
827d2891 LC |
62 | |
63 | (define* (cross-gcc target | |
64 | #:optional (xbinutils (cross-binutils target)) libc) | |
65 | "Return a cross-compiler for TARGET, where TARGET is a GNU triplet. Use | |
66 | XBINUTILS as the associated cross-Binutils. If LIBC is false, then build a | |
67 | GCC that does not target a libc; otherwise, target that libc." | |
68 | (define args | |
69 | ;; Get the arguments as if we were building for TARGET. In particular, we | |
70 | ;; want `glibc-dynamic-linker' to return the right thing. | |
71 | (parameterize ((%current-system (gnu-triplet->nix-system target))) | |
72 | (package-arguments gcc-4.7))) | |
73 | ||
74 | (package (inherit gcc-4.7) | |
75 | (name (string-append "gcc-cross-" | |
76 | (if libc "" "sans-libc-") | |
77 | target)) | |
78 | (arguments | |
79 | `(#:implicit-inputs? #f | |
80 | #:modules ((guix build gnu-build-system) | |
81 | (guix build utils) | |
82 | (ice-9 regex) | |
83 | (srfi srfi-1) | |
84 | (srfi srfi-26)) | |
85 | #:patches (list (assoc-ref %build-inputs "patch/cross-env-vars")) | |
86 | ||
87 | ,@(substitute-keyword-arguments args | |
88 | ((#:configure-flags flags) | |
89 | `(append (list ,(string-append "--target=" target) | |
90 | ,@(if libc | |
91 | '() | |
92 | `( ;; Disable features not needed at this stage. | |
93 | "--disable-shared" "--enable-static" | |
94 | ||
95 | ;; Disable C++ because libstdc++'s | |
96 | ;; configure script otherwise fails with | |
97 | ;; "Link tests are not allowed after | |
98 | ;; GCC_NO_EXECUTABLES." | |
99 | "--enable-languages=c" | |
100 | ||
101 | "--disable-threads" ; libgcc, would need libc | |
102 | "--disable-libmudflap" | |
103 | "--disable-libgomp" | |
104 | "--disable-libssp" | |
105 | "--disable-libquadmath" | |
106 | "--disable-decimal-float" ; would need libc | |
107 | ))) | |
108 | ||
109 | ,(if libc | |
110 | flags | |
111 | `(remove (cut string-match "--enable-languages.*" <>) | |
112 | ,flags)))) | |
113 | ((#:make-flags flags) | |
114 | (if libc | |
115 | `(let ((libc (assoc-ref %build-inputs "libc"))) | |
116 | ;; FLAGS_FOR_TARGET are needed for the target libraries to | |
117 | ;; receive the -Bxxx for the startfiles. | |
118 | (cons (string-append "FLAGS_FOR_TARGET=-B" libc "/lib") | |
119 | ,flags)) | |
120 | flags)) | |
121 | ((#:phases phases) | |
122 | (let ((phases | |
123 | `(alist-cons-after | |
124 | 'install 'make-cross-binutils-visible | |
125 | (lambda* (#:key outputs inputs #:allow-other-keys) | |
126 | (let* ((out (assoc-ref outputs "out")) | |
127 | (libexec (string-append out "/libexec/gcc/" | |
128 | ,target)) | |
129 | (binutils (string-append | |
130 | (assoc-ref inputs "binutils-cross") | |
131 | "/bin/" ,target "-"))) | |
132 | (for-each (lambda (file) | |
133 | (symlink (string-append binutils file) | |
134 | (string-append libexec "/" | |
135 | file))) | |
136 | '("as" "ld" "nm")) | |
137 | #t)) | |
138 | ,phases))) | |
139 | (if libc | |
140 | `(alist-cons-before | |
141 | 'configure 'set-cross-path | |
142 | (lambda* (#:key inputs #:allow-other-keys) | |
143 | ;; Add the cross Linux headers to CROSS_CPATH, and remove | |
144 | ;; them from CPATH. | |
145 | (let ((libc (assoc-ref inputs "libc")) | |
146 | (linux (assoc-ref inputs | |
147 | "libc/cross-linux-headers"))) | |
148 | (define (cross? x) | |
149 | ;; Return #t if X is a cross-libc or cross Linux. | |
150 | (or (string-prefix? libc x) | |
151 | (string-prefix? linux x))) | |
152 | ||
153 | (setenv "CROSS_CPATH" | |
154 | (string-append libc "/include:" | |
155 | linux "/include")) | |
156 | (setenv "CROSS_LIBRARY_PATH" | |
157 | (string-append libc "/lib")) | |
158 | ||
159 | (let ((cpath (search-path-as-string->list | |
160 | (getenv "CPATH"))) | |
161 | (libpath (search-path-as-string->list | |
162 | (getenv "LIBRARY_PATH")))) | |
163 | (setenv "CPATH" | |
164 | (list->search-path-as-string | |
165 | (remove cross? cpath) ":")) | |
166 | (setenv "LIBRARY_PATH" | |
167 | (list->search-path-as-string | |
168 | (remove cross? libpath) ":")) | |
169 | #t))) | |
170 | ,phases) | |
171 | phases))) | |
172 | ((#:strip-binaries? _) | |
173 | ;; Disable stripping as this can break binaries, with object files | |
174 | ;; of libgcc.a showing up as having an unknown architecture. See | |
175 | ;; <http://lists.fedoraproject.org/pipermail/arm/2010-August/000663.html> | |
176 | ;; for instance. | |
177 | #f)))) | |
178 | (inputs | |
179 | `(("patch/cross-env-vars" | |
180 | ,(search-patch "gcc-cross-environment-variables.patch")) | |
181 | ||
182 | ("binutils-cross" ,xbinutils) | |
183 | ||
184 | ;; Call it differently so that the builder can check whether the "libc" | |
185 | ;; input is #f. | |
186 | ("libc-native" ,@(assoc-ref %final-inputs "libc")) | |
187 | ||
188 | ;; Remaining inputs. | |
189 | ,@(let ((inputs (append (package-inputs gcc-4.7) | |
190 | (alist-delete "libc" %final-inputs)))) | |
191 | (if libc | |
192 | `(("libc" ,libc) | |
193 | ,@inputs) | |
17bb886f LC |
194 | inputs)))) |
195 | ||
196 | ;; Only search target inputs, not host inputs. | |
197 | (search-paths | |
198 | (list (search-path-specification | |
199 | (variable "CROSS_CPATH") | |
200 | (directories '("include"))) | |
201 | (search-path-specification | |
202 | (variable "CROSS_LIBRARY_PATH") | |
203 | (directories '("lib" "lib64"))))) | |
204 | (native-search-paths '()))) | |
827d2891 LC |
205 | |
206 | (define* (cross-libc target | |
207 | #:optional | |
208 | (xgcc (cross-gcc target)) | |
209 | (xbinutils (cross-binutils target))) | |
210 | "Return a libc cross-built for TARGET, a GNU triplet. Use XGCC and | |
211 | XBINUTILS and the cross tool chain." | |
212 | (define xlinux-headers | |
213 | (package (inherit linux-libre-headers) | |
214 | (name (string-append (package-name linux-libre-headers) | |
215 | "-cross-" target)) | |
216 | (arguments | |
217 | (substitute-keyword-arguments (package-arguments linux-libre-headers) | |
218 | ((#:phases phases) | |
219 | `(alist-replace | |
220 | 'build | |
221 | (lambda _ | |
222 | (setenv "ARCH" ,(system->linux-architecture target)) | |
223 | (format #t "`ARCH' set to `~a' (cross compiling)~%" (getenv "ARCH")) | |
224 | ||
225 | (and (zero? (system* "make" "defconfig")) | |
226 | (zero? (system* "make" "mrproper" "headers_check")))) | |
227 | ,phases)))) | |
228 | (inputs `(("cross-gcc" ,xgcc) | |
229 | ("cross-binutils" ,xbinutils) | |
230 | ,@(package-inputs linux-libre-headers))))) | |
231 | ||
232 | (package (inherit glibc) | |
233 | (name (string-append "glibc-cross-" target)) | |
234 | (arguments | |
235 | (substitute-keyword-arguments | |
236 | `(#:strip-binaries? #f ; disable stripping (see above) | |
237 | ,@(package-arguments glibc)) | |
238 | ((#:configure-flags flags) | |
239 | `(cons ,(string-append "--host=" target) | |
240 | ,flags)) | |
241 | ((#:phases phases) | |
242 | `(alist-cons-before | |
243 | 'configure 'set-cross-linux-headers-path | |
244 | (lambda* (#:key inputs #:allow-other-keys) | |
245 | (let ((linux (assoc-ref inputs "cross-linux-headers"))) | |
246 | (setenv "CROSS_CPATH" | |
247 | (string-append linux "/include")) | |
248 | #t)) | |
249 | ,phases)))) | |
250 | (propagated-inputs `(("cross-linux-headers" ,xlinux-headers))) | |
251 | (inputs `(("cross-gcc" ,xgcc) | |
252 | ("cross-binutils" ,xbinutils) | |
253 | ,@(package-inputs glibc))))) | |
254 | ||
255 | \f | |
256 | ;;; | |
257 | ;;; Concrete cross toolchains. | |
258 | ;;; | |
259 | ||
260 | (define-public xgcc-mips64el | |
261 | (let ((triplet "mips64el-linux-gnu")) | |
262 | (cross-gcc triplet | |
263 | (cross-binutils triplet) | |
264 | (cross-libc triplet)))) | |
265 | ||
266 | ;; (define-public xgcc-armel | |
267 | ;; (let ((triplet "armel-linux-gnueabi")) | |
268 | ;; (cross-gcc triplet | |
269 | ;; (cross-binutils triplet) | |
270 | ;; (cross-libc triplet)))) |