#:use-module (guix licenses)
#:use-module (guix build-system trivial)
#:use-module (guix build-system gnu)
- #:use-module ((distro) #:select (search-patch))
+ #:use-module ((gnu packages) #:select (search-patch))
#:use-module (gnu packages base)
+ #:use-module (gnu packages cross-base)
#:use-module (gnu packages bash)
#:use-module (gnu packages compression)
#:use-module (gnu packages gawk)
+ #:use-module (gnu packages gcc)
#:use-module (gnu packages guile)
+ #:use-module (gnu packages bdw-gc)
#:use-module (gnu packages linux)
#:use-module (gnu packages multiprecision)
#:use-module (ice-9 match)
;;; Commentary:
;;;
-;;; This modules provides tools to build tarballs of the "bootstrap binaries"
+;;; This module provides tools to build tarballs of the "bootstrap binaries"
;;; used in (gnu packages bootstrap). These statically-linked binaries are
;;; taken for granted and used as the root of the whole bootstrap procedure.
;;;
;;; Code:
-(define %glibc-for-bootstrap
- ;; A libc whose `system' and `popen' functions looks for `sh' in $PATH,
- ;; without nscd, and with static NSS modules.
- (package (inherit glibc-final)
+(define* (glibc-for-bootstrap #:optional (base glibc))
+ "Return a libc deriving from BASE whose `system' and `popen' functions looks
+for `sh' in $PATH, and without nscd, and with static NSS modules."
+ (package (inherit base)
(arguments
- (lambda (system)
- (substitute-keyword-arguments ((package-arguments glibc-final) system)
- ((#:patches patches)
- `(cons (assoc-ref %build-inputs "patch/system")
- ,patches))
- ((#:configure-flags flags)
- ;; Arrange so that getaddrinfo & co. do not contact the nscd,
- ;; and can use statically-linked NSS modules.
- `(cons* "--disable-nscd" "--disable-build-nscd"
- "--enable-static-nss"
- ,flags)))))
+ (substitute-keyword-arguments (package-arguments base)
+ ((#:patches patches)
+ `(cons (assoc-ref %build-inputs "patch/system") ,patches))
+ ((#:configure-flags flags)
+ ;; Arrange so that getaddrinfo & co. do not contact the nscd,
+ ;; and can use statically-linked NSS modules.
+ `(cons* "--disable-nscd" "--disable-build-nscd"
+ "--enable-static-nss"
+ ,flags))))
(inputs
`(("patch/system" ,(search-patch "glibc-bootstrap-system.patch"))
- ,@(package-inputs glibc-final)))))
+ ,@(package-inputs base)))))
+
+(define (package-with-relocatable-glibc p)
+ "Return a variant of P that uses the libc as defined by
+`glibc-for-bootstrap'."
+
+ (define (cross-bootstrap-libc)
+ (let ((target (%current-target-system)))
+ (glibc-for-bootstrap
+ ;; `cross-libc' already returns a cross libc, so clear
+ ;; %CURRENT-TARGET-SYSTEM.
+ (parameterize ((%current-target-system #f))
+ (cross-libc target)))))
-(define %standard-inputs-with-relocatable-glibc
;; Standard inputs with the above libc and corresponding GCC.
- `(("libc", %glibc-for-bootstrap)
- ("gcc" ,(package-with-explicit-inputs
- gcc-4.7
- `(("libc",%glibc-for-bootstrap)
- ,@(alist-delete "libc" %final-inputs))
- (current-source-location)))
- ,@(fold alist-delete %final-inputs '("libc" "gcc"))))
+
+ (define (inputs)
+ (if (%current-target-system) ; is this package cross built?
+ `(("cross-libc" ,(cross-bootstrap-libc)))
+ '()))
+
+ (define (native-inputs)
+ (if (%current-target-system)
+ (let ((target (%current-target-system)))
+ `(("cross-gcc" ,(cross-gcc target
+ (cross-binutils target)
+ (cross-bootstrap-libc)))
+ ("cross-binutils" ,(cross-binutils target))
+ ,@%final-inputs))
+ `(("libc" ,(glibc-for-bootstrap))
+ ("gcc" ,(package (inherit gcc-4.7)
+ (inputs
+ `(("libc",(glibc-for-bootstrap))
+ ,@(package-inputs gcc-4.7)))))
+ ,@(fold alist-delete %final-inputs '("libc" "gcc")))))
+
+ (package-with-explicit-inputs p inputs
+ (current-source-location)
+ #:native-inputs native-inputs))
(define %bash-static
(static-package bash-light))
(define %static-inputs
;; Packages that are to be used as %BOOTSTRAP-INPUTS.
(let ((coreutils (package (inherit coreutils)
- (arguments
- `(#:configure-flags
- '("--disable-nls"
- "--disable-silent-rules"
- "--enable-no-install-program=stdbuf,libstdbuf.so"
- "CFLAGS=-Os -g0" ; smaller, please
- "LDFLAGS=-static -pthread")
- #:tests? #f ; signal-related Gnulib tests fail
- ,@(package-arguments coreutils)))
-
- ;; Remove optional dependencies such as GMP.
- (inputs `(,(assoc "perl" (package-inputs coreutils))))))
+ (arguments
+ `(#:configure-flags
+ '("--disable-nls"
+ "--disable-silent-rules"
+ "--enable-no-install-program=stdbuf,libstdbuf.so"
+ "CFLAGS=-Os -g0" ; smaller, please
+ "LDFLAGS=-static -pthread")
+ #:tests? #f ; signal-related Gnulib tests fail
+ ,@(package-arguments coreutils)))
+
+ ;; Remove optional dependencies such as GMP. Keep Perl
+ ;; except if it's missing (which is the case when
+ ;; cross-compiling).
+ (inputs (match (assoc "perl" (package-inputs coreutils))
+ (#f '())
+ (x (list x))))
+
+ ;; Remove the `debug' output.
+ (outputs '("out"))))
(bzip2 (package (inherit bzip2)
(arguments
(substitute-keyword-arguments (package-arguments bzip2)
%standard-phases)))))
(gawk (package (inherit gawk)
(arguments
- (lambda (system)
- `(#:patches (list (assoc-ref %build-inputs "patch/sh"))
- ,@(substitute-keyword-arguments
- ((package-arguments gawk) system)
- ((#:phases phases)
- `(alist-cons-before
- 'configure 'no-export-dynamic
- (lambda _
- ;; Since we use `-static', remove
- ;; `-export-dynamic'.
- (substitute* "configure"
- (("-export-dynamic") "")))
- ,phases))))))
- (inputs `(("patch/sh" ,(search-patch "gawk-shell.patch"))))))
- (finalize (lambda (p)
- (static-package (package-with-explicit-inputs
- p
- %standard-inputs-with-relocatable-glibc)
- (current-source-location)))))
+ `(#:patches (list (assoc-ref %build-inputs "patch/sh"))
+
+ ;; Starting from gawk 4.1.0, some of the tests for the
+ ;; plug-in mechanism just fail on static builds:
+ ;;
+ ;; ./fts.awk:1: error: can't open shared library `filefuncs' for reading (No such file or directory)
+ #:tests? #f
+
+ ,@(substitute-keyword-arguments (package-arguments gawk)
+ ((#:phases phases)
+ `(alist-cons-before
+ 'configure 'no-export-dynamic
+ (lambda _
+ ;; Since we use `-static', remove
+ ;; `-export-dynamic'.
+ (substitute* "configure"
+ (("-export-dynamic") "")))
+ ,phases)))))
+ (inputs `(("patch/sh" ,(search-patch "gawk-shell.patch"))
+ ,@(if (%current-target-system)
+ `(("bash" ,%bash-static))
+ '())))))
+ (finalize (compose static-package
+ package-with-relocatable-glibc)))
`(,@(map (match-lambda
((name package)
(list name (finalize package))))
("sed" ,sed)
("grep" ,grep)
("gawk" ,gawk)))
- ("bash" ,%bash-static)
- ;; ("ld-wrapper" ,ld-wrapper)
- ;; ("binutils" ,binutils-final)
- ;; ("gcc" ,gcc-final)
- ;; ("libc" ,glibc-final)
- )))
+ ("bash" ,%bash-static))))
(define %static-binaries
(package
(package (inherit binutils)
(name "binutils-static")
(arguments
- `(#:configure-flags '("--disable-gold" "--with-lib-path=/no-ld-lib-path")
+ `(#:configure-flags (cons "--disable-gold"
+ ,(match (memq #:configure-flags
+ (package-arguments binutils))
+ ((#:configure-flags flags _ ...)
+ flags)))
#:strip-flags '("--strip-all")
#:phases (alist-cons-before
'configure 'all-static
(define %binutils-static-stripped
;; The subset of Binutils that we need.
(package (inherit %binutils-static)
+ (name (string-append (package-name %binutils-static) "-stripped"))
(build-system trivial-build-system)
+ (outputs '("out"))
(arguments
`(#:modules ((guix build utils))
#:builder
;; GNU libc's essential shared libraries, dynamic linker, and headers,
;; with all references to store directories stripped. As a result,
;; libc.so is unusable and need to be patched for proper relocation.
- (let ((glibc %glibc-for-bootstrap))
+ (let ((glibc (glibc-for-bootstrap)))
(package (inherit glibc)
(name "glibc-stripped")
(build-system trivial-build-system)
(copy-recursively (string-append linux "/include/asm-generic")
(string-append incdir "/asm-generic"))
#t))))
- (inputs `(("libc" ,glibc)
- ("linux-headers" ,linux-libre-headers))))))
+ (inputs `(("libc" ,(let ((target (%current-target-system)))
+ (if target
+ (glibc-for-bootstrap
+ (parameterize ((%current-target-system #f))
+ (cross-libc target)))
+ glibc)))
+ ("linux-headers" ,linux-libre-headers)))
+
+ ;; Only one output.
+ (outputs '("out")))))
(define %gcc-static
;; A statically-linked GCC, with stripped-down functionality.
- (package-with-explicit-inputs
- (package (inherit gcc-final)
+ (package-with-relocatable-glibc
+ (package (inherit gcc-4.7)
(name "gcc-static")
(arguments
- (lambda (system)
- `(#:modules ((guix build utils)
- (guix build gnu-build-system)
- (srfi srfi-1)
- (srfi srfi-26)
- (ice-9 regex))
- ,@(substitute-keyword-arguments ((package-arguments gcc-final) system)
- ((#:guile _) #f)
- ((#:implicit-inputs? _) #t)
- ((#:configure-flags flags)
- `(append (list
- "--disable-shared"
- "--disable-plugin"
- "--enable-languages=c"
- "--disable-libmudflap"
- "--disable-libgomp"
- "--disable-libssp"
- "--disable-libquadmath"
- "--disable-decimal-float")
- (remove (cut string-match "--(.*plugin|enable-languages)" <>)
- ,flags)))
- ((#:make-flags flags)
- `(cons "BOOT_LDFLAGS=-static" ,flags))))))
+ `(#:modules ((guix build utils)
+ (guix build gnu-build-system)
+ (srfi srfi-1)
+ (srfi srfi-26)
+ (ice-9 regex))
+ ,@(substitute-keyword-arguments (package-arguments gcc-4.7)
+ ((#:guile _) #f)
+ ((#:implicit-inputs? _) #t)
+ ((#:configure-flags flags)
+ `(append (list
+ "--disable-shared"
+ "--disable-plugin"
+ "--enable-languages=c"
+ "--disable-libmudflap"
+ "--disable-libgomp"
+ "--disable-libssp"
+ "--disable-libquadmath"
+ "--disable-decimal-float")
+ (remove (cut string-match "--(.*plugin|enable-languages)" <>)
+ ,flags)))
+ ((#:make-flags flags)
+ (if (%current-target-system)
+ `(cons "LDFLAGS=-static" ,flags)
+ `(cons "BOOT_LDFLAGS=-static" ,flags))))))
(inputs `(("gmp-source" ,(package-source gmp))
("mpfr-source" ,(package-source mpfr))
("mpc-source" ,(package-source mpc))
- ("binutils" ,binutils-final)
- ,@(package-inputs gcc-4.7))))
- %standard-inputs-with-relocatable-glibc))
+ ("binutils" ,binutils)
+ ,@(package-inputs gcc-4.7))))))
(define %gcc-stripped
;; The subset of GCC files needed for bootstrap.
;; A statically-linked Guile that is relocatable--i.e., it can search
;; .scm and .go files relative to its installation directory, rather
;; than in hard-coded configure-time paths.
- (let ((guile (package (inherit guile-2.0)
- (inputs
- `(("patch/relocatable"
- ,(search-patch "guile-relocatable.patch"))
- ("patch/utf8"
- ,(search-patch "guile-default-utf8.patch"))
- ,@(package-inputs guile-2.0)))
- (arguments
- `(;; When `configure' checks for ltdl availability, it
- ;; doesn't try to link using libtool, and thus fails
- ;; because of a missing -ldl. Work around that.
- #:configure-flags '("LDFLAGS=-ldl")
-
- #:phases (alist-cons-before
- 'configure 'static-guile
- (lambda _
- (substitute* "libguile/Makefile.in"
- ;; Create a statically-linked `guile'
- ;; executable.
- (("^guile_LDFLAGS =")
- "guile_LDFLAGS = -all-static")
-
- ;; Add `-ldl' *after* libguile-2.0.la.
- (("^guile_LDADD =(.*)$" _ ldadd)
- (string-append "guile_LDADD = "
- (string-trim-right ldadd)
- " -ldl\n"))))
- %standard-phases)
-
- ;; Allow Guile to be relocated, as is needed during
- ;; bootstrap.
- #:patches
- (list (assoc-ref %build-inputs "patch/relocatable")
- (assoc-ref %build-inputs "patch/utf8"))
-
- ;; There are uses of `dynamic-link' in
- ;; {foreign,coverage}.test that don't fly here.
- #:tests? #f)))))
- (package-with-explicit-inputs (static-package guile)
- %standard-inputs-with-relocatable-glibc
- (current-source-location))))
+ (let* ((guile (package (inherit guile-2.0)
+ (name (string-append (package-name guile-2.0) "-static"))
+ (synopsis "Statically-linked and relocatable Guile")
+ (inputs
+ `(("patch/relocatable"
+ ,(search-patch "guile-relocatable.patch"))
+ ("patch/utf8"
+ ,(search-patch "guile-default-utf8.patch"))
+ ("patch/syscalls"
+ ,(search-patch "guile-linux-syscalls.patch"))
+ ,@(package-inputs guile-2.0)))
+ (propagated-inputs
+ `(("bdw-gc" ,libgc)
+ ,@(alist-delete "bdw-gc"
+ (package-propagated-inputs guile-2.0))))
+ (arguments
+ `(;; When `configure' checks for ltdl availability, it
+ ;; doesn't try to link using libtool, and thus fails
+ ;; because of a missing -ldl. Work around that.
+ #:configure-flags '("LDFLAGS=-ldl"
+ ,@(if (%current-target-system)
+ '("CC_FOR_BUILD=gcc")
+ '()))
+
+ #:phases (alist-cons-before
+ 'configure 'static-guile
+ (lambda _
+ (substitute* "libguile/Makefile.in"
+ ;; Create a statically-linked `guile'
+ ;; executable.
+ (("^guile_LDFLAGS =")
+ "guile_LDFLAGS = -all-static")
+
+ ;; Add `-ldl' *after* libguile-2.0.la.
+ (("^guile_LDADD =(.*)$" _ ldadd)
+ (string-append "guile_LDADD = "
+ (string-trim-right ldadd)
+ " -ldl\n"))))
+ %standard-phases)
+
+ ;; Allow Guile to be relocated, as is needed during
+ ;; bootstrap.
+ #:patches
+ (list (assoc-ref %build-inputs "patch/relocatable")
+ (assoc-ref %build-inputs "patch/utf8")
+ (assoc-ref %build-inputs "patch/syscalls"))
+
+ ;; There are uses of `dynamic-link' in
+ ;; {foreign,coverage}.test that don't fly here.
+ #:tests? #f)))))
+ (package-with-relocatable-glibc (static-package guile))))
(define %guile-static-stripped
;; A stripped static Guile binary, for use during bootstrap.
(let ()
(use-modules (guix build utils))
- (let ((in (assoc-ref %build-inputs "guile"))
- (out (assoc-ref %outputs "out")))
+ (let* ((in (assoc-ref %build-inputs "guile"))
+ (out (assoc-ref %outputs "out"))
+ (guile1 (string-append in "/bin/guile"))
+ (guile2 (string-append out "/bin/guile")))
(mkdir-p (string-append out "/share/guile/2.0"))
(copy-recursively (string-append in "/share/guile/2.0")
(string-append out "/share/guile/2.0"))
(string-append out "/lib/guile/2.0/ccache"))
(mkdir (string-append out "/bin"))
- (copy-file (string-append in "/bin/guile")
- (string-append out "/bin/guile"))
- (remove-store-references (string-append out "/bin/guile"))
- #t))))
- (inputs `(("guile" ,%guile-static)))))
+ (copy-file guile1 guile2)
+
+ ;; Does the relocated Guile work?
+ (and ,(if (%current-target-system)
+ #t
+ '(zero? (system* guile2 "--version")))
+ (begin
+ ;; Strip store references.
+ (remove-store-references guile2)
+
+ ;; Does the stripped Guile work? If it aborts, it could be
+ ;; that it tries to open iconv descriptors and fails because
+ ;; libc's iconv data isn't available (see
+ ;; `guile-default-utf8.patch'.)
+ ,(if (%current-target-system)
+ #t
+ '(zero? (system* guile2 "--version")))))))))
+ (inputs `(("guile" ,%guile-static)))
+ (outputs '("out"))
+ (synopsis "Minimal statically-linked and relocatable Guile")))
(define (tarball-package pkg)
"Return a package containing a tarball of PKG."
(location (source-properties->location (current-source-location)))
(name (string-append (package-name pkg) "-tarball"))
(build-system trivial-build-system)
- (inputs `(("tar" ,tar)
- ("xz" ,xz)
- ("input" ,pkg)))
+ (native-inputs `(("tar" ,tar)
+ ("xz" ,xz)))
+ (inputs `(("input" ,pkg)))
(arguments
- (lambda (system)
- (let ((name (package-name pkg))
- (version (package-version pkg)))
- `(#:modules ((guix build utils))
- #:builder
- (begin
- (use-modules (guix build utils))
- (let ((out (assoc-ref %outputs "out"))
- (input (assoc-ref %build-inputs "input"))
- (tar (assoc-ref %build-inputs "tar"))
- (xz (assoc-ref %build-inputs "xz")))
- (mkdir out)
- (set-path-environment-variable "PATH" '("bin") (list tar xz))
- (with-directory-excursion input
- (zero? (system* "tar" "cJvf"
- (string-append out "/"
- ,name "-" ,version
- "-" ,system ".tar.xz")
- ".")))))))))))
+ (let ((name (package-name pkg))
+ (version (package-version pkg)))
+ `(#:modules ((guix build utils))
+ #:builder
+ (begin
+ (use-modules (guix build utils))
+ (let ((out (assoc-ref %outputs "out"))
+ (input (assoc-ref %build-inputs "input"))
+ (tar (assoc-ref %build-inputs "tar"))
+ (xz (assoc-ref %build-inputs "xz")))
+ (mkdir out)
+ (set-path-environment-variable "PATH" '("bin") (list tar xz))
+ (with-directory-excursion input
+ (zero? (system* "tar" "cJvf"
+ (string-append out "/"
+ ,name "-" ,version
+ "-"
+ ,(or (%current-target-system)
+ (%current-system))
+ ".tar.xz")
+ "."))))))))))
(define %bootstrap-binaries-tarball
;; A tarball with the statically-linked bootstrap binaries.
HCoop / jackhill / guix / guix.git / blobdiff