gnu/packages/commencement.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
   4 ;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
   5 ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
   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 packages commencement)
  23   #:use-module ((guix licenses)
  24                 #:select (gpl3+ lgpl2.0+ public-domain))
  25   #:use-module (gnu packages bootstrap)
  26   #:use-module (gnu packages base)
  27   #:use-module (gnu packages bash)
  28   #:use-module (gnu packages gcc)
  29   #:use-module (gnu packages m4)
  30   #:use-module (gnu packages indent)
  31   #:use-module (gnu packages file)
  32   #:use-module (gnu packages gawk)
  33   #:use-module (gnu packages bison)
  34   #:use-module (gnu packages flex)
  35   #:use-module (gnu packages guile)
  36   #:use-module (gnu packages gettext)
  37   #:use-module (gnu packages multiprecision)
  38   #:use-module (gnu packages compression)
  39   #:use-module (gnu packages perl)
  40   #:use-module (gnu packages linux)
  41   #:use-module (gnu packages hurd)
  42   #:use-module (gnu packages texinfo)
  43   #:use-module (gnu packages pkg-config)
  44   #:use-module (guix packages)
  45   #:use-module (guix download)
  46   #:use-module (guix build-system gnu)
  47   #:use-module (guix build-system trivial)
  48   #:use-module (guix utils)
  49   #:use-module (srfi srfi-1)
  50   #:use-module (srfi srfi-26)
  51   #:use-module (ice-9 vlist)
  52   #:use-module (ice-9 match)
  53   #:use-module (ice-9 regex))
  54
  55 ;;; Commentary:
  56 ;;;
  57 ;;; This is the commencement, this is where things start.  Before the
  58 ;;; commencement, of course, there's the 'bootstrap' module, which provides us
  59 ;;; with the initial binaries.  This module uses those bootstrap binaries to
  60 ;;; actually build up the whole tool chain that make up the implicit inputs of
  61 ;;; 'gnu-build-system'.
  62 ;;;
  63 ;;; To avoid circular dependencies, this module should not be imported
  64 ;;; directly from anywhere.
  65 ;;;
  66 ;;; Code:
  67
  68 (define gnu-make-boot0
  69   (package-with-bootstrap-guile
  70    (package (inherit gnu-make)
  71      (name "make-boot0")
  72      (arguments
  73       `(#:guile ,%bootstrap-guile
  74         #:implicit-inputs? #f
  75         #:tests? #f                  ; cannot run "make check"
  76         ,@(substitute-keyword-arguments (package-arguments gnu-make)
  77             ((#:phases phases)
  78              `(modify-phases ,phases
  79                 (replace 'build
  80                   (lambda _
  81                     (zero? (system* "./build.sh"))))
  82                 (replace 'install
  83                   (lambda* (#:key outputs #:allow-other-keys)
  84                     (let* ((out (assoc-ref outputs "out"))
  85                            (bin (string-append out "/bin")))
  86                       (install-file "make" bin)))))))))
  87      (native-inputs '())                          ; no need for 'pkg-config'
  88      (inputs %bootstrap-inputs))))
  89
  90 (define diffutils-boot0
  91   (package-with-bootstrap-guile
  92    (let ((p (package-with-explicit-inputs diffutils
  93                                           `(("make" ,gnu-make-boot0)
  94                                             ,@%bootstrap-inputs)
  95                                           #:guile %bootstrap-guile)))
  96      (package (inherit p)
  97        (name "diffutils-boot0")
  98        (arguments `(#:tests? #f         ; the test suite needs diffutils
  99                     ,@(package-arguments p)))))))
 100
 101 (define findutils-boot0
 102   (package-with-bootstrap-guile
 103    (package-with-explicit-inputs (package
 104                                    (inherit findutils)
 105                                    (name "findutils-boot0"))
 106                                  `(("make" ,gnu-make-boot0)
 107                                    ("diffutils" ,diffutils-boot0) ; for tests
 108                                    ,@%bootstrap-inputs)
 109                                  (current-source-location)
 110                                  #:guile %bootstrap-guile)))
 111
 112 (define file-boot0
 113   (package-with-bootstrap-guile
 114    (package-with-explicit-inputs (package
 115                                    (inherit file)
 116                                    (name "file-boot0"))
 117                                  `(("make" ,gnu-make-boot0)
 118                                    ,@%bootstrap-inputs)
 119                                  (current-source-location)
 120                                  #:guile %bootstrap-guile)))
 121
 122
 123 (define %boot0-inputs
 124   `(("make" ,gnu-make-boot0)
 125     ("diffutils" ,diffutils-boot0)
 126     ("findutils" ,findutils-boot0)
 127     ("file" ,file-boot0)
 128     ,@%bootstrap-inputs))
 129
 130 (define* (boot-triplet #:optional (system (%current-system)))
 131   ;; Return the triplet used to create the cross toolchain needed in the
 132   ;; first bootstrapping stage.
 133   (nix-system->gnu-triplet system "guix"))
 134
 135 ;; Following Linux From Scratch, build a cross-toolchain in stage 0.  That
 136 ;; toolchain actually targets the same OS and arch, but it has the advantage
 137 ;; of being independent of the libc and tools in %BOOTSTRAP-INPUTS, since
 138 ;; GCC-BOOT0 (below) is built without any reference to the target libc.
 139
 140 (define binutils-boot0
 141   (package-with-bootstrap-guile
 142    (package (inherit binutils)
 143      (name "binutils-cross-boot0")
 144      (arguments
 145       `(#:guile ,%bootstrap-guile
 146         #:implicit-inputs? #f
 147
 148         #:modules ((guix build gnu-build-system)
 149                    (guix build utils)
 150                    (ice-9 ftw))                    ; for 'scandir'
 151         #:phases (alist-cons-after
 152                   'install 'add-symlinks
 153                   (lambda* (#:key outputs #:allow-other-keys)
 154                     ;; The cross-gcc invokes 'as', 'ld', etc, without the
 155                     ;; triplet prefix, so add symlinks.
 156                     (let ((out (assoc-ref outputs "out"))
 157                           (triplet-prefix (string-append ,(boot-triplet) "-")))
 158                       (define (has-triplet-prefix? name)
 159                         (string-prefix? triplet-prefix name))
 160                       (define (remove-triplet-prefix name)
 161                         (substring name (string-length triplet-prefix)))
 162                       (with-directory-excursion (string-append out "/bin")
 163                         (for-each (lambda (name)
 164                                     (symlink name (remove-triplet-prefix name)))
 165                                   (scandir "." has-triplet-prefix?)))
 166                       #t))
 167                   %standard-phases)
 168
 169         ,@(substitute-keyword-arguments (package-arguments binutils)
 170             ((#:configure-flags cf)
 171              `(cons ,(string-append "--target=" (boot-triplet))
 172                     ,cf)))))
 173      (inputs %boot0-inputs))))
 174
 175 (define gcc-boot0
 176   (package-with-bootstrap-guile
 177    (package (inherit gcc)
 178      (name "gcc-cross-boot0")
 179      (arguments
 180       `(#:guile ,%bootstrap-guile
 181         #:implicit-inputs? #f
 182         #:modules ((guix build gnu-build-system)
 183                    (guix build utils)
 184                    (ice-9 regex)
 185                    (srfi srfi-1)
 186                    (srfi srfi-26))
 187         ,@(substitute-keyword-arguments (package-arguments gcc)
 188             ((#:configure-flags flags)
 189              `(append (list ,(string-append "--target=" (boot-triplet))
 190
 191                             ;; No libc yet.
 192                             "--without-headers"
 193
 194                             ;; Disable features not needed at this stage.
 195                             "--disable-shared"
 196                             "--enable-languages=c,c++"
 197
 198                             ;; libstdc++ cannot be built at this stage
 199                             ;; ("Link tests are not allowed after
 200                             ;; GCC_NO_EXECUTABLES.").
 201                             "--disable-libstdc++-v3"
 202
 203                             "--disable-threads"
 204                             "--disable-libmudflap"
 205                             "--disable-libatomic"
 206                             "--disable-libsanitizer"
 207                             "--disable-libitm"
 208                             "--disable-libgomp"
 209                             "--disable-libcilkrts"
 210                             "--disable-libvtv"
 211                             "--disable-libssp"
 212                             "--disable-libquadmath"
 213                             "--disable-decimal-float")
 214                       (remove (cut string-match
 215                                 "--(with-system-zlib|enable-languages.*)" <>)
 216                               ,flags)))
 217             ((#:phases phases)
 218              `(alist-cons-after
 219                'unpack 'unpack-gmp&co
 220                (lambda* (#:key inputs #:allow-other-keys)
 221                  (let ((gmp  (assoc-ref %build-inputs "gmp-source"))
 222                        (mpfr (assoc-ref %build-inputs "mpfr-source"))
 223                        (mpc  (assoc-ref %build-inputs "mpc-source")))
 224
 225                    ;; To reduce the set of pre-built bootstrap inputs, build
 226                    ;; GMP & co. from GCC.
 227                    (for-each (lambda (source)
 228                                (or (zero? (system* "tar" "xvf" source))
 229                                    (error "failed to unpack tarball"
 230                                           source)))
 231                              (list gmp mpfr mpc))
 232
 233                    ;; Create symlinks like `gmp' -> `gmp-x.y.z'.
 234                    ,@(map (lambda (lib)
 235                             ;; Drop trailing letters, as gmp-6.0.0a unpacks
 236                             ;; into gmp-6.0.0.
 237                             `(symlink ,(string-trim-right
 238                                         (package-full-name lib)
 239                                         char-set:letter)
 240                                       ,(package-name lib)))
 241                           (list gmp-6.0 mpfr mpc))))
 242                (alist-cons-after
 243                 'install 'symlink-libgcc_eh
 244                 (lambda* (#:key outputs #:allow-other-keys)
 245                   (let ((out (assoc-ref outputs "lib")))
 246                     ;; Glibc wants to link against libgcc_eh, so provide
 247                     ;; it.
 248                     (with-directory-excursion
 249                         (string-append out "/lib/gcc/"
 250                                        ,(boot-triplet)
 251                                        "/" ,(package-version gcc))
 252                       (symlink "libgcc.a" "libgcc_eh.a"))))
 253                 ,phases))))))
 254
 255      (inputs `(("gmp-source" ,(package-source gmp-6.0))
 256                ("mpfr-source" ,(package-source mpfr))
 257                ("mpc-source" ,(package-source mpc))
 258                ("binutils-cross" ,binutils-boot0)
 259
 260                ;; Call it differently so that the builder can check whether
 261                ;; the "libc" input is #f.
 262                ("libc-native" ,@(assoc-ref %boot0-inputs "libc"))
 263                ,@(alist-delete "libc" %boot0-inputs)))
 264
 265      ;; No need for Texinfo at this stage.
 266      (native-inputs (alist-delete "texinfo"
 267                                   (package-native-inputs gcc))))))
 268
 269 (define perl-boot0
 270   (let ((perl (package
 271                 (inherit perl)
 272                 (name "perl-boot0")
 273                 (replacement #f)
 274                 (arguments
 275                  ;; At the very least, this must not depend on GCC & co.
 276                  (let ((args `(#:disallowed-references
 277                                ,(list %bootstrap-binutils))))
 278                    (substitute-keyword-arguments (package-arguments perl)
 279                      ((#:phases phases)
 280                       `(modify-phases ,phases
 281                          ;; Pthread support is missing in the bootstrap compiler
 282                          ;; (broken spec file), so disable it.
 283                          (add-before 'configure 'disable-pthreads
 284                            (lambda _
 285                              (substitute* "Configure"
 286                                (("^libswanted=(.*)pthread" _ before)
 287                                 (string-append "libswanted=" before)))))))
 288                      ;; Do not configure with '-Dusethreads' since pthread
 289                      ;; support is missing.
 290                      ((#:configure-flags configure-flags)
 291                       `(delete "-Dusethreads" ,configure-flags))))))))
 292     (package-with-bootstrap-guile
 293      (package-with-explicit-inputs perl
 294                                    %boot0-inputs
 295                                    (current-source-location)
 296                                    #:guile %bootstrap-guile))))
 297
 298 (define bison-boot0
 299   ;; This Bison is needed to build MiG so we need it early in the process.
 300   ;; It is also needed to rebuild Bash's parser, which is modified by
 301   ;; its CVE patches.  Remove it when it's no longer needed.
 302   (let* ((m4    (package-with-bootstrap-guile
 303                  (package-with-explicit-inputs m4 %boot0-inputs
 304                                                (current-source-location)
 305                                                #:guile %bootstrap-guile)))
 306          (bison (package (inherit bison)
 307                   (propagated-inputs `(("m4" ,m4)))
 308                   (inputs '())                    ;remove Flex...
 309                   (arguments
 310                    '(#:tests? #f                  ;... and thus disable tests
 311
 312                      ;; Zero timestamps in liby.a; this must be done
 313                      ;; explicitly here because the bootstrap Binutils don't
 314                      ;; do that (default is "cru".)
 315                      #:make-flags '("ARFLAGS=crD" "RANLIB=ranlib -D"
 316                                     "V=1"))))))
 317     (package
 318       (inherit (package-with-bootstrap-guile
 319                 (package-with-explicit-inputs bison %boot0-inputs
 320                                               (current-source-location)
 321                                               #:guile %bootstrap-guile)))
 322       (native-inputs `(("perl" ,perl-boot0))))))
 323
 324 (define flex-boot0
 325   ;; This Flex is needed to build MiG.
 326   (let* ((flex (package (inherit flex)
 327                  (native-inputs `(("bison" ,bison-boot0)))
 328                  (propagated-inputs `(("m4" ,m4)))
 329                  (inputs `(("indent" ,indent)))
 330                  (arguments '(#:tests? #f)))))
 331     (package-with-bootstrap-guile
 332      (package-with-explicit-inputs flex %boot0-inputs
 333                                    (current-source-location)
 334                                    #:guile %bootstrap-guile))))
 335
 336 (define (linux-libre-headers-boot0)
 337   "Return Linux-Libre header files for the bootstrap environment."
 338   ;; Note: this is wrapped in a thunk to nicely handle circular dependencies
 339   ;; between (gnu packages linux) and this module.
 340   (package-with-bootstrap-guile
 341    (package (inherit linux-libre-headers)
 342      (arguments `(#:guile ,%bootstrap-guile
 343                   #:implicit-inputs? #f
 344                   ,@(package-arguments linux-libre-headers)))
 345      (native-inputs
 346       `(("perl" ,perl-boot0)
 347         ,@%boot0-inputs)))))
 348
 349 (define gnumach-headers-boot0
 350   (package-with-bootstrap-guile
 351    (package-with-explicit-inputs gnumach-headers
 352                                  %boot0-inputs
 353                                  (current-source-location)
 354                                  #:guile %bootstrap-guile)))
 355
 356 (define mig-boot0
 357   (let* ((mig (package (inherit mig)
 358                  (native-inputs `(("bison" ,bison-boot0)
 359                                   ("flex" ,flex-boot0)))
 360                  (inputs `(("flex" ,flex-boot0)))
 361                  (arguments
 362                   `(#:configure-flags
 363                     `(,(string-append "LDFLAGS=-Wl,-rpath="
 364                                       (assoc-ref %build-inputs "flex") "/lib/")))))))
 365     (package-with-bootstrap-guile
 366      (package-with-explicit-inputs mig %boot0-inputs
 367                                    (current-source-location)
 368                                    #:guile %bootstrap-guile))))
 369
 370 (define hurd-headers-boot0
 371   (let ((hurd-headers (package (inherit hurd-headers)
 372                         (native-inputs `(("mig" ,mig-boot0)))
 373                         (inputs '()))))
 374     (package-with-bootstrap-guile
 375      (package-with-explicit-inputs hurd-headers %boot0-inputs
 376                                    (current-source-location)
 377                                    #:guile %bootstrap-guile))))
 378
 379 (define hurd-minimal-boot0
 380   (let ((hurd-minimal (package (inherit hurd-minimal)
 381                         (native-inputs `(("mig" ,mig-boot0)))
 382                         (inputs '()))))
 383     (package-with-bootstrap-guile
 384      (package-with-explicit-inputs hurd-minimal %boot0-inputs
 385                                    (current-source-location)
 386                                    #:guile %bootstrap-guile))))
 387
 388 (define (hurd-core-headers-boot0)
 389   "Return the Hurd and Mach headers as well as initial Hurd libraries for
 390 the bootstrap environment."
 391   (package-with-bootstrap-guile
 392    (package (inherit hurd-core-headers)
 393             (arguments `(#:guile ,%bootstrap-guile
 394                                  ,@(package-arguments hurd-core-headers)))
 395             (inputs
 396              `(("gnumach-headers" ,gnumach-headers-boot0)
 397                ("hurd-headers" ,hurd-headers-boot0)
 398                ("hurd-minimal" ,hurd-minimal-boot0)
 399                ,@%boot0-inputs)))))
 400
 401 (define* (kernel-headers-boot0 #:optional (system (%current-system)))
 402   (match system
 403     ("i586-gnu" (hurd-core-headers-boot0))
 404     (_ (linux-libre-headers-boot0))))
 405
 406 (define texinfo-boot0
 407   ;; Texinfo used to build libc's manual.
 408   ;; We build without ncurses because it fails to build at this stage, and
 409   ;; because we don't need the stand-alone Info reader.
 410   ;; Also, use %BOOT0-INPUTS to avoid building Perl once more.
 411   (let ((texinfo (package (inherit texinfo)
 412                    (native-inputs '())
 413                    (inputs `(("perl" ,perl-boot0)))
 414
 415                    ;; Some of Texinfo 6.1's tests would fail with "Couldn't
 416                    ;; set UTF-8 character type in locale" but we don't have a
 417                    ;; UTF-8 locale at this stage, so skip them.
 418                    (arguments '(#:tests? #f)))))
 419     (package-with-bootstrap-guile
 420      (package-with-explicit-inputs texinfo %boot0-inputs
 421                                    (current-source-location)
 422                                    #:guile %bootstrap-guile))))
 423
 424 (define ld-wrapper-boot0
 425   ;; We need this so binaries on Hurd will have libmachuser and libhurduser
 426   ;; in their RUNPATH, otherwise validate-runpath will fail.
 427   ;;
 428   ;; XXX: Work around <http://bugs.gnu.org/24832> by fixing the name and
 429   ;; triplet on GNU/Linux.  For GNU/Hurd, use the right triplet.
 430   (make-ld-wrapper (string-append "ld-wrapper-" "x86_64-guix-linux-gnu")
 431                    #:target (lambda (system)
 432                               (if (string-suffix? "-linux" system)
 433                                   "x86_64-guix-linux-gnu"
 434                                   (boot-triplet system)))
 435                    #:binutils binutils-boot0
 436                    #:guile %bootstrap-guile
 437                    #:bash (car (assoc-ref %boot0-inputs "bash"))))
 438
 439 (define %boot1-inputs
 440   ;; 2nd stage inputs.
 441   `(("gcc" ,gcc-boot0)
 442     ("ld-wrapper-cross" ,ld-wrapper-boot0)
 443     ("binutils-cross" ,binutils-boot0)
 444     ,@(alist-delete "binutils" %boot0-inputs)))
 445
 446 (define glibc-final-with-bootstrap-bash
 447   ;; The final libc, "cross-built".  If everything went well, the resulting
 448   ;; store path has no dependencies.  Actually, the really-final libc is
 449   ;; built just below; the only difference is that this one uses the
 450   ;; bootstrap Bash.
 451   (package-with-bootstrap-guile
 452    (package (inherit glibc)
 453      (name "glibc-intermediate")
 454      (arguments
 455       `(#:guile ,%bootstrap-guile
 456         #:implicit-inputs? #f
 457
 458         ,@(substitute-keyword-arguments (package-arguments glibc)
 459             ((#:configure-flags flags)
 460              `(append (list ,(string-append "--host=" (boot-triplet))
 461                             ,(string-append "--build="
 462                                             (nix-system->gnu-triplet))
 463
 464                             ;; Build Sun/ONC RPC support.  In particular,
 465                             ;; install rpc/*.h.
 466                             "--enable-obsolete-rpc")
 467                       ,flags))
 468             ((#:phases phases)
 469              `(alist-cons-before
 470                'configure 'pre-configure
 471                (lambda* (#:key inputs #:allow-other-keys)
 472                  ;; Don't clobber CPATH with the bootstrap libc.
 473                  (setenv "NATIVE_CPATH" (getenv "CPATH"))
 474                  (unsetenv "CPATH")
 475
 476                  ;; Tell 'libpthread' where to find 'libihash' on Hurd systems.
 477                  ,@(if (hurd-triplet? (%current-system))
 478                        `((substitute* "libpthread/Makefile"
 479                            (("LDLIBS-pthread.so =.*")
 480                             (string-append "LDLIBS-pthread.so = "
 481                                            (assoc-ref %build-inputs "kernel-headers")
 482                                            "/lib/libihash.a\n"))))
 483                        '())
 484
 485                  ;; 'rpcgen' needs native libc headers to be built.
 486                  (substitute* "sunrpc/Makefile"
 487                    (("sunrpc-CPPFLAGS =.*" all)
 488                     (string-append "CPATH = $(NATIVE_CPATH)\n"
 489                                    "export CPATH\n"
 490                                    all "\n"))))
 491                ,phases)))))
 492      (propagated-inputs `(("kernel-headers" ,(kernel-headers-boot0))))
 493      (native-inputs
 494       `(("texinfo" ,texinfo-boot0)
 495         ("perl" ,perl-boot0)))
 496      (inputs
 497       `(;; The boot inputs.  That includes the bootstrap libc.  We don't want
 498         ;; it in $CPATH, hence the 'pre-configure' phase above.
 499         ,@%boot1-inputs
 500
 501         ;; A native MiG is needed to build Glibc on Hurd.
 502         ,@(if (hurd-triplet? (%current-system))
 503               `(("mig" ,mig-boot0))
 504               '())
 505
 506         ;; A native GCC is needed to build `cross-rpcgen'.
 507         ("native-gcc" ,@(assoc-ref %boot0-inputs "gcc"))
 508
 509         ;; Here, we use the bootstrap Bash, which is not satisfactory
 510         ;; because we don't want to depend on bootstrap tools.
 511         ("static-bash" ,@(assoc-ref %boot0-inputs "bash")))))))
 512
 513 (define (cross-gcc-wrapper gcc binutils glibc bash)
 514   "Return a wrapper for the pseudo-cross toolchain GCC/BINUTILS/GLIBC
 515 that makes it available under the native tool names."
 516   (package (inherit gcc)
 517     (name (string-append (package-name gcc) "-wrapped"))
 518     (source #f)
 519     (build-system trivial-build-system)
 520     (outputs '("out"))
 521     (arguments
 522      `(#:guile ,%bootstrap-guile
 523        #:modules ((guix build utils))
 524        #:builder (begin
 525                    (use-modules (guix build utils))
 526
 527                    (let* ((binutils (assoc-ref %build-inputs "binutils"))
 528                           (gcc      (assoc-ref %build-inputs "gcc"))
 529                           (libc     (assoc-ref %build-inputs "libc"))
 530                           (bash     (assoc-ref %build-inputs "bash"))
 531                           (out      (assoc-ref %outputs "out"))
 532                           (bindir   (string-append out "/bin"))
 533                           (triplet  ,(boot-triplet)))
 534                      (define (wrap-program program)
 535                        ;; GCC-BOOT0 is a libc-less cross-compiler, so it
 536                        ;; needs to be told where to find the crt files and
 537                        ;; the dynamic linker.
 538                        (call-with-output-file program
 539                          (lambda (p)
 540                            (format p "#!~a/bin/bash
 541 exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
 542                                    bash
 543                                    gcc triplet program
 544                                    libc libc
 545                                    ,(glibc-dynamic-linker))))
 546
 547                        (chmod program #o555))
 548
 549                      (mkdir-p bindir)
 550                      (with-directory-excursion bindir
 551                        (for-each (lambda (tool)
 552                                    (symlink (string-append binutils "/bin/"
 553                                                            triplet "-" tool)
 554                                             tool))
 555                                  '("ar" "ranlib"))
 556                        (for-each wrap-program '("gcc" "g++")))))))
 557     (native-inputs
 558      `(("binutils" ,binutils)
 559        ("gcc" ,gcc)
 560        ("libc" ,glibc)
 561        ("bash" ,bash)))
 562     (inputs '())))
 563
 564 (define static-bash-for-glibc
 565   ;; A statically-linked Bash to be used by GLIBC-FINAL in system(3) & co.
 566   (let* ((gcc  (cross-gcc-wrapper gcc-boot0 binutils-boot0
 567                                   glibc-final-with-bootstrap-bash
 568                                   (car (assoc-ref %boot1-inputs "bash"))))
 569          (bash (package (inherit static-bash)
 570                  (arguments
 571                   `(#:guile ,%bootstrap-guile
 572                     ,@(package-arguments static-bash)))))
 573          (inputs `(("gcc" ,gcc)
 574                    ("libc" ,glibc-final-with-bootstrap-bash)
 575                    ,@(fold alist-delete %boot1-inputs
 576                            '("gcc" "libc")))))
 577     (package-with-bootstrap-guile
 578      (package-with-explicit-inputs bash inputs
 579                                    (current-source-location)
 580                                    #:guile %bootstrap-guile))))
 581
 582 (define gettext-boot0
 583   ;; A minimal gettext used during bootstrap.
 584   (let ((gettext-minimal
 585          (package (inherit gettext-minimal)
 586            (name "gettext-boot0")
 587            (inputs '())                           ;zero dependencies
 588            (arguments
 589             (substitute-keyword-arguments
 590                 `(#:tests? #f
 591                   ,@(package-arguments gettext-minimal))
 592               ((#:phases phases)
 593                `(modify-phases ,phases
 594                   ;; Build only the tools.
 595                   (add-after 'unpack 'chdir
 596                              (lambda _
 597                                (chdir "gettext-tools")))
 598
 599                   ;; Some test programs require pthreads, which we don't have.
 600                   (add-before 'configure 'no-test-programs
 601                               (lambda _
 602                                 (substitute* "tests/Makefile.in"
 603                                   (("^PROGRAMS =.*$")
 604                                    "PROGRAMS =\n"))
 605                                 #t))
 606
 607                   ;; Don't try to link against libexpat.
 608                   (delete 'link-expat)
 609                   (delete 'patch-tests))))))))
 610     (package-with-bootstrap-guile
 611      (package-with-explicit-inputs gettext-minimal
 612                                    %boot1-inputs
 613                                    (current-source-location)
 614                                    #:guile %bootstrap-guile))))
 615
 616 (define glibc-final
 617   ;; The final glibc, which embeds the statically-linked Bash built above.
 618   (package (inherit glibc-final-with-bootstrap-bash)
 619     (name "glibc")
 620     (inputs `(("static-bash" ,static-bash-for-glibc)
 621               ,@(alist-delete
 622                  "static-bash"
 623                  (package-inputs glibc-final-with-bootstrap-bash))))
 624
 625     ;; This time we need 'msgfmt' to install all the libc.mo files.
 626     (native-inputs `(,@(package-native-inputs glibc-final-with-bootstrap-bash)
 627                      ("gettext" ,gettext-boot0)))
 628
 629     ;; The final libc only refers to itself, but the 'debug' output contains
 630     ;; references to GCC-BOOT0 and to the Linux headers.  XXX: Would be great
 631     ;; if 'allowed-references' were per-output.
 632     (arguments
 633      `(#:allowed-references
 634        ,(cons* `(,gcc-boot0 "lib") (kernel-headers-boot0)
 635                static-bash-for-glibc
 636                (package-outputs glibc-final-with-bootstrap-bash))
 637
 638        ,@(package-arguments glibc-final-with-bootstrap-bash)))))
 639
 640 (define gcc-boot0-wrapped
 641   ;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the
 642   ;; non-cross names.
 643   (cross-gcc-wrapper gcc-boot0 binutils-boot0 glibc-final
 644                      (car (assoc-ref %boot1-inputs "bash"))))
 645
 646 (define %boot2-inputs
 647   ;; 3rd stage inputs.
 648   `(("libc" ,glibc-final)
 649     ("gcc" ,gcc-boot0-wrapped)
 650     ,@(fold alist-delete %boot1-inputs '("libc" "gcc"))))
 651
 652 (define binutils-final
 653   (package-with-bootstrap-guile
 654    (package (inherit binutils)
 655      (arguments
 656       `(#:guile ,%bootstrap-guile
 657         #:implicit-inputs? #f
 658         #:allowed-references ("out" ,glibc-final)
 659         ,@(package-arguments binutils)))
 660      (inputs %boot2-inputs))))
 661
 662 (define libstdc++
 663   ;; Intermediate libstdc++ that will allow us to build the final GCC
 664   ;; (remember that GCC-BOOT0 cannot build libstdc++.)
 665   ;; TODO: Write in terms of 'make-libstdc++'.
 666   (package-with-bootstrap-guile
 667    (package (inherit gcc)
 668      (name "libstdc++")
 669      (arguments
 670       `(#:guile ,%bootstrap-guile
 671         #:implicit-inputs? #f
 672         #:allowed-references ("out")
 673         #:out-of-source? #t
 674         #:phases (alist-cons-before
 675                   'configure 'chdir
 676                   (lambda _
 677                     (chdir "libstdc++-v3"))
 678                   %standard-phases)
 679         #:configure-flags `("--disable-shared"
 680                             "--disable-libstdcxx-threads"
 681                             "--disable-libstdcxx-pch"
 682                             ,(string-append "--with-gxx-include-dir="
 683                                             (assoc-ref %outputs "out")
 684                                             "/include"
 685                                             ;; "/include/c++/"
 686                                             ;; ,(package-version gcc)
 687                                             ))))
 688      (outputs '("out"))
 689      (inputs %boot2-inputs)
 690      (native-inputs '())
 691      (propagated-inputs '())
 692      (synopsis "GNU C++ standard library (intermediate)"))))
 693
 694 (define zlib-final
 695   ;; Zlib used by GCC-FINAL.
 696   (package-with-bootstrap-guile
 697    (package
 698      (inherit zlib)
 699      (arguments
 700       `(#:guile ,%bootstrap-guile
 701         #:implicit-inputs? #f
 702         #:allowed-references ("out" ,glibc-final)
 703         ,@(package-arguments zlib)))
 704      (inputs %boot2-inputs))))
 705
 706 (define ld-wrapper-boot3
 707   ;; A linker wrapper that uses the bootstrap Guile.
 708   (make-ld-wrapper "ld-wrapper-boot3"
 709                    #:binutils binutils-final
 710                    #:guile %bootstrap-guile
 711                    #:bash (car (assoc-ref %boot2-inputs "bash"))))
 712
 713 (define gcc-final
 714   ;; The final GCC.
 715   (package (inherit gcc-boot0)
 716     (name "gcc")
 717
 718     ;; XXX: Currently #:allowed-references applies to all the outputs but the
 719     ;; "debug" output contains disallowed references, notably
 720     ;; linux-libre-headers.  Disable the debugging output to work around that.
 721     (outputs (delete "debug" (package-outputs gcc-boot0)))
 722
 723     (arguments
 724      `(#:guile ,%bootstrap-guile
 725        #:implicit-inputs? #f
 726
 727        #:allowed-references ("out" "lib" ,zlib-final
 728                              ,glibc-final ,static-bash-for-glibc)
 729
 730        ;; Things like libasan.so and libstdc++.so NEED ld.so for some
 731        ;; reason, but it is not in their RUNPATH.  This is a false
 732        ;; positive, so turn it off.
 733        #:validate-runpath? #f
 734
 735        ;; Build again GMP & co. within GCC's build process, because it's hard
 736        ;; to do outside (because GCC-BOOT0 is a cross-compiler, and thus
 737        ;; doesn't honor $LIBRARY_PATH, which breaks `gnu-build-system'.)
 738        ,@(substitute-keyword-arguments (package-arguments gcc-boot0)
 739            ((#:configure-flags boot-flags)
 740             (let loop ((args (package-arguments gcc)))
 741               (match args
 742                 ((#:configure-flags normal-flags _ ...)
 743                  normal-flags)
 744                 ((_ rest ...)
 745                  (loop rest)))))
 746            ((#:make-flags flags)
 747             ;; Since $LIBRARY_PATH is not honored, add the relevant flags.
 748             `(let ((zlib (assoc-ref %build-inputs "zlib")))
 749                (map (lambda (flag)
 750                       (if (string-prefix? "LDFLAGS=" flag)
 751                           (string-append flag " -L"
 752                                          (assoc-ref %build-inputs "libstdc++")
 753                                          "/lib -L" zlib "/lib -Wl,-rpath="
 754                                          zlib "/lib")
 755                           flag))
 756                     ,flags)))
 757            ((#:phases phases)
 758             `(alist-delete 'symlink-libgcc_eh ,phases)))))
 759
 760     ;; This time we want Texinfo, so we get the manual.  Add
 761     ;; STATIC-BASH-FOR-GLIBC so that it's used in the final shebangs of
 762     ;; scripts such as 'mkheaders' and 'fixinc.sh' (XXX: who cares about these
 763     ;; scripts?).
 764     (native-inputs `(("texinfo" ,texinfo-boot0)
 765                      ("static-bash" ,static-bash-for-glibc)
 766                      ,@(package-native-inputs gcc-boot0)))
 767
 768     (inputs `(("gmp-source" ,(bootstrap-origin (package-source gmp-6.0)))
 769               ("mpfr-source" ,(package-source mpfr))
 770               ("mpc-source" ,(package-source mpc))
 771               ("ld-wrapper" ,ld-wrapper-boot3)
 772               ("binutils" ,binutils-final)
 773               ("libstdc++" ,libstdc++)
 774               ("zlib" ,zlib-final)
 775               ,@%boot2-inputs))))
 776
 777 (define %boot3-inputs
 778   ;; 4th stage inputs.
 779   `(("gcc" ,gcc-final)
 780     ("ld-wrapper" ,ld-wrapper-boot3)
 781     ,@(alist-delete "gcc" %boot2-inputs)))
 782
 783 (define bash-final
 784   ;; Link with `-static-libgcc' to make sure we don't retain a reference
 785   ;; to the bootstrap GCC.
 786   ;; FIXME: This depends on 'bootstrap-binaries' via Makefile.in.
 787   (package-with-bootstrap-guile
 788    (package-with-explicit-inputs (static-libgcc-package bash)
 789                                  %boot3-inputs
 790                                  (current-source-location)
 791                                  #:guile %bootstrap-guile)))
 792
 793 (define %boot4-inputs
 794   ;; Now use the final Bash.
 795   `(("bash" ,bash-final)
 796     ,@(alist-delete "bash" %boot3-inputs)))
 797
 798 (define-public guile-final
 799   ;; This package must be public because other modules refer to it.  However,
 800   ;; mark it as hidden so that 'fold-packages' ignores it.
 801   (package-with-bootstrap-guile
 802    (package-with-explicit-inputs (hidden-package guile-2.0/fixed)
 803                                  %boot4-inputs
 804                                  (current-source-location)
 805                                  #:guile %bootstrap-guile)))
 806
 807 (define glibc-utf8-locales-final
 808   ;; Now that we have GUILE-FINAL, build the UTF-8 locales.  They are needed
 809   ;; by the build processes afterwards so their 'scm_to_locale_string' works
 810   ;; with the full range of Unicode codepoints (remember
 811   ;; 'scm_to_locale_string' is called every time a string is passed to a C
 812   ;; function.)
 813   (package
 814     (inherit glibc-utf8-locales)
 815     (inputs `(("glibc" ,glibc-final)
 816               ("gzip"
 817                ,(package-with-explicit-inputs gzip %boot4-inputs
 818                                               (current-source-location)
 819                                               #:guile %bootstrap-guile))))))
 820
 821 (define-public ld-wrapper
 822   ;; The final 'ld' wrapper, which uses the final Guile and Binutils.
 823   (package (inherit ld-wrapper-boot3)
 824     (name "ld-wrapper")
 825     (inputs `(("guile" ,guile-final)
 826               ("bash"  ,bash-final)
 827               ,@(fold alist-delete (package-inputs ld-wrapper-boot3)
 828                       '("guile" "bash"))))))
 829
 830 (define %boot5-inputs
 831   ;; Now with UTF-8 locales.  Remember that the bootstrap binaries were built
 832   ;; with an older libc, which cannot load the new locale format.  See
 833   ;; <https://lists.gnu.org/archive/html/guix-devel/2015-08/msg00737.html>.
 834   `(("locales" ,glibc-utf8-locales-final)
 835     ,@%boot4-inputs))
 836
 837 (define gnu-make-final
 838   ;; The final GNU Make, which uses the final Guile.
 839   (package-with-bootstrap-guile
 840    (package-with-explicit-inputs gnu-make
 841                                  `(("guile" ,guile-final)
 842                                    ,@%boot5-inputs)
 843                                  (current-source-location))))
 844
 845 (define coreutils-final
 846   ;; The final Coreutils.  Treat them specially because some packages, such as
 847   ;; Findutils, keep a reference to the Coreutils they were built with.
 848   (package-with-bootstrap-guile
 849    (package-with-explicit-inputs coreutils
 850                                  %boot5-inputs
 851                                  (current-source-location)
 852
 853                                  ;; Use the final Guile, linked against the
 854                                  ;; final libc with working iconv, so that
 855                                  ;; 'substitute*' works well when touching
 856                                  ;; test files in Gettext.
 857                                  #:guile guile-final)))
 858
 859 (define grep-final
 860   ;; The final grep.  Gzip holds a reference to it (via zgrep), so it must be
 861   ;; built before gzip.
 862   (package-with-bootstrap-guile
 863    (package-with-explicit-inputs (package
 864                                    (inherit grep)
 865                                    (native-inputs `(("perl" ,perl-boot0))))
 866                                  %boot5-inputs
 867                                  (current-source-location)
 868                                  #:guile guile-final)))
 869
 870 (define %boot6-inputs
 871   ;; Now use the final Coreutils.
 872   `(("coreutils" ,coreutils-final)
 873     ("grep" ,grep-final)
 874     ,@%boot5-inputs))
 875
 876 (define-public %final-inputs
 877   ;; Final derivations used as implicit inputs by 'gnu-build-system'.  We
 878   ;; still use 'package-with-bootstrap-guile' so that the bootstrap tools are
 879   ;; used for origins that have patches, thereby avoiding circular
 880   ;; dependencies.
 881   (let ((finalize (compose package-with-bootstrap-guile
 882                            (cut package-with-explicit-inputs <> %boot6-inputs
 883                                 (current-source-location)))))
 884     `(,@(map (match-lambda
 885               ((name package)
 886                (list name (finalize package))))
 887              `(("tar" ,tar)
 888                ("gzip" ,gzip)
 889                ("bzip2" ,bzip2)
 890                ("xz" ,xz)
 891                ("file" ,file)
 892                ("diffutils" ,diffutils)
 893                ("patch" ,patch)
 894                ("sed" ,sed)
 895                ("findutils" ,findutils)
 896                ("gawk" ,gawk)))
 897       ("grep" ,grep-final)
 898       ("coreutils" ,coreutils-final)
 899       ("make" ,gnu-make-final)
 900       ("bash" ,bash-final)
 901       ("ld-wrapper" ,ld-wrapper)
 902       ("binutils" ,binutils-final)
 903       ("gcc" ,gcc-final)
 904       ("libc" ,glibc-final)
 905       ("locales" ,glibc-utf8-locales-final))))
 906
 907 (define-public canonical-package
 908   (let ((name->package (fold (lambda (input result)
 909                                (match input
 910                                  ((_ package)
 911                                   (vhash-cons (package-full-name package)
 912                                               package result))))
 913                              vlist-null
 914                              `(("guile" ,guile-final)
 915                                ,@%final-inputs))))
 916     (lambda (package)
 917       "Return the 'canonical' variant of PACKAGE---i.e., if PACKAGE is one of
 918 the implicit inputs of 'gnu-build-system', return that one, otherwise return
 919 PACKAGE.
 920
 921 The goal is to avoid duplication in cases like GUILE-FINAL vs. GUILE-2.0,
 922 COREUTILS-FINAL vs. COREUTILS, etc."
 923       ;; XXX: This doesn't handle dependencies of the final inputs, such as
 924       ;; libunistring, GMP, etc.
 925       (match (vhash-assoc (package-full-name package) name->package)
 926         ((_ . canon)
 927          ;; In general we want CANON, except if we're cross-compiling: CANON
 928          ;; uses explicit inputs, so it is "anchored" in the bootstrapped
 929          ;; process, with dependencies on things that cannot be
 930          ;; cross-compiled.
 931          (if (%current-target-system)
 932              package
 933              canon))
 934         (_ package)))))
 935
 936 \f
 937 ;;;
 938 ;;; GCC toolchain.
 939 ;;;
 940
 941 (define (gcc-toolchain gcc)
 942   "Return a complete toolchain for GCC."
 943   (package
 944     (name "gcc-toolchain")
 945     (version (package-version gcc))
 946     (source #f)
 947     (build-system trivial-build-system)
 948     (arguments
 949      '(#:modules ((guix build union))
 950        #:builder (begin
 951                    (use-modules (ice-9 match)
 952                                 (srfi srfi-26)
 953                                 (guix build union))
 954
 955                    (let ((out (assoc-ref %outputs "out")))
 956
 957                      (match %build-inputs
 958                        (((names . directories) ...)
 959                         (union-build out directories)))
 960
 961                      (union-build (assoc-ref %outputs "debug")
 962                                   (list (assoc-ref %build-inputs
 963                                                    "libc-debug")))))))
 964
 965     (native-search-paths (package-native-search-paths gcc))
 966     (search-paths (package-search-paths gcc))
 967
 968     (license (package-license gcc))
 969     (synopsis "Complete GCC tool chain for C/C++ development")
 970     (description
 971      "This package provides a complete GCC tool chain for C/C++ development to
 972 be installed in user profiles.  This includes GCC, as well as libc (headers
 973 and binaries, plus debugging symbols in the 'debug' output), and Binutils.")
 974     (home-page "http://gcc.gnu.org/")
 975     (outputs '("out" "debug"))
 976
 977     ;; The main raison d'être of this "meta-package" is (1) to conveniently
 978     ;; install everything that we need, and (2) to make sure ld-wrapper comes
 979     ;; before Binutils' ld in the user's profile.
 980     (inputs `(("gcc" ,gcc)
 981               ("ld-wrapper" ,(car (assoc-ref %final-inputs "ld-wrapper")))
 982               ("binutils" ,binutils-final)
 983               ("libc" ,glibc-final)
 984               ("libc-debug" ,glibc-final "debug")))))
 985
 986 (define-public gcc-toolchain-4.8
 987   (gcc-toolchain gcc-4.8))
 988
 989 (define-public gcc-toolchain-4.9
 990   (gcc-toolchain gcc-final))
 991
 992 (define-public gcc-toolchain-5
 993   (gcc-toolchain gcc-5))
 994
 995 (define-public gcc-toolchain-6
 996   (gcc-toolchain gcc-6))
 997
 998 ;;; commencement.scm ends here