09/24: bootloader: grub: Add support for multiboot.

[guix-commits]

janneke pushed a commit to branch wip-hurd-vm
in repository guix.

commit 1244491a0d5334e1589159a2ff67bbc967b9648b
Author: Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
AuthorDate: Tue May 26 18:09:01 2020 +0200

    bootloader: grub: Add support for multiboot.
    
    * gnu/bootloader/grub.scm (grub-configuration-file): Add support for
    multiboot.
---
 gnu/bootloader/grub.scm | 76 +++++++++++++++++++++++++++++++------------------
 1 file changed, 49 insertions(+), 27 deletions(-)

diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 2d9a39a..d4dbb57 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -330,36 +330,58 @@ when booting a root file system on a Btrfs subvolume."
   (define all-entries
     (append entries (bootloader-configuration-menu-entries config)))
   (define (menu-entry->gexp entry)
-    (let* ((device (menu-entry-device entry))
-           (device-mount-point (menu-entry-device-mount-point entry))
-           (label (menu-entry-label entry))
-           (arguments (menu-entry-linux-arguments entry))
-           (kernel (normalize-file (menu-entry-linux entry)
-                                   device-mount-point
-                                   store-directory-prefix))
-           (initrd (normalize-file (menu-entry-initrd entry)
-                                   device-mount-point
-                                   store-directory-prefix)))
-      ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
-      ;; Use the right file names for KERNEL and INITRD in case
-      ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
-      ;; separate partition.
-      #~(format port "menuentry ~s {
+    (let ((label (menu-entry-label entry))
+          (linux (menu-entry-linux entry))
+          (device (menu-entry-device entry))
+          (device-mount-point (menu-entry-device-mount-point entry)))
+      (if linux
+          (let ((arguments (menu-entry-linux-arguments entry))
+                (linux (normalize-file linux
+                                       device-mount-point
+                                       store-directory-prefix))
+                (initrd (normalize-file (menu-entry-initrd entry)
+                                        device-mount-point
+                                        store-directory-prefix)))
+         ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
+         ;; Use the right file names for LINUX and INITRD in case
+         ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
+         ;; separate partition.
+
+         ;; When BTRFS-SUBVOLUME-FILE-NAME is defined, prepend it the linux and
+         ;; initrd paths, to allow booting from a Btrfs subvolume.
+         #~(format port "menuentry ~s {
   ~a
   linux ~a ~a
   initrd ~a
 }~%"
-                #$label
-                #$(grub-root-search device kernel)
-                #$kernel (string-join (list #$@arguments))
-                #$initrd)))
-  (define sugar
-    (eye-candy config
-               (menu-entry-device (first all-entries))
-               (menu-entry-device-mount-point (first all-entries))
-               #:store-directory-prefix store-directory-prefix
-               #:system system
-               #:port #~port))
+                   #$label
+                   #$(grub-root-search device linux)
+                   #$linux (string-join (list #$@arguments))
+                   #$initrd))
+          (let ((kernel (menu-entry-multiboot-kernel entry))
+                (arguments (menu-entry-multiboot-arguments entry))
+                (modules (menu-entry-multiboot-modules entry))
+                (root-index 1))            ; XXX EFI will need root-index 2
+        #~(format port "
+menuentry ~s {
+  multiboot ~a root=device:hd0s~a~a~a
+}~%"
+                  #$label
+                  #$kernel
+                  #$root-index (string-join (list #$@arguments) " " 'prefix)
+                  (string-join (map string-join '#$modules)
+                               "\n  module " 'prefix))))))
+
+  (define (sugar)
+    (let* ((entry (first all-entries))
+           (device (menu-entry-device entry))
+           (mount-point (menu-entry-device-mount-point entry)))
+      (eye-candy config
+                 device
+                 mount-point
+                 #:store-directory-prefix store-directory-prefix
+                 #:system system
+                 #:port #~port)))
 
   (define keyboard-layout-config
     (let* ((layout (bootloader-configuration-keyboard-layout config))
@@ -384,7 +406,7 @@ keymap ~a~%" #$keymap))))
                   "# This file was generated from your Guix configuration.  
Any changes
 # will be lost upon reconfiguration.
 ")
-          #$sugar
+          #$(sugar)
           #$keyboard-layout-config
           (format port "
 set default=~a