Commit | Line | Data |
---|---|---|
3593e5d5 LC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> | |
3 | ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> | |
4 | ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> | |
5 | ;;; Copyright © 2016 Manolis Fragkiskos Ragkousis <manolis837@gmail.com> | |
6 | ;;; | |
7 | ;;; This file is part of GNU Guix. | |
8 | ;;; | |
9 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
10 | ;;; under the terms of the GNU General Public License as published by | |
11 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
12 | ;;; your option) any later version. | |
13 | ;;; | |
14 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
15 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;;; GNU General Public License for more details. | |
18 | ;;; | |
19 | ;;; You should have received a copy of the GNU General Public License | |
20 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | (define-module (gnu build cross-toolchain) | |
23 | #:use-module (guix build utils) | |
24 | #:use-module (guix build gnu-build-system) | |
25 | #:use-module (srfi srfi-1) | |
26 | #:use-module (srfi srfi-26) | |
27 | #:use-module (ice-9 match) | |
28 | #:use-module (ice-9 ftw) | |
29 | #:export (cross-gcc-build-phases)) | |
30 | ||
31 | ;;; Commentary: | |
32 | ;;; | |
33 | ;;; This module provides tools to build a cross-compiler. | |
34 | ;;; | |
35 | ;;; Code: | |
36 | ||
37 | (define %gcc-include-paths | |
38 | ;; Environment variables for header search paths. | |
39 | ;; Note: See <http://bugs.gnu.org/22186> for why not 'CPATH'. | |
40 | '("C_INCLUDE_PATH" | |
41 | "CPLUS_INCLUDE_PATH" | |
42 | "OBJC_INCLUDE_PATH" | |
43 | "OBJCPLUS_INCLUDE_PATH")) | |
44 | ||
45 | (define %gcc-cross-include-paths | |
46 | ;; Search path for target headers when cross-compiling. | |
47 | (map (cut string-append "CROSS_" <>) %gcc-include-paths)) | |
48 | ||
49 | (define* (make-cross-binutils-visible #:key outputs inputs target | |
50 | #:allow-other-keys) | |
51 | "Create symlinks for 'as', 'nm', and 'ld' in the \"out\" output, under | |
52 | libexec/gcc, so that the cross-GCC can find them." | |
53 | (let* ((out (assoc-ref outputs "out")) | |
54 | (libexec (string-append out "/libexec/gcc/" target)) | |
55 | (binutils (string-append (assoc-ref inputs "binutils-cross") | |
56 | "/bin/" target "-")) | |
57 | (wrapper (string-append (assoc-ref inputs "ld-wrapper-cross") | |
58 | "/bin/" target "-ld"))) | |
59 | (for-each (lambda (file) | |
60 | (symlink (string-append binutils file) | |
61 | (string-append libexec "/" file))) | |
62 | '("as" "nm")) | |
63 | (symlink wrapper (string-append libexec "/ld")) | |
64 | #t)) | |
65 | ||
66 | (define* (set-cross-path #:key inputs #:allow-other-keys) | |
67 | "Add the cross kernel headers to CROSS_CPATH, and remove them from | |
68 | C_INCLUDE_PATH et al." | |
69 | (match (assoc-ref inputs "libc") | |
70 | ((? string? libc) | |
71 | (let ((kernel (assoc-ref inputs "xkernel-headers"))) | |
72 | (define (cross? x) | |
73 | ;; Return #t if X is a cross-libc or cross Linux. | |
74 | (or (string-prefix? libc x) | |
75 | (string-prefix? kernel x))) | |
76 | ||
77 | (let ((cpath (string-append libc "/include" | |
78 | ":" kernel "/include"))) | |
79 | (for-each (cut setenv <> cpath) | |
80 | %gcc-cross-include-paths)) | |
81 | ||
82 | (setenv "CROSS_LIBRARY_PATH" | |
83 | (string-append libc "/lib:" kernel "/lib")) ;for Hurd's libihash | |
84 | ||
85 | (for-each (lambda (var) | |
86 | (and=> (getenv var) | |
87 | (lambda (value) | |
88 | (let* ((path (search-path-as-string->list value)) | |
89 | (native-path (list->search-path-as-string | |
90 | (remove cross? path) ":"))) | |
91 | (setenv var native-path))))) | |
92 | (cons "LIBRARY_PATH" %gcc-include-paths)) | |
93 | #t)) | |
94 | (#f | |
95 | ;; We're building the sans-libc cross-compiler, so nothing to do. | |
96 | #t))) | |
97 | ||
98 | (define* (set-cross-path/mingw #:key inputs #:allow-other-keys) | |
99 | "Add the cross MinGW headers to CROSS_C_*_INCLUDE_PATH, and remove them from | |
100 | C_*INCLUDE_PATH." | |
101 | (let ((libc (assoc-ref inputs "libc")) | |
102 | (gcc (assoc-ref inputs "gcc"))) | |
103 | (define (cross? x) | |
104 | (and libc (string-prefix? libc x))) | |
105 | ||
106 | (define (unpacked-mingw-dir) | |
107 | (match (scandir "." (lambda (name) | |
108 | (string-contains name "mingw-w64"))) | |
109 | ((mingw-dir) | |
110 | (string-append | |
111 | (getcwd) "/" mingw-dir "/mingw-w64-headers")))) | |
112 | ||
113 | (if libc | |
114 | (let ((cpath (string-append libc "/include" | |
115 | ":" libc "/i686-w64-mingw32/include"))) | |
116 | (for-each (cut setenv <> cpath) | |
117 | %gcc-cross-include-paths)) | |
118 | ||
119 | ;; libc is false, so we are building xgcc-sans-libc. | |
120 | ;; Add essential headers from mingw-w64. | |
121 | (let ((mingw-source (assoc-ref inputs "mingw-source"))) | |
122 | (system* "tar" "xvf" mingw-source) | |
123 | (let ((mingw-headers (unpacked-mingw-dir))) | |
124 | ;; We need _mingw.h which will gets built from _mingw.h.in by | |
125 | ;; mingw-w64's configure. We cannot configure mingw-w64 until we | |
126 | ;; have xgcc-sans-libc; substitute to the rescue. | |
127 | (copy-file (string-append mingw-headers "/crt/_mingw.h.in") | |
128 | (string-append mingw-headers "/crt/_mingw.h")) | |
129 | ||
130 | (substitute* (string-append mingw-headers "/crt/_mingw.h") | |
131 | (("@MINGW_HAS_SECURE_API@") | |
132 | "#define MINGW_HAS_SECURE_API 1")) | |
133 | ||
134 | (let ((cpath (string-append mingw-headers "/include" | |
135 | ":" mingw-headers "/crt" | |
136 | ":" mingw-headers | |
137 | "/defaults/include"))) | |
138 | (for-each (cut setenv <> cpath) | |
139 | (cons "CROSS_LIBRARY_PATH" | |
140 | %gcc-cross-include-paths)))))) | |
141 | ||
142 | (when libc | |
143 | (setenv "CROSS_LIBRARY_PATH" | |
144 | (string-append libc "/lib" | |
145 | ":" libc "/i686-w64-mingw32/lib"))) | |
146 | ||
147 | (setenv "CPP" (string-append gcc "/bin/cpp")) | |
148 | (for-each (lambda (var) | |
149 | (and=> (getenv var) | |
150 | (lambda (value) | |
151 | (let* ((path (search-path-as-string->list | |
152 | value)) | |
153 | (native-path (list->search-path-as-string | |
154 | (remove cross? path) ":"))) | |
155 | (setenv var native-path))))) | |
156 | (cons "LIBRARY_PATH" %gcc-include-paths)) | |
157 | #t)) | |
158 | ||
159 | (define (install-strip . _) | |
160 | "Install a stripped GCC." | |
161 | ;; Unlike our 'strip' phase, this will do the right thing for | |
162 | ;; cross-compilers. | |
163 | (zero? (system* "make" "install-strip"))) | |
164 | ||
165 | (define* (cross-gcc-build-phases target | |
166 | #:optional (phases %standard-phases)) | |
167 | "Modify PHASES to include everything needed to build a cross-GCC for TARGET, | |
168 | a target triplet." | |
169 | (modify-phases phases | |
170 | (add-before 'configure 'set-cross-path | |
171 | (if (string-contains target "mingw") | |
172 | set-cross-path/mingw | |
173 | set-cross-path)) | |
174 | (add-after 'install 'make-cross-binutils-visible | |
175 | (cut make-cross-binutils-visible #:target target <...>)) | |
176 | (replace 'install install-strip))) | |
177 | ||
178 | ;;; cross-toolchain.scm ends here |