projects/guix·blob python-team · refs

870 lines · 36.5 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012-2021, 2023-2024 Ludovic Courtès <[email protected]>
3;;; Copyright © 2017, 2021 Efraim Flashner <[email protected]>
4;;; Copyright © 2018 Tobias Geerinckx-Rice <[email protected]>
5;;; Copyright © 2018, 2019 Mark H Weaver <[email protected]>
6;;; Copyright © 2018, 2019, 2021, 2022, 2023 Jan (janneke) Nieuwenhuizen <[email protected]>
7;;; Copyright © 2019, 2020, 2022 Marius Bakke <[email protected]>
8;;; Copyright © 2020 Mathieu Othacehe <[email protected]>
9;;; Copyright © 2021 Pierre Langlois <[email protected]>
10;;;
11;;; This file is part of GNU Guix.
12;;;
13;;; GNU Guix is free software; you can redistribute it and/or modify it
14;;; under the terms of the GNU General Public License as published by
15;;; the Free Software Foundation; either version 3 of the License, or (at
16;;; your option) any later version.
17;;;
18;;; GNU Guix is distributed in the hope that it will be useful, but
19;;; WITHOUT ANY WARRANTY; without even the implied warranty of
20;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;;; GNU General Public License for more details.
22;;;
23;;; You should have received a copy of the GNU General Public License
24;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
25
26;;; Commentary:
27;;;
28;;; This module provides tools to build tarballs of the "bootstrap binaries"
29;;; used in (gnu packages bootstrap). These statically-linked binaries are
30;;; taken for granted and used as the root of the whole bootstrap procedure.
31;;;
32;;; Code:
33
34(define-module (gnu packages make-bootstrap)
35 #:use-module (guix gexp)
36 #:use-module (guix utils)
37 #:use-module (guix packages)
38 #:use-module (guix memoization)
39 #:use-module ((guix licenses) #:select (gpl3+))
40 #:use-module (guix build-system trivial)
41 #:use-module (guix build-system gnu)
42 #:use-module ((gnu packages) #:select (search-patch search-patches))
43 #:use-module (gnu packages base)
44 #:use-module (gnu packages cross-base)
45 #:use-module (gnu packages bash)
46 #:use-module (gnu packages compression)
47 #:use-module (gnu packages gawk)
48 #:use-module (gnu packages gcc)
49 #:use-module (gnu packages guile)
50 #:use-module (gnu packages bdw-gc)
51 #:use-module (gnu packages libunistring)
52 #:use-module (gnu packages linux)
53 #:use-module (gnu packages hurd)
54 #:use-module (gnu packages mes)
55 #:use-module (gnu packages multiprecision)
56 #:use-module (ice-9 match)
57 #:use-module (srfi srfi-1)
58 #:export (%bootstrap-binaries-tarball
59 %linux-libre-headers-bootstrap-tarball
60 %binutils-bootstrap-tarball
61 %glibc-bootstrap-tarball
62 %gcc-bootstrap-tarball
63 %guile-bootstrap-tarball
64 %bootstrap-tarballs
65
66 %guile-static-stripped
67 %guile-static-initrd))
68
69(define glibc-for-bootstrap
70 (mlambdaq (base)
71 "Return a libc deriving from BASE whose `system' and `popen' functions looks
72for `sh' in $PATH, and without nscd, and with static NSS modules."
73 (package
74 (inherit base)
75 (source (origin (inherit (package-source base))
76 (patches (append (search-patches
77 (match (package-version base)
78 ("2.41" "glibc-2.41-bootstrap-system.patch")
79 (_ "glibc-bootstrap-system.patch")))
80 (origin-patches (package-source base))))))
81 (arguments
82 (substitute-keyword-arguments arguments
83 ((#:configure-flags flags)
84 ;; Arrange so that getaddrinfo & co. do not contact the nscd,
85 ;; and can use statically-linked NSS modules.
86 `(cons* "--disable-nscd" "--disable-build-nscd"
87 "--enable-static-nss"
88 ,flags))))
89
90 ;; Remove the 'debug' output to allow bit-reproducible builds (when the
91 ;; 'debug' output is used, ELF files end up with a .gnu_debuglink, which
92 ;; includes a CRC of the corresponding debugging symbols; those symbols
93 ;; contain store file names, so the CRC changes at every rebuild.)
94 (outputs (delete "debug" (package-outputs base))))))
95
96(define gcc-for-bootstrap
97 (mlambdaq (glibc)
98 "Return a variant of GCC that uses the bootstrap variant of GLIBC."
99 (package
100 (inherit gcc)
101 (outputs '("out")) ;all in one so libgcc_s is easily found
102 (inputs
103 `( ;; Distinguish the name so we can refer to it below.
104 ("bootstrap-libc" ,(glibc-for-bootstrap glibc))
105 ("libc:static" ,(glibc-for-bootstrap glibc) "static")
106 ,@(package-inputs gcc))))))
107
108(define (package-with-relocatable-glibc p)
109 "Return a variant of P that uses the libc as defined by
110`glibc-for-bootstrap'."
111
112 (define (cross-bootstrap-libc target)
113 (glibc-for-bootstrap
114 ;; `cross-libc' already returns a cross libc, so clear
115 ;; %CURRENT-TARGET-SYSTEM.
116 (parameterize ((%current-target-system #f))
117 (cross-libc target))))
118
119 ;; Standard inputs with the above libc and corresponding GCC.
120
121 (define (inputs)
122 (if (%current-target-system) ; is this package cross built?
123 `(("cross-libc"
124 ,(cross-bootstrap-libc (%current-target-system)))
125 ("cross-libc:static"
126 ,(cross-bootstrap-libc (%current-target-system))
127 "static"))
128 '()))
129
130 (define (native-inputs)
131 (if (%current-target-system)
132 (let* ((target (%current-target-system))
133 (xgcc (cross-gcc
134 target
135 #:xbinutils (cross-binutils target)
136 #:libc (cross-bootstrap-libc target))))
137 `(,@(%final-inputs)
138 ;; As versions for gcc and cross-gcc can differ, make sure to have
139 ;; cross-gcc behind gcc in CPLUS_INCLUDE_PATH.
140 ("cross-gcc" ,(package
141 (inherit xgcc)
142 (search-paths
143 ;; Ensure the cross libc headers appears on the
144 ;; C++ system header search path.
145 (cons (search-path-specification
146 (variable "CROSS_CPLUS_INCLUDE_PATH")
147 (files '("include")))
148 (package-search-paths gcc)))))
149 ("cross-binutils" ,(cross-binutils target))))
150 `(("libc" ,(glibc-for-bootstrap glibc))
151 ("libc:static" ,(glibc-for-bootstrap glibc) "static")
152 ("gcc" ,(gcc-for-bootstrap glibc))
153 ,@(fold alist-delete (%final-inputs) '("libc" "gcc")))))
154
155 (package-with-explicit-inputs p inputs
156 (current-source-location)
157 #:native-inputs native-inputs))
158
159(define %static-inputs
160 ;; Packages that are to be used as %BOOTSTRAP-INPUTS.
161 (let ((coreutils (package
162 (inherit coreutils)
163 (arguments
164 (substitute-keyword-arguments
165 (package-arguments coreutils)
166 ((#:configure-flags _ #~'())
167 #~'("--disable-nls"
168 "--disable-silent-rules"
169 "--enable-no-install-program=stdbuf,libstdbuf.so"
170 "CFLAGS=-Os -g0" ; smaller, please
171 "LDFLAGS=-static -pthread"
172
173 ;; Work around a cross-compilation bug whereby libcoreutils.a
174 ;; would provide '__mktime_internal', which conflicts with the
175 ;; one in libc.a.
176 #$@(if (%current-target-system)
177 #~("gl_cv_func_working_mktime=yes")
178 #~())))
179 ((#:tests? _ #t)
180 #f))) ;signal-related Gnulib tests fail
181
182 ;; Remove optional dependencies such as GMP.
183 (inputs '())
184
185 ;; Remove the 'debug' output (see above for the reason.)
186 (outputs '("out"))))
187 (bzip2 (package
188 (inherit bzip2)
189 (arguments
190 (substitute-keyword-arguments arguments
191 ((#:phases phases)
192 #~(modify-phases #$phases
193 (add-before 'build 'dash-static
194 (lambda _
195 (substitute* "Makefile"
196 (("^LDFLAGS[[:blank:]]*=.*$")
197 "LDFLAGS = -static"))))))))))
198 (xz (package
199 (inherit xz)
200 (outputs '("out"))
201 (arguments
202 (list #:strip-flags #~'("--strip-all")
203 #:phases #~(modify-phases %standard-phases
204 (add-before 'configure 'static-executable
205 (lambda _
206 ;; Ask Libtool for a static executable.
207 (substitute* "src/xz/Makefile.in"
208 (("^xz_LDADD =")
209 "xz_LDADD = -all-static")))))))))
210 (gawk (package
211 (inherit gawk)
212 (source (origin
213 (inherit (package-source gawk))
214 (modules '((guix build utils)))
215 (snippet
216 ;; Do not build 'getopt.c' since that leads to a
217 ;; link failure due to duplicate symbols with
218 ;; 'libc.a'.
219 '(substitute* "support/Makefile.in"
220 (("getopt\\.\\$\\(OBJEXT\\)") "")))
221 (patches (cons (search-patch "gawk-shell.patch")
222 (origin-patches
223 (package-source gawk))))))
224 (arguments
225 (substitute-keyword-arguments arguments
226 ((#:configure-flags _ #~'())
227 ;; Starting from gawk 4.1.0, some of the tests for the
228 ;; plug-in mechanism just fail on static builds:
229 ;;
230 ;; ./fts.awk:1: error: can't open shared library `filefuncs' for reading (No such file or directory)
231 ;;
232 ;; Therefore disable extensions support.
233 #~(list "--disable-extensions"))
234 ((#:phases phases)
235 #~(modify-phases #$phases
236 (add-before 'configure 'no-export-dynamic
237 (lambda _
238 ;; Since we use `-static', remove
239 ;; `-export-dynamic'.
240 (substitute* "configure"
241 (("-Wl,-export-dynamic") ""))))))))
242 (inputs (if (%current-target-system)
243 (list static-bash)
244 '()))))
245 (tar (package
246 (inherit tar)
247 (arguments
248 (substitute-keyword-arguments arguments
249 ((#:configure-flags flags #~'())
250 ;; Work around a cross-compilation bug whereby libgnu.a
251 ;; would provide '__mktime_internal', which conflicts
252 ;; with the one in libc.a.
253 #~'("gl_cv_func_working_mktime=yes"))
254 ((#:phases phases)
255 #~(modify-phases #$phases
256 (replace 'set-shell-file-name
257 (lambda _
258 ;; Do not use "/bin/sh" to run programs; see
259 ;; <http://lists.gnu.org/archive/html/guix-devel/2016-09/msg02272.html>.
260 (substitute* "src/system.c"
261 (("/bin/sh") "sh")
262 (("execv ") "execvp "))))))))))
263 ;; We don't want to retain a reference to /gnu/store in the bootstrap
264 ;; versions of egrep/fgrep, so we remove the custom phase added since
265 ;; [email protected]. The effect is 'egrep' and 'fgrep' look for 'grep' in
266 ;; $PATH.
267 (grep (package
268 (inherit grep)
269 (inputs '()) ;remove PCRE, which is optional
270 (arguments
271 (substitute-keyword-arguments arguments
272 ((#:configure-flags flags #~'())
273 #~(cons "--disable-perl-regexp"
274 (delete "--enable-perl-regexp" #$flags)))
275 ((#:phases phases)
276 #~(modify-phases #$phases
277 (delete 'fix-egrep-and-fgrep)))))))
278 (finalize (compose static-package
279 package-with-relocatable-glibc)))
280 (append (map finalize
281 (list tar gzip bzip2 xz patch coreutils sed grep gawk))
282 (list static-bash))))
283
284(define %static-binaries
285 (package
286 (name "static-binaries")
287 (version "0")
288 (build-system trivial-build-system)
289 (source #f)
290 (inputs %static-inputs)
291 (arguments
292 `(#:modules ((guix build utils))
293 #:builder
294 (begin
295 (use-modules (ice-9 ftw)
296 (ice-9 match)
297 (srfi srfi-1)
298 (srfi srfi-26)
299 (guix build utils))
300
301 (let ()
302 (define (directory-contents dir)
303 (map (cut string-append dir "/" <>)
304 (scandir dir (negate (cut member <> '("." ".."))))))
305
306 (define (copy-directory source destination)
307 (for-each (lambda (file)
308 (format #t "copying ~s...~%" file)
309 (copy-file file
310 (string-append destination "/"
311 (basename file))))
312 (directory-contents source)))
313
314 (let* ((out (assoc-ref %outputs "out"))
315 (bin (string-append out "/bin")))
316 (mkdir-p bin)
317
318 ;; Copy Coreutils binaries.
319 (let* ((coreutils (assoc-ref %build-inputs "coreutils"))
320 (source (string-append coreutils "/bin")))
321 (copy-directory source bin))
322
323 ;; For the other inputs, copy just one binary, which has the
324 ;; same name as the input.
325 (for-each (match-lambda
326 ((name . dir)
327 (let* ((name (if (string-prefix? "bash" name)
328 "bash"
329 name))
330 (source (string-append dir "/bin/" name)))
331 (format #t "copying ~s...~%" source)
332 (copy-file source
333 (string-append bin "/" name)))))
334 (alist-delete "coreutils" %build-inputs))
335
336 ;; But of course, there are exceptions to this rule.
337 (let ((grep (assoc-ref %build-inputs "grep")))
338 (install-file (string-append grep "/bin/fgrep") bin)
339 (install-file (string-append grep "/bin/egrep") bin))
340
341 ;; Clear references to the store path.
342 (for-each remove-store-references
343 (directory-contents bin))
344
345 (with-directory-excursion bin
346 ;; Programs such as Perl's build system want these aliases.
347 (symlink "bash" "sh")
348 (symlink "gawk" "awk"))
349
350 #t)))))
351 (synopsis "Statically-linked bootstrap binaries")
352 (description
353 "Binaries used to bootstrap the distribution.")
354 (license gpl3+)
355 (home-page #f)))
356
357(define %linux-libre-headers-stripped
358 ;; The subset of Linux-Libre-Headers that we need.
359 (package (inherit linux-libre-headers)
360 (name (string-append (package-name linux-libre-headers) "-stripped"))
361 (build-system trivial-build-system)
362 (outputs '("out"))
363 (arguments
364 `(#:modules ((guix build utils)
365 (guix build make-bootstrap))
366 #:builder
367 (begin
368 (use-modules (guix build utils)
369 (guix build make-bootstrap))
370
371 (let* ((in (assoc-ref %build-inputs "linux-libre-headers"))
372 (out (assoc-ref %outputs "out")))
373 (copy-linux-headers out in)
374 #t))))
375 (inputs (list linux-libre-headers))))
376
377(define %binutils-static
378 ;; Statically-linked Binutils.
379 (package
380 (inherit binutils)
381 (name "binutils-static")
382 (arguments
383 (list #:configure-flags
384 #~(cons "--disable-gold"
385 #$(match (memq #:configure-flags (package-arguments binutils))
386 ((#:configure-flags flags _ ...)
387 flags)))
388 #:make-flags
389 #~(append
390 #$(if (target-hurd64?)
391 #~'("lt_cv_prog_compiler_static_works=yes"
392 "lt_cv_prog_compiler_static_works_CXX=yes")
393 #~'())
394 #$(match (memq #:make-flags (package-arguments binutils))
395 ((#:make-flags flags _ ...)
396 flags)
397 (_ #~'())))
398 #:strip-flags #~'("--strip-all")
399 #:phases
400 #~(modify-phases %standard-phases
401 (add-before 'configure 'all-static
402 (lambda _
403 ;; The `-all-static' libtool flag can only be passed after
404 ;; `configure', since configure tests don't use libtool,
405 ;; and only for executables built with libtool.
406 (substitute* '("binutils/Makefile.in"
407 "gas/Makefile.in" "ld/Makefile.in")
408 (("^LDFLAGS =(.*)$" line)
409 (string-append
410 line
411 "\nAM_LDFLAGS = -static -all-static\n"))))))))))
412
413(define %binutils-static-stripped
414 ;; The subset of Binutils that we need.
415 (package
416 (inherit %binutils-static)
417 (name (string-append (package-name %binutils-static) "-stripped"))
418 (build-system trivial-build-system)
419 (outputs '("out"))
420 (arguments
421 (list #:modules '((guix build utils))
422 #:builder
423 #~(begin
424 (use-modules (guix build utils))
425
426 (setvbuf (current-output-port)
427 (cond-expand (guile-2.0 _IOLBF) (else 'line)))
428 (let* ((in #$%binutils-static)
429 (out #$output)
430 (bin (string-append out "/bin")))
431 (mkdir-p bin)
432 (for-each (lambda (file)
433 (let ((target (string-append bin "/" file)))
434 (format #t "copying `~a'...~%" file)
435 (copy-file (string-append in "/bin/" file)
436 target)
437 (remove-store-references target)))
438 '("ar" "as" "ld" "nm" "objcopy" "objdump"
439 "ranlib" "readelf" "size" "strings" "strip"))))))))
440
441(define (%glibc-stripped)
442 ;; GNU libc's essential shared libraries, dynamic linker, and headers,
443 ;; with all references to store directories stripped. As a result,
444 ;; libc.so is unusable and need to be patched for proper relocation.
445 (let ((glibc (glibc-for-bootstrap glibc)))
446 (package (inherit glibc)
447 (name "glibc-stripped")
448 (build-system trivial-build-system)
449 (arguments
450 `(#:modules ((guix build utils)
451 (guix build make-bootstrap))
452 #:builder
453 (begin
454 (use-modules (guix build make-bootstrap))
455 (make-stripped-libc (assoc-ref %outputs "out")
456 (assoc-ref %build-inputs "libc")
457 (assoc-ref %build-inputs "kernel-headers")))))
458 (native-inputs
459 `(("libc" ,(let ((target (%current-target-system)))
460 (if target
461 (glibc-for-bootstrap
462 (parameterize ((%current-target-system #f))
463 (cross-libc target)))
464 glibc)))))
465 (inputs
466 `(("kernel-headers"
467 ,(cond ((or (and (%current-target-system)
468 (target-hurd? (%current-target-system)))
469 (string-suffix? "-hurd" (%current-system)))
470 gnumach-headers)
471 (else linux-libre-headers)))))
472 (propagated-inputs '())
473
474 ;; Only one output.
475 (outputs '("out")))))
476
477(define %gcc-static
478 ;; A statically-linked GCC, with stripped-down functionality.
479 (package-with-relocatable-glibc
480 (package (inherit gcc-14)
481 (name "gcc-static")
482 (outputs '("out")) ; all in one
483 (arguments
484 (substitute-keyword-arguments arguments
485 ((#:modules modules %default-gnu-modules)
486 `((srfi srfi-1)
487 (srfi srfi-26)
488 (ice-9 regex)
489 ,@modules))
490 ((#:guile _) #f)
491 ((#:implicit-inputs? _) #t)
492 ((#:configure-flags flags)
493 #~(append (list
494 ;; We don't need a full bootstrap here.
495 "--disable-bootstrap"
496
497 ;; Make sure '-static' is passed where it matters.
498 "--with-stage1-ldflags=-static"
499
500 ;; GCC 4.8+ requires a C++ compiler and library.
501 "--enable-languages=c,c++"
502
503 ;; Make sure gcc-nm doesn't require liblto_plugin.so.
504 "--disable-lto"
505
506 "--disable-shared"
507 "--disable-plugin"
508 "--disable-libmudflap"
509 "--disable-libatomic"
510 "--disable-libsanitizer"
511 "--disable-libitm"
512 "--disable-libgomp"
513 "--disable-libcilkrts"
514 "--disable-libvtv"
515 "--disable-libssp"
516 "--disable-libquadmath")
517 (remove (cut string-match "--(.*plugin|enable-languages)" <>)
518 #$flags)))
519 ((#:phases phases)
520 #~(modify-phases #$phases
521 (add-after 'pre-configure 'remove-lgcc_s
522 (lambda _
523 ;; Remove the '-lgcc_s' added to GNU_USER_TARGET_LIB_SPEC in
524 ;; the 'pre-configure phase of our main gcc package, because
525 ;; that shared library is not present in this static gcc. See
526 ;; <https://lists.gnu.org/archive/html/guix-devel/2015-01/msg00008.html>.
527 (substitute* (cons "gcc/config/rs6000/sysv4.h"
528 (find-files "gcc/config"
529 "^gnu-user.*\\.h$"))
530 ((" -lgcc_s}}") "}}"))))))))
531 (inputs
532 `(("zlib:static" ,zlib "static")
533 ("isl:static" ,isl "static")
534 ,@(fold alist-delete (package-inputs gcc-14)
535 '("libstdc++" "libstdc++-headers"))))
536 (native-inputs
537 (if (%current-target-system)
538 `(;; When doing a Canadian cross, we need GMP/MPFR/MPC both
539 ;; as target inputs and as native inputs; the latter is
540 ;; needed when building build-time tools ('genconstants',
541 ;; etc.) Failing to do that leads to misdetections of
542 ;; declarations by 'gcc/configure', and eventually to
543 ;; duplicate declarations as reported in
544 ;; <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=59217>.
545 ("gmp-native" ,gmp)
546 ("mpfr-native" ,mpfr)
547 ("mpc-native" ,mpc)
548 ,@(package-native-inputs gcc-14))
549 (package-native-inputs gcc-14))))))
550
551(define %gcc-stripped
552 ;; The subset of GCC files needed for bootstrap.
553 (package
554 (inherit gcc-14)
555 (name "gcc-stripped")
556 (build-system trivial-build-system)
557 (source #f)
558 (outputs '("out")) ;only one output
559 (inputs '())
560 (native-inputs '())
561 (arguments
562 (list #:modules '((guix build utils))
563 #:builder
564 #~(begin
565 (use-modules (srfi srfi-1)
566 (srfi srfi-26)
567 (guix build utils))
568
569 (setvbuf (current-output-port)
570 (cond-expand (guile-2.0 _IOLBF) (else 'line)))
571 (let* ((out #$output)
572 (bindir (string-append out "/bin"))
573 (libdir (string-append out "/lib"))
574 (includedir (string-append out "/include"))
575 (libexecdir (string-append out "/libexec"))
576 (gcc #$%gcc-static))
577 (copy-recursively (string-append gcc "/bin") bindir)
578 (for-each remove-store-references
579 (find-files bindir ".*"))
580
581 (copy-recursively (string-append gcc "/lib") libdir)
582 (for-each remove-store-references
583 (remove (cut string-suffix? ".h" <>)
584 (find-files libdir ".*")))
585
586 (copy-recursively (string-append gcc "/libexec")
587 libexecdir)
588 (for-each remove-store-references
589 (find-files libexecdir ".*"))
590
591 ;; Starting from GCC 4.8, helper programs built natively
592 ;; (‘genchecksum’, ‘gcc-nm’, etc.) rely on C++ headers.
593 (copy-recursively (string-append gcc "/include/c++")
594 (string-append includedir "/c++"))
595
596 ;; For native builds, check whether the binaries actually work.
597 #$@(if (%current-target-system)
598 '()
599 '((for-each (lambda (prog)
600 (invoke (string-append gcc "/bin/" prog)
601 "--version"))
602 '("gcc" "g++" "cpp"))))))))))
603
604(define* (make-guile-static guile patches)
605 (package-with-relocatable-glibc
606 (static-package
607 (package
608 (inherit guile)
609 (source
610 (origin (inherit (package-source guile))
611 (patches (append (map search-patch patches)
612 (origin-patches (package-source guile))))))
613 (name (string-append (package-name guile) "-static"))
614 (synopsis "Statically-linked and relocatable Guile")
615
616 ;; Remove the 'debug' output (see above for the reason.)
617 (outputs (delete "debug" (package-outputs guile)))
618
619 (inputs
620 (modify-inputs inputs
621 (prepend `(,libunistring "static"))))
622
623 (propagated-inputs
624 (modify-inputs propagated-inputs
625 (replace "libgc" libgc/static-libs)))
626
627 (arguments
628 (substitute-keyword-arguments arguments
629 ((#:configure-flags flags #~'())
630 ;; When `configure' checks for ltdl availability, it
631 ;; doesn't try to link using libtool, and thus fails
632 ;; because of a missing -ldl. Work around that.
633 #~(list "LDFLAGS=-ldl" "--enable-mini-gmp"
634
635 ;; Guile does an LTO build by default, but in 3.0.9 it
636 ;; wrongfully picks 'ar' instead of 'gcc-ar', so work around
637 ;; it (see <https://issues.guix.gnu.org/61086>).
638 #$@(if (version-prefix? "3.0" (package-version guile))
639 #~("AR=gcc-ar" "RANLIB=gcc-ranlib")
640 #~())
641
642 #$@(if (target-hurd?)
643 #~("--disable-jit")
644 #~())
645 #$@(if (target-hurd64?)
646 #~("lt_cv_prog_compiler_static_works=yes")
647 #~())))
648 ((#:phases phases '%standard-phases)
649 #~(modify-phases #$phases
650
651 ;; Do not record the absolute file name of 'sh' in
652 ;; (ice-9 popen). This makes 'open-pipe' unusable in
653 ;; a build chroot ('open-pipe*' is fine) but avoids
654 ;; keeping a reference to Bash.
655 (delete 'pre-configure)
656
657 (add-before 'configure 'static-guile
658 (lambda _
659 (substitute* "libguile/Makefile.in"
660 ;; Create a statically-linked `guile'
661 ;; executable.
662 (("^guile_LDFLAGS =")
663 "guile_LDFLAGS = -all-static")
664
665 ;; Add `-ldl' *after* libguile-2.0.la.
666 (("^guile_LDADD =(.*)$" _ ldadd)
667 (string-append "guile_LDADD = "
668 (string-trim-right ldadd)
669 " -ldl\n")))))))
670 ((#:tests? _ #f)
671 ;; There are uses of `dynamic-link' in
672 ;; {foreign,coverage}.test that don't fly here.
673 #f)
674 ((#:parallel-build? _ #f)
675 ;; Work around the fact that the Guile build system is
676 ;; not deterministic when parallel-build is enabled.
677 #f)))))))
678
679(define %guile-static
680 ;; A statically-linked Guile that is relocatable--i.e., it can search
681 ;; .scm and .go files relative to its installation directory, rather
682 ;; than in hard-coded configure-time paths.
683 (make-guile-static guile-2.0 '("guile-relocatable.patch"
684 "guile-default-utf8.patch"
685 "guile-linux-syscalls.patch")))
686
687(define %guile-static-3.0
688 (make-guile-static guile-3.0-latest
689 '("guile-2.2-default-utf8.patch"
690 "guile-3.0-linux-syscalls.patch"
691 "guile-3.0-relocatable.patch")))
692
693(define* (make-guile-static-stripped static-guile
694 #:optional (directories-to-remove '()))
695 (package
696 (inherit static-guile)
697 (name (string-append (package-name static-guile) "-stripped"))
698 (build-system trivial-build-system)
699 (arguments
700 ;; The end result should depend on nothing but itself.
701 (list #:allowed-references '("out")
702 #:modules '((guix build utils))
703 #:builder
704 #~(let ((version #$(version-major+minor (package-version static-guile))))
705 (use-modules (guix build utils))
706
707 (let* ((in #$static-guile)
708 (out #$output)
709 (guile1 (string-append in "/bin/guile"))
710 (guile2 (string-append out "/bin/guile")))
711 (mkdir-p (string-append out "/share/guile/" version))
712 (copy-recursively (string-append in "/share/guile/" version)
713 (string-append out "/share/guile/" version))
714
715 (mkdir-p (string-append out "/lib/guile/" version "/ccache"))
716 (copy-recursively (string-append in "/lib/guile/" version "/ccache")
717 (string-append out "/lib/guile/" version "/ccache"))
718
719 (mkdir (string-append out "/bin"))
720 (copy-file guile1 guile2)
721
722 ;; Optionally remove additional directories.
723 (for-each (lambda (directory)
724 (delete-file-recursively
725 (string-append out "/" directory)))
726 '#$directories-to-remove)
727
728 ;; Verify that the relocated Guile works.
729 #$@(if (%current-target-system)
730 '()
731 '((invoke guile2 "--version")))
732
733 ;; Strip store references.
734 (remove-store-references guile2)
735
736 ;; Verify that the stripped Guile works. If it aborts, it could be
737 ;; that it tries to open iconv descriptors and fails because libc's
738 ;; iconv data isn't available (see `guile-default-utf8.patch'.)
739 #$@(if (%current-target-system)
740 '()
741 '((invoke guile2 "--version")))))))
742 (outputs '("out"))
743 (synopsis "Minimal statically-linked and relocatable Guile")))
744
745(define %guile-static-stripped
746 ;; A stripped static Guile 3.0 binary for use during bootstrap.
747 (make-guile-static-stripped %guile-static-3.0))
748
749(define %guile-static-initrd
750 ;; A stripped static Guile 3.0 binary for use in initrds. Remove various
751 ;; modules that are useless in an initrd. Note: Keep most of language/
752 ;; because it is needed for Bournish.
753 (package
754 (inherit
755 (make-guile-static-stripped
756 %guile-static-3.0
757 (append-map (lambda (directory)
758 (list (string-append "lib/guile/3.0/ccache/" directory)
759 (string-append "share/guile/3.0/" directory)))
760 '("language/brainfuck"
761 "language/ecmascript"
762 "language/elisp"
763 "oop"
764 "scripts"
765 "sxml"
766 "texinfo"
767 "web"))))
768 (name "guile-static-initrd")))
769
770(define (tarball-package pkg)
771 "Return a package containing a tarball of PKG."
772 (package
773 (inherit pkg)
774 (name (string-append (package-name pkg) "-tarball"))
775 (build-system trivial-build-system)
776 (native-inputs (list tar xz))
777 (arguments
778 (list #:modules '((guix build utils))
779 #:builder
780 #~(begin
781 (use-modules (guix build utils))
782 (let ((out #$output)
783 (input #$pkg)
784 (tar #+(this-package-native-input "tar"))
785 (xz #+(this-package-native-input "xz")))
786 (mkdir out)
787 (set-path-environment-variable "PATH" '("bin") (list tar xz))
788 (with-directory-excursion input
789 (invoke "tar" "cJvf"
790 (string-append out "/"
791 #$(package-name pkg) "-"
792 #$(package-version pkg)
793 "-"
794 #$(or (%current-target-system)
795 (%current-system))
796 ".tar.xz")
797 "."
798 ;; avoid non-determinism in the archive
799 "--sort=name" "--mtime=@0"
800 "--owner=root:0" "--group=root:0"))))))))
801
802(define %bootstrap-binaries-tarball
803 ;; A tarball with the statically-linked bootstrap binaries.
804 (tarball-package %static-binaries))
805
806(define %linux-libre-headers-bootstrap-tarball
807 ;; A tarball with the statically-linked Linux-Libre-Headers programs.
808 (tarball-package %linux-libre-headers-stripped))
809
810(define %binutils-bootstrap-tarball
811 ;; A tarball with the statically-linked Binutils programs.
812 (tarball-package %binutils-static-stripped))
813
814(define (%glibc-bootstrap-tarball)
815 ;; A tarball with GNU libc's shared libraries, dynamic linker, and headers.
816 (tarball-package (%glibc-stripped)))
817
818(define %gcc-bootstrap-tarball
819 ;; A tarball with a dynamic-linked GCC and its headers.
820 (tarball-package %gcc-stripped))
821
822(define %guile-bootstrap-tarball
823 ;; A tarball with the statically-linked, relocatable Guile.
824 (tarball-package %guile-static-stripped))
825
826(define %bootstrap-tarballs
827 ;; A single derivation containing all the bootstrap tarballs, for
828 ;; convenience.
829 (package
830 (name "bootstrap-tarballs")
831 (version "0")
832 (source #f)
833 (build-system trivial-build-system)
834 (arguments
835 (list #:modules '((guix build utils))
836 #:builder
837 #~(begin
838 (use-modules (guix build utils)
839 (ice-9 match)
840 (srfi srfi-26))
841
842 (define out #$output)
843
844 (setvbuf (current-output-port)
845 (cond-expand (guile-2.0 _IOLBF) (else 'line)))
846 (mkdir out)
847 (chdir out)
848 (for-each (match-lambda
849 ((name . directory)
850 (for-each (lambda (file)
851 (format #t "~a -> ~a~%" file out)
852 (symlink file (basename file)))
853 (find-files directory "\\.tar\\."))))
854 %build-inputs))))
855 (inputs
856 (append (list %guile-bootstrap-tarball)
857 (match (or (%current-target-system) (%current-system))
858 ((or "i686-linux" "x86_64-linux")
859 (list %linux-libre-headers-bootstrap-tarball))
860 (_
861 (list %gcc-bootstrap-tarball
862 %binutils-bootstrap-tarball
863 (%glibc-bootstrap-tarball)
864 %bootstrap-binaries-tarball)))))
865 (synopsis "Tarballs containing all the bootstrap binaries")
866 (description synopsis)
867 (home-page #f)
868 (license gpl3+)))
869
870;;; make-bootstrap.scm ends here