Mirror of GNU Guix
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.

702 lines
30 KiB

gnu: Split (gnu packages base), adding (gnu packages commencement). * gnu/packages/base.scm (gnu-make-boot0, diffutils-boot0, findutils-boot0, %boot0-inputs, nix-system->gnu-triplet, boot-triplet, binutils-boot0, gcc-boot0, perl-boot0, linux-libre-headers-boot0, texinfo-boot0, %boot1-inputs, glibc-final-with-bootstrap-bash, cross-gcc-wrapper, static-bash-for-glibc, glibc-final, gcc-boot0-wrapped, %boot2-inputs, binutils-final, libstdc++, gcc-final, ld-wrapper-boot3, %boot3-inputs, bash-final, %boot4-inputs, guile-final, gnu-make-final, ld-wrapper, coreutils-final, grep-final, %boot5-inputs, %final-inputs, canonical-package, gcc-toolchain, gcc-toolchain-4.8, gcc-toolchain-4.9): Move to... * gnu/packages/commencement.scm: ... here. New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add it. * build-aux/check-final-inputs-self-contained.scm: Adjust accordingly. * gnu/packages/cross-base.scm: Likewise. * gnu/packages/make-bootstrap.scm: Likewise. * guix/build-system/cmake.scm (cmake-build): Likewise. * guix/build-system/gnu.scm (standard-packages, gnu-build, gnu-cross-build): Likewise. * guix/build-system/perl.scm (perl-build): Likewise. * guix/build-system/python.scm (python-build): Likewise. * guix/build-system/trivial.scm (guile-for-build): Likewise. * guix/download.scm (url-fetch): Likewise. * guix/gexp.scm (default-guile): Likewise. * guix/git-download.scm (git-fetch): Likewise. * guix/monads.scm (run-with-store): Likewise. * guix/packages.scm (default-guile): Likewise. * guix/scripts/package.scm (guix-package): Likewise. * guix/scripts/refresh.scm: Likewise. * guix/svn-download.scm (svn-fetch): Likewise. * tests/builders.scm (%bootstrap-inputs, %bootstrap-search-paths): Likewise. * tests/packages.scm ("GNU Make, bootstrap"): Likewise. * tests/guix-package.sh: Likewise. * gnu/services/base.scm: Use 'canonical-package' instead of xxx-final. * gnu/services/xorg.scm: Likewise. * gnu/system/vm.scm: Likewise. * guix/scripts/pull.scm (guix-pull): Likewise.
8 years ago
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2012, 2013, 2014, 2015, 2016 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 make-bootstrap)
  19. #:use-module (guix utils)
  20. #:use-module (guix packages)
  21. #:use-module (guix licenses)
  22. #:use-module (guix build-system trivial)
  23. #:use-module (guix build-system gnu)
  24. #:use-module ((gnu packages) #:select (search-patch))
  25. #:use-module ((gnu packages commencement) #:select (%final-inputs))
  26. #:use-module (gnu packages base)
  27. #:use-module (gnu packages cross-base)
  28. #:use-module (gnu packages bash)
  29. #:use-module (gnu packages compression)
  30. #:use-module (gnu packages gawk)
  31. #:use-module (gnu packages gcc)
  32. #:use-module (gnu packages guile)
  33. #:use-module (gnu packages bdw-gc)
  34. #:use-module (gnu packages linux)
  35. #:use-module (gnu packages multiprecision)
  36. #:use-module (ice-9 match)
  37. #:use-module (srfi srfi-1)
  38. #:export (%bootstrap-binaries-tarball
  39. %binutils-bootstrap-tarball
  40. %glibc-bootstrap-tarball
  41. %gcc-bootstrap-tarball
  42. %guile-bootstrap-tarball
  43. %bootstrap-tarballs
  44. %guile-static-stripped))
  45. ;;; Commentary:
  46. ;;;
  47. ;;; This module provides tools to build tarballs of the "bootstrap binaries"
  48. ;;; used in (gnu packages bootstrap). These statically-linked binaries are
  49. ;;; taken for granted and used as the root of the whole bootstrap procedure.
  50. ;;;
  51. ;;; Code:
  52. (define* (glibc-for-bootstrap #:optional (base glibc))
  53. "Return a libc deriving from BASE whose `system' and `popen' functions looks
  54. for `sh' in $PATH, and without nscd, and with static NSS modules."
  55. (package (inherit base)
  56. (source (origin (inherit (package-source base))
  57. (patches (cons (search-patch "glibc-bootstrap-system.patch")
  58. (origin-patches (package-source base))))))
  59. (arguments
  60. (substitute-keyword-arguments (package-arguments base)
  61. ((#:configure-flags flags)
  62. ;; Arrange so that getaddrinfo & co. do not contact the nscd,
  63. ;; and can use statically-linked NSS modules.
  64. `(cons* "--disable-nscd" "--disable-build-nscd"
  65. "--enable-static-nss"
  66. ,flags))))
  67. ;; Remove the 'debug' output to allow bit-reproducible builds (when the
  68. ;; 'debug' output is used, ELF files end up with a .gnu_debuglink, which
  69. ;; includes a CRC of the corresponding debugging symbols; those symbols
  70. ;; contain store file names, so the CRC changes at every rebuild.)
  71. (outputs (delete "debug" (package-outputs base)))))
  72. (define (package-with-relocatable-glibc p)
  73. "Return a variant of P that uses the libc as defined by
  74. `glibc-for-bootstrap'."
  75. (define (cross-bootstrap-libc)
  76. (let ((target (%current-target-system)))
  77. (glibc-for-bootstrap
  78. ;; `cross-libc' already returns a cross libc, so clear
  79. ;; %CURRENT-TARGET-SYSTEM.
  80. (parameterize ((%current-target-system #f))
  81. (cross-libc target)))))
  82. ;; Standard inputs with the above libc and corresponding GCC.
  83. (define (inputs)
  84. (if (%current-target-system) ; is this package cross built?
  85. `(("cross-libc" ,(cross-bootstrap-libc)))
  86. '()))
  87. (define (native-inputs)
  88. (if (%current-target-system)
  89. (let ((target (%current-target-system)))
  90. `(("cross-gcc" ,(cross-gcc target
  91. (cross-binutils target)
  92. (cross-bootstrap-libc)))
  93. ("cross-binutils" ,(cross-binutils target))
  94. ,@%final-inputs))
  95. `(("libc" ,(glibc-for-bootstrap))
  96. ("gcc" ,(package (inherit gcc)
  97. (outputs '("out")) ; all in one so libgcc_s is easily found
  98. (inputs
  99. `(("libc",(glibc-for-bootstrap))
  100. ,@(package-inputs gcc)))))
  101. ,@(fold alist-delete %final-inputs '("libc" "gcc")))))
  102. (package-with-explicit-inputs p inputs
  103. (current-source-location)
  104. #:native-inputs native-inputs))
  105. (define %bash-static
  106. (static-package bash-minimal))
  107. (define %static-inputs
  108. ;; Packages that are to be used as %BOOTSTRAP-INPUTS.
  109. (let ((coreutils (package (inherit coreutils)
  110. (arguments
  111. `(#:configure-flags
  112. '("--disable-nls"
  113. "--disable-silent-rules"
  114. "--enable-no-install-program=stdbuf,libstdbuf.so"
  115. "CFLAGS=-Os -g0" ; smaller, please
  116. "LDFLAGS=-static -pthread")
  117. #:tests? #f ; signal-related Gnulib tests fail
  118. ,@(package-arguments coreutils)))
  119. ;; Remove optional dependencies such as GMP. Keep Perl
  120. ;; except if it's missing (which is the case when
  121. ;; cross-compiling).
  122. (inputs (match (assoc "perl" (package-inputs coreutils))
  123. (#f '())
  124. (x (list x))))
  125. ;; Remove the 'debug' output (see above for the reason.)
  126. (outputs '("out"))))
  127. (bzip2 (package (inherit bzip2)
  128. (arguments
  129. (substitute-keyword-arguments (package-arguments bzip2)
  130. ((#:phases phases)
  131. `(alist-cons-before
  132. 'build 'dash-static
  133. (lambda _
  134. (substitute* "Makefile"
  135. (("^LDFLAGS[[:blank:]]*=.*$")
  136. "LDFLAGS = -static")))
  137. ,phases))))))
  138. (xz (package (inherit xz)
  139. (arguments
  140. `(#:strip-flags '("--strip-all")
  141. #:phases (alist-cons-before
  142. 'configure 'static-executable
  143. (lambda _
  144. ;; Ask Libtool for a static executable.
  145. (substitute* "src/xz/Makefile.in"
  146. (("^xz_LDADD =")
  147. "xz_LDADD = -all-static")))
  148. %standard-phases)))))
  149. (gawk (package (inherit gawk)
  150. (source (origin (inherit (package-source gawk))
  151. (patches (cons (search-patch "gawk-shell.patch")
  152. (origin-patches
  153. (package-source gawk))))))
  154. (arguments
  155. `(;; Starting from gawk 4.1.0, some of the tests for the
  156. ;; plug-in mechanism just fail on static builds:
  157. ;;
  158. ;; ./fts.awk:1: error: can't open shared library `filefuncs' for reading (No such file or directory)
  159. #:tests? #f
  160. ,@(substitute-keyword-arguments (package-arguments gawk)
  161. ((#:phases phases)
  162. `(alist-cons-before
  163. 'configure 'no-export-dynamic
  164. (lambda _
  165. ;; Since we use `-static', remove
  166. ;; `-export-dynamic'.
  167. (substitute* "configure"
  168. (("-Wl,-export-dynamic") "")))
  169. ,phases)))))
  170. (inputs (if (%current-target-system)
  171. `(("bash" ,%bash-static))
  172. '()))))
  173. (tar (package (inherit tar)
  174. (arguments
  175. '(#:phases (modify-phases %standard-phases
  176. (add-before 'build 'set-shell-file-name
  177. (lambda _
  178. ;; Do not use "/bin/sh" to run programs; see
  179. ;; <http://lists.gnu.org/archive/html/guix-devel/2016-09/msg02272.html>.
  180. (substitute* "src/system.c"
  181. (("/bin/sh") "sh")
  182. (("execv ") "execvp "))
  183. #t)))))))
  184. (finalize (compose static-package
  185. package-with-relocatable-glibc)))
  186. `(,@(map (match-lambda
  187. ((name package)
  188. (list name (finalize package))))
  189. `(("tar" ,tar)
  190. ("gzip" ,gzip)
  191. ("bzip2" ,bzip2)
  192. ("xz" ,xz)
  193. ("patch" ,patch)
  194. ("coreutils" ,coreutils)
  195. ("sed" ,sed)
  196. ("grep" ,grep)
  197. ("gawk" ,gawk)))
  198. ("bash" ,%bash-static))))
  199. (define %static-binaries
  200. (package
  201. (name "static-binaries")
  202. (version "0")
  203. (build-system trivial-build-system)
  204. (source #f)
  205. (inputs %static-inputs)
  206. (arguments
  207. `(#:modules ((guix build utils))
  208. #:builder
  209. (begin
  210. (use-modules (ice-9 ftw)
  211. (ice-9 match)
  212. (srfi srfi-1)
  213. (srfi srfi-26)
  214. (guix build utils))
  215. (let ()
  216. (define (directory-contents dir)
  217. (map (cut string-append dir "/" <>)
  218. (scandir dir (negate (cut member <> '("." ".."))))))
  219. (define (copy-directory source destination)
  220. (for-each (lambda (file)
  221. (format #t "copying ~s...~%" file)
  222. (copy-file file
  223. (string-append destination "/"
  224. (basename file))))
  225. (directory-contents source)))
  226. (let* ((out (assoc-ref %outputs "out"))
  227. (bin (string-append out "/bin")))
  228. (mkdir-p bin)
  229. ;; Copy Coreutils binaries.
  230. (let* ((coreutils (assoc-ref %build-inputs "coreutils"))
  231. (source (string-append coreutils "/bin")))
  232. (copy-directory source bin))
  233. ;; For the other inputs, copy just one binary, which has the
  234. ;; same name as the input.
  235. (for-each (match-lambda
  236. ((name . dir)
  237. (let ((source (string-append dir "/bin/" name)))
  238. (format #t "copying ~s...~%" source)
  239. (copy-file source
  240. (string-append bin "/" name)))))
  241. (alist-delete "coreutils" %build-inputs))
  242. ;; But of course, there are exceptions to this rule.
  243. (let ((grep (assoc-ref %build-inputs "grep")))
  244. (install-file (string-append grep "/bin/fgrep") bin)
  245. (install-file (string-append grep "/bin/egrep") bin))
  246. ;; Clear references to the store path.
  247. (for-each remove-store-references
  248. (directory-contents bin))
  249. (with-directory-excursion bin
  250. ;; Programs such as Perl's build system want these aliases.
  251. (symlink "bash" "sh")
  252. (symlink "gawk" "awk"))
  253. #t)))))
  254. (synopsis "Statically-linked bootstrap binaries")
  255. (description
  256. "Binaries used to bootstrap the distribution.")
  257. (license gpl3+)
  258. (home-page #f)))
  259. (define %binutils-static
  260. ;; Statically-linked Binutils.
  261. (package (inherit binutils)
  262. (name "binutils-static")
  263. (arguments
  264. `(#:configure-flags (cons "--disable-gold"
  265. ,(match (memq #:configure-flags
  266. (package-arguments binutils))
  267. ((#:configure-flags flags _ ...)
  268. flags)))
  269. #:strip-flags '("--strip-all")
  270. #:phases (alist-cons-before
  271. 'configure 'all-static
  272. (lambda _
  273. ;; The `-all-static' libtool flag can only be passed
  274. ;; after `configure', since configure tests don't use
  275. ;; libtool, and only for executables built with libtool.
  276. (substitute* '("binutils/Makefile.in"
  277. "gas/Makefile.in"
  278. "ld/Makefile.in")
  279. (("^LDFLAGS =(.*)$" line)
  280. (string-append line
  281. "\nAM_LDFLAGS = -static -all-static\n"))))
  282. %standard-phases)))))
  283. (define %binutils-static-stripped
  284. ;; The subset of Binutils that we need.
  285. (package (inherit %binutils-static)
  286. (name (string-append (package-name %binutils-static) "-stripped"))
  287. (build-system trivial-build-system)
  288. (outputs '("out"))
  289. (arguments
  290. `(#:modules ((guix build utils))
  291. #:builder
  292. (begin
  293. (use-modules (guix build utils))
  294. (setvbuf (current-output-port) _IOLBF)
  295. (let* ((in (assoc-ref %build-inputs "binutils"))
  296. (out (assoc-ref %outputs "out"))
  297. (bin (string-append out "/bin")))
  298. (mkdir-p bin)
  299. (for-each (lambda (file)
  300. (let ((target (string-append bin "/" file)))
  301. (format #t "copying `~a'...~%" file)
  302. (copy-file (string-append in "/bin/" file)
  303. target)
  304. (remove-store-references target)))
  305. '("ar" "as" "ld" "nm" "objcopy" "objdump"
  306. "ranlib" "readelf" "size" "strings" "strip"))
  307. #t))))
  308. (inputs `(("binutils" ,%binutils-static)))))
  309. (define %glibc-stripped
  310. ;; GNU libc's essential shared libraries, dynamic linker, and headers,
  311. ;; with all references to store directories stripped. As a result,
  312. ;; libc.so is unusable and need to be patched for proper relocation.
  313. (let ((glibc (glibc-for-bootstrap)))
  314. (package (inherit glibc)
  315. (name "glibc-stripped")
  316. (build-system trivial-build-system)
  317. (arguments
  318. `(#:modules ((guix build utils))
  319. #:builder
  320. (begin
  321. (use-modules (guix build utils))
  322. (setvbuf (current-output-port) _IOLBF)
  323. (let* ((out (assoc-ref %outputs "out"))
  324. (libdir (string-append out "/lib"))
  325. (incdir (string-append out "/include"))
  326. (libc (assoc-ref %build-inputs "libc"))
  327. (linux (assoc-ref %build-inputs "kernel-headers")))
  328. (mkdir-p libdir)
  329. (for-each (lambda (file)
  330. (let ((target (string-append libdir "/"
  331. (basename file))))
  332. (copy-file file target)
  333. (remove-store-references target)))
  334. (find-files (string-append libc "/lib")
  335. "^(crt.*|ld.*|lib(c|m|dl|rt|pthread|nsl|util).*\\.so(\\..*)?|libc_nonshared\\.a)$"))
  336. (copy-recursively (string-append libc "/include") incdir)
  337. ;; Copy some of the Linux-Libre headers that glibc headers
  338. ;; refer to.
  339. (mkdir (string-append incdir "/linux"))
  340. (for-each (lambda (file)
  341. (copy-file (string-append linux "/include/linux/" file)
  342. (string-append incdir "/linux/"
  343. (basename file))))
  344. '("limits.h" "errno.h" "socket.h" "kernel.h"
  345. "sysctl.h" "param.h" "ioctl.h" "types.h"
  346. "posix_types.h" "stddef.h"))
  347. (copy-recursively (string-append linux "/include/asm")
  348. (string-append incdir "/asm"))
  349. (copy-recursively (string-append linux "/include/asm-generic")
  350. (string-append incdir "/asm-generic"))
  351. #t))))
  352. (inputs `(("libc" ,(let ((target (%current-target-system)))
  353. (if target
  354. (glibc-for-bootstrap
  355. (parameterize ((%current-target-system #f))
  356. (cross-libc target)))
  357. glibc)))
  358. ("kernel-headers" ,linux-libre-headers)))
  359. ;; Only one output.
  360. (outputs '("out")))))
  361. (define %gcc-static
  362. ;; A statically-linked GCC, with stripped-down functionality.
  363. (package-with-relocatable-glibc
  364. (package (inherit gcc)
  365. (name "gcc-static")
  366. (outputs '("out")) ; all in one
  367. (arguments
  368. `(#:modules ((guix build utils)
  369. (guix build gnu-build-system)
  370. (srfi srfi-1)
  371. (srfi srfi-26)
  372. (ice-9 regex))
  373. ,@(substitute-keyword-arguments (package-arguments gcc)
  374. ((#:guile _) #f)
  375. ((#:implicit-inputs? _) #t)
  376. ((#:configure-flags flags)
  377. `(append (list
  378. ;; We don't need a full bootstrap here.
  379. "--disable-bootstrap"
  380. ;; Make sure '-static' is passed where it matters.
  381. "--with-stage1-ldflags=-static"
  382. ;; GCC 4.8+ requires a C++ compiler and library.
  383. "--enable-languages=c,c++"
  384. ;; Make sure gcc-nm doesn't require liblto_plugin.so.
  385. "--disable-lto"
  386. "--disable-shared"
  387. "--disable-plugin"
  388. "--disable-libmudflap"
  389. "--disable-libatomic"
  390. "--disable-libsanitizer"
  391. "--disable-libitm"
  392. "--disable-libgomp"
  393. "--disable-libcilkrts"
  394. "--disable-libvtv"
  395. "--disable-libssp"
  396. "--disable-libquadmath")
  397. (remove (cut string-match "--(.*plugin|enable-languages)" <>)
  398. ,flags)))
  399. ((#:phases phases)
  400. `(alist-cons-after
  401. 'pre-configure 'remove-lgcc_s
  402. (lambda _
  403. ;; Remove the '-lgcc_s' added to GNU_USER_TARGET_LIB_SPEC in
  404. ;; the 'pre-configure phase of our main gcc package, because
  405. ;; that shared library is not present in this static gcc. See
  406. ;; <https://lists.gnu.org/archive/html/guix-devel/2015-01/msg00008.html>.
  407. (substitute* (find-files "gcc/config"
  408. "^gnu-user.*\\.h$")
  409. ((" -lgcc_s}}") "}}")))
  410. ,phases)))))
  411. (native-inputs
  412. (if (%current-target-system)
  413. `(;; When doing a Canadian cross, we need GMP/MPFR/MPC both
  414. ;; as target inputs and as native inputs; the latter is
  415. ;; needed when building build-time tools ('genconstants',
  416. ;; etc.) Failing to do that leads to misdetections of
  417. ;; declarations by 'gcc/configure', and eventually to
  418. ;; duplicate declarations as reported in
  419. ;; <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=59217>.
  420. ("gmp-native" ,gmp)
  421. ("mpfr-native" ,mpfr)
  422. ("mpc-native" ,mpc)
  423. ,@(package-native-inputs gcc))
  424. (package-native-inputs gcc))))))
  425. (define %gcc-stripped
  426. ;; The subset of GCC files needed for bootstrap.
  427. (package (inherit gcc)
  428. (name "gcc-stripped")
  429. (build-system trivial-build-system)
  430. (source #f)
  431. (outputs '("out")) ;only one output
  432. (arguments
  433. `(#:modules ((guix build utils))
  434. #:builder
  435. (begin
  436. (use-modules (srfi srfi-1)
  437. (srfi srfi-26)
  438. (guix build utils))
  439. (setvbuf (current-output-port) _IOLBF)
  440. (let* ((out (assoc-ref %outputs "out"))
  441. (bindir (string-append out "/bin"))
  442. (libdir (string-append out "/lib"))
  443. (includedir (string-append out "/include"))
  444. (libexecdir (string-append out "/libexec"))
  445. (gcc (assoc-ref %build-inputs "gcc")))
  446. (copy-recursively (string-append gcc "/bin") bindir)
  447. (for-each remove-store-references
  448. (find-files bindir ".*"))
  449. (copy-recursively (string-append gcc "/lib") libdir)
  450. (for-each remove-store-references
  451. (remove (cut string-suffix? ".h" <>)
  452. (find-files libdir ".*")))
  453. (copy-recursively (string-append gcc "/libexec")
  454. libexecdir)
  455. (for-each remove-store-references
  456. (find-files libexecdir ".*"))
  457. ;; Starting from GCC 4.8, helper programs built natively
  458. ;; (‘genchecksum’, ‘gcc-nm’, etc.) rely on C++ headers.
  459. (copy-recursively (string-append gcc "/include/c++")
  460. (string-append includedir "/c++"))
  461. ;; For native builds, check whether the binaries actually work.
  462. ,(if (%current-target-system)
  463. '#t
  464. '(every (lambda (prog)
  465. (zero? (system* (string-append gcc "/bin/" prog)
  466. "--version")))
  467. '("gcc" "g++" "cpp")))))))
  468. (inputs `(("gcc" ,%gcc-static)))))
  469. (define %guile-static
  470. ;; A statically-linked Guile that is relocatable--i.e., it can search
  471. ;; .scm and .go files relative to its installation directory, rather
  472. ;; than in hard-coded configure-time paths.
  473. (let* ((patches (cons* (search-patch "guile-relocatable.patch")
  474. (search-patch "guile-default-utf8.patch")
  475. (search-patch "guile-linux-syscalls.patch")
  476. (origin-patches (package-source guile-2.0))))
  477. (source (origin (inherit (package-source guile-2.0))
  478. (patches patches)))
  479. (guile (package (inherit guile-2.0)
  480. (name (string-append (package-name guile-2.0) "-static"))
  481. (source source)
  482. (synopsis "Statically-linked and relocatable Guile")
  483. ;; Remove the 'debug' output (see above for the reason.)
  484. (outputs (delete "debug" (package-outputs guile-2.0)))
  485. (propagated-inputs
  486. `(("bdw-gc" ,libgc)
  487. ,@(alist-delete "bdw-gc"
  488. (package-propagated-inputs guile-2.0))))
  489. (arguments
  490. `(;; When `configure' checks for ltdl availability, it
  491. ;; doesn't try to link using libtool, and thus fails
  492. ;; because of a missing -ldl. Work around that.
  493. #:configure-flags '("LDFLAGS=-ldl")
  494. #:phases (alist-cons-before
  495. 'configure 'static-guile
  496. (lambda _
  497. (substitute* "libguile/Makefile.in"
  498. ;; Create a statically-linked `guile'
  499. ;; executable.
  500. (("^guile_LDFLAGS =")
  501. "guile_LDFLAGS = -all-static")
  502. ;; Add `-ldl' *after* libguile-2.0.la.
  503. (("^guile_LDADD =(.*)$" _ ldadd)
  504. (string-append "guile_LDADD = "
  505. (string-trim-right ldadd)
  506. " -ldl\n"))))
  507. %standard-phases)
  508. ;; There are uses of `dynamic-link' in
  509. ;; {foreign,coverage}.test that don't fly here.
  510. #:tests? #f)))))
  511. (package-with-relocatable-glibc (static-package guile))))
  512. (define %guile-static-stripped
  513. ;; A stripped static Guile binary, for use during bootstrap.
  514. (package (inherit %guile-static)
  515. (name "guile-static-stripped")
  516. (build-system trivial-build-system)
  517. (arguments
  518. `(#:modules ((guix build utils))
  519. #:builder
  520. (let ()
  521. (use-modules (guix build utils))
  522. (let* ((in (assoc-ref %build-inputs "guile"))
  523. (out (assoc-ref %outputs "out"))
  524. (guile1 (string-append in "/bin/guile"))
  525. (guile2 (string-append out "/bin/guile")))
  526. (mkdir-p (string-append out "/share/guile/2.0"))
  527. (copy-recursively (string-append in "/share/guile/2.0")
  528. (string-append out "/share/guile/2.0"))
  529. (mkdir-p (string-append out "/lib/guile/2.0/ccache"))
  530. (copy-recursively (string-append in "/lib/guile/2.0/ccache")
  531. (string-append out "/lib/guile/2.0/ccache"))
  532. (mkdir (string-append out "/bin"))
  533. (copy-file guile1 guile2)
  534. ;; Does the relocated Guile work?
  535. (and ,(if (%current-target-system)
  536. #t
  537. '(zero? (system* guile2 "--version")))
  538. (begin
  539. ;; Strip store references.
  540. (remove-store-references guile2)
  541. ;; Does the stripped Guile work? If it aborts, it could be
  542. ;; that it tries to open iconv descriptors and fails because
  543. ;; libc's iconv data isn't available (see
  544. ;; `guile-default-utf8.patch'.)
  545. ,(if (%current-target-system)
  546. #t
  547. '(zero? (system* guile2 "--version")))))))))
  548. (inputs `(("guile" ,%guile-static)))
  549. (outputs '("out"))
  550. (synopsis "Minimal statically-linked and relocatable Guile")))
  551. (define (tarball-package pkg)
  552. "Return a package containing a tarball of PKG."
  553. (package (inherit pkg)
  554. (name (string-append (package-name pkg) "-tarball"))
  555. (build-system trivial-build-system)
  556. (native-inputs `(("tar" ,tar)
  557. ("xz" ,xz)))
  558. (inputs `(("input" ,pkg)))
  559. (arguments
  560. (let ((name (package-name pkg))
  561. (version (package-version pkg)))
  562. `(#:modules ((guix build utils))
  563. #:builder
  564. (begin
  565. (use-modules (guix build utils))
  566. (let ((out (assoc-ref %outputs "out"))
  567. (input (assoc-ref %build-inputs "input"))
  568. (tar (assoc-ref %build-inputs "tar"))
  569. (xz (assoc-ref %build-inputs "xz")))
  570. (mkdir out)
  571. (set-path-environment-variable "PATH" '("bin") (list tar xz))
  572. (with-directory-excursion input
  573. (zero? (system* "tar" "cJvf"
  574. (string-append out "/"
  575. ,name "-" ,version
  576. "-"
  577. ,(or (%current-target-system)
  578. (%current-system))
  579. ".tar.xz")
  580. "."
  581. ;; avoid non-determinism in the archive
  582. "--sort=name" "--mtime=@0"
  583. "--owner=root:0" "--group=root:0"))))))))))
  584. (define %bootstrap-binaries-tarball
  585. ;; A tarball with the statically-linked bootstrap binaries.
  586. (tarball-package %static-binaries))
  587. (define %binutils-bootstrap-tarball
  588. ;; A tarball with the statically-linked Binutils programs.
  589. (tarball-package %binutils-static-stripped))
  590. (define %glibc-bootstrap-tarball
  591. ;; A tarball with GNU libc's shared libraries, dynamic linker, and headers.
  592. (tarball-package %glibc-stripped))
  593. (define %gcc-bootstrap-tarball
  594. ;; A tarball with a dynamic-linked GCC and its headers.
  595. (tarball-package %gcc-stripped))
  596. (define %guile-bootstrap-tarball
  597. ;; A tarball with the statically-linked, relocatable Guile.
  598. (tarball-package %guile-static-stripped))
  599. (define %bootstrap-tarballs
  600. ;; A single derivation containing all the bootstrap tarballs, for
  601. ;; convenience.
  602. (package
  603. (name "bootstrap-tarballs")
  604. (version "0")
  605. (source #f)
  606. (build-system trivial-build-system)
  607. (arguments
  608. `(#:modules ((guix build utils))
  609. #:builder
  610. (let ((out (assoc-ref %outputs "out")))
  611. (use-modules (guix build utils)
  612. (ice-9 match)
  613. (srfi srfi-26))
  614. (setvbuf (current-output-port) _IOLBF)
  615. (mkdir out)
  616. (chdir out)
  617. (for-each (match-lambda
  618. ((name . directory)
  619. (for-each (lambda (file)
  620. (format #t "~a -> ~a~%" file out)
  621. (symlink file (basename file)))
  622. (find-files directory "\\.tar\\."))))
  623. %build-inputs)
  624. #t)))
  625. (inputs `(("guile-tarball" ,%guile-bootstrap-tarball)
  626. ("gcc-tarball" ,%gcc-bootstrap-tarball)
  627. ("binutils-tarball" ,%binutils-bootstrap-tarball)
  628. ("glibc-tarball" ,%glibc-bootstrap-tarball)
  629. ("coreutils&co-tarball" ,%bootstrap-binaries-tarball)))
  630. (synopsis "Tarballs containing all the bootstrap binaries")
  631. (description synopsis)
  632. (home-page #f)
  633. (license gpl3+)))
  634. ;;; make-bootstrap.scm ends here