07/21: system: Add 'hurd' field to <boot-parameters>.

[guix-commits]

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

commit 025b2156c87ab6929aed94b9a3a0c8d5f9762cc7
Author: Jan (janneke) Nieuwenhuizen <address@hidden>
AuthorDate: Sun May 10 13:18:18 2020 +0200

    system: Add 'hurd' field to <boot-parameters>.
    
    * gnu/system.scm (<boot-parameters>)[hurd]: New field.
    (read-boot-parameters): Initialize it.
    (operating-system-boot-parameters): Cater for the Hurd and initialize it;
    avoid initrd in that case.
    (operating-system-kernel-file): Cater for for Gnumach (the Hurd) besides 
Linux.
    (boot-parameters->menu-entry): Use it to support <hurd-menu-entry>.
---
 gnu/system.scm | 51 +++++++++++++++++++++++++++++++++------------------
 1 file changed, 33 insertions(+), 18 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index bc542ea..76bddf0 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -41,6 +41,7 @@
   #:use-module (gnu packages guile)
   #:use-module (gnu packages guile-xyz)
   #:use-module (gnu packages admin)
+  #:use-module (gnu packages hurd)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages pciutils)
   #:use-module (gnu packages package-management)
@@ -141,6 +142,7 @@
             boot-parameters-kernel
             boot-parameters-kernel-arguments
             boot-parameters-initrd
+            boot-parameters-hurd
             read-boot-parameters
             read-boot-parameters-file
             boot-parameters->menu-entry
@@ -282,7 +284,8 @@ directly by the user."
   (store-mount-point boot-parameters-store-mount-point)
   (kernel           boot-parameters-kernel)
   (kernel-arguments boot-parameters-kernel-arguments)
-  (initrd           boot-parameters-initrd))
+  (initrd           boot-parameters-initrd)
+  (hurd             boot-parameters-hurd))
 
 (define (ensure-not-/dev device)
   "If DEVICE starts with a slash, return #f.  This is meant to filter out
@@ -313,7 +316,7 @@ file system labels."
   (match (read port)
     (('boot-parameters ('version 0)
                        ('label label) ('root-device root)
-                       ('kernel linux)
+                       ('kernel kernel)
                        rest ...)
      (boot-parameters
       (label label)
@@ -329,12 +332,12 @@ file system labels."
          ((_ entries) (map sexp->menu-entry entries))
          (#f          '())))
 
-      ;; In the past, we would store the directory name of the kernel instead
-      ;; of the absolute file name of its image.  Detect that and correct it.
-      (kernel (if (string=? linux (direct-store-path linux))
-                  (string-append linux "/"
+      ;; In the past, we would store the directory name of linux instead of
+      ;; the absolute file name of its image.  Detect that and correct it.
+      (kernel (if (string=? kernel (direct-store-path kernel))
+                  (string-append kernel "/"
                                  (system-linux-image-file-name))
-                  linux))
+                  kernel))
 
       (kernel-arguments
        (match (assq 'kernel-arguments rest)
@@ -348,6 +351,8 @@ file system labels."
          (('initrd (? string? file))
           file)))
 
+      (hurd (assq 'hurd rest))
+
       (store-device
        ;; Linux device names like "/dev/sda1" are not suitable GRUB device
        ;; identifiers, so we just filter them out.
@@ -385,14 +390,20 @@ The object has its kernel-arguments extended in order to 
make it bootable."
                                (boot-parameters-kernel-arguments params))))))
 
 (define (boot-parameters->menu-entry conf)
-  (menu-entry
-   (label (boot-parameters-label conf))
-   (device (boot-parameters-store-device conf))
-   (device-mount-point (boot-parameters-store-mount-point conf))
-   (linux (boot-parameters-kernel conf))
-   (linux-arguments (boot-parameters-kernel-arguments conf))
-   (initrd (boot-parameters-initrd conf))))
-
+  (if (boot-parameters-hurd conf)
+      (hurd-menu-entry
+       (label (boot-parameters-label conf))
+       (device (boot-parameters-store-device conf))
+       (device-mount-point (boot-parameters-store-mount-point conf))
+       (mach (boot-parameters-kernel conf))
+       (hurd (boot-parameters-hurd conf)))
+      (menu-entry
+       (label (boot-parameters-label conf))
+       (device (boot-parameters-store-device conf))
+       (device-mount-point (boot-parameters-store-mount-point conf))
+       (linux (boot-parameters-kernel conf))
+       (linux-arguments (boot-parameters-kernel-arguments conf))
+       (initrd (boot-parameters-initrd conf)))))
 
 
 ;;;
@@ -484,8 +495,10 @@ from the initrd."
 (define (operating-system-kernel-file os)
   "Return an object representing the absolute file name of the kernel image of
 OS."
-  (file-append (operating-system-kernel os)
-               "/" (system-linux-image-file-name)))
+  (if (operating-system-hurd os)
+      (file-append (operating-system-kernel os) "/boot/gnumach")
+      (file-append (operating-system-kernel os)
+                      "/" (system-linux-image-file-name))))
 
 (define (package-for-kernel target-kernel module-package)
   "Return a package like MODULE-PACKAGE, adapted for TARGET-KERNEL, if
@@ -1131,7 +1144,8 @@ a list of <menu-entry>, to populate the \"old entries\" 
menu."
   "Return a monadic <boot-parameters> record that describes the boot
 parameters of OS.  When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments
 such as '--root' and '--load' to <boot-parameters>."
-  (let* ((initrd          (operating-system-initrd-file os))
+  (let* ((initrd          (and (hurd-target?)
+                               (operating-system-initrd-file os)))
          (store           (operating-system-store-file-system os))
          (bootloader      (bootloader-configuration-bootloader
                            (operating-system-bootloader os)))
@@ -1146,6 +1160,7 @@ such as '--root' and '--load' to <boot-parameters>."
           (operating-system-kernel-arguments os root-device)
           (operating-system-user-kernel-arguments os)))
      (initrd initrd)
+     (hurd (operating-system-hurd os))
      (bootloader-name bootloader-name)
      (bootloader-menu-entries
       (bootloader-configuration-menu-entries (operating-system-bootloader os)))