3 files changed, 63 insertions(+), 68 deletions(-)

M gnu/build/linux-boot.scm
M gnu/system/linux-initrd.scm
M gnu/system/vm.scm

@@ 221,6 221,7 @@ networking values.)  Return #t if INTERFACE is up, #f otherwise."
 (define (load-linux-module* file)
   "Load Linux module from FILE, the name of a `.ko' file."
   (define (slurp module)
+    ;; TODO: Use 'mmap' to reduce memory usage.
     (call-with-input-file file get-bytevector-all))
 
   (load-linux-module (slurp file)))

@@ 68,85 68,77 @@ initrd."
   ;; General Linux overview in `Documentation/early-userspace/README' and
   ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
 
-  (define graph-files
-    (unfold-right zero?
-                  number->string
-                  1-
-                  (length to-copy)))
-
-  (mlet %store-monad ((source     (imported-modules modules))
-                      (compiled   (compiled-modules modules))
-                      (module-dir (flat-linux-module-directory linux
-                                                               linux-modules)))
+  (mlet* %store-monad ((init       (gexp->script "init" exp
+                                                 #:modules modules
+                                                 #:guile guile))
+                       (to-copy -> (cons init to-copy))
+                       (module-dir (flat-linux-module-directory linux
+                                                                linux-modules)))
+    (define graph-files
+      (unfold-right zero?
+                    number->string
+                    1-
+                    (length to-copy)))
+
     (define builder
       ;; TODO: Move most of this code to (gnu build linux-initrd).
       #~(begin
           (use-modules (gnu build linux-initrd)
                        (guix build utils)
                        (guix build store-copy)
-                       (ice-9 pretty-print)
-                       (ice-9 popen)
-                       (ice-9 match)
-                       (ice-9 ftw)
-                       (srfi srfi-26)
                        (system base compile)
                        (rnrs bytevectors)
                        ((system foreign) #:select (sizeof)))
 
-          (let ((modules #$source)
-                (gos     #$compiled)
-                (scm-dir (string-append "share/guile/" (effective-version)))
-                (go-dir  (format #f ".cache/guile/ccache/~a-~a-~a-~a"
-                                 (effective-version)
-                                 (if (eq? (native-endianness) (endianness little))
-                                     "LE"
-                                     "BE")
-                                 (sizeof '*)
-                                 (effective-version))))
-            (mkdir #$output)
-            (mkdir "contents")
-
-            (with-directory-excursion "contents"
-              (copy-recursively #$guile ".")
-              (call-with-output-file "init"
-                (lambda (p)
-                  (format p "#!/bin/guile -ds~%!#~%" #$guile)
-                  (pretty-print '#$exp p)))
-              (chmod "init" #o555)
-              (chmod "bin/guile" #o555)
-
-              ;; Copy Guile modules.
-              (chmod scm-dir #o777)
-              (copy-recursively modules scm-dir
-                                #:follow-symlinks? #t)
-              (copy-recursively gos (string-append "lib/guile/"
-                                                   (effective-version) "/ccache")
-                                #:follow-symlinks? #t)
-
-              ;; Compile `init'.
+          (mkdir #$output)
+          (mkdir "contents")
+
+          (with-directory-excursion "contents"
+            ;; Copy Linux modules.
+            (mkdir "modules")
+            (copy-recursively #$module-dir "modules")
+
+            ;; Populate the initrd's store.
+            (with-directory-excursion ".."
+              (populate-store '#$graph-files "contents"))
+
+            ;; Make '/init'.
+            (symlink #$init "init")
+
+            ;; Compile it.
+            (let* ((init    (readlink "init"))
+                   (scm-dir (string-append "share/guile/" (effective-version)))
+                   (go-dir  (format #f ".cache/guile/ccache/~a-~a-~a-~a/~a"
+                                    (effective-version)
+                                    (if (eq? (native-endianness) (endianness little))
+                                        "LE"
+                                        "BE")
+                                    (sizeof '*)
+                                    (effective-version)
+                                    (dirname init))))
               (mkdir-p go-dir)
-              (set! %load-path (cons modules %load-path))
-              (set! %load-compiled-path (cons gos %load-compiled-path))
-              (compile-file "init"
+              (compile-file init
                             #:opts %auto-compilation-options
-                            #:output-file (string-append go-dir "/init.go"))
-
-              ;; Copy Linux modules.
-              (mkdir "modules")
-              (copy-recursively #$module-dir "modules")
-
-              ;; Populate the initrd's store.
-              (with-directory-excursion ".."
-                (populate-store '#$graph-files "contents"))
-
-              ;; Reset the timestamps of all the files that will make it in the
-              ;; initrd.
-              (for-each (cut utime <> 0 0 0 0)
-                        (find-files "." ".*"))
-
-              (write-cpio-archive (string-append #$output "/initrd") "."
-                                  #:cpio (string-append #$cpio "/bin/cpio")
-                                  #:gzip (string-append #$gzip "/bin/gzip"))))))
+                            #:output-file (string-append go-dir "/"
+                                                         (basename init)
+                                                         ".go")))
+
+            ;; This hack allows Guile to find out where it is.  See
+            ;; 'guile-relocatable.patch'.
+            (mkdir-p "proc/self")
+            (symlink (string-append #$guile "/bin/guile") "proc/self/exe")
+            (readlink "proc/self/exe")
+
+            ;; Reset the timestamps of all the files that will make it in the
+            ;; initrd.
+            (for-each (lambda (file)
+                        (unless (eq? 'symlink (stat:type (lstat file)))
+                          (utime file 0 0 0 0)))
+                      (find-files "." ".*"))
+
+            (write-cpio-archive (string-append #$output "/initrd") "."
+                                #:cpio (string-append #$cpio "/bin/cpio")
+                                #:gzip (string-append #$gzip "/bin/gzip")))))
 
    (gexp->derivation name builder
                      #:modules '((guix build utils)

@@ 428,7 428,9 @@ exec " #$qemu "/bin/" #$(qemu-command (%current-system))
   "--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" \
   -serial stdio \
   -drive file=" #$image
-  ",if=virtio,cache=writeback,werror=report,readonly\n")
+  ",if=virtio,cache=writeback,werror=report,readonly \
+  -m 256
+\n")
              port)
             (chmod port #o555))))