diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 3ddc112cc6..cb96b076ae 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
 ;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,45 +25,53 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu bootloader)
+  #:autoload   (gnu build file-systems)
+               (read-partition-label read-partition-uuid
+                find-partition-by-label find-partition-by-uuid)
+  #:use-module (gnu packages linux)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system uuid)
-  #:use-module (guix discovery)
-  #:use-module (guix gexp)
-  #:use-module (guix profiles)
-  #:use-module (guix records)
+  #:autoload   (guix build syscalls)
+               (mounts mount-source mount-point mount-type)
   #:use-module (guix deprecation)
   #:use-module (guix diagnostics)
+  #:use-module (guix gexp)
   #:use-module (guix i18n)
   #:use-module (guix modules)
+  #:use-module (guix profiles)
+  #:use-module (guix records)
+  #:use-module (guix utils)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
-  #:use-module (ice-9 match)
-  #:export (menu-entry
+  #:export (<menu-entry>
+            menu-entry
             menu-entry?
             menu-entry-label
             menu-entry-device
+            menu-entry-device-mount-point
+            menu-entry-device-subvol
             menu-entry-linux
             menu-entry-linux-arguments
             menu-entry-initrd
-            menu-entry-device-mount-point
             menu-entry-multiboot-kernel
             menu-entry-multiboot-arguments
             menu-entry-multiboot-modules
             menu-entry-chain-loader
 
+            normalize-file
             menu-entry->sexp
             sexp->menu-entry
 
             bootloader
             bootloader?
             bootloader-name
-            bootloader-package
+            bootloader-default-targets
             bootloader-installer
-            bootloader-disk-image-installer
-            bootloader-configuration-file
-            bootloader-configuration-file-generator
 
             <bootloader-target>
             bootloader-target
@@ -84,13 +93,15 @@ (define-module (gnu bootloader)
             :path :devpath :device :fs :label :uuid
             with-targets
 
+            <bootloader-configuration>
             bootloader-configuration
             bootloader-configuration?
             bootloader-configuration-bootloader
-            bootloader-configuration-target ;deprecated
             bootloader-configuration-targets
             bootloader-configuration-menu-entries
             bootloader-configuration-default-entry
+            bootloader-configuration-efi-removable?
+            bootloader-configuration-32bit?
             bootloader-configuration-timeout
             bootloader-configuration-keyboard-layout
             bootloader-configuration-theme
@@ -101,10 +112,11 @@ (define-module (gnu bootloader)
             bootloader-configuration-device-tree-support?
             bootloader-configuration-extra-initrd
 
-            %bootloaders
-            lookup-bootloader-by-name
+            bootloader-configuration->gexp
+            bootloader-configurations->gexp
 
-            efi-bootloader-chain))
+            efi-arch
+            install-efi))
 
 
 ;;;
@@ -119,6 +131,8 @@ (define-record-type* <menu-entry>
                    (default #f))
   (device-mount-point menu-entry-device-mount-point
                    (default #f))
+  (device-subvol menu-entry-device-subvol
+                   (default #f))
   (linux           menu-entry-linux
                    (default #f))
   (linux-arguments menu-entry-linux-arguments
@@ -135,6 +149,18 @@ (define-record-type* <menu-entry>
   (chain-loader     menu-entry-chain-loader
                     (default #f)))         ; string, path of efi file
 
+(define (normalize-file entry val)
+  "Normalize a file VAL stored in a menu entry into one suitable for a
+bootloader.  Realizes device-mount-point and device-subvol."
+  (match-record entry <menu-entry> (device-mount-point device-subvol)
+    #~(let* ((rel (lambda (s) (substring s (if (string-prefix? "/" s) 1 0))))
+             (file (rel #$val))
+             (subvol (and=> #$device-subvol rel))
+             (mount (and=> #$device-mount-point rel)))
+        (string-append (if subvol (string-append "/" subvol "/") "/")
+                       (if (and mount (string-prefix? mount file))
+                           (substring file (string-length mount)) file)))))
+
 (define (report-menu-entry-error menu-entry)
   (raise
    (condition
@@ -162,7 +188,7 @@ (define (menu-entry->sexp entry)
        `(label ,(file-system-label->string label)))
       (_ device)))
   (match entry
-    (($ <menu-entry> label device mount-point
+    (($ <menu-entry> label device mount-point subvol
                      (? identity linux) linux-arguments (? identity initrd)
                      #f () () #f)
      `(menu-entry (version 0)
@@ -171,8 +197,9 @@ (define (menu-entry->sexp entry)
                   (device-mount-point ,mount-point)
                   (linux ,linux)
                   (linux-arguments ,linux-arguments)
-                  (initrd ,initrd)))
-    (($ <menu-entry> label device mount-point #f () #f
+                  (initrd ,initrd)
+                  (device-subvol ,subvol)))
+    (($ <menu-entry> label device mount-point subvol #f () #f
                      (? identity multiboot-kernel) multiboot-arguments
                      multiboot-modules #f)
      `(menu-entry (version 0)
@@ -181,19 +208,23 @@ (define (menu-entry->sexp entry)
                   (device-mount-point ,mount-point)
                   (multiboot-kernel ,multiboot-kernel)
                   (multiboot-arguments ,multiboot-arguments)
-                  (multiboot-modules ,multiboot-modules)))
-    (($ <menu-entry> label device mount-point #f () #f #f () ()
+                  (multiboot-modules ,multiboot-modules)
+                  (device-subvol ,subvol)))
+    (($ <menu-entry> label device mount-point subvol #f () #f #f () ()
                      (? identity chain-loader))
      `(menu-entry (version 0)
                   (label ,label)
                   (device ,(device->sexp device))
                   (device-mount-point ,mount-point)
-                  (chain-loader ,chain-loader)))
+                  (chain-loader ,chain-loader)
+                  (device-subvol ,subvol)))
     (_ (report-menu-entry-error entry))))
 
 (define (sexp->menu-entry sexp)
   "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
 record."
+  ;; XXX: rely on shadowing to support the match ors below
+  (define subvol #f)
   (define (sexp->device device-sexp)
     (match device-sexp
       (('uuid type uuid-string)
@@ -206,35 +237,41 @@ (define (sexp->menu-entry sexp)
                   ('label label) ('device device)
                   ('device-mount-point mount-point)
                   ('linux linux) ('linux-arguments linux-arguments)
-                  ('initrd initrd) _ ...)
+                  ('initrd initrd)
+                  (or ('device-subvol subvol _ ...) (_ ...)))
      (menu-entry
       (label label)
       (device (sexp->device device))
       (device-mount-point mount-point)
+      (device-subvol subvol)
       (linux linux)
       (linux-arguments linux-arguments)
       (initrd initrd)))
     (('menu-entry ('version 0)
                   ('label label) ('device device)
-                  ('device-mount-point mount-point)
+                  ('device-mount-point mount-point) ('device-subvol subvol)
                   ('multiboot-kernel multiboot-kernel)
                   ('multiboot-arguments multiboot-arguments)
-                  ('multiboot-modules multiboot-modules) _ ...)
+                  ('multiboot-modules multiboot-modules)
+                  (or ('device-subvol subvol _ ...) (_ ...)))
      (menu-entry
       (label label)
       (device (sexp->device device))
       (device-mount-point mount-point)
+      (device-subvol subvol)
       (multiboot-kernel multiboot-kernel)
       (multiboot-arguments multiboot-arguments)
       (multiboot-modules multiboot-modules)))
     (('menu-entry ('version 0)
                   ('label label) ('device device)
-                  ('device-mount-point mount-point)
-                  ('chain-loader chain-loader) _ ...)
+                  ('device-mount-point mount-point) ('device-subvol subvol)
+                  ('chain-loader chain-loader)
+                  (or ('device-subvol subvol _ ...) (_ ...)))
      (menu-entry
       (label label)
       (device (sexp->device device))
       (device-mount-point mount-point)
+      (device-subvol subvol)
       (chain-loader chain-loader)))))
 
 
@@ -247,15 +284,10 @@ (define (sexp->menu-entry sexp)
 ;; has to be described by this record.
 
 (define-record-type* <bootloader>
-  bootloader make-bootloader
-  bootloader?
-  (name                            bootloader-name)
-  (package                         bootloader-package)
-  (installer                       bootloader-installer)
-  (disk-image-installer            bootloader-disk-image-installer
-                                   (default #f))
-  (configuration-file              bootloader-configuration-file)
-  (configuration-file-generator    bootloader-configuration-file-generator))
+  bootloader make-bootloader bootloader?
+  (name            bootloader-name)
+  (default-targets bootloader-default-targets (default '()))
+  (installer       bootloader-installer))
 
 
 ;;;
@@ -450,28 +482,48 @@ (define-syntax with-targets
 ;; The <bootloader-configuration> record contains bootloader independant
 ;; configuration used to fill bootloader configuration file.
 
-(define-with-syntax-properties (warn-target-field-deprecation
-                                (value properties))
-  (when value
-    (warning (source-properties->location properties)
-             (G_ "the 'target' field is deprecated, please use 'targets' \
-instead~%")))
-  value)
+(define-with-syntax-properties (warn-update-targets (value properties))
+  (let ((loc (source-properties->location properties)))
+    (define update
+      (match-lambda
+        ((? bootloader-target? target) (cons #f target))
+        ((? string? s) (cons #t (if (string-prefix? "/dev" s)
+                                  (bootloader-target
+                                    (type 'disk)
+                                    (device s))
+                                  (bootloader-target
+                                    (type 'esp)
+                                    (offset 'root)
+                                    (path s)))))
+        (x (error loc (G_ "invalid target '~a'~%") x))))
+
+    (let* ((updated (map update (if (list? value) value (list value))))
+           (targets (map cdr updated))
+           (types (map bootloader-target-type targets)))
+      ;; XXX: should this be an error?
+      (when (any car updated)
+        (warning loc (G_ "the 'targets' field should now contain \
+<bootloader-target> records. inferring a best guess (this might break!)...~%")))
+      (when (not (eqv? (length types) (length (delete-duplicates types))))
+        (error loc (G_ "the 'targets' field may not contain duplicates~%")))
+      targets)))
 
 (define-record-type* <bootloader-configuration>
   bootloader-configuration make-bootloader-configuration
   bootloader-configuration?
   (bootloader
-   bootloader-configuration-bootloader) ;<bootloader>
-  (targets               %bootloader-configuration-targets
-                         (default #f))     ;list of strings
-  (target                %bootloader-configuration-target ;deprecated
-                         (default #f)
-                         (sanitize warn-target-field-deprecation))
+   bootloader-configuration-bootloader)   ;<bootloader>
+  (targets               bootloader-configuration-targets
+                         (default '())    ;list of strings
+                         (sanitize warn-update-targets))
   (menu-entries          bootloader-configuration-menu-entries
                          (default '()))   ;list of <menu-entry>
   (default-entry         bootloader-configuration-default-entry
                          (default 0))     ;integer
+  (efi-removable?        bootloader-configuration-efi-removable?
+                         (default #f))    ;bool
+  (32bit?                bootloader-configuration-32bit?
+                         (default #f))    ;bool
   (timeout               bootloader-configuration-timeout
                          (default 5))     ;seconds as integer
   (keyboard-layout       bootloader-configuration-keyboard-layout
@@ -479,9 +531,9 @@ (define-record-type* <bootloader-configuration>
   (theme                 bootloader-configuration-theme
                          (default #f))    ;bootloader-specific theme
   (terminal-outputs      bootloader-configuration-terminal-outputs
-                         (default '(gfxterm)))   ;list of symbols
+                         (default #f))    ;list of symbols | #f (default outs)
   (terminal-inputs       bootloader-configuration-terminal-inputs
-                         (default '()))   ;list of symbols
+                         (default #f))    ;list of symbols | #f (default ins)
   (serial-unit           bootloader-configuration-serial-unit
                          (default #f))    ;integer | #f
   (serial-speed          bootloader-configuration-serial-speed
@@ -491,164 +543,140 @@ (define-record-type* <bootloader-configuration>
   (extra-initrd          bootloader-configuration-extra-initrd
                          (default #f)))   ;string | #f
 
-(define-deprecated (bootloader-configuration-target config)
-  bootloader-configuration-targets
-  (%bootloader-configuration-target config))
+
+;;;
+;;; Bootloader installation paths.
+;;;
 
-(define (bootloader-configuration-targets config)
-  (or (%bootloader-configuration-targets config)
-      ;; TODO: Remove after the deprecated 'target' field is removed.
-      (list (%bootloader-configuration-target config))
-      ;; XXX: At least the GRUB installer (see (gnu bootloader grub)) has this
-      ;; peculiar behavior of installing fonts and GRUB modules when DEVICE is #f,
-      ;; hence the default value of '(#f) rather than '().
-      (list #f)))
+;; highest -> lowest priority
+(define (target-overrides . layers)
+  (let* ((types (fold append '()
+                  (map (cute map bootloader-target-type <>) layers)))
+         (pred (lambda (type layer found)
+                 (or found (get-target-of-type type layer))))
+         (find (lambda (type) (fold (cute pred type <> <>) #f layers))))
+    (filter ->bool (map find (delete-duplicates types)))))
+
+(define (normalize targets)
+  "Augments user-supplied targets with filesystem information at runtime,
+allowing users to specify a lot less information.  Relatively minimal to prevent
+errors.  Puts targets into a normal form, where all paths are fully specified up
+to a device offset."
+  (let* ((mass (lambda (m) `((,(mount-source m) . ,m) (,(mount-point m) . ,m))))
+         (amounts (delay (apply append (map mass (mounts)))))
+         (accessible=> (lambda (d f) (and d (access? d R_OK) (f d))))
+         (assoc-mnt (lambda (f) (lambda (v)
+                                  (and=> (assoc-ref (force amounts) v) f)))))
+
+    (define (scrape target)
+      (match-record target <bootloader-target>
+        (expected? path offset device label uuid file-system)
+        (if expected? target
+          (bootloader-target
+            (inherit target)
+            (device (or device (false-if-exception
+                                 (or (and=> uuid find-partition-by-uuid)
+                                     (and=> label find-partition-by-label)))
+                               (and path ((assoc-mnt mount-source)
+                                          (unfold-pathcat target targets)))))
+            (label (or label (accessible=> device read-partition-label)))
+            (uuid (or uuid (accessible=> device read-partition-uuid)))
+            (file-system (or file-system (and=> device (assoc-mnt mount-type))))
+            (offset (and path offset))
+            (path (or path (and=> device (assoc-mnt mount-point))))))))
+
+    (define (fixuuid target)
+      (match-record target <bootloader-target> (uuid file-system)
+        (let ((type (cond ((member file-system '("vfat" "fat32") 'fat))
+                          ((string=? file-system "ntfs") 'ntfs)
+                          ((string=? file-system "iso9660") 'iso9660)
+                          (else 'dce))))
+          (cond ((uuid? uuid) uuid)
+                ((bytevector? uuid) (bytevector->uuid uuid type))
+                ((string? uuid) (string->uuid uuid type))))))
+
+    (define (arborify target targets)
+      (let* ((up (lambda (t) (and t (parent-of t targets))))
+             (proto (unfold target-base? identity up (up target) list))
+             (chain (reverse (cons target proto))))
+        (bootloader-target
+          (inherit target)
+          (offset (and=> (car chain) bootloader-target-type))
+          (path (reduce pathcat #f (map bootloader-target-path (cdr chain)))))))
+
+    (let ((mid (map (compose fixuuid scrape) targets)))
+      (map (cut arborify <> mid) mid))))
+
+(define* (bootloader-configuration->gexp bootloader-config args #:key
+                                          (root-offset "/") (overrides '()))
+  "Returns a gexp to install BOOTLOADER-CONFIG to its targets, passing ARGS
+to each installer alongside the additional #:bootloader-config keyword
+arguments.  Target OVERRIDES are applied and all path targets have ROOT-OFFSET
+applied.  The following keyword arguments are expected in ARGS:
+@enumerate
+@item current-boot-alternative
+@item old-boot-alternatives
+@item locale (from bootmeta)
+@item store-directory-prefix (from bootmeta)
+@item store-crypto-devices (from bootmeta)
+@end enumerate"
+  (let* ((bootloader (bootloader-configuration-bootloader bootloader-config))
+         (installer (bootloader-installer bootloader))
+         (auto-targets (list (bootloader-target
+                               (type 'root)
+                               (path root-offset)
+                               (offset #f))))
+         (targets (target-overrides
+                    overrides
+                    (bootloader-configuration-targets bootloader-config)
+                    auto-targets
+                    (bootloader-default-targets bootloader)))
+         (conf (bootloader-configuration
+                 (inherit bootloader-config)
+                 (targets (normalize targets)))))
+    (apply installer #:bootloader-config conf args)))
+
+(define (bootloader-configurations->gexp bootloader-configs . rest)
+  (apply gbegin (filter-map (cut apply bootloader-configuration->gexp <> rest)
+                            bootloader-configs)))
 
 
-;;;
-;;; Bootloaders.
+=
+;;; EFI shit
 ;;;
 
-(define (bootloader-modules)
-  "Return the list of bootloader modules."
-  ;; don't provide #:warn to prevent mutual imports
-  (all-modules (map (lambda (entry)
-                      `(,entry . "gnu/bootloader"))
-                    %load-path)))
-
-(define %bootloaders
-  ;; The list of publically-known bootloaders.
-  (delay (fold-module-public-variables (lambda (obj result)
-                                         (if (bootloader? obj)
-                                             (cons obj result)
-                                             result))
-                                       '()
-                                       (bootloader-modules))))
-
-(define (lookup-bootloader-by-name name)
-  "Return the bootloader called NAME."
-  (or (find (lambda (bootloader)
-              (eq? name (bootloader-name bootloader)))
-            (force %bootloaders))
-      (leave (G_ "~a: no such bootloader~%") name)))
-
-(define (efi-bootloader-profile packages files hooks)
-  "Creates a profile from the lists of PACKAGES and FILES from the store.
-This profile is meant to be used by the bootloader-installer.
-
-FILES is a list of file or directory names from the store, which will be
-symlinked into the profile.  If a directory name ends with '/', then the
-directory content instead of the directory itself will be symlinked into the
-profile.
-
-FILES may contain file like objects produced by procedures like plain-file,
-local-file, etc., or package contents produced with file-append.
-
-HOOKS lists additional hook functions to modify the profile."
-  (define* (efi-bootloader-profile-hook manifest #:optional system)
-    (define build
-        (with-imported-modules '((guix build utils))
-          #~(begin
-            (use-modules ((guix build utils)
-                          #:select (mkdir-p strip-store-file-name))
-                         ((ice-9 ftw)
-                          #:select (scandir))
-                         ((srfi srfi-1)
-                          #:select (append-map every remove))
-                         ((srfi srfi-26)
-                          #:select (cut)))
-            (define (symlink-to file directory transform)
-              "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY."
-              (symlink file (string-append directory "/" (transform file))))
-            (define (directory-content directory)
-              "Creates a list of absolute path names inside DIRECTORY."
-              (map (lambda (name)
-                     (string-append directory name))
-                   (or (scandir directory (lambda (name)
-                                            (not (member name '("." "..")))))
-                       '())))
-            (define name-ends-with-/? (cut string-suffix? "/" <>))
-            (define (name-is-store-entry? name)
-              "Return #t if NAME is a direct store entry and nothing inside."
-              (not (string-index (strip-store-file-name name) #\/)))
-            (let* ((files '#$files)
-                   (directories (filter name-ends-with-/? files))
-                   (names-from-directories
-                    (append-map (lambda (directory)
-                                  (directory-content directory))
-                                directories))
-                   (names (append names-from-directories
-                                  (remove name-ends-with-/? files))))
-              (mkdir-p #$output)
-              (if (every file-exists? names)
-                  (begin
-                    (for-each (lambda (name)
-                               (symlink-to name #$output
-                                            (if (name-is-store-entry? name)
-                                                strip-store-file-name
-                                                basename)))
-                              names)
-                    #t)
-                  #f)))))
-
-    (gexp->derivation "efi-bootloader-profile"
-                      build
-                      #:system system
-                      #:local-build? #t
-                      #:substitutable? #f
-                      #:properties
-                      `((type . profile-hook)
-                        (hook . efi-bootloader-profile-hook))))
-
-  (profile (content (packages->manifest packages))
-           (name "efi-bootloader-profile")
-           (hooks (cons efi-bootloader-profile-hook hooks))
-           (locales? #f)
-           (allow-collisions? #f)
-           (relative-symlinks? #f)))
-
-(define* (efi-bootloader-chain final-bootloader
-                               #:key
-                               (packages '())
-                               (files '())
-                               (hooks '())
-                               installer
-                               disk-image-installer)
-  "Define a chain of bootloaders with the FINAL-BOOTLOADER, optional PACKAGES,
-and optional directories and files from the store given in the list of FILES.
-
-The package of the FINAL-BOOTLOADER and all PACKAGES and FILES will be placed
-in an efi-bootloader-profile, which will be passed to the INSTALLER.
-
-FILES may contain file-like objects produced by procedures like plain-file,
-local-file, etc., or package contents produced with file-append.
-
-If a directory name in FILES ends with '/', then the directory content instead
-of the directory itself will be symlinked into the efi-bootloader-profile.
-
-The procedures in the HOOKS list can be used to further modify the bootloader
-profile.  It is possible to pass a single function instead of a list.
-
-If the INSTALLER argument is used, then this gexp procedure will be called to
-install the efi-bootloader-profile.  Otherwise the installer of the
-FINAL-BOOTLOADER will be called.
-
-If the DISK-IMAGE-INSTALLER is used, then this gexp procedure will be called
-to install the efi-bootloader-profile into a disk image.  Otherwise the
-disk-image-installer of the FINAL-BOOTLOADER will be called."
-  (bootloader
-    (inherit final-bootloader)
-    (name "efi-bootloader-chain")
-    (package
-     (efi-bootloader-profile (cons (bootloader-package final-bootloader)
-                                   packages)
-                             files
-                             (if (list? hooks)
-                                 hooks
-                                 (list hooks))))
-    (installer
-     (or installer
-         (bootloader-installer final-bootloader)))
-    (disk-image-installer
-     (or disk-image-installer
-         (bootloader-disk-image-installer final-bootloader)))))
+(define* (efi-arch #:key (target (or (%current-target-system) (%current-system)))
+                         (32? #f))
+  "Returns the UEFI architecture name for the current target, in lowercase."
+  (cond ((target-x86-32? target)  "ia32")
+        ((target-x86-64? target)  (if 32? "ia32" "x64"))
+        ((target-arm32? target)   "arm")
+        ((target-aarch64? target) (if 32? "arm" "aa64"))
+        ((target-riscv64? target) (if 32? "riscv32" "riscv64"))
+        (else (raise (formatted-message (G_ "no UEFI standard arch for ~a!")
+                                        target)))))
+
+(define (install-efi bootloader-config plan)
+  "Returns a gexp installing PLAN to the ESP, as denoted by the 'vendir target.
+PLAN is a gexp of a list of '(BUILDER DEST-BASENAME . LABEL) triples, that
+should be in boot order.  If the user selects a removable bootloader, only the
+first entry in PLAN is used."
+  (match-record bootloader-config <bootloader-configuration>
+    (targets efi-removable? 32bit?)
+    (if efi-removable?
+      ;; Hard code the output location to a well-known path recognized by
+      ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
+      ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
+      (with-targets targets
+        (('esp => (path :path))
+         #~(let ((boot #$(string-append path "/EFI/BOOT"))
+                 (arch #$(string-upcase (efi-arch #:32? 32bit?)))
+                 (builder (car (car #$plan))))
+             (mkdir-p boot)
+             ;; only realize first planspec
+             (builder (string-append boot "/BOOT" arch ".EFI")))))
+      ;; normal install when not doing a removable config
+      (with-targets targets
+        (('vendir => (vendir :path) (loader :devpath) (disk :device))
+         #~(install-efi #+(file-append efibootmgr "/sbin/efibootmgr")
+                        #$vendir #$loader #$disk #$plan))))))
diff --git a/gnu/bootloader/depthcharge.scm b/gnu/bootloader/depthcharge.scm
index 0a50374bd9..ad29f5d5e4 100644
--- a/gnu/bootloader/depthcharge.scm
+++ b/gnu/bootloader/depthcharge.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,92 +18,86 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu bootloader depthcharge)
-  #:use-module (gnu bootloader extlinux)
   #:use-module (gnu bootloader)
   #:use-module (gnu packages bootloaders)
+  #:use-module (gnu system boot)
   #:use-module (guix gexp)
+  #:use-module (guix deprecation)
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
+  #:use-module (guix records)
   #:use-module (guix utils)
-  #:use-module (ice-9 match)
-  #:export (depthcharge-bootloader))
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-35)
+  #:export (depthcharge-veyron-speedy-bootloader
+            depthcharge-bootloader))
 
-(define (signed-kernel kernel kernel-arguments initrd)
-  (define builder
-    (with-imported-modules '((guix build utils))
-      #~(begin
-          (use-modules (guix build utils)
-                       (ice-9 binary-ports)
-                       (rnrs bytevectors))
-          (set-path-environment-variable "PATH" '("bin") (list #$dtc))
+(define* (install-depthcharge arch dtb
+                              #:key bootloader-config current-boot-alternative
+                              #:allow-other-keys)
+  (when (not (null? (bootloader-configuration-menu-entries bootloader-config)))
+    (raise (formatted-message
+             (G_ "extra menu-entries are not supported for depthcharge!"))))
+  (with-targets (bootloader-configuration-targets bootloader-config)
+    ;; use 'part instead of 'disk, cause we write an image directly into a
+    ;; partition instead of the extra-partition disk space
+    (('part => (disk :device))
+     (match-record (boot-alternative->menu-entry current-boot-alternative)
+                   <menu-entry> (linux linux-arguments initrd)
+       #~(begin
+           (use-modules (ice-9 binary-ports) (rnrs bytevectors))
+           (set-path-environment-variable "PATH" '("bin") (list #$dtc))
 
-          ;; TODO: These files have to be writable, so we copy them.
-          ;; This can probably be fixed by using a ".its" file, just
-          ;; be careful not to break initrd loading.
-          (copy-file #$kernel "zImage")
-          (chmod "zImage" #o755)
-          (copy-file (string-append (dirname #$kernel) "/lib/dtbs/"
-                                    "rk3288-veyron-speedy.dtb")
-                     "rk3288-veyron-speedy.dtb")
-          (chmod "rk3288-veyron-speedy.dtb" #o644)
-          (copy-file #$initrd "initrd")
-          (chmod "initrd" #o644)
+           ;; TODO: These files have to be writable, so we copy them.
+           ;; This can probably be fixed by using a ".its" file, just
+           ;; be careful not to break initrd loading.
+           (copy-file #$linux "zImage")
+           (chmod "zImage" #o755)
+           (copy-file (string-append (dirname #$linux) "/lib/dtbs/" #$dtb)
+                      "dtb")
+           (chmod "dtb" #o644)
+           (copy-file #$initrd "initrd")
+           (chmod "initrd" #o644)
 
-          (invoke (string-append #$u-boot-tools "/bin/mkimage")
-                  "-D" "-I dts -O dtb -p 2048"
-		  "-f" "auto"
-                  "-A" "arm"
-                  "-O" "linux"
-                  "-T" "kernel"
-                  "-C" "None"
-                  "-d" "zImage"
-                  "-a" "0"
-                  "-b" "rk3288-veyron-speedy.dtb"
-                  "-i" "initrd"
-	          "image.itb")
-          (call-with-output-file "bootloader.bin"
-            (lambda (port)
-              (put-bytevector port (make-bytevector 512 0))))
-          (with-output-to-file "kernel-arguments"
-	    (lambda ()
-	      (display (string-join (list #$@kernel-arguments)))))
-          (invoke (string-append #$vboot-utils "/bin/vbutil_kernel")
-                  "--pack" #$output
-                  "--version" "1"
-                  "--vmlinuz" "image.itb"
-		  "--arch" "arm"
-		  "--keyblock" (string-append #$vboot-utils
-                                              "/share/vboot-utils/devkeys/"
-                                              "kernel.keyblock")
-		  "--signprivate" (string-append #$vboot-utils
-                                                 "/share/vboot-utils/devkeys/"
-                                                 "kernel_data_key.vbprivk")
-                  "--config" "kernel-arguments"
-                  "--bootloader" "bootloader.bin"))))
-  (computed-file "vmlinux.kpart" builder))
+           (invoke #+(file-append u-boot-tools "/bin/mkimage")
+                     "-D" "-I dts -O dtb -p 2048"
+                     "-f" "auto" ; format
+                     "-A" #$arch ; architecture
+                     "-O" "linux" ; os
+                     "-T" "kernel" ; image type
+                     "-C" "None" ; compression
+                     "-d" "zImage" ; image data
+                     "-a" "0" ; load address (hex)
+                     "-b" "dtb" ; dtb for device
+                     "-i" "initrd" ; initrd
+                     "image.itb")
+           (call-with-output-file "bootloader.bin"
+             (lambda (port)
+               (put-bytevector port (make-bytevector 512 0))))
+           (call-with-output-file "kernel-arguments"
+             (lambda (port)
+               (display (string-join (list #$@linux-arguments)) port)))
+           (invoke #+(file-append vboot-utils "/bin/vbutil_kernel")
+                   "--version" "1"
+                   "--vmlinuz" "image.itb"
+                   "--arch" #$arch
+                   "--keyblock"
+                   #$(file-append vboot-utils
+                       "/share/vboot-utils/devkeys/kernel.keyblock")
+                   "--signprivate"
+                   #$(file-append vboot-utils
+                       "/share/vboot-utils/devkeys/kernel_data_key.vbprivk")
+                   "--config" "kernel-arguments"
+                   "--pack" "vmlinux.kpart")
+           (write-file-on-device "vmlinux.kpart"
+                                 (stat:size (stat "vmlinux.kpart"))
+                                 #$disk 0))))))
 
-(define* (depthcharge-configuration-file config entries
-                                         #:key
-                                         (system (%current-system))
-                                         (old-entries '())
-                                         #:allow-other-keys)
-  (match entries
-    ((entry)
-     (let ((kernel (menu-entry-linux entry))
-           (kernel-arguments (menu-entry-linux-arguments entry))
-           (initrd (menu-entry-initrd entry)))
-       ;; XXX: Make this a symlink.
-       (signed-kernel kernel kernel-arguments initrd)))
-    (_ (error "Too many bootloader menu entries!"))))
-
-(define install-depthcharge
-  #~(lambda (bootloader device mount-point)
-      (let ((kpart (string-append mount-point
-                                  "/boot/depthcharge/vmlinux.kpart")))
-        (write-file-on-device kpart (stat:size (stat kpart)) device 0))))
-
-(define depthcharge-bootloader
+(define depthcharge-veyron-speedy-bootloader
   (bootloader
    (name 'depthcharge)
-   (package #f)
-   (installer install-depthcharge)
-   (configuration-file "/boot/depthcharge/vmlinux.kpart")
-   (configuration-file-generator depthcharge-configuration-file)))
+   (installer (cute install-depthcharge "arm" "rk3288-veyron-speedy.dtb"
+                    <...>))))
+
+(define-deprecated/alias depthcharge-bootloader
+  depthcharge-veyron-speedy-bootloader)
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index d9b6d8bf8a..c3ab6f3275 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,112 +22,102 @@
 (define-module (gnu bootloader extlinux)
   #:use-module (gnu bootloader)
   #:use-module (gnu packages bootloaders)
+  #:use-module (gnu system boot)
   #:use-module (guix gexp)
+  #:use-module (guix deprecation)
+  #:use-module (guix records)
   #:use-module (guix utils)
-  #:export (extlinux-bootloader
+  #:export (install-extlinux-config ; for u-boot
+            extlinux-bootloader
+            extlinux-gpt-bootloader
             extlinux-bootloader-gpt))
 
-(define* (extlinux-configuration-file config entries
-                                      #:key
-                                      (system (%current-system))
-                                      (old-entries '())
-                                      #:allow-other-keys)
-  "Return the U-Boot configuration file corresponding to CONFIG, a
-<u-boot-configuration> object, and where the store is available at STORE-FS, a
-<file-system> object.  OLD-ENTRIES is taken to be a list of menu entries
-corresponding to old generations of the system."
-
-  (define all-entries
-    (append entries (bootloader-configuration-menu-entries config)))
-
-  (define with-fdtdir?
-    (bootloader-configuration-device-tree-support? config))
+
+;;;
+;;; Config procedures.
+;;;
 
-  (define (menu-entry->gexp entry)
-    (let ((label (menu-entry-label entry))
-          (kernel (menu-entry-linux entry))
-          (kernel-arguments (menu-entry-linux-arguments entry))
-          (initrd (menu-entry-initrd entry)))
-      #~(format port "LABEL ~a
+(define* (install-extlinux-config #:key bootloader-config
+                                        current-boot-alternative
+                                        old-boot-alternatives
+                                  #:allow-other-keys)
+  "Installer for the extlinux configuration file, meant to be shared by all
+bootloaders that use the format to specify boot options."
+  (match-record bootloader-config <bootloader-configuration>
+    (targets menu-entries device-tree-support? timeout)
+    (define (menu-entry->gexp entry)
+      (match-record entry <menu-entry> (label linux linux-arguments initrd)
+        (let* ((normkern (normalize-file entry linux))
+               (fdt #~(string-append "FDTDIR" (dirname #$normkern) "/lib/dtbs")))
+          #~(format port "LABEL ~a
   MENU LABEL ~a
   KERNEL ~a
   ~a
   INITRD ~a
   APPEND ~a
-~%"
-                #$label #$label
-                #$kernel
-                (if #$with-fdtdir?
-                    (string-append "FDTDIR " (dirname #$kernel) "/lib/dtbs")
-                    "")
-                #$initrd
-                (string-join (list #$@kernel-arguments)))))
-
-  (define builder
-    #~(call-with-output-file #$output
-        (lambda (port)
-          (let ((timeout #$(bootloader-configuration-timeout config)))
-            (format port "# This file was generated from your Guix configuration.  Any changes
+~%"                 #$label #$label #$normkern
+                    #$(if device-tree-support? fdt "")
+                    #$(normalize-file entry initrd)
+                    (string-join (list #$@linux-arguments))))))
+
+    (let ((ents (cons (boot-alternative->menu-entry current-boot-alternative)
+                  (append menu-entries
+                    (map boot-alternative->menu-entry old-boot-alternatives)))))
+      (with-targets targets
+        (('extlinux => (path :path))
+         #~(begin (mkdir-p #$path)
+             (call-with-output-file #$path
+               (lambda (port)
+                 (format port "\
+# This file was generated from your Guix configuration.  Any changes
 # will be lost upon reconfiguration.
 UI menu.c32
 MENU TITLE GNU Guix Boot Options
 PROMPT ~a
-TIMEOUT ~a~%"
-                    (if (> timeout 0) 1 0)
-                    ;; timeout is expressed in 1/10s of seconds.
-                    (* 10 timeout))
-            #$@(map menu-entry->gexp all-entries)
-
-            #$@(if (pair? old-entries)
-                   #~((format port "~%")
-                      #$@(map menu-entry->gexp old-entries)
-                      (format port "~%"))
-                   #~())))))
-
-  (computed-file "extlinux.conf" builder
-                 #:options '(#:local-build? #t
-                             #:substitutable? #f)))
-
+TIMEOUT ~a~%"      ;; timeout is expressed in tenths of a second
+                   #$(if (> timeout 0) 1 0) #$(* 10 timeout))
+                 #$@(map menu-entry->gexp ents)))))))))
 
 
-
 ;;;
-;;; Install procedures.
+;;; Install procedure.
 ;;;
 
 (define (install-extlinux mbr)
-  #~(lambda (bootloader device mount-point)
-      (let ((extlinux (string-append bootloader "/sbin/extlinux"))
-            (install-dir (string-append mount-point "/boot/extlinux"))
-            (syslinux-dir (string-append bootloader "/share/syslinux")))
-        (for-each (lambda (file)
-                    (install-file file install-dir))
-                  (find-files syslinux-dir "\\.c32$"))
-        (invoke/quiet extlinux "--install" install-dir)
-        (write-file-on-device (string-append syslinux-dir "/" #$mbr)
-                              440 device 0))))
-
-(define install-extlinux-mbr
-  (install-extlinux "mbr.bin"))
+  (lambda* (#:key bootloader-config #:allow-other-keys . args)
+    (with-targets (bootloader-configuration-targets bootloader-config)
+      (('extlinux => (path :path))
+       #~(begin
+           #$(apply install-extlinux-config args)
+           (copy-recursively #$(file-append syslinux "/share/syslinux") #$path)
+           (invoke/quiet #+(file-append syslinux "/sbin/extlinux")
+                         "--install" #$path)))
+      (('disk => (disk :device))
+       #~(write-file-on-device #$(file-append syslinux "/share/syslinux/" mbr)
+                               440 #$disk 0)))))
 
-(define install-extlinux-gpt
-  (install-extlinux "gptmbr.bin"))
 
 
-
 ;;;
 ;;; Bootloader definitions.
 ;;;
 
 (define extlinux-bootloader
   (bootloader
-   (name 'extlinux)
-   (package syslinux)
-   (installer install-extlinux-mbr)
-   (configuration-file "/boot/extlinux/extlinux.conf")
-   (configuration-file-generator extlinux-configuration-file)))
-
-(define extlinux-bootloader-gpt
+    (name 'extlinux)
+    (default-targets (list (bootloader-target
+                             (type 'install)
+                             (offset 'root)
+                             (path "boot"))
+                           (bootloader-target
+                             (type 'extlinux)
+                             (offset 'install)
+                             (path "extlinux"))))
+    (installer (install-extlinux "mbr.bin"))))
+
+(define extlinux-gpt-bootloader
   (bootloader
-   (inherit extlinux-bootloader)
-   (installer install-extlinux-gpt)))
+    (inherit extlinux-bootloader)
+    (installer (install-extlinux "gptmbr.bin"))))
+
+(define-deprecated/alias extlinux-bootloader-gpt extlinux-gpt-bootloader)
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 2723eda5f4..71fcc90ec7 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -10,6 +10,7 @@
 ;;; Copyright © 2022 Karl Hallsby <karl@hallsby.com>
 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
 ;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -27,24 +28,26 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu bootloader grub)
-  #:use-module (guix build union)
-  #:use-module (guix records)
-  #:use-module (guix store)
-  #:use-module (guix utils)
-  #:use-module (guix gexp)
   #:use-module (gnu artwork)
   #:use-module (gnu bootloader)
-  #:use-module (gnu system uuid)
-  #:use-module (gnu system file-systems)
-  #:use-module (gnu system keyboard)
-  #:use-module (gnu system locale)
   #:use-module (gnu packages bootloaders)
   #:autoload   (gnu packages gtk) (guile-cairo guile-rsvg)
   #:autoload   (gnu packages xorg) (xkeyboard-config)
+  #:use-module (gnu system boot)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system keyboard)
+  #:use-module (gnu system locale)
+  #:use-module (gnu system uuid)
+  #:use-module (guix deprecation)
+  #:use-module (guix diagnostics)
+  #:use-module (guix gexp)
+  #:use-module (guix i18n)
+  #:use-module (guix records)
+  #:use-module (guix utils)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-2)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-35)
   #:export (grub-theme
             grub-theme?
             grub-theme-image
@@ -53,54 +56,109 @@ (define-module (gnu bootloader grub)
             grub-theme-color-highlight
             grub-theme-gfxmode
 
-            install-grub-efi-removable
-            make-grub-efi-netboot-installer
-
+            grub.dir ; for (gnu build image) iso9660 images
             grub-bootloader
+            grub-minimal-bootloader
             grub-efi-bootloader
+            ;; deprecated
             grub-efi-removable-bootloader
             grub-efi32-bootloader
             grub-efi-netboot-bootloader
-            grub-efi-netboot-removable-bootloader
-            grub-mkrescue-bootloader
-            grub-minimal-bootloader
+            grub-efi-netboot-removable-bootloader))
 
-            grub-configuration))
-
-;;; Commentary:
+
 ;;;
-;;; Configuration of GNU GRUB.
+;;; General utils.
 ;;;
-;;; Code:
 
-(define* (normalize-file file mount-point store-directory-prefix)
-  "Strip MOUNT-POINT and prepend STORE-DIRECTORY-PREFIX, if any, to FILE, a
-G-expression or other lowerable object denoting a file name."
+;; in-gexp procedure to sanitize a value to be inserted into a GRUB script
+(define (sanitize str)
+  "Sanitize a value for use in a GRUB script."
+  #~(let* ((glycerin (lambda (l r) (if (pair? l) (append l r) (cons l r))))
+           (isopropyl (lambda (c) (case c ((#\\ #\$ #\") '(#\\ ,c)) (else c)))))
+      (use-modules (srfi srfi-1))
+      (list->string (fold-right glycerin '()
+                      (map isopropyl (string->list #$str))))))
 
-  (define (strip-mount-point mount-point file)
-    (if mount-point
-        (if (string=? mount-point "/")
-            file
-            #~(let ((file #$file))
-                (if (string-prefix? #$mount-point file)
-                    (substring #$file #$(string-length mount-point))
-                    file)))
-        file))
 
-  (define (prepend-store-directory-prefix store-directory-prefix file)
-    (if store-directory-prefix
-        #~(string-append #$store-directory-prefix #$file)
-        file))
 
-  (prepend-store-directory-prefix store-directory-prefix
-                                  (strip-mount-point mount-point file)))
+(define (grub-format type 32?)
+  (string-append
+    (cond ((string-prefix? "pc" type) "i386")
+          ((target-x86-32?) "i386")
+          ((target-x86-64?) (if 32? "i386" "x86_64"))
+          ((target-arm32?) "arm")
+          ((target-aarch64?) (if 32? "arm" "arm64"))
+          ((target-powerpc?) "powerpc")
+          ((target-riscv64?) "riscv64")
+          (else (raise (formatted-message (G_ "unrecognized target arch '~a'!")
+                         (or (%current-target-system) (%current-system))))))
+    "-" type))
 
 
 
+(define* (search/target type targets var #:optional (port #f))
+  "Returns a gexp of a GRUB search command for target TYPE, storing the result
+in VAR.  Optionally outputs to the gexp PORT instead of returning a string."
+  (define (form name val)
+    #~(format #$port "search.~a \"~a\" ~a~%" #$name #$val #$var))
+  (with-targets targets
+    ((type => (path :devpath) (device :device) (fs :fs)
+              (label :label) (uuid :uuid))
+     (cond ((member fs '("tftp" "nfs")) #~(format #$port "set ~a=tftp~%" #$var))
+           (uuid (form "fs_uuid" (uuid->string uuid)))
+           (label (form "fs_label" label))
+           (else (form "file" (sanitize path)))))))
+
+
+
+(define* (search/menu-entry device file var #:optional (port #f))
+  "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
+a gexp.  The result is a gexp that can be inserted in the grub.cfg-generation
+code to set the variable VAR.  This procedure is able to handle DEVICEs
+unmounted at evaltime."
+  (match device
+    ;; Preferably refer to DEVICE by its UUID or label.  This is more
+    ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
+    ((? uuid? idfk) ; calling idfk uuid here errors for some reason
+     #~(format #$port "search.fs_uuid ~a ~a~%" #$(uuid->string device) #$var))
+    ((? file-system-label? label)
+     #~(format #$port "search.fs_label \"~a\" ~a~%"
+               #$(sanitize (file-system-label->string label)) #$var))
+    ((? (lambda (device)
+          (and (string? device) (string-contains device ":/"))) nfs-uri)
+     ;; If the device is an NFS share, then we assume that the expected
+     ;; file on that device (e.g. the GRUB background image or the kernel)
+     ;; has to be loaded over the network.  Otherwise we would need an
+     ;; additional device information for some local disk to look for that
+     ;; file, which we do not have.
+     ;;
+     ;; TFTP is preferred to HTTP because it is used more widely and
+     ;; specified in standards more widely--especially BOOTP/DHCPv4
+     ;; defines a TFTP server for DHCP option 66, but not HTTP.
+     ;;
+     ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
+     ;; which can contain a HTTP or TFTP URL.
+     ;;
+     ;; Note: It is assumed that the file paths are of a similar
+     ;; setup on both the TFTP server and the NFS server (it is
+     ;; not possible to search for files on TFTP).
+     ;;
+     ;; TODO: Allow HTTP.
+     #~(format #$port "set ~a=tftp~%" #$var))
+    ((or #f (? string?))
+     #~(format #$port "search.file \"~a\" ~a~%" #$(sanitize file) #$var))))
+
+
+
+
+;;;
+;;; Theming.
+;;;
+
 (define-record-type* <grub-theme>
   ;; Default theme contributed by Felipe López.
-  grub-theme make-grub-theme
-  grub-theme?
+  grub-theme make-grub-theme grub-theme?
   (image           grub-theme-image
                    (default (file-append %artwork-repository
                                          "/grub/GuixSD-fully-black-4-3.svg")))
@@ -113,128 +171,274 @@ (define-record-type* <grub-theme>
   (gfxmode         grub-theme-gfxmode
                    (default '("auto"))))          ;list of string
 
+(define (grub-theme-png theme)
+  "Return the GRUB background image defined in THEME. If the suffix of the
+image file is \".svg\", then it is converted into a PNG file with the
+resolution provided in CONFIG.  Returns #f if no file is provided."
+  (match-record theme <grub-theme> (image resolution)
+    (match resolution
+      (((? number? width) . (? number? height))
+       (computed-file "grub-image.png"
+         (with-imported-modules '((gnu build svg) (guix build utils))
+           (with-extensions (list guile-rsvg guile-cairo)
+             #~(begin (use-modules (gnu build svg) (guix build utils))
+                      (if (png-file? #$image) (copy-file #$image #$output)
+                        (svg->png #$image #$output
+                                  #:width #$width
+                                  #:height #$height)))))))
+      (_ image))))
+
+
+
 
 ;;;
-;;; Background image & themes.
+;;; Core config.
+;;; GRUB architecture works by having a bootstage load up a core.img, which then
+;;; sets the root and prefix variables, allowing grub to load its main config
+;;; and modules, and then enter normal mode. On i386-pc systems a boot.img is
+;;; flashed which loads the core.img from the MBR gap, but on efi systems the
+;;; core.img is just a PE executable, able to be booted directly. We set up a
+;;; minimal core.img capable of finding the user-configured 'install target to
+;;; load its config from there.
 ;;;
 
-(define (bootloader-theme config)
-  "Return user defined theme in CONFIG if defined or a default theme
-otherwise."
-  (or (bootloader-configuration-theme config) (grub-theme)))
-
-(define* (image->png image #:key width height)
-  "Build a PNG of HEIGHT x WIDTH from IMAGE if its file suffix is \".svg\".
-Otherwise the picture in IMAGE is just copied."
-  (computed-file "grub-image.png"
-                 (with-imported-modules '((gnu build svg))
-                   (with-extensions (list guile-rsvg guile-cairo)
-                     #~(if (string-suffix? ".svg" #+image)
-                           (begin
-                             (use-modules (gnu build svg))
-                             (svg->png #+image #$output
-                                       #:width #$width
-                                       #:height #$height))
-                           (copy-file #+image #$output))))))
-
-(define* (grub-background-image config)
-  "Return the GRUB background image defined in CONFIG or #f if none was found.
-If the suffix of the image file is \".svg\", then it is converted into a PNG
-file with the resolution provided in CONFIG."
-  (let* ((theme (bootloader-theme config))
-         (image (grub-theme-image theme)))
-    (and image
-         (match (grub-theme-resolution theme)
-           (((? number? width) . (? number? height))
-            (image->png image #:width width #:height height))
-           (_ #f)))))
-
-(define (grub-locale-directory grub)
-  "Generate a directory with the locales from GRUB."
-  (define builder
-    #~(begin
-        (use-modules (ice-9 ftw))
-        (let ((locale (string-append #$grub "/share/locale"))
-              (out    #$output))
-          (mkdir out)
-          (chdir out)
-          (for-each (lambda (lang)
-                      (let ((file (string-append locale "/" lang
-                                                 "/LC_MESSAGES/grub.mo"))
-                            (dest (string-append lang ".mo")))
-                        (when (file-exists? file)
-                          (copy-file file dest))))
-                    (scandir locale)))))
-  (computed-file "grub-locales" builder))
-
-(define* (eye-candy config store-device store-mount-point
-                    #:key store-directory-prefix port)
-  "Return a gexp that writes to PORT (a port-valued gexp) the 'grub.cfg' part
-concerned with graphics mode, background images, colors, and all that.
-STORE-DEVICE designates the device holding the store, and STORE-MOUNT-POINT is
-its mount point; these are used to determine where the background image and
-fonts must be searched for.  STORE-DIRECTORY-PREFIX is a directory prefix to
-prepend to any store file name."
-  (define (setup-gfxterm config)
-    (if (memq 'gfxterm (bootloader-configuration-terminal-outputs config))
-        #~(format #f "
+(define (core.cfg targets store-crypto-devices)
+  "Returns a filelike object for a core configuration file good enough to
+decrypt STORE-CRYPTO-DEVICES and boot to normal."
+  (define (crypto-device->cryptomount dev)
+    (and (uuid? dev) ; ignore non-uuids - warning given by os
+         #~(format port "cryptomount -u ~a~%"
+                   ;; cryptomount only accepts UUID without the hyphen.
+                   #$(string-delete #\- (uuid->string dev)))))
+
+  (and=>
+    (with-targets targets
+      (('install => (path :devpath))
+       #~(call-with-output-file #$output
+           (lambda (port)
+             #$@(filter ->bool
+                  (map crypto-device->cryptomount store-crypto-devices))
+             #$(search/target 'install targets "root" #~port)
+             (format port "set \"prefix=($root)~a\"~%" #$(sanitize path))))))
+    (cut computed-file "core.cfg" <>)))
+
+
+
+;; TODO: do we need LVM support here?
+(define* (core.img grub format #:key bootloader-config store-crypto-devices
+                               #:allow-other-keys)
+  "The core image for GRUB, built for FORMAT."
+  (let* ((targets (bootloader-configuration-targets bootloader-config))
+         (bios? (string-prefix? format "pc"))
+         (efi? (string=? format "efi"))
+         (32? (bootloader-configuration-32bit? bootloader-config))
+         (cfg (core.cfg targets store-crypto-devices)))
+    (and cfg
+      (and=>
+        (with-targets targets
+          (('install => (fs :fs))
+           (let ((tftp? (or (string=? fs "tftp") (string=? fs "nfs"))))
+             (with-imported-modules '((guix build utils))
+               #~(begin
+                   (use-modules (guix build utils) (ice-9 textual-ports)
+                                (srfi srfi-1))
+                   (apply invoke #$(file-append grub "/bin/grub-mkimage")
+                     "--output" #$output
+                     "--config" #$cfg
+                     "--prefix" "none" ; we override this in cfg
+                     ;; bios pxe uses pxeboot instead of diskboot - diff format
+                     "--format" #$(string-append (grub-format format 32?)
+                                    (if (and bios? tftp?) "-pxe" ""))
+                     "--compression" "auto"
+                     ;; modules
+                     "minicmd"
+                     (append
+                       ;; disk drivers
+                       '#$(if bios? '("biosdisk") '())
+                       ;; partmaps (TODO: detect which to use?)
+                       '#$(if tftp? '() '("part_msdos" "part_gpt"))
+                       ;; file systems
+                       '#$(cond ((member fs '("ext2" "ext3" "ext4")) '("ext2"))
+                                ((member fs "vfat" "fat32") "fat")
+                                ((and tftp? efi?) "efinet")
+                                ((and tftp? bios?) "pxe")
+                                (else (list fs)))
+                       ;; store crypto devs
+                       '#$(if (any uuid? store-crypto-devices)
+                            '("luks" "luks2" "cryptomount") '())
+                       ;; search module that cfg uses
+                       (call-with-input-file #$cfg
+                         (lambda (port)
+                            (let* ((str (get-string-all port))
+                                   (use (lambda (s) (string-contains str s))))
+                              (cond ((use "search.fs_uuid") '("search_fs_uuid"))
+                                    ((use "search.fs_label") '("search_label"))
+                                    ((use "search.file") '("search_fs_file"))
+                                    (else '()))))))))))))
+        (cut computed-file "core.img" <>
+             #:options '(#:local-build? #t #:substitutable? #f))))))
+
+
+
+
+;;;
+;;; Main config.
+;;; This is what does the heavy lifting after core.img finds it.
+;;;
+
+(define (menu-entry->gexp store extra-initrd port)
+  (lambda (entry)
+    (match-record entry <menu-entry>
+      (label device linux linux-arguments initrd
+       multiboot-kernel multiboot-arguments multiboot-modules chain-loader)
+      (let ((norm (compose sanitize (cut normalize-file entry <>))))
+        #~(begin
+            (format #$port "menuentry ~s {~%  " #$label)
+            #$(search/menu-entry
+                device (or linux multiboot-kernel chain-loader) "boot" port)
+            #$@(cond
+                 (linux
+                   (list #~(format #$port "  linux \"($boot)~a\" ~a~%"
+                                   #$(norm linux)
+                                   ;; grub passes rest of the line _verbatim_
+                                   (string-join (list #$@linux-arguments)))
+                         #~(format #$port "  initrd ~a \"($boot)~a\"~%"
+                             (if #$extra-initrd (string-append "($boot)\""
+                                                  (norm #$extra-initrd) "\"")
+                                 "")
+                             #$(norm initrd))))
+                 ;; previously, this provided a (wrong) root= argument. just
+                 ;; don't bother anymore. better less info than wrong info
+                 (multiboot-kernel
+                   (cons #~(format #$port "  multiboot \"($boot)~a\" ~a~%"
+                                   #$(norm multiboot-kernel)
+                                   (string-join (list #$@multiboot-arguments)))
+                     (map (lambda (mod) #~(format port "  module \"($boot)~a\"~%"
+                                                  #$(norm mod)))
+                          multiboot-modules)))
+                 (chain-loader
+                   (list #~(format #$port "  chainloader \"~a\"~%"
+                                   #$(norm chain-loader)))))
+            (format #$port "}~%"))))))
+
+
+
+(define* (grub.cfg #:key bootloader-config
+                         current-boot-alternative
+                         old-boot-alternatives
+                         locale
+                         store-directory-prefix
+                   #:allow-other-keys)
+  "Returns a valid grub config given installer inputs. Expects locales, keymap,
+and theme image at LOCALES-TARG, KEYMAP-TARG, and IMAGE-TARG, respectively."
+  (match-record bootloader-config <bootloader-configuration>
+    ;; can't match keyboard-layout here cause it's bound to its struct
+    (targets menu-entries default-entry timeout extra-initrd
+     theme terminal-outputs terminal-inputs serial-unit serial-speed)
+    (let* ((entry->gexp (menu-entry->gexp store-directory-prefix
+                                          extra-initrd #~port))
+           (terms->str (compose string-join (cut map symbol->string <>)))
+           (colors->str (lambda (c) (format #f "~a/~a" (assoc-ref c 'fg)
+                                                       (assoc-ref c 'bg))))
+           (outputs (or terminal-outputs '(gfxterm))) ; set default outs
+           (inputs (or terminal-inputs '())) ; set default ins
+           (theme (or theme (grub-theme))))
+      (and=>
+        (with-targets targets
+          (('install => (install :devpath))
+           #~(call-with-output-file #$output
+               (lambda (port)
+                 ;; preamble
+                 (format port "\
+# This file was generated from your Guix configuration. Any changes
+# will be lost upon reconfiguration~%")
+                 #$@(filter ->bool
+                      (list
+                 ;; menu settings
+                        (and default-entry
+                          #~(format port "set default=~a~%" #$default-entry))
+                        (and timeout
+                          #~(format port "set timeout=~a~%" #$timeout))
+                 ;; gfxterm setup
+                        (and (memq 'gfxterm outputs)
+                          #~(format port "\
 if loadfont unicode; then
   set gfxmode=~a
   insmod all_video
   insmod gfxterm
-fi~%"
-                  #$(string-join
-                     (grub-theme-gfxmode (bootloader-theme config))
-                     ";"))
-        ""))
-
-  (define (theme-colors type)
-    (let* ((theme  (bootloader-theme config))
-           (colors (type theme)))
-      (string-append (symbol->string (assoc-ref colors 'fg)) "/"
-                     (symbol->string (assoc-ref colors 'bg)))))
-
-  (define image
-    (normalize-file (grub-background-image config)
-                    store-mount-point
-                    store-directory-prefix))
-
-  (and image
-       #~(format #$port "
-# Set 'root' to the partition that contains /gnu/store.
-~a
-
-~a
-~a
-
+fi~%"                         #$(string-join (grub-theme-gfxmode theme) ";")))
+                 ;; io
+                        (and (or serial-unit serial-speed)
+                          #~(format port "serial --unit=~a --speed=~a~%"
+                              ;; documented defaults are unit 0 at 9600 baud.
+                              #$(number->string (or serial-unit 0))
+                              #$(number->string (or serial-speed 9600))))
+                        (and (pair? outputs)
+                          #~(format port "terminal_output ~a~%"
+                                    #$(terms->str outputs)))
+                        (and (pair? inputs)
+                          #~(format port "terminal_input ~a~%"
+                                    #$(terms->str inputs)))
+                 ;; locale
+                        (and locale
+                          #~(format port "\
+set \"locale_dir=($root)~a/locales\"
+set lang=~a~%"                      #$(sanitize install)
+                                    #$(locale-definition-source
+                                        (locale-name->definition locale))))
+                 ;; keyboard layout
+                        (and (bootloader-configuration-keyboard-layout
+                               bootloader-config)
+                          #~(format port "\
+insmod keylayouts
+keymap \"($root)~a/keymap~%\""      #$(sanitize install)))
+                 ;; theme
+                        (match-record theme <grub-theme>
+                          (image color-normal color-highlight)
+                          (and image
+                            #~(format port "\
 insmod png
-if background_image ~a; then
+if background_image \"($root)~a/image.png\"; then
   set color_normal=~a
   set color_highlight=~a
 else
   set menu_color_normal=cyan/blue
-  set menu_color_highlight=white/blue
-fi~%"
-                 #$(grub-root-search store-device image)
-                 #$(setup-gfxterm config)
-                 #$(grub-setup-io config)
+  set menu_color_highlight=whiute/blue
+fi~%"                                 #$(sanitize install)
+                                      #$(colors->str color-normal)
+                                      #$(colors->str color-highlight))))))
+                 ;; menu entries
+                 #$(entry->gexp
+                     (boot-alternative->menu-entry current-boot-alternative))
+                 #$@(map entry->gexp menu-entries)
+                 #$@(if (pair? old-boot-alternatives)
+                      (append (list #~(format port "submenu ~s {~%"
+                                        "GNU system, old configurations..."))
+                              (map (compose entry->gexp
+                                            boot-alternative->menu-entry)
+                                   old-boot-alternatives)
+                              (list #~(format port "}~%"))) '())
+                 (format port "
+if [ \"${grub_platform}\" == efi ]; then
+  menuentry \"Firmware setup\" {
+    fwsetup
+  }
+fi~%")))))
+        (cut computed-file "grub.cfg" <>
+             ;; Since this file is rather unique, there's no point in trying to
+             ;; substitute it.
+             #:options '(#:local-build? #t #:substitutable? #f))))))
 
-                 #$image
-                 #$(theme-colors grub-theme-color-normal)
-                 #$(theme-colors grub-theme-color-highlight))))
 
-
-;;;
-;;; Configuration file.
-;;;
 
-(define* (keyboard-layout-file layout
-                               #:key
-                               (grub grub))
+(define (keyboard-layout-file layout grub)
   "Process the X keyboard layout description LAYOUT, a <keyboard-layout> record,
 and return a file in the format for GRUB keymaps.  LAYOUT must be present in
 the 'share/X11/xkb/symbols/' directory of 'xkeyboard-config'."
-  (define builder
+  (computed-file
+    (string-append "grub-keymap."
+      (string-map (match-lambda (#\, #\-) (chr chr))
+        (keyboard-layout-name layout)))
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils))
@@ -243,670 +447,175 @@ (define* (keyboard-layout-file layout
           ;; (from the 'console-setup' package).
           (invoke #+(file-append grub "/bin/grub-mklayout")
                   "-i" #+(keyboard-layout->console-keymap layout)
-                  "-o" #$output))))
-
-  (computed-file (string-append "grub-keymap."
-                                (string-map (match-lambda
-                                              (#\, #\-)
-                                              (chr chr))
-                                            (keyboard-layout-name layout)))
-                 builder))
-
-(define (grub-setup-io config)
-  "Return GRUB commands to configure the input / output interfaces.  The result
-is a string that can be inserted in grub.cfg."
-  (let* ((symbols->string (lambda (list)
-                           (string-join (map symbol->string list) " ")))
-         (outputs (bootloader-configuration-terminal-outputs config))
-         (inputs (bootloader-configuration-terminal-inputs config))
-         (unit (bootloader-configuration-serial-unit config))
-         (speed (bootloader-configuration-serial-speed config))
-
-         ;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT,
-         ;; as documented in GRUB manual section "Simple Configuration
-         ;; Handling".
-         (valid-outputs '(console serial serial_0 serial_1 serial_2 serial_3
-                          gfxterm vga_text mda_text morse spkmodem))
-         (valid-inputs '(console serial serial_0 serial_1 serial_2 serial_3
-                         at_keyboard usb_keyboard))
-
-         (io (string-append
-              ;; UNIT and SPEED are arguments to the same GRUB command
-              ;; ("serial"), so we process them together.
-              (if (or unit speed)
-                  (string-append
-                   "serial"
-                   (if unit
-                       ;; COM ports 1 through 4
-                       (if (and (exact-integer? unit) (<= unit 3) (>= unit 0))
-                           (string-append " --unit=" (number->string unit))
-                           #f)
-                       "")
-                   (if speed
-                       (if (exact-integer? speed)
-                           (string-append " --speed=" (number->string speed))
-                           #f)
-                       "")
-                   "\n")
-                  "")
-              (if (null? inputs)
-                  ""
-                  (string-append
-                   "terminal_input "
-                   (symbols->string
-                    (map
-                     (lambda (input)
-                       (if (memq input valid-inputs) input #f)) inputs))
-                   "\n"))
-              "terminal_output "
-              (symbols->string
-               (map
-                (lambda (output)
-                  (if (memq output valid-outputs) output #f)) outputs)))))
-    (format #f "~a" io)))
-
-(define (grub-root-search device file)
-  "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
-a gexp.  The result is a gexp that can be inserted in the grub.cfg-generation
-code."
-  ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but
-  ;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of
-  ;; custom menu entries.  In the latter case, don't emit a 'search' command.
-  (if (and (string? file) (not (string-prefix? "/" file)))
-      ""
-      (match device
-        ;; Preferably refer to DEVICE by its UUID or label.  This is more
-        ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
-        ((? uuid? uuid)
-         (format #f "search --fs-uuid --set ~a"
-                 (uuid->string device)))
-        ((? file-system-label? label)
-         (format #f "search --label --set ~a"
-                 (file-system-label->string label)))
-        ((? (lambda (device)
-              (and (string? device) (string-contains device ":/"))) nfs-uri)
-         ;; If the device is an NFS share, then we assume that the expected
-         ;; file on that device (e.g. the GRUB background image or the kernel)
-         ;; has to be loaded over the network.  Otherwise we would need an
-         ;; additional device information for some local disk to look for that
-         ;; file, which we do not have.
-         ;;
-         ;; We explicitly set "root=(tftp)" here even though if grub.cfg
-         ;; had been loaded via TFTP, Grub would have set "root=(tftp)"
-         ;; automatically anyway.  The reason is if you have a system that
-         ;; used to be on NFS but now is local, root would be set to local
-         ;; disk.  If you then selected an older system generation that is
-         ;; supposed to boot from network in the Grub boot menu, Grub still
-         ;; wouldn't load those files from network otherwise.
-         ;;
-         ;; TFTP is preferred to HTTP because it is used more widely and
-         ;; specified in standards more widely--especially BOOTP/DHCPv4
-         ;; defines a TFTP server for DHCP option 66, but not HTTP.
-         ;;
-         ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
-         ;; which can contain a HTTP or TFTP URL.
-         ;;
-         ;; Note: It is assumed that the file paths are of a similar
-         ;; setup on both the TFTP server and the NFS server (it is
-         ;; not possible to search for files on TFTP).
-         ;;
-         ;; TODO: Allow HTTP.
-         "set root=(tftp)")
-        ((or #f (? string?))
-         #~(format #f "search --file --set ~a" #$file)))))
-
-(define* (make-grub-configuration grub config entries
-                                  #:key
-                                  (locale #f)
-                                  (system (%current-system))
-                                  (old-entries '())
-                                  (store-crypto-devices '())
-                                  store-directory-prefix)
-  "Return the GRUB configuration file corresponding to CONFIG, a
-<bootloader-configuration> object, and where the store is available at
-STORE-FS, a <file-system> object.  OLD-ENTRIES is taken to be a list of menu
-entries corresponding to old generations of the system.
-STORE-CRYPTO-DEVICES contain the UUIDs of the encrypted units that must
-be unlocked to access the store contents.
-STORE-DIRECTORY-PREFIX may be used to specify a store prefix, as is required
-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 ((label (menu-entry-label entry))
-          (linux (menu-entry-linux entry))
-          (device (menu-entry-device entry))
-          (device-mount-point (menu-entry-device-mount-point entry))
-          (multiboot-kernel (menu-entry-multiboot-kernel entry))
-          (chain-loader (menu-entry-chain-loader entry)))
-      (cond
-       (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))
-              (extra-initrd (bootloader-configuration-extra-initrd config)))
-          ;; 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 STORE-DIRECTORY-PREFIX 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 ~a
-}~%"
-                    #$label
-                    #$(grub-root-search device linux)
-                    #$linux (string-join (list #$@arguments))
-                    (or #$extra-initrd "")
-                    #$initrd)))
-       (multiboot-kernel
-        (let* ((kernel (menu-entry-multiboot-kernel entry))
-               (arguments (menu-entry-multiboot-arguments entry))
-               ;; Choose between device names as understood by Mach's built-in
-               ;; IDE driver ("hdX") and those understood by rumpdisk ("wdX"
-               ;; in the "noide" case).
-               (disk (if (member "noide" arguments) "w" "h"))
-               (modules (menu-entry-multiboot-modules entry))
-               (root-index 1))          ; XXX EFI will need root-index 2
-          #~(format port "
-menuentry ~s {
-  multiboot ~a root=part:~a:device:~ad0~a~a
-}~%"
-                    #$label
-                    #$kernel
-                    #$root-index
-                    #$disk
-                    (string-join (list #$@arguments) " " 'prefix)
-                    (string-join (map string-join '#$modules)
-                                 "\n  module " 'prefix))))
-       (chain-loader
-        #~(format port "
-menuentry ~s {
-  ~a
-  chainloader ~a
-}~%"
-                  #$label
-                  #$(grub-root-search device chain-loader)
-                  #$chain-loader)))))
-
-  (define (crypto-devices)
-    (define (crypto-device->cryptomount dev)
-      (if (uuid? dev)
-          #~(format port "cryptomount -u ~a~%"
-                    ;; cryptomount only accepts UUID without the hypen.
-                    #$(string-delete #\- (uuid->string dev)))
-          ;; Other type of devices aren't implemented.
-          #~()))
-    (let ((devices (map crypto-device->cryptomount store-crypto-devices))
-          (modules #~(format port "insmod luks~%insmod luks2~%")))
-      (if (null? devices)
-          devices
-          (cons modules devices))))
-
-  (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
-                 #:port #~port)))
-
-  (define locale-config
-    (let* ((entry (first all-entries))
-           (device (menu-entry-device entry))
-           (mount-point (menu-entry-device-mount-point entry)))
-      #~(let ((locale #$(and locale
-                             (locale-definition-source
-                              (locale-name->definition locale))))
-              (locales #$(and locale
-                              (normalize-file (grub-locale-directory grub)
-                                              mount-point
-                                              store-directory-prefix))))
-          (when locale
-            (format port "\
-# Localization configuration.
-~asearch --file --set ~a/en@quot.mo
-set locale_dir=~a
-set lang=~a~%"
-                    ;; Skip the search if there is an image, as it has already
-                    ;; been performed by eye-candy and traversing the store is
-                    ;; an expensive operation.
-                    #$(if (grub-theme-image (bootloader-theme config))
-                          "# "
-                          "")
-                    locales
-                    locales
-                    locale)))))
-
-  (define keyboard-layout-config
-    (let* ((layout (bootloader-configuration-keyboard-layout config))
-           (keymap* (and layout
-                         (keyboard-layout-file layout #:grub grub)))
-           (entry (first all-entries))
-           (device (menu-entry-device entry))
-           (mount-point (menu-entry-device-mount-point entry))
-           (keymap (and keymap*
-                        (normalize-file keymap* mount-point
-                                        store-directory-prefix))))
-      #~(when #$keymap
-          (format port "\
-insmod keylayouts
-keymap ~a~%" #$keymap))))
-
-  (define builder
-    #~(call-with-output-file #$output
-        (lambda (port)
-          (format port
-                  "# This file was generated from your Guix configuration.  Any changes
-# will be lost upon reconfiguration.
-")
-          #$@(crypto-devices)
-          #$(sugar)
-          #$locale-config
-          #$keyboard-layout-config
-          (format port "
-set default=~a
-set timeout=~a~%"
-                  #$(bootloader-configuration-default-entry config)
-                  #$(bootloader-configuration-timeout config))
-          #$@(map menu-entry->gexp all-entries)
-
-          #$@(if (pair? old-entries)
-                 #~((format port "
-submenu \"GNU system, old configurations...\" {~%")
-                    #$@(map menu-entry->gexp old-entries)
-                    (format port "}~%"))
-                 #~())
-          (format port "
-if [ \"${grub_platform}\" == efi ]; then
-  menuentry \"Firmware setup\" {
-    fwsetup
-  }
-fi~%"))))
+                  "-o" #$output)))))
+
+
+
+(define* (grub.dir grub #:key bootloader-config locale
+                        #:allow-other-keys . args)
+  "Everything what should go in GRUB's prefix, including fonts, modules,
+locales, keymap, theme image, and grub.cfg."
+  (match-record bootloader-config <bootloader-configuration>
+    ;; can't match for keyboard-layout: identifier bound in this scope
+    (targets theme)
+    (let* ((theme (or theme (grub-theme)))
+           (keyboard-layout (bootloader-configuration-keyboard-layout
+                              bootloader-config))
+           (lang (and=> locale (compose locale-definition-source
+                                        locale-name->definition)))
+           (lc-mesg (and=> lang (cut file-append grub "/share/locale" <>
+                                                 "/LC_MESSAGES/grub.mo"))))
+      (computed-file "grub.dir"
+        (with-imported-modules '((guix build utils))
+          #~(begin (use-modules (guix build utils))
+              (mkdir-p #$output)
+              (chdir #$output)
+              ;; grub files
+              (copy-recursively #$(file-append grub "/lib/grub/") #$output
+                                #:copy-file symlink)
+              (mkdir "fonts")
+              (symlink #$(file-append grub "/share/grub/unicode.pf2")
+                       "fonts/unicode.pf2")
+              ;; config file
+              (symlink #$(apply grub.cfg args) "grub.cfg")
+              ;; locales
+              (when (and=> #$lc-mesg file-exists?)
+                (mkdir "locales")
+                (symlink #$lc-mesg (string-append "locales/" #$lang ".mo")))
+              ;; keymap
+              #$@(filter ->bool
+                   (list
+                     (and keyboard-layout
+                       #~(symlink #$(keyboard-layout-file keyboard-layout grub)
+                                  "keymap"))
+              ;; image
+                     (and (grub-theme-image theme)
+                       #~(copy-file #$(grub-theme-png theme) "image.png"))))))
+        #:options '(#:local-build? #t #:substitutable? #f)))))
 
-  ;; Since this file is rather unique, there's no point in trying to
-  ;; substitute it.
-  (computed-file "grub.cfg" builder
-                 #:options '(#:local-build? #t
-                             #:substitutable? #f)))
 
-(define (grub-configuration-file config . args)
-  (let* ((bootloader (bootloader-configuration-bootloader config))
-         (grub (bootloader-package bootloader)))
-    (apply make-grub-configuration grub config args)))
-
-(define (grub-efi-configuration-file . args)
-  (apply make-grub-configuration grub-efi args))
-
-(define grub-cfg "/boot/grub/grub.cfg")
 
 
-
 ;;;
-;;; Install procedures.
+;;; Installers.
 ;;;
 
-(define install-grub
-  #~(lambda (bootloader device mount-point)
-      (let ((grub (string-append bootloader "/sbin/grub-install"))
-            (install-dir (string-append mount-point "/boot")))
-        ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT. If DEVICE
-        ;; is #f, then we populate the disk-image rooted at MOUNT-POINT.
-        (if device
-            (begin
-              ;; Tell 'grub-install' that there might be a LUKS-encrypted
-              ;; /boot or root partition.
-              (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-
-              ;; Hide potentially confusing messages from the user, such as
-              ;; "Installing for i386-pc platform."
-              (invoke/quiet grub "--no-floppy" "--target=i386-pc"
-                            "--boot-directory" install-dir
-                            device))
-            ;; When creating a disk-image, only install a font and GRUB modules.
-            (let* ((fonts (string-append install-dir "/grub/fonts")))
-              (mkdir-p fonts)
-              (copy-file (string-append bootloader "/share/grub/unicode.pf2")
-                         (string-append fonts "/unicode.pf2"))
-              (copy-recursively (string-append bootloader "/lib/")
-                                install-dir))))))
-
-(define install-grub-disk-image
-  #~(lambda (bootloader root-index image)
-      ;; Install GRUB on the given IMAGE. The root partition index is
-      ;; ROOT-INDEX.
-      (let ((grub-mkimage
-             (string-append bootloader "/bin/grub-mkimage"))
-            (modules '("biosdisk" "part_msdos" "fat" "ext2"))
-            (grub-bios-setup
-             (string-append bootloader "/sbin/grub-bios-setup"))
-            (root-device (format #f "hd0,msdos~a" root-index))
-            (boot-img (string-append bootloader "/lib/grub/i386-pc/boot.img"))
-            (device-map "device.map"))
-
-        ;; Create a minimal, standalone GRUB image that will be written
-        ;; directly in the MBR-GAP (space between the end of the MBR and the
-        ;; first partition).
-        (apply invoke grub-mkimage
-               "-O" "i386-pc"
-               "-o" "core.img"
-               "-p" (format #f "(~a)/boot/grub" root-device)
-               modules)
-
-        ;; Create a device mapping file.
-        (call-with-output-file device-map
-          (lambda (port)
-            (format port "(hd0) ~a~%" image)))
-
-        ;; Copy the default boot.img, that will be written on the MBR sector
-        ;; by GRUB-BIOS-SETUP.
-        (copy-file boot-img "boot.img")
-
-        ;; Install both the "boot.img" and the "core.img" files on the given
-        ;; IMAGE. On boot, the MBR sector will execute the minimal GRUB
-        ;; written in the MBR-GAP. GRUB configuration and missing modules will
-        ;; be read from ROOT-DEVICE.
-        (invoke grub-bios-setup
-                "-m" device-map
-                "-r" root-device
-                "-d" "."
-                image))))
-
-(define install-grub-efi
-  #~(lambda (bootloader efi-dir mount-point)
-      ;; There is nothing useful to do when called in the context of a disk
-      ;; image generation.
-      (when efi-dir
-        ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
-        ;; system whose root is mounted at MOUNT-POINT.
-        (let ((grub-install (string-append bootloader "/sbin/grub-install"))
-              (install-dir (string-append mount-point "/boot"))
-              ;; When installing Guix, it's common to mount EFI-DIR below
-              ;; MOUNT-POINT rather than /boot/efi on the live image.
-              (target-esp (if (file-exists? (string-append mount-point efi-dir))
-                              (string-append mount-point efi-dir)
-                              efi-dir)))
-          ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
-          ;; root partition.
-          (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-          (invoke/quiet grub-install "--boot-directory" install-dir
-                        "--bootloader-id=Guix"
-                        "--efi-directory" target-esp)))))
-
-(define install-grub-efi-removable
-  #~(lambda (bootloader efi-dir mount-point)
-      ;; NOTE: mount-point is /mnt in guix system init /etc/config.scm /mnt/point
-      ;; NOTE: efi-dir comes from target list of booloader configuration
-      ;; There is nothing useful to do when called in the context of a disk
-      ;; image generation.
-      (when efi-dir
-        ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
-        ;; system whose root is mounted at MOUNT-POINT.
-        (let ((grub-install (string-append bootloader "/sbin/grub-install"))
-              (install-dir (string-append mount-point "/boot"))
-              ;; When installing Guix, it's common to mount EFI-DIR below
-              ;; MOUNT-POINT rather than /boot/efi on the live image.
-              (target-esp (if (file-exists? (string-append mount-point efi-dir))
-                              (string-append mount-point efi-dir)
-                              efi-dir)))
-          ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
-          ;; root partition.
-          (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-          (invoke/quiet grub-install "--boot-directory" install-dir
-                        "--removable"
-                        ;; "--no-nvram"
-                        "--bootloader-id=Guix"
-                        "--efi-directory" target-esp)))))
-
-(define install-grub-efi32
-  #~(lambda (bootloader efi-dir mount-point)
-      ;; There is nothing useful to do when called in the context of a disk
-      ;; image generation.
-      (when efi-dir
-        ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
-        ;; system whose root is mounted at MOUNT-POINT.
-        (let ((grub-install (string-append bootloader "/sbin/grub-install"))
-              (install-dir (string-append mount-point "/boot"))
-              ;; When installing Guix, it's common to mount EFI-DIR below
-              ;; MOUNT-POINT rather than /boot/efi on the live image.
-              (target-esp (if (file-exists? (string-append mount-point efi-dir))
-                              (string-append mount-point efi-dir)
-                              efi-dir)))
-          ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
-          ;; root partition.
-          (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-          (invoke/quiet grub-install "--boot-directory" install-dir
-                        "--bootloader-id=Guix"
-			(cond ((target-x86?) "--target=i386-efi")
-                              ((target-arm?) "--target=arm-efi"))
-                        "--efi-directory" target-esp)))))
-
-(define* (make-grub-efi-netboot-installer grub-efi grub-cfg subdir)
-  "Make a bootloader-installer for a grub-efi-netboot bootloader, which expects
-its files in SUBDIR and its configuration file in GRUB-CFG.
-
-As a grub-efi-netboot package is already pre-installed by 'grub-mknetdir', the
-installer basically copies all files from the bootloader-package (or profile)
-into the bootloader-target directory.
-
-Additionally for network booting over TFTP, two relative symlinks to the store
-and to the GRUB-CFG file are necessary.  Due to this a TFTP root directory must
-not be located on a FAT file-system.
-
-If the bootloader-target does not support symlinks, then it is assumed to be a
-kind of EFI System Partition (ESP).  In this case an intermediate configuration
-file is created with the help of GRUB-EFI to load the GRUB-CFG.
-
-The installer is usable for any efi-bootloader-chain, which prepares the
-bootloader-profile in a way ready for copying.
-
-The installer does not manipulate the system's 'UEFI Boot Manager'.
-
-The returned installer accepts the BOOTLOADER, TARGET and MOUNT-POINT
-arguments.  Its job is to copy the BOOTLOADER, which must be a pre-installed
-grub-efi-netboot package with a SUBDIR like efi/boot or efi/Guix, below the
-directory TARGET for the system whose root is mounted at MOUNT-POINT.
-
-MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point'
-or '/' for other 'guix system' commands.
-
-Where TARGET comes from the targets argument given to the
-bootloader-configuration in:
-
-(operating-system
- (bootloader (bootloader-configuration
-              (targets '(\"/boot/efi\"))
-              …))
- …)
-
-TARGET is required to be an absolute directory name, usually mounted via NFS,
-and finally needs to be provided by a TFTP server as
-the TFTP root directory.
-
-Usually the installer will be used to prepare network booting over TFTP.  Then
-GRUB will load tftp://server/SUBDIR/grub.cfg and this file will instruct it to
-load more files from the store like tftp://server/gnu/store/…-linux…/Image.
-
-To make this possible two symlinks are created.  The first symlink points
-relatively form MOUNT-POINT/TARGET/SUBDIR/grub.cfg to
-MOUNT-POINT/boot/grub/grub.cfg, and the second symlink points relatively from
-MOUNT-POINT/TARGET/%store-prefix to MOUNT-POINT/%store-prefix.
-
-It is important to note that these symlinks need to be relative, as the absolute
-paths on the TFTP server side are unknown.
-
-It is also important to note that both symlinks will point outside the TFTP root
-directory and that the TARGET/%store-prefix symlink makes the whole store
-accessible via TFTP.  Possibly the TFTP server must be configured to allow
-accesses outside its TFTP root directory.  This all may need to be considered
-for security aspects.  It is advised to disable any TFTP write access!
-
-The installer can also be used to prepare booting from local storage, if the
-underlying file-system, like FAT on an EFI System Partition (ESP), does not
-support symlinks.  In this case the MOUNT-POINT/TARGET/SUBDIR/grub.cfg will be
-created with the help of GRUB-EFI to load the /boot/grub/grub.cfg file.  A
-symlink to the store is not needed in this case."
-  (with-imported-modules '((guix build union))
-    #~(lambda (bootloader target mount-point)
-        ;; In context of a disk image creation TARGET will be #f and an
-        ;; installer is expected to do necessary installations on MOUNT-POINT,
-        ;; which will become the root file system.  If TARGET is #f, this
-        ;; installer has nothing to do, as it only cares about the EFI System
-        ;; Partition (ESP).
-        (when target
-          (use-modules ((guix build union) #:select (symlink-relative))
-                       (ice-9 popen)
-                       (ice-9 rdelim))
-          (let* ((mount-point/target (string-append mount-point target "/"))
-                 ;; When installing Guix, it is common to mount TARGET below
-                 ;; MOUNT-POINT rather than the root directory.
-                 (bootloader-target (if (file-exists? mount-point/target)
-                                        mount-point/target
-                                        target))
-                 (store (string-append mount-point (%store-prefix)))
-                 (store-link (string-append bootloader-target (%store-prefix)))
-                 (grub-cfg (string-append mount-point #$grub-cfg))
-                 (grub-cfg-link (string-append bootloader-target
-                                               #$subdir "/"
-                                               (basename grub-cfg))))
-            ;; Copy the bootloader into the bootloader-target directory.
-            ;; Should we beforehand recursively delete any existing file?
-            (copy-recursively bootloader bootloader-target
-                              #:follow-symlinks? #t
-                              #:log (%make-void-port "w"))
-            ;; For TFTP we need to install additional relative symlinks.
-            ;; If we install on an EFI System Partition (ESP) or some other FAT
-            ;; file-system, then symlinks cannot be created and are not needed.
-            ;; Therefore we ignore exceptions when trying.
-            ;; Prepare the symlink to the grub.cfg.
-            (mkdir-p (dirname grub-cfg-link))
-            (false-if-exception (delete-file grub-cfg-link))
-            (if (unspecified?
-                 (false-if-exception (symlink-relative grub-cfg grub-cfg-link)))
-                ;; Symlinks are supported.
-                (begin
-                  ;; Prepare the symlink to the store.
-                  (mkdir-p (dirname store-link))
-                  (false-if-exception (delete-file store-link))
-                  (symlink-relative store store-link))
-                ;; Creating symlinks does not seem to be supported.  Probably
-                ;; an ESP is used.  Add a script to search and load the actual
-                ;; grub.cfg.
-                (let* ((probe #$(file-append grub-efi "/sbin/grub-probe"))
-                       (port (open-pipe* OPEN_READ probe "--target=fs_uuid"
-                                         grub-cfg))
-                       (search-root
-                        (match (read-line port)
-                          ((? eof-object?)
-                           ;; There is no UUID available. As a fallback search
-                           ;; everywhere for the grub.cfg.
-                           (string-append "search --file --set " #$grub-cfg))
-                          (fs-uuid
-                           ;; The UUID to load the grub.cfg from is known.
-                           (string-append "search --fs-uuid --set " fs-uuid))))
-                       (load-grub-cfg (string-append "configfile " #$grub-cfg)))
-                  (close-pipe port)
-                  (with-output-to-file grub-cfg-link
-                    (lambda ()
-                      (display (string-join (list search-root
-                                                  load-grub-cfg)
-                                            "\n")))))))))))
+(define* (install-grub.dir grub #:key bootloader-config
+                                #:allow-other-keys . args)
+  (with-targets (bootloader-configuration-targets bootloader-config)
+    (('install => (path :path))
+     #~(copy-recursively #$(apply grub.dir grub args) #$path
+                         #:log (%make-void-port "w")
+                         #:follow-symlinks? #t
+                         #:copy-file atomic-copy))))
+
+(define (install-grub-bios grub)
+  "Returns an installer for the bios-bootable grub package GRUB."
+  (lambda* (#:key bootloader-config #:allow-other-keys . args)
+    (gbegin (apply install-grub.dir grub args)
+      (with-targets (bootloader-configuration-targets bootloader-config)
+        (('disk => (device :device))
+         #~(invoke #$(file-append grub "/sbin/grub-bios-setup") "-v" "-v"
+                         "--directory" "/" ; can't be blank
+                         "--device-map" "" ; no dev map - need to specify
+                         "--boot-image"
+                         #$(file-append grub "/lib/grub/i386-pc/boot.img")
+                         "--core-image" #$(apply core.img grub "pc" args)
+                         "--root-device" #$(string-append "hostdisk/" device)
+                         #$device))))))
+
+(define* (install-grub-efi #:key bootloader-config #:allow-other-keys . args)
+  "Installs grub into the system's uefi bootloader, taking into account
+user-specified requirements for a 32-bit or fallback bootloader."
+  (let* ((32? (bootloader-configuration-32bit? bootloader-config))
+         (grub (if 32? grub-efi32 grub-efi))
+         (core (apply core.img grub "efi" args))
+         (copy #~(lambda (dest) (copy-file #$core dest))))
+    (gbegin (apply install-grub.dir grub args)
+      (install-efi bootloader-config #~`((,#$copy "grub.efi" . "GNU GRUB"))))))
+
 
-
 
+
 ;;;
-;;; Bootloader definitions.
+;;; Bootloaders.
 ;;;
-;;; For all these grub-bootloader variables the path to /boot/grub/grub.cfg
-;;; is fixed.  Inheriting and overwriting the field 'configuration-file' will
-;;; break 'guix system delete-generations', 'guix system switch-generation',
-;;; and 'guix system roll-back'.
+
+(define %grub-default-targets
+  (list (bootloader-target
+          (type 'install)
+          (offset 'root)
+          (path "boot"))))
 
 (define grub-bootloader
   (bootloader
-   (name 'grub)
-   (package grub)
-   (installer install-grub)
-   (disk-image-installer install-grub-disk-image)
-   (configuration-file grub-cfg)
-   (configuration-file-generator grub-configuration-file)))
+    (name 'grub)
+    (default-targets %grub-default-targets)
+    (installer (install-grub-bios grub))))
 
 (define grub-minimal-bootloader
   (bootloader
-   (inherit grub-bootloader)
-   (package grub-minimal)))
+    (name 'grub)
+    (default-targets %grub-default-targets)
+    (installer (install-grub-bios grub-minimal))))
 
 (define grub-efi-bootloader
   (bootloader
-   (name 'grub-efi)
-   (package grub-efi)
-   (installer install-grub-efi)
-   (disk-image-installer #f)
-   (configuration-file grub-cfg)
-   (configuration-file-generator grub-configuration-file)))
-
-(define grub-efi-removable-bootloader
-  (bootloader
-   (inherit grub-efi-bootloader)
-   (name 'grub-efi-removable-bootloader)
-   (installer install-grub-efi-removable)))
+    (name 'grub-efi)
+    (default-targets (cons (bootloader-target
+                             (type 'vendir)
+                             (offset 'esp)
+                             (path "EFI/Guix"))
+                       %grub-default-targets))
+    (installer install-grub-efi)))
 
-(define grub-efi32-bootloader
-  (bootloader
-   (inherit grub-efi-bootloader)
-   (installer install-grub-efi32)
-   (name 'grub-efi32)
-   (package grub-efi32)))
 
-(define (make-grub-efi-netboot-bootloader name subdir)
-  (bootloader
-   (name name)
-   (package (make-grub-efi-netboot (symbol->string name) subdir))
-   (installer (make-grub-efi-netboot-installer grub-efi grub-cfg subdir))
-   (disk-image-installer #f)
-   (configuration-file grub-cfg)
-   (configuration-file-generator grub-efi-configuration-file)))
-
-(define grub-efi-netboot-bootloader
-  (make-grub-efi-netboot-bootloader 'grub-efi-netboot-bootloader
-                                    "efi/Guix"))
-
-(define grub-efi-netboot-removable-bootloader
-  (make-grub-efi-netboot-bootloader 'grub-efi-netboot-removable-bootloader
-                                    "efi/boot"))
-
-(define grub-mkrescue-bootloader
-  (bootloader
-   (inherit grub-efi-bootloader)
-   (package grub-hybrid)))
 
 
 ;;;
-;;; Compatibility macros.
+;;; deprecated shit!
+;;; use the bootloader-config flags instead! or, in the case of netboot, set
+;;; your 'install (or parent thereof) target fs to be "tftp" or "nfs"
 ;;;
 
-(define-syntax grub-configuration
-  (syntax-rules (grub)
-                ((_ (grub package) fields ...)
-                 (if (eq? package grub)
-                     (bootloader-configuration
-                      (bootloader grub-bootloader)
-                      fields ...)
-                   (bootloader-configuration
-                    (bootloader grub-efi-bootloader)
-                    fields ...)))
-                ((_ fields ...)
-                 (bootloader-configuration
-                  (bootloader grub-bootloader)
-                  fields ...))))
-
-;;; grub.scm ends here
+(define (deprecated-installer installer removable? 32?)
+  (lambda args (apply installer
+                 (substitute-keyword-arguments args
+                   ((#:bootloader-config conf) (bootloader-configuration
+                                                 (inherit conf)
+                                                 (efi-removable? removable?)
+                                                 (32bit? 32?)))))))
+
+(define-deprecated grub-efi-removable-bootloader grub-efi-bootloader
+  (bootloader
+    (inherit grub-efi-bootloader)
+    (installer (deprecated-installer install-grub-efi #t #f))))
+
+(define-deprecated grub-efi32-bootloader grub-efi-bootloader
+  (bootloader
+    (inherit grub-efi-bootloader)
+    (installer (deprecated-installer install-grub-efi #f #t))))
+
+(define %netboot-targets
+  (list (bootloader-target
+          (type 'install)
+          (offset 'root)
+          (path "boot")
+          (file-system "tftp"))
+        (bootloader-target
+          (type 'vendir)
+          (offset 'esp)
+          (path "EFI/Guix"))))
+
+(define-deprecated grub-efi-netboot-bootloader
+                   grub-efi-bootloader
+  (bootloader
+    (inherit grub-efi-bootloader)
+    (default-targets %netboot-targets)))
+
+(define-deprecated grub-efi-netboot-removable-bootloader
+                   grub-efi-bootloader
+  (bootloader
+    (inherit grub-efi-bootloader)
+    (default-targets %netboot-targets)
+    (installer (deprecated-installer install-grub-efi #t #f))))
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index c5437a7b63..7d3e202f8c 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2023 Herman Rimm <herman_rimm@protonmail.com>
 ;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,12 +25,11 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu bootloader u-boot)
-  #:use-module (gnu bootloader extlinux)
   #:use-module (gnu bootloader)
+  #:use-module (gnu bootloader extlinux)
   #:use-module (gnu packages bootloaders)
   #:use-module (guix gexp)
-  #:export (u-boot-bootloader
-            u-boot-a20-olinuxino-lime-bootloader
+  #:export (u-boot-a20-olinuxino-lime-bootloader
             u-boot-a20-olinuxino-lime2-bootloader
             u-boot-a20-olinuxino-micro-bootloader
             u-boot-bananapi-m2-ultra-bootloader
@@ -53,301 +53,172 @@ (define-module (gnu bootloader u-boot)
             u-boot-ts7970-q-2g-1000mhz-c-bootloader
             u-boot-wandboard-bootloader))
 
-(define install-u-boot
-  #~(lambda (bootloader root-index image)
-      (if bootloader
-        (error "Failed to install U-Boot"))))
+(define (make-install-u-boot firmware installers)
+  (lambda* (#:key bootloader-config #:allow-other-keys . args)
+    (with-targets (bootloader-configuration-targets bootloader-config)
+      ('extlinux (apply install-extlinux-config args))
+      (('install => (path :path)) #~(let ((path #$path) #$firmware)))
+      (('disk => (disk :device)) #~(let ((disk #$disk)) #f #$@installers)))))
+
+(define-syntax-rule (define-u-bootloader def-name package firmware
+                                                  (file size doffset) ...)
+  "Defines a u-boot installer DEF-NAME, using u-boot PACKAGE. Installs each
+given FILE of SIZE (or #f to autodetect) to the targetted disk at OFFSET.
+FIRMWARE is ran on the u-boot firmware directory for installation of supporting
+files, with the variable path set to the dir path."
+  (define def-name
+    (bootloader
+      (name 'u-boot)
+      (default-targets (list (bootloader-target
+                               (type 'install)
+                               (offset 'root)
+                               (path "boot"))
+                             (bootloader-target
+                               (type 'extlinux)
+                               (offset 'install)
+                               (path "extlinux"))))
+      (installer (make-install-u-boot firmware
+                   (list #~(let ((fw #$(file-append package "/libexec/" file)))
+                             (write-file-on-device fw
+                               #$(or size #~(stat:size (stat fw)))
+                               disk #$doffset)) ...))))))
+
+
+;;;
+;;; Bootloader definitions.
+;;;
 
-(define install-beaglebone-black-u-boot
+(define-u-bootloader u-boot-beaglebone-black-bootloader
+  u-boot-am335x-boneblack #f
   ;; http://wiki.beyondlogic.org/index.php?title=BeagleBoneBlack_Upgrading_uBoot
   ;; This first stage bootloader called MLO (U-Boot SPL) is expected at
   ;; 0x20000 by BBB ROM code. The second stage bootloader will be loaded by
   ;; the MLO and is expected at 0x60000.  Write both first stage ("MLO") and
-  ;; second stage ("u-boot.img") images, read in BOOTLOADER directory, to the
-  ;; specified DEVICE.
-  #~(lambda (bootloader root-index image)
-      (let ((mlo (string-append bootloader "/libexec/MLO"))
-            (u-boot (string-append bootloader "/libexec/u-boot.img")))
-        (write-file-on-device mlo (* 256 512)
-                              image (* 256 512))
-        (write-file-on-device u-boot (* 1024 512)
-                              image (* 768 512)))))
-
-(define install-allwinner-u-boot
-  #~(lambda (bootloader root-index image)
-      (let ((u-boot (string-append bootloader
-                                   "/libexec/u-boot-sunxi-with-spl.bin")))
-        (write-file-on-device u-boot (stat:size (stat u-boot))
-                              image (* 8 1024)))))
-
-(define install-allwinner64-u-boot
-  #~(lambda (bootloader root-index image)
-      (let ((spl (string-append bootloader "/libexec/u-boot-sunxi-with-spl.bin"))
-            (u-boot (string-append bootloader "/libexec/u-boot-sunxi-with-spl.fit.itb")))
-        (write-file-on-device spl (stat:size (stat spl))
-                              image (* 8 1024))
-        (write-file-on-device u-boot (stat:size (stat u-boot))
-                              image (* 40 1024)))))
-
-(define install-imx-u-boot
-  #~(lambda (bootloader root-index image)
-      (let ((spl (string-append bootloader "/libexec/SPL"))
-            (u-boot (string-append bootloader "/libexec/u-boot.img")))
-        (write-file-on-device spl (stat:size (stat spl))
-                              image (* 1 1024))
-        (write-file-on-device u-boot (stat:size (stat u-boot))
-                              image (* 69 1024)))))
-
-(define install-orangepi-r1-plus-lts-rk3328-u-boot
-  #~(lambda (bootloader root-index image)
-      (let ((idb (string-append bootloader "/libexec/idbloader.img"))
-            (u-boot (string-append bootloader "/libexec/u-boot.itb")))
-        (write-file-on-device idb (stat:size (stat idb))
-                              image (* 64 512))
-        (write-file-on-device u-boot (stat:size (stat u-boot))
-                              image (* 16384 512)))))
-
-(define install-puma-rk3399-u-boot
-  #~(lambda (bootloader root-index image)
-      (let ((spl (string-append bootloader "/libexec/idbloader.img"))
-            (u-boot (string-append bootloader "/libexec/u-boot.itb")))
-        (write-file-on-device spl (stat:size (stat spl))
-                              image (* 64 512))
-        (write-file-on-device u-boot (stat:size (stat u-boot))
-                              image (* 512 512)))))
-
-(define install-firefly-rk3399-u-boot
-  #~(lambda (bootloader root-index image)
-      (let ((idb (string-append bootloader "/libexec/idbloader.img"))
-            (u-boot (string-append bootloader "/libexec/u-boot.itb")))
-        (write-file-on-device idb (stat:size (stat idb))
-                              image (* 64 512))
-        (write-file-on-device u-boot (stat:size (stat u-boot))
-                              image (* 16384 512)))))
-
-(define install-rock64-rk3328-u-boot
-  #~(lambda (bootloader root-index image)
-      (let ((idb (string-append bootloader "/libexec/idbloader.img"))
-            (u-boot (string-append bootloader "/libexec/u-boot.itb")))
-        (write-file-on-device idb (stat:size (stat idb))
-                              image (* 64 512))
-        (write-file-on-device u-boot (stat:size (stat u-boot))
-                              image (* 16384 512)))))
-
-(define install-rockpro64-rk3399-u-boot
-  #~(lambda (bootloader root-index image)
-      (let ((idb (string-append bootloader "/libexec/idbloader.img"))
-            (u-boot (string-append bootloader "/libexec/u-boot.itb")))
-        (write-file-on-device idb (stat:size (stat idb))
-                              image (* 64 512))
-        (write-file-on-device u-boot (stat:size (stat u-boot))
-                              image (* 16384 512)))))
-
-(define install-pinebook-pro-rk3399-u-boot install-rockpro64-rk3399-u-boot)
-
-(define install-u-boot-ts7970-q-2g-1000mhz-c-u-boot
-  #~(lambda (bootloader device mount-point)
-      (let ((u-boot.imx (string-append bootloader "/libexec/u-boot.imx"))
-            (install-dir (string-append mount-point "/boot")))
-        (install-file u-boot.imx install-dir))))
-
-(define install-sifive-unmatched-u-boot
-  #~(lambda (bootloader root-index image)
-      (let ((spl (string-append bootloader "/libexec/spl/u-boot-spl.bin"))
-            (u-boot (string-append bootloader "/libexec/u-boot.itb")))
-        (write-file-on-device spl (stat:size (stat spl))
-                              image (* 34 512))
-        (write-file-on-device u-boot (stat:size (stat u-boot))
-                              image (* 2082 512)))))
-
-(define install-starfive-visionfive2-u-boot
-  #~(lambda (bootloader root-index image)
-      (let ((spl (string-append
-                  bootloader "/libexec/spl/u-boot-spl.bin.normal.out"))
-            (u-boot (string-append bootloader "/libexec/u-boot.itb")))
-        (write-file-on-device spl (stat:size (stat spl))
-                              image (* 34 512))
-        (write-file-on-device u-boot (stat:size (stat u-boot))
-                              image (* 2082 512)))))
-
-(define install-starfive-visionfive2-uEnv.txt
-  #~(lambda (bootloader device mount-point)
-      (mkdir-p (string-append mount-point "/boot"))
-      (call-with-output-file (string-append mount-point "/boot/uEnv.txt")
+  ;; second stage ("u-boot.img") images to the target.
+  ("MLO"        (* 256 512)  (* 256 512))
+  ("u-boot.img" (* 1024 512) (* 768 512)))
+
+(define-u-bootloader u-boot-sifive-unmatched-bootloader
+  u-boot-sifive-unmatched #f
+  ("spl/u-boot-spl.bin" #f (* 34 512))
+  ("u-boot.itb"         #f (* 2082 512)))
+
+(define-u-bootloader u-boot-starfive-visionfive2-bootloader
+  u-boot-starfive-visionfive2
+  #~(begin (mkdir-p path)
+      (call-with-output-file (string-append path "/uEnv.txt")
         (lambda (port)
           (format port
-                  ;; if board SPI use vender's u-boot, will find
-                  ;; ""starfive/starfive_visionfive2.dtb"", We cannot guarantee
-                  ;; that users will update this u-boot, so set it.
-                  "fdtfile=starfive/jh7110-starfive-visionfive-2-v1.3b.dtb~%")))))
+            ;; if board SPI use vender's u-boot, will find
+            ;; ""starfive/starfive_visionfive2.dtb"", We cannot guarantee
+            ;; that users will update this u-boot, so set it.
+            "fdtfile=starfive/jh7110-starfive-visionfive-2-v1.3b.dtb~%"))))
+  ("spl/u-boot-spl.bin.normal.out" #f (* 34 512))
+  ("u-boot.itb"                    #f (* 2082 512)))
+
+
+;;;
+;;; Allwinner bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-allwinner def-name package)
+  (define-u-bootloader def-name package #f
+    ("u-boot-sunxi-with-spl.bin" #f (* 8 1024))))
+
 
-(define install-qemu-riscv64-u-boot
-  #~(lambda (bootloader device mount-point)
-      (let ((u-boot.bin (string-append bootloader "/libexec/u-boot.bin"))
-            (install-dir (string-append mount-point "/boot")))
-        (install-file u-boot.bin install-dir))))
+(define-u-bootloader-allwinner u-boot-nintendo-nes-classic-edition-bootloader
+  u-boot-nintendo-nes-classic-edition)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-lime-bootloader
+  u-boot-a20-olinuxino-lime)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-lime2-bootloader
+  u-boot-a20-olinuxino-lime2)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-micro-bootloader
+  u-boot-a20-olinuxino-micro)
+
+(define-u-bootloader-allwinner u-boot-bananapi-m2-ultra-bootloader
+  u-boot-bananapi-m2-ultra)
+
+(define-u-bootloader-allwinner u-boot-cubietruck-bootloader u-boot-cubietruck)
+
+(define-u-bootloader-allwinner u-boot-pine64-lts-bootloader u-boot-pine64-lts)
 
 
+;;;
+;;; Allwinner64 bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-allwinner64 def-name package)
+  (define-u-bootloader def-name package #f
+    ("u-boot-sunxi-with-spl.bin"     #f (* 8 1024))
+    ("u-boot-sunxi-with-spl.fit.itb" #f (* 40 1024))))
+
+
+(define-u-bootloader-allwinner64 u-boot-pine64-plus-bootloader
+  u-boot-pine64-plus)
+
+(define-u-bootloader-allwinner64 u-boot-pinebook-bootloader u-boot-pinebook)
 
+
 ;;;
-;;; Bootloader definitions.
+;;; IMX bootloader definitions.
 ;;;
+(define-syntax-rule (define-u-bootloader-imx def-name package)
+  (define-u-bootloader def-name package #f
+    ("SPL"        #f (* 8 1024))
+    ("u-boot.img" #f (* 40 1024))))
 
-(define u-boot-bootloader
-  (bootloader
-   (inherit extlinux-bootloader)
-   (name 'u-boot)
-   (package #f)
-   (installer #f)
-   (disk-image-installer install-u-boot)))
-
-(define u-boot-beaglebone-black-bootloader
-  (bootloader
-   (inherit u-boot-bootloader)
-   (package u-boot-am335x-boneblack)
-   (disk-image-installer install-beaglebone-black-u-boot)))
-
-(define u-boot-allwinner-bootloader
-  (bootloader
-   (inherit u-boot-bootloader)
-   (disk-image-installer install-allwinner-u-boot)))
-
-(define u-boot-allwinner64-bootloader
-  (bootloader
-   (inherit u-boot-bootloader)
-   (disk-image-installer install-allwinner64-u-boot)))
-
-(define u-boot-imx-bootloader
-  (bootloader
-   (inherit u-boot-bootloader)
-   (disk-image-installer install-imx-u-boot)))
-
-(define u-boot-nintendo-nes-classic-edition-bootloader
-  (bootloader
-    (inherit u-boot-allwinner-bootloader)
-    (package u-boot-nintendo-nes-classic-edition)))
-
-(define u-boot-a20-olinuxino-lime-bootloader
-  (bootloader
-   (inherit u-boot-allwinner-bootloader)
-   (package u-boot-a20-olinuxino-lime)))
-
-(define u-boot-a20-olinuxino-lime2-bootloader
-  (bootloader
-   (inherit u-boot-allwinner-bootloader)
-   (package u-boot-a20-olinuxino-lime2)))
-
-(define u-boot-a20-olinuxino-micro-bootloader
-  (bootloader
-   (inherit u-boot-allwinner-bootloader)
-   (package u-boot-a20-olinuxino-micro)))
-
-(define u-boot-bananapi-m2-ultra-bootloader
-  (bootloader
-   (inherit u-boot-allwinner-bootloader)
-   (package u-boot-bananapi-m2-ultra)))
-
-(define u-boot-cubietruck-bootloader
-  (bootloader
-    (inherit u-boot-allwinner-bootloader)
-    (package u-boot-cubietruck)))
-
-(define u-boot-firefly-rk3399-bootloader
-  ;; SD and eMMC use the same format
-  (bootloader
-   (inherit u-boot-bootloader)
-   (package u-boot-firefly-rk3399)
-   (disk-image-installer install-firefly-rk3399-u-boot)))
-
-(define u-boot-mx6cuboxi-bootloader
-  (bootloader
-   (inherit u-boot-imx-bootloader)
-   (package u-boot-mx6cuboxi)))
-
-(define u-boot-wandboard-bootloader
-  (bootloader
-   (inherit u-boot-imx-bootloader)
-   (package u-boot-wandboard)))
-
-(define u-boot-novena-bootloader
-  (bootloader
-   (inherit u-boot-imx-bootloader)
-   (package u-boot-novena)))
-
-(define u-boot-orangepi-r1-plus-lts-rk3328-bootloader
-  (bootloader
-   (inherit u-boot-bootloader)
-   (package u-boot-orangepi-r1-plus-lts-rk3328)
-   (disk-image-installer install-orangepi-r1-plus-lts-rk3328-u-boot)))
-
-(define u-boot-pine64-plus-bootloader
-  (bootloader
-   (inherit u-boot-allwinner64-bootloader)
-   (package u-boot-pine64-plus)))
-
-(define u-boot-pine64-lts-bootloader
-  (bootloader
-   (inherit u-boot-allwinner-bootloader)
-   (package u-boot-pine64-lts)))
-
-(define u-boot-pinebook-bootloader
-  (bootloader
-   (inherit u-boot-allwinner64-bootloader)
-   (package u-boot-pinebook)))
-
-(define u-boot-puma-rk3399-bootloader
-  (bootloader
-   (inherit u-boot-bootloader)
-   (package u-boot-puma-rk3399)
-   (disk-image-installer install-puma-rk3399-u-boot)))
-
-(define u-boot-rock64-rk3328-bootloader
-  ;; SD and eMMC use the same format
-  (bootloader
-   (inherit u-boot-bootloader)
-   (package u-boot-rock64-rk3328)
-   (disk-image-installer install-rock64-rk3328-u-boot)))
 
-(define u-boot-rockpro64-rk3399-bootloader
-  ;; SD and eMMC use the same format
-  (bootloader
-   (inherit u-boot-bootloader)
-   (package u-boot-rockpro64-rk3399)
-   (disk-image-installer install-rockpro64-rk3399-u-boot)))
+(define-u-bootloader-imx u-boot-mx6cuboxi-bootloader u-boot-mx6cuboxi)
+
+(define-u-bootloader-imx u-boot-wandboard-bootloader u-boot-wandboard)
 
-(define u-boot-pinebook-pro-rk3399-bootloader
+(define-u-bootloader-imx u-boot-novena-bootloader u-boot-novena)
+
+
+;;;
+;;; Rockchip bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-rockchip def-name package)
   ;; SD and eMMC use the same format
-  (bootloader
-   (inherit u-boot-bootloader)
-   (package u-boot-pinebook-pro-rk3399)
-   (disk-image-installer install-pinebook-pro-rk3399-u-boot)))
-
-(define u-boot-ts7970-q-2g-1000mhz-c-bootloader
-  ;; This bootloader doesn't really need to be installed, as it is read from
-  ;; an SPI memory chip, not the SD card.  It is copied to /boot/u-boot.imx
-  ;; for convenience and should be manually flashed at the U-Boot prompt.
-  (bootloader
-   (inherit u-boot-bootloader)
-   (package u-boot-ts7970-q-2g-1000mhz-c)
-   (installer install-u-boot-ts7970-q-2g-1000mhz-c-u-boot)
-   (disk-image-installer #f)))
-
-(define u-boot-sifive-unmatched-bootloader
-  (bootloader
-   (inherit u-boot-bootloader)
-   (package u-boot-sifive-unmatched)
-   (disk-image-installer install-sifive-unmatched-u-boot)))
-
-(define u-boot-starfive-visionfive2-bootloader
-  (bootloader
-   (inherit u-boot-bootloader)
-   (package u-boot-starfive-visionfive2)
-   (installer install-starfive-visionfive2-uEnv.txt)
-   (disk-image-installer install-starfive-visionfive2-u-boot)))
-
-(define u-boot-qemu-riscv64-bootloader
-  (bootloader
-   (inherit u-boot-bootloader)
-   (package u-boot-qemu-riscv64)
-   (installer install-qemu-riscv64-u-boot)
-   (disk-image-installer #f)))
+  (define-u-bootloader def-name package #f
+    ("idbloader.img" #f (* 64 512))
+    ("u-boot.itb"    #f (* 16384 512))))
+
+(define-u-bootloader-rockchip u-boot-firefly-rk3399-bootloader
+  u-boot-firefly-rk3399)
+
+(define-u-bootloader-rockchip u-boot-orangepi-r1-plus-lts-rk3328-bootloader
+  u-boot-orangepi-r1-plus-lts-rk3328)
+
+(define-u-bootloader-rockchip u-boot-rock64-rk3328-bootloader
+  u-boot-rock64-rk3328)
+
+(define-u-bootloader-rockchip u-boot-rockpro64-rk3399-bootloader
+  u-boot-rockpro64-rk3399)
+
+(define-u-bootloader-rockchip u-boot-pinebook-pro-rk3399-bootloader
+  u-boot-pinebook-pro-rk3399)
+
+(define-u-bootloader u-boot-puma-rk3399-bootloader u-boot-puma-rk3399 #f
+  ("idbloader.img" #f (* 64 512))
+  ("u-boot.itb"    #f (* 512 512)))
+
+
+;;;
+;;; Copy-only bootloader definitions.
+;;;
+
+;; These bootloaders don't really need to be installed, as they are read from
+;; an SPI memory chip  or directly from the FS, not the disk.
+(define-syntax-rule (define-u-bootloader-copy def-name package file)
+  (define-u-bootloader def-name package
+    #~(install-file #$(file-append package "/libexec/" file) path)))
+
+;; user should manually install this to SPI flash
+;; TODO: write directly to SPI flash? unless wear issues are a problem.
+(define-u-bootloader-copy u-boot-ts7970-q-2g-1000mhz-c-bootloader
+  u-boot-ts7970-q-2g-1000mhz-c "u-boot.imx")
+
+(define-u-bootloader-copy u-boot-qemu-riscv64-bootloader
+  u-boot-qemu-riscv64 "u-boot.bin")
diff --git a/gnu/build/bootloader.scm b/gnu/build/bootloader.scm
index af6063a884..b59287d759 100644
--- a/gnu/build/bootloader.scm
+++ b/gnu/build/bootloader.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
 ;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,20 +21,45 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu build bootloader)
+  #:autoload   (guix build syscalls) (free-disk-space)
   #:use-module (guix build utils)
-  #:use-module (guix utils)
-  #:use-module (ice-9 binary-ports)
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 regex)
   #:use-module (rnrs io ports)
   #:use-module (rnrs io simple)
-  #:export (write-file-on-device
-            install-efi-loader))
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-35)
+  #:export (atomic-copy
+            in-temporary-directory
+            write-file-on-device
+            install-efi))
 
 
 ;;;
 ;;; Writing utils.
 ;;;
 
+(define (atomic-copy from to)
+  (let ((pivot (string-append to ".new")))
+    (copy-file from pivot)
+    (rename-file pivot to)))
+
+(define-syntax-rule (in-temporary-directory block ...)
+  "Run blocks... while chdir'd into a temporary directory."
+  ;; mkdtemp under POSIX.1-2008 must make the dir with 700 perms
+  (let* ((tmp (or (getenv "TMPDIR") "/tmp"))
+         (dir (mkdtemp (string-append tmp "/guix-bootloader.XXXXXX")))
+         (cwd (getcwd)))
+    (dynamic-wind (lambda () (chdir dir))
+                  (lambda () block ...)
+                  (lambda () (chdir cwd) (delete-file-recursively dir)))))
+
 (define (write-file-on-device file size device offset)
   "Write SIZE bytes from FILE to DEVICE starting at OFFSET."
   (call-with-input-file file
@@ -56,57 +82,78 @@ (define (write-file-on-device file size device offset)
 ;;; EFI bootloader.
 ;;;
 
-(define* (install-efi grub grub-config esp #:key targets)
-  "Write a self-contained GRUB EFI loader to the mounted ESP using
-GRUB-CONFIG.
-
-If TARGETS is set, use its car as the GRUB image format and its cdr as
-the output filename.  Otherwise, use defaults for the host platform."
-  (let* ((system %host-type)
-         ;; Hard code the output location to a well-known path recognized by
-         ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
-         ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
-         (grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
-         (efi-directory (string-append esp "/EFI/BOOT"))
-         ;; Map grub target names to boot file names.
-         (efi-targets (or targets
-                          (cond ((string-prefix? "x86_64" system)
-                                 '("x86_64-efi" . "BOOTX64.EFI"))
-                                ((string-prefix? "i686" system)
-                                 '("i386-efi" . "BOOTIA32.EFI"))
-                                ((string-prefix? "armhf" system)
-                                 '("arm-efi" . "BOOTARM.EFI"))
-                                ((string-prefix? "aarch64" system)
-                                 '("arm64-efi" . "BOOTAA64.EFI"))))))
-    ;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
-    (setenv "TMPDIR" esp)
-
-    (mkdir-p efi-directory)
-    (invoke grub-mkstandalone "-O" (car efi-targets)
-            "-o" (string-append efi-directory "/"
-                                (cdr efi-targets))
-            ;; Graft the configuration file onto the image.
-            (string-append "boot/grub/grub.cfg=" grub-config))))
+(define parse-bootnums
+  (make-regexp "^Boot([0-9a-fA-F]+).*[^A-Za-z]File\\(([^)]+)\\)$" regexp/newline))
 
-(define* (install-efi-loader grub-efi esp #:key targets)
-  "Install in ESP directory the given GRUB-EFI bootloader.  Configure it to
-load the Grub bootloader located in the 'Guix_image' root partition.
+;; XXX: parsing efibootmgr output may be kinda jank? a better way may exist
+(define (efi-bootnums efibootmgr)
+  "Returns '(path . bootnum) pairs for each EFI boot entry. bootnum is a string,
+and path is backslash-deliminated and relative to the ESP."
+  (let* ((pipe (open-pipe* OPEN_READ efibootmgr))
+         (text (get-string-all pipe))
+         (status (status:exit-val (close-pipe pipe))))
+    (unless (zero? status)
+      (raise-exception
+        (formatted-message (G_ "efibootmgr exited with error code ~a") status)))
+    (fold-matches parse-bootnums text '()
+      (lambda (match acc)
+        (let* ((path (match:substring match 2))
+               (bootnum (match:substring match 1)))
+          (cons (cons path bootnum) acc))))))
 
-If TARGETS is set, use its car as the GRUB image format and its cdr as
-the output filename.  Otherwise, use defaults for the host platform."
-  (let ((grub-config "grub.cfg"))
-    (call-with-output-file grub-config
-      (lambda (port)
-        ;; Create a tiny configuration file telling the embedded grub where to
-        ;; load the real thing.  XXX This is quite fragile, and can prevent
-        ;; the image from booting when there's more than one volume with this
-        ;; label present.  Reproducible almost-UUIDs could reduce the risk
-        ;; (not eliminate it).
-        (format port
-                "insmod part_msdos~@
-               insmod part_gpt~@
-               search --set=root --label Guix_image~@
-               configfile /boot/grub/grub.cfg~%")))
-    (install-efi grub-efi grub-config esp #:targets targets)
-    (delete-file grub-config)))
+(define (install-efi efibootmgr vendir loader* disk plan)
+  "See install-efi in (gnu bootloader)."
+  (let* ((loader (string-map (match-lambda (#\/ #\\) (x x)) loader*))
+         (bootnums (filter (compose (cut string-prefix? loader <>) car)
+                     (efi-bootnums efibootmgr)))
+         (plan-files (map cadr plan)))
+    (define (size file) (if (file-exists? file) (stat:size (stat file)) 0))
+    (define (vendirof file) (string-append vendir "/" file))
+    (define (loaderof file) (string-append loader "\\" file))
+    (define (delete-boot num file)
+      (invoke efibootmgr "--quiet" "--bootnum" num "--delete-bootnum")
+      (when (file-exists? file) (delete-file file)))
 
+    (mkdir-p vendir)
+    ;; delete old entries first, to clear up space
+    (for-each (lambda (spec) ; '(path . bootnum)
+                (let* ((s (substring (car spec) (string-length loader)))
+                       (file (substring s (if (string-prefix? "\\" s) 1 0))))
+                  (unless (member file plan-files)
+                    (delete-boot (cdr spec) (vendirof file)))))
+      bootnums)
+    ;; new and updated entries
+    (in-temporary-directory
+      (for-each
+        (lambda (spec)
+          (let* ((builder (car spec)) (name (cadr spec))
+                 (dest (vendirof name)) (loadest (loaderof name))
+                 (rest (reverse (cdr (member name plan-files)))))
+            (builder name) ; build to a tmp file so we can check size
+            ;; disk space is usually limited on esps.
+            ;; try to clear space as we install new bootloaders.
+            (if (while (> (- (size name) (size dest)) (free-disk-space vendir))
+                  (let ((del (find (compose file-exists? vendirof) rest)))
+                    (if del (delete-file (vendirof del)) (break #t))))
+              (begin
+                (and=> (assoc-ref bootnums loadest) (cut delete-boot <> dest))
+                (warning (G_ "ESP too small for bootloader ~a!~%") name))
+              ;; esp too small for atomic copy
+              (begin
+                (copy-file name dest)
+                (unless (assoc loadest bootnums)
+                  (invoke efibootmgr "--quiet" "--create-only"
+                    "--label" (cddr spec) "--disk" disk "--loader" loadest))))
+            (delete-file name)))
+        plan))
+    ;; verify at least the first entry was installed
+    (unless (file-exists? (vendirof (cadr (car plan))))
+      ;; extremely fatal error so we use leave instead of raise
+      (leave (G_ "not enough space in ESP to install bootloader!
+ SYSTEM WILL NOT BOOT UNLESS THIS IS FIXED!~%")))
+    ;; boot order. recall efi-bootnums to get fresh list with new installs
+    ;; some UEFI systems will refuse to acknowledge the existence of boot
+    ;; entries unless they're in bootorder, so just shove everything in there
+    (invoke efibootmgr "--quiet" "--bootorder"
+      (let ((num (cute assoc-ref (efi-bootnums efibootmgr) <>))) ; cute is eager
+        (string-join (filter-map (compose num loaderof) plan-files) ",")))))
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 49dc01c0d1..b1abc99bba 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -28,6 +28,7 @@ (define-module (gnu build image)
   #:use-module (guix build store-copy)
   #:use-module (guix build syscalls)
   #:use-module (guix build utils)
+  #:use-module (guix deprecation)
   #:use-module (guix store database)
   #:use-module (guix utils)
   #:use-module (gnu build bootloader)
@@ -181,30 +182,13 @@ (define* (register-closure prefix closure
                        #:prefix prefix
                        #:registration-time %epoch)))))
 
-(define* (initialize-efi-partition root
-                                   #:key
-                                   grub-efi
-                                   #:allow-other-keys)
-  "Install in ROOT directory, an EFI loader using GRUB-EFI."
-  (install-efi-loader grub-efi root))
-
-(define* (initialize-efi32-partition root
-                                     #:key
-                                     grub-efi32
-                                     #:allow-other-keys)
-  "Install in ROOT directory, an EFI 32bit loader using GRUB-EFI32."
-  (install-efi-loader grub-efi32 root
-                      #:targets (cond ((target-x86?)
-                                       '("i386-efi" . "BOOTIA32.EFI"))
-                                      ((target-arm?)
-                                       '("arm-efi" . "BOOTARM.EFI")))))
+(define (initialize-efi-partition root . rest)
+  (mkdir-p (string-append root "/EFI")))
+
+(define-deprecated/alias initialize-efi32-partition initialize-efi-partition)
 
 (define* (initialize-root-partition root
                                     #:key
-                                    bootcfg
-                                    bootcfg-location
-                                    bootloader-package
-                                    bootloader-installer
                                     (copy-closures? #t)
                                     (deduplicate? #t)
                                     references-graphs
@@ -251,18 +235,10 @@ (define* (initialize-root-partition root
 
     (unless copy-closures?
       (delete-file root-store)
-      (rename-file tmp-store root-store)))
-
-  ;; There's no point installing a bootloader if we do not populate the store.
-  (when copy-closures?
-    (when bootloader-installer
-      (display "installing bootloader...\n")
-      (bootloader-installer bootloader-package #f root))
-    (when bootcfg
-      (install-boot-config bootcfg bootcfg-location root))))
+      (rename-file tmp-store root-store))))
 
 (define* (make-iso9660-image xorriso grub-mkrescue-environment
-                             grub bootcfg system-directory root target
+                             grub grub.dir system-directory root target
                              #:key (volume-id "Guix_image") (volume-uuid #f)
                              register-closures? (references-graphs '())
                              (compression? #t))
@@ -321,7 +297,7 @@ (define* (make-iso9660-image xorriso grub-mkrescue-environment
   (apply invoke grub-mkrescue
          (string-append "--xorriso=" grub-mkrescue-sed.sh)
          "-o" target
-         (string-append "boot/grub/grub.cfg=" bootcfg)
+         (string-append "boot/grub=" grub.dir)
          root
          "--"
          ;; Set all timestamps to 1.
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 0aa227b4d8..6b5435f13c 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -25,8 +25,7 @@ (define-module (gnu build install)
   #:use-module (guix build store-copy)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
-  #:export (install-boot-config
-            evaluate-populate-directive
+  #:export (evaluate-populate-directive
             populate-root-file-system
             install-database-and-gc-roots
             populate-single-profile-directory
@@ -42,19 +41,6 @@ (define-module (gnu build install)
 ;;;
 ;;; Code:
 
-(define (install-boot-config bootcfg bootcfg-location mount-point)
-  "Atomically copy BOOTCFG into BOOTCFG-LOCATION on the MOUNT-POINT.  Note
-that the caller must make sure that BOOTCFG is registered as a GC root so
-that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
-  (let* ((target (string-append mount-point bootcfg-location))
-         (pivot  (string-append target ".new")))
-    (mkdir-p (dirname target))
-
-    ;; Copy BOOTCFG instead of just symlinking it, because symlinks won't
-    ;; work when /boot is on a separate partition.  Do that atomically.
-    (copy-file bootcfg pivot)
-    (rename-file pivot target)))
-
 (define* (evaluate-populate-directive directive target
                                       #:key
                                       (default-gid 0)
diff --git a/gnu/image.scm b/gnu/image.scm
index 7fb06dec10..6a3251014f 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -35,6 +35,7 @@ (define-module (gnu image)
             partition-label
             partition-uuid
             partition-flags
+            partition-target
             partition-initializer
 
             image
@@ -131,6 +132,8 @@ (define-record-type* <partition> partition make-partition
   (flags                partition-flags
                         (default '())  ;list of symbols
                         (sanitize validate-partition-flags))
+  (target               partition-target ; bootloader target type: symbol | #f
+                        (default #f))
   (initializer          partition-initializer
                         (default #false))) ;gexp | #false
 
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 51fa7cf9d9..83682ea539 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -1454,15 +1454,19 @@ (define (root-user-partition? partition)
 
 (define (bootloader-configuration user-partitions)
   "Return the bootloader configuration field for USER-PARTITIONS."
-  (let* ((root-partition (find root-user-partition?
-                               user-partitions))
+  (let* ((root-partition (find root-user-partition? user-partitions))
          (root-partition-disk (user-partition-disk-file-name root-partition)))
     `((bootloader-configuration
        ,@(if (efi-installation?)
              `((bootloader grub-efi-bootloader)
-               (targets (list ,(default-esp-mount-point))))
+               (targets (list (bootloader-target
+                                (type 'esp)
+                                (path ,(default-esp-mount-point))))))
              `((bootloader grub-bootloader)
-               (targets (list ,root-partition-disk))))
+               (targets (list (bootloader-target
+                                (type 'disk)
+                                ;; TODO: we should provide a uuid or label here
+                                (device ,root-partition-disk))))))
 
        ;; XXX: Assume we defined the 'keyboard-layout' field of
        ;; <operating-system> right above.
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 8dd8c342a0..4a9d3faee1 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -505,18 +505,15 @@ (define (deploy-managed-host machine)
                                   (machine-ssh-session machine)
                                   (machine-become-command machine)))
 
-  (mlet %store-monad ((_ (check-deployment-sanity machine))
-                      (boot-alternatives (machine->boot-alternatives machine)))
+  (mlet %store-monad ((_ (check-deployment-sanity machine)))
     ;; Make sure code that check %CURRENT-SYSTEM, such as
     ;; %BASE-INITRD-MODULES, gets to see the right value.
     (parameterize ((%current-system system)
                    (%current-target-system #f))
       (let* ((os (machine-operating-system machine))
              (eval (cut machine-remote-eval machine <>))
-             (menu-entries (map boot-parameters->menu-entry
-                                (map boot-alternative-parameters boot-alternatives)))
-             (bootloader-configuration (operating-system-bootloader os))
-             (bootcfg (operating-system-bootcfg os menu-entries)))
+             (bootloader-config (operating-system-bootloader os))
+             (bootmeta (operating-system-bootmeta os)))
         (define-syntax-rule (eval/error-handling condition handler ...)
           ;; Return a wrapper around EVAL such that HANDLER is evaluated if an
           ;; exception is raised.
@@ -548,13 +545,15 @@ (define (deploy-managed-host machine)
                                                       (inferior-exception-arguments
                                                        c)))
                                            os)
-                (install-bootloader (eval/error-handling c
-                                      (raise (formatted-message
-                                              (G_ "\
+                (mlet %store-monad
+                      ((boot-alternatives (machine->boot-alternatives machine)))
+                  (apply install-bootloader
+                    (eval/error-handling c
+                      (raise (formatted-message
+                               (G_ "\
 failed to install bootloader on '~a':~%~{~s ~}~%")
-                                              host
-                                              (inferior-exception-arguments c))))
-                                    bootloader-configuration bootcfg)))))))))
+                               host (inferior-exception-arguments c))))
+                    bootloader-config boot-alternatives bootmeta))))))))))
 
 
 ;;;
@@ -585,32 +584,28 @@ (define (roll-back-managed-host machine)
   (define roll-back-failure
     (condition (&message (message (G_ "could not roll-back machine")))))
 
-  (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
-                       (_ -> (if (< (length boot-alternatives) 2)
-                                 (raise roll-back-failure)))
-                       (chosen-alternative (second boot-alternatives))
-                       (parameters (boot-alternative-parameters chosen-alternative))
-                       (entries -> (list (boot-parameters->menu-entry parameters)))
-                       (locale -> (boot-parameters-locale parameters))
-                       (crypto-dev -> (boot-parameters-store-crypto-devices parameters))
-                       (store-dir -> (boot-parameters-store-directory-prefix parameters))
-                       (old-entries -> (map boot-parameters->menu-entry
-                                            (map boot-alternative-parameters
-                                                 (drop boot-alternatives 2))))
-                       (bootloader -> (operating-system-bootloader
-                                       (machine-operating-system machine)))
-                       (bootcfg (lower-object
-                                 ((bootloader-configuration-file-generator
-                                   (bootloader-configuration-bootloader
-                                    bootloader))
-                                  bootloader entries
-                                  #:locale locale
-                                  #:store-crypto-devices crypto-dev
-                                  #:store-directory-prefix store-dir
-                                  #:old-entries old-entries)))
-                       (remote-result (machine-remote-eval machine remote-exp)))
-    (when (eqv? 'error remote-result)
-      (raise roll-back-failure))))
+  (mlet %store-monad ((boot-alternatives (machine->boot-alternatives machine)))
+    (when (< (length boot-alternatives) 2) (raise roll-back-failure))
+    (mlet* %store-monad ((remote-result (machine-remote-eval machine remote-exp)))
+      (mwhen (eqv? 'error remote-result)
+        (raise roll-back-failure)))
+
+    (mlet* %store-monad ((os -> (machine-operating-system machine))
+                         (chosen -> (cadr boot-alternatives))
+                         (alts -> (cons* chosen (car boot-alternatives)
+                                                (cddr boot-alternatives)))
+                         (params -> (boot-alternative-parameters chosen))
+                         (locale -> (boot-parameters-locale chosen))
+                         (crypto-dev -> (boot-parameters-store-crypto-devices
+                                          chosen))
+                         (store-pre -> (boot-parameters-store-directory-prefix
+                                         chosen)))
+      (install-bootloader (cute machine-remote-eval machine <>)
+                          (operating-system-bootloader os)
+                          alts
+                          #:locale locale
+                          #:store-crypto-devices crypto-dev
+                          #:store-directory-prefix store-pre))))
 
 
 ;;;
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 4072df50d7..12f918a123 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -498,92 +498,6 @@ (define-public grub-hybrid
                                                         basename))))
                             (scandir input-dir)))))))))))
 
-(define-public (make-grub-efi-netboot name subdir)
-  "Make a grub-efi-netboot package named NAME, which will be able to boot over
-network via TFTP by accessing its files in the SUBDIR of a TFTP root directory.
-This package is also able to boot from local storage devices.
-
-A bootloader-installer basically needs to copy the package content into the
-bootloader-target directory, which will usually be the TFTP root, as
-'grub-mknetdir' will be invoked already during the package creation.
-
-Alternatively the bootloader-target directory can be a mounted EFI System
-Partition (ESP), or a similar partition with a FAT file system, for booting
-from local storage devices.
-
-The name of the GRUB EFI binary will conform to the UEFI specification for
-removable media.  Depending on the system it will be e.g. bootx64.efi or
-bootaa64.efi below SUBDIR.
-
-The SUBDIR argument needs to be set to \"efi/boot\" to create a package which
-conforms to the UEFI specification for removable media.
-
-The SUBDIR argument defaults to \"efi/Guix\", as it is also the case for
-'grub-efi-bootloader'."
-  (package
-    (name name)
-    (version (package-version grub-efi))
-    ;; Source is not needed, but it cannot be omitted.
-    (source #f)
-    (build-system trivial-build-system)
-    (arguments
-     (let* ((system (string-split (nix-system->gnu-triplet
-                                   (or (%current-target-system)
-                                       (%current-system)))
-                                  #\-))
-            (arch (first system))
-            (boot-efi
-             (match system
-               ;; These are the supportend systems and the names defined by
-               ;; the UEFI standard for removable media.
-               (("i686" _ ...)        "/bootia32.efi")
-               (("x86_64" _ ...)      "/bootx64.efi")
-               (("arm" _ ...)         "/bootarm.efi")
-               (("aarch64" _ ...)     "/bootaa64.efi")
-               (("riscv" _ ...)       "/bootriscv32.efi")
-               (("riscv64" _ ...)     "/bootriscv64.efi")
-               ;; Other systems are not supported, although defined.
-               ;; (("riscv128" _ ...) "/bootriscv128.efi")
-               ;; (("ia64" _ ...)     "/bootia64.efi")
-               ((_ ...)               #f)))
-            (core-efi (string-append
-                       ;; This is the arch dependent file name of GRUB, e.g.
-                       ;; i368-efi/core.efi or arm64-efi/core.efi.
-                       (match arch
-                         ("i686"    "i386")
-                         ("aarch64" "arm64")
-                         ("riscv"   "riscv32")
-                         (_         arch))
-                       "-efi/core.efi")))
-       (list
-        #:modules '((guix build utils))
-        #:builder
-        #~(begin
-            (use-modules (guix build utils))
-            (let* ((bootloader #$(this-package-input "grub-efi"))
-                   (net-dir #$output)
-                   (sub-dir (string-append net-dir "/" #$subdir "/"))
-                   (boot-efi (string-append sub-dir #$boot-efi))
-                   (core-efi (string-append sub-dir #$core-efi)))
-              ;; Install GRUB, which refers to the grub.cfg, with support for
-              ;; encrypted partitions,
-              (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-              (invoke/quiet (string-append bootloader "/bin/grub-mknetdir")
-                            (string-append "--net-directory=" net-dir)
-                            (string-append "--subdir=" #$subdir)
-                            ;; These modules must be pre-loaded to allow booting
-                            ;; from an ESP or a similar partition with a FAT
-                            ;; file system.
-                            (string-append "--modules=part_msdos part_gpt fat"))
-              ;; Move GRUB's core.efi to the removable media name.
-              (false-if-exception (delete-file boot-efi))
-              (rename-file core-efi boot-efi))))))
-    (inputs (list grub-efi))
-    (synopsis (package-synopsis grub-efi))
-    (description (package-description grub-efi))
-    (home-page (package-home-page grub-efi))
-    (license (package-license grub-efi))))
-
 (define-public syslinux
   (let ((commit "bb41e935cc83c6242de24d2271e067d76af3585c"))
     (package
diff --git a/gnu/packages/raspberry-pi.scm b/gnu/packages/raspberry-pi.scm
index c4f03c3ed9..66f980dd79 100644
--- a/gnu/packages/raspberry-pi.scm
+++ b/gnu/packages/raspberry-pi.scm
@@ -19,8 +19,6 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages raspberry-pi)
-  #:use-module (gnu bootloader)
-  #:use-module (gnu bootloader grub)
   #:use-module (gnu packages)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages algebra)
@@ -328,22 +326,6 @@ (define (make-raspi-bcm28-dtbs linux)
      (format #f "The device-tree files for Raspberry Pi models from ~a."
              (package-name linux)))))
 
-(define-public grub-efi-bootloader-chain-raspi-64
-  ;; A bootloader capable to boot a Raspberry Pi over network via TFTP or from
-  ;; a local storage like a micro SD card.  It neither installs firmware nor
-  ;; device-tree files for the Raspberry Pi.  It just assumes them to be
-  ;; existing in boot/efi in the same way that some UEFI firmware with ACPI
-  ;; data is usually assumed to be existing on PCs.  It creates firmware
-  ;; configuration files and a bootloader-chain with U-Boot to provide an EFI
-  ;; API for the final GRUB bootloader.  It also serves as a blue-print to
-  ;; create an a custom bootloader-chain with firmware and device-tree
-  ;; packages or files.
-  (efi-bootloader-chain grub-efi-netboot-removable-bootloader
-                        #:packages (list u-boot-rpi-arm64-efi-bin)
-                        #:files (list %raspi-config-txt
-                                      %raspi-bcm27-dtb-txt
-                                      %raspi-u-boot-bootloader-txt)))
-
 (define (make-raspi-defconfig arch defconfig sha256-as-base32)
   "Make for the architecture ARCH a file-like object from the DEFCONFIG file
 with the hash SHA256-AS-BASE32.  This object can be used as the #:defconfig
diff --git a/gnu/system.scm b/gnu/system.scm
index 4a084b2ecf..a345b52d55 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -140,10 +140,11 @@ (define-module (gnu system)
 
             operating-system-derivation
             operating-system-profile
-            operating-system-bootcfg
+            operating-system-bootmeta
             operating-system-etc-directory
             operating-system-locale-directory
             operating-system-boot-script
+            operating-system-boot-parameters
             operating-system-uuid
 
             operating-system-with-gc-roots
@@ -171,6 +172,9 @@ (define-module (gnu system)
 ;;;
 ;;; Code:
 
+(define (convert-bootloader-field bootloader)
+  (if (list? bootloader) bootloader (list bootloader)))
+
 (define-with-syntax-properties (warn-hosts-file-field-deprecation
                                 (value properties))
   (when value
@@ -193,7 +197,9 @@ (define-record-type* <operating-system> operating-system
                     (default %default-kernel-arguments)) ; list of gexps/strings
   (hurd operating-system-hurd
         (default #f))                             ; package
-  (bootloader operating-system-bootloader)        ; <bootloader-configuration>
+  (bootloader operating-system-bootloader         ; <bootloader-configuration>
+              (default '())
+              (sanitize convert-bootloader-field))
   (label operating-system-label                   ; string
          (thunked)
          (default (operating-system-default-label this-operating-system)))
@@ -1208,30 +1214,17 @@ (define (operating-system-store-file-system os)
   "Return the file system that contains the store of OS."
   (store-file-system (operating-system-file-systems os)))
 
-(define* (operating-system-bootcfg os #:optional (old-entries '()))
-  "Return the bootloader configuration file for OS.  Use OLD-ENTRIES,
-a list of <menu-entry>, to populate the \"old entries\" menu."
+(define (operating-system-bootmeta os)
+  "Return operating system information to be passed to the bootloader
+installers."
   (let* ((file-systems    (operating-system-file-systems os))
+         (store-root      (btrfs-store-subvolume-file-name file-systems))
          (root-fs         (operating-system-root-file-system os))
-         (root-device     (file-system-device root-fs))
          (locale          (operating-system-locale os))
-         (crypto-devices  (operating-system-bootloader-crypto-devices os))
-         (params          (operating-system-boot-parameters
-                           os root-device
-                           #:system-kernel-arguments? #t))
-         (entry           (boot-parameters->menu-entry params))
-         (bootloader-conf (operating-system-bootloader os)))
-
-    (define generate-config-file
-      (bootloader-configuration-file-generator
-       (bootloader-configuration-bootloader bootloader-conf)))
-
-    (generate-config-file bootloader-conf (list entry)
-                          #:old-entries old-entries
-                          #:locale locale
-                          #:store-crypto-devices crypto-devices
-                          #:store-directory-prefix
-			  (btrfs-store-subvolume-file-name file-systems))))
+         (crypto-devices  (operating-system-bootloader-crypto-devices os)))
+    (list #:store-crypto-devices crypto-devices
+          #:store-directory-prefix store-root
+          #:locale locale)))
 
 (define (operating-system-multiboot-modules os)
   (if (operating-system-hurd os) (hurd-multiboot-modules os) '()))
@@ -1295,9 +1288,9 @@ (define* (operating-system-boot-parameters os root-device
          (file-systems    (operating-system-file-systems os))
          (crypto-devices  (operating-system-bootloader-crypto-devices os))
          (locale          (operating-system-locale os))
-         (bootloader      (bootloader-configuration-bootloader
-                           (operating-system-bootloader os)))
-         (bootloader-name (bootloader-name bootloader))
+         (bootloader      (map bootloader-configuration-bootloader
+                               (operating-system-bootloader os)))
+         (bootloader-name (map bootloader-name bootloader))
          (label           (operating-system-label os))
          (multiboot-modules (operating-system-multiboot-modules os)))
     (boot-parameters
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 833caef496..2b5302ce5f 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -81,6 +81,7 @@ (define-module (gnu system boot)
             epoch->date-string
             decorated-boot-label
             boot-parameters->menu-entry
+            boot-alternative->menu-entry
 
             ensure-not-/dev
             system-linux-image-file-name))
@@ -171,7 +172,8 @@ (define (read-boot-parameters port)
 
       (bootloader-name
        (match (assq 'bootloader-name rest)
-         ((_ args) args)
+         ((_ (args ...)) args)
+         ((_ args) (list args))
          (#f       'grub))) ; for compatibility reasons.
 
       (bootloader-menu-entries
@@ -340,6 +342,7 @@ (define (boot-parameters->menu-entry conf)
      (label (boot-parameters-label conf))
      (device (boot-parameters-store-device conf))
      (device-mount-point (boot-parameters-store-mount-point conf))
+     (device-subvol (boot-parameters-store-directory-prefix conf))
      (linux (and (not multiboot?) kernel))
      (linux-arguments (if (not multiboot?)
                           (boot-parameters-kernel-arguments conf)
@@ -353,6 +356,9 @@ (define (boot-parameters->menu-entry conf)
                             (boot-parameters-multiboot-modules conf)
                             '())))))
 
+(define boot-alternative->menu-entry
+  (compose boot-parameters->menu-entry boot-alternative-parameters))
+
 (define (ensure-not-/dev device)
   "If DEVICE starts with a slash, return #f.  This is meant to filter out
 Linux device names such as /dev/sda, and to preserve GRUB device names and
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index b0c96c60f0..050f5b578b 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2022 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +24,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu system image)
+  #:use-module (guix deprecation)
   #:use-module (guix diagnostics)
   #:use-module (guix discovery)
   #:use-module (guix gexp)
@@ -42,6 +44,7 @@ (define-module (gnu system image)
   #:use-module (gnu services base)
   #:use-module (gnu system)
   #:use-module (gnu system accounts)
+  #:use-module (gnu system boot)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system linux-container)
   #:use-module (gnu system uuid)
@@ -133,12 +136,10 @@ (define esp-partition
    ;; FAT-ness is based on file system size (16 in this case).
    (file-system "vfat")
    (flags '(esp))
-   (initializer (gexp initialize-efi-partition))))
+   (target 'esp)
+   (initializer #~initialize-efi-partition)))
 
-(define esp32-partition
-  (partition
-   (inherit esp-partition)
-   (initializer (gexp initialize-efi32-partition))))
+(define-deprecated/alias esp32-partition esp-partition)
 
 (define root-partition
   (partition
@@ -149,6 +150,7 @@ (define root-partition
    ;; with U-Boot.
    (file-system-options (list "-O" "^metadata_csum,^64bit"))
    (flags '(boot))
+   (target 'root)
    (initializer (gexp initialize-root-partition))))
 
 (define mbr-disk-image
@@ -173,11 +175,7 @@ (define efi-disk-image
    (partition-table-type 'gpt)
    (partitions (list esp-partition root-partition))))
 
-(define efi32-disk-image
-  (image-without-os
-   (format 'disk-image)
-   (partition-table-type 'gpt)
-   (partitions (list esp32-partition root-partition))))
+(define-deprecated/alias efi32-disk-image efi-disk-image)
 
 (define iso9660-image
   (image-without-os
@@ -238,10 +236,7 @@ (define efi-raw-image-type
    (name 'efi-raw)
    (constructor (cut image-with-os efi-disk-image <>))))
 
-(define efi32-raw-image-type
-  (image-type
-   (name 'efi32-raw)
-   (constructor (cut image-with-os efi32-disk-image <>))))
+(define-deprecated/alias efi32-raw-image-type efi-raw-image-type)
 
 (define qcow2-image-type
   (image-type
@@ -350,10 +345,6 @@ (define (find-root-partition image)
       (raise (formatted-message
               (G_ "image lacks a partition with the 'boot' flag")))))
 
-(define (root-partition-index image)
-  "Return the index of the root partition of the given IMAGE."
-  (1+ (srfi-1:list-index root-partition? (image-partitions image))))
-
 
 ;;
 ;; Disk image.
@@ -362,8 +353,8 @@ (define (root-partition-index image)
 (define* (system-disk-image image
                             #:key
                             (name "disk-image")
-                            bootcfg
-                            bootloader
+                            bootloader-config
+                            bootmeta
                             register-closures?
                             (inputs '()))
   "Return as a file-like object, the disk-image described by IMAGE.  Said
@@ -380,6 +371,28 @@ (define* (system-disk-image image
 
   (define genimage-name "image")
 
+  (define (targets current)
+    ;; provides list of target overrides for a given CURRENT partition, which
+    ;; may be #f for the full-disk targets.
+
+    ;; XXX: how we pass paths is v much a hack
+    (cons (bootloader-target
+            (type 'disk)
+            (device (and (not current) (string-append "images/" genimage-name)))
+            (expected? (->bool current)))
+      (map (lambda (partition)
+             (let ((current? (and current (eq? (partition-target partition)
+                                               (partition-target current)))))
+               (bootloader-target
+                 (type (partition-target partition))
+                 (expected? (not current?))
+                 (path (and current? "tmp-root"))
+                 (offset #f)
+                 (file-system (partition-file-system partition))
+                 (label (partition-label partition))
+                 (uuid (partition-uuid partition)))))
+        (filter partition-target (image-partitions image)))))
+
   (define (image->genimage-cfg image)
     ;; Return as a file-like object, the genimage configuration file
     ;; describing the given IMAGE.
@@ -460,7 +473,8 @@ (define* (system-disk-image image
                                    (list dosfstools fakeroot mtools))
                                   (else
                                     '())))
-                     (image-root "tmp-root"))
+                     (image-root (string-append (getcwd) "/tmp-root"))
+                     (copy-closures? (not #$(image-shared-store? image))))
                  (sql-schema #$schema)
 
                  (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
@@ -476,18 +490,13 @@ (define* (system-disk-image image
                  (initializer image-root
                               #:references-graphs '#$graph
                               #:deduplicate? #f
-                              #:copy-closures? (not
-                                                #$(image-shared-store? image))
-                              #:system-directory #$os
-                              #:grub-efi #+grub-efi
-                              #:grub-efi32 #+grub-efi32
-                              #:bootloader-package
-                              #+(bootloader-package bootloader)
-                              #:bootloader-installer
-                              #+(bootloader-installer bootloader)
-                              #:bootcfg #$bootcfg
-                              #:bootcfg-location
-                              #$(bootloader-configuration-file bootloader))
+                              #:copy-closures? copy-closures?
+                              #:system-directory #$os)
+                 ;; no point installing a bootloader if we don't populate store
+                 (when copy-closures?
+                   ;; root-offset isn't necessary - we override 'root
+                   #$(bootloader-configurations->gexp bootloader-config bootmeta
+                       #:overrides (targets partition)))
                  (make-partition-image #$(partition->gexp partition)
                                        #$output
                                        image-root)))))
@@ -534,14 +543,6 @@ (define* (system-disk-image image
                 (image-partition-table-type image)))
        (else "")))
 
-    (when (and (memq (bootloader-name bootloader)
-                     '(grub-efi grub-efi32 grub-efi-removable-bootloader))
-               (not
-                (gpt-image? image)))
-      (raise
-       (formatted-message
-        (G_ "EFI bootloader required with GPT partitioning"))))
-
     (let* ((format (image-format image))
            (image-type (format->image-type format))
            (image-type-options (genimage-type-options image-type image))
@@ -552,13 +553,15 @@ (define* (system-disk-image image
                 (let ((format (@ (ice-9 format) format)))
                   (call-with-output-file #$output
                     (lambda (port)
-                      (format port
-                              "\
+                      (format port "\
 image ~a {
 ~/~a {~a}
 ~{~a~^~%~}
-}~%" #$genimage-name #$image-type #$image-type-options
- (list #$@partitions-config))))))))
+}~%"
+                        #$genimage-name
+                        #$image-type
+                        #$image-type-options
+                        (list #$@partitions-config))))))))
       (computed-file "genimage.cfg" builder)))
 
   (let* ((image-name (image-name image))
@@ -570,17 +573,13 @@ (define* (system-disk-image image
          (builder
           (with-imported-modules*
            (let ((inputs '#+(list genimage coreutils findutils qemu-minimal))
-                 (bootloader-installer
-                  #+(bootloader-disk-image-installer bootloader))
                  (out-image (string-append "images/" #$genimage-name)))
              (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
              (genimage #$(image->genimage-cfg image))
-             ;; Install the bootloader directly on the disk-image.
-             (when bootloader-installer
-               (bootloader-installer
-                #+(bootloader-package bootloader)
-                #$(root-partition-index image)
-                out-image))
+             ;; don't install bootloader unless installing store
+             (unless #$(image-shared-store? image)
+               #$(bootloader-configurations->gexp bootloader-config bootmeta
+                                                  #:overrides (targets #f)))
              (convert-disk-image out-image '#$format #$output)))))
     (computed-file name builder
                    #:local-build? #f              ;too I/O-intensive
@@ -600,8 +599,8 @@ (define (has-guix-service-type? os)
 (define* (system-iso9660-image image
                                #:key
                                (name "image.iso")
-                               bootcfg
-                               bootloader
+                               bootloader-config
+                               bootmeta
                                register-closures?
                                (inputs '())
                                (grub-mkrescue-environment '()))
@@ -621,7 +620,6 @@ (define* (system-iso9660-image image
        (uuid-bytevector (partition-uuid partition)))))
 
   (let* ((os (image-operating-system image))
-         (bootloader (bootloader-package bootloader))
          (compression? (image-compression? image))
          (substitutable? (image-substitutable? image))
          (schema (local-file (search-path %load-path
@@ -629,6 +627,14 @@ (define* (system-iso9660-image image
          (graph (match inputs
                   (((names . _) ...)
                    names)))
+         (config (bootloader-configuration
+                   (bootloader grub-bootloader)
+                   (targets (list (bootloader-target
+                                    (type 'root)
+                                    (path "tmp-root"))
+                                  (bootloader-target
+                                    (type 'install)
+                                    (path "boot/grub"))))))
          (builder
           (with-imported-modules*
            (let* ((inputs '#$(list parted e2fsprogs dosfstools xorriso
@@ -649,10 +655,12 @@ (define* (system-iso9660-image image
                                         #:references-graphs '#$graph
                                         #:deduplicate? #f
                                         #:system-directory #$os)
+
              (make-iso9660-image #$xorriso
                                  '#$grub-mkrescue-environment
-                                 #$bootloader
-                                 #$bootcfg
+                                 #$grub-hybrid
+                                 #$(apply grub.dir grub-hybrid
+                                     #:bootloader-config config bootmeta)
                                  #$os
                                  image-root
                                  #$output
@@ -954,11 +962,7 @@ (define (operating-system-for-image image)
                              file-systems
                              #:volatile-root? volatile-root?
                              rest)))
-            (bootloader (if (eq? format 'iso9660)
-                            (bootloader-configuration
-                             (inherit
-                              (operating-system-bootloader base-os))
-                             (bootloader grub-mkrescue-bootloader))
+            (bootloader (if (eq? format 'iso9660) '()
                             (operating-system-bootloader base-os)))
             (file-systems (cons (file-system
                                   (mount-point "/")
@@ -1007,17 +1011,28 @@ (define* (system-image image)
            (image* (image-with-os* image os))
            (image-format (image-format image))
            (register-closures? (has-guix-service-type? os))
-           (bootcfg (operating-system-bootcfg os))
-           (bootloader (bootloader-configuration-bootloader
-                        (operating-system-bootloader os))))
+           ;; force removable - images don't have efivarfs
+           (bootloader-config (map (lambda (c) (bootloader-configuration
+                                                 (inherit c)
+                                                 (efi-removable? #t)))
+                                (operating-system-bootloader os)))
+           (alt (boot-alternative
+                  (generation 1)
+                  (system-path "/var/guix/profiles/system-1-link")
+                  (epoch 0)
+                  (parameters (operating-system-boot-parameters os
+                                (partition-uuid (find-root-partition image*))
+                                #:system-kernel-arguments? #t))))
+           (bootmeta (cons* #:current-boot-alternative alt
+                            #:old-boot-alternatives '()
+                            (operating-system-bootmeta os))))
       (cond
        ((memq image-format '(disk-image compressed-qcow2))
          (system-disk-image image*
-                            #:bootcfg bootcfg
-                            #:bootloader bootloader
+                            #:bootloader-config bootloader-config
+                            #:bootmeta bootmeta
                             #:register-closures? register-closures?
-                            #:inputs `(("system" ,os)
-                                       ("bootcfg" ,bootcfg))))
+                            #:inputs `(("system" ,os))))
        ((memq image-format '(docker))
         (system-docker-image image*))
        ((memq image-format '(tarball))
@@ -1027,11 +1042,10 @@ (define* (system-image image)
        ((memq image-format '(iso9660))
          (system-iso9660-image
           image*
-          #:bootcfg bootcfg
-          #:bootloader bootloader
+          #:bootloader-config bootloader-config
+          #:bootmeta bootmeta
           #:register-closures? register-closures?
-          #:inputs `(("system" ,os)
-                     ("bootcfg" ,bootcfg))
+          #:inputs `(("system" ,os))
           ;; Make sure to use a mode that does no imply
           ;; HFS+ tree creation that may fail with:
           ;;
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index 9b618f7dc6..8fb00a6903 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -41,9 +41,7 @@ (define-module (gnu system images hurd)
 (define hurd-barebones-os
   (operating-system
     (inherit %hurd-default-operating-system)
-    (bootloader (bootloader-configuration
-                 (bootloader grub-minimal-bootloader)
-                 (targets '("/dev/sdX"))))
+    (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader)))
     (file-systems (cons (file-system
                           (device (file-system-label "my-root"))
                           (mount-point "/")
diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm
index 810e2bed5f..a7a1f499dd 100644
--- a/gnu/system/images/novena.scm
+++ b/gnu/system/images/novena.scm
@@ -39,8 +39,7 @@ (define novena-barebones-os
     (timezone "Europe/Paris")
     (locale "en_US.utf8")
     (bootloader (bootloader-configuration
-                 (bootloader u-boot-novena-bootloader)
-                 (targets '("/dev/vda"))))
+                 (bootloader u-boot-novena-bootloader)))
     (initrd-modules '())
     (kernel linux-libre-arm-generic)
     (kernel-arguments '("console=ttymxc1,115200"))
diff --git a/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm b/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
index 6ec644f113..a3dae24377 100644
--- a/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
+++ b/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
@@ -39,8 +39,7 @@ (define orangepi-r1-plus-lts-rk3328-barebones-os
     (timezone "Europe/Amsterdam")
     (locale "en_US.utf8")
     (bootloader (bootloader-configuration
-                  (bootloader u-boot-orangepi-r1-plus-lts-rk3328-bootloader)
-                  (targets '("/dev/mmcblk0"))))
+                  (bootloader u-boot-orangepi-r1-plus-lts-rk3328-bootloader)))
     (initrd-modules '())
     (kernel linux-libre-arm64-generic)
     (file-systems (cons (file-system
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
index 457ff4345f..b166838ddd 100644
--- a/gnu/system/images/pine64.scm
+++ b/gnu/system/images/pine64.scm
@@ -41,8 +41,7 @@ (define pine64-barebones-os
     (timezone "Europe/Paris")
     (locale "en_US.utf8")
     (bootloader (bootloader-configuration
-                 (bootloader u-boot-pine64-lts-bootloader)
-                 (targets '("/dev/vda"))))
+                 (bootloader u-boot-pine64-lts-bootloader)))
     (initrd-modules '())
     (kernel linux-libre-arm64-generic)
     (file-systems (cons (file-system
diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm
index 3a0f3abf1f..b26adfb7b9 100644
--- a/gnu/system/images/pinebook-pro.scm
+++ b/gnu/system/images/pinebook-pro.scm
@@ -38,8 +38,7 @@ (define pinebook-pro-barebones-os
     (timezone "Europe/Paris")
     (locale "en_US.utf8")
     (bootloader (bootloader-configuration
-                 (bootloader u-boot-pinebook-pro-rk3399-bootloader)
-                 (targets '("/dev/vda"))))
+                 (bootloader u-boot-pinebook-pro-rk3399-bootloader)))
     (initrd-modules '())
     (kernel linux-libre-arm64-generic)
     (file-systems (cons (file-system
diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm
index b3dcfc6193..0b243662d6 100644
--- a/gnu/system/images/rock64.scm
+++ b/gnu/system/images/rock64.scm
@@ -39,8 +39,7 @@ (define rock64-barebones-os
     (timezone "Europe/Oslo")
     (locale "en_US.utf8")
     (bootloader (bootloader-configuration
-                 (bootloader u-boot-rock64-rk3328-bootloader)
-                 (targets '("/dev/sda"))))
+                 (bootloader u-boot-rock64-rk3328-bootloader)))
     (initrd-modules '())
     (kernel linux-libre-arm64-generic)
     (file-systems (cons (file-system
diff --git a/gnu/system/images/unmatched.scm b/gnu/system/images/unmatched.scm
index d40a32f184..7eb147bbab 100644
--- a/gnu/system/images/unmatched.scm
+++ b/gnu/system/images/unmatched.scm
@@ -39,8 +39,7 @@ (define unmatched-barebones-os
     (timezone "Asia/Jerusalem")
     (locale "en_US.utf8")
     (bootloader (bootloader-configuration
-                 (bootloader u-boot-sifive-unmatched-bootloader)
-                 (targets '("/dev/vda"))))
+                 (bootloader u-boot-sifive-unmatched-bootloader)))
     (initrd-modules '())
     (kernel linux-libre-riscv64-generic)
     (file-systems (cons (file-system
diff --git a/gnu/system/images/visionfive2.scm b/gnu/system/images/visionfive2.scm
index 26f70afbc1..a1c0733692 100644
--- a/gnu/system/images/visionfive2.scm
+++ b/gnu/system/images/visionfive2.scm
@@ -62,8 +62,7 @@ (define visionfive2-barebones-os
     (timezone "Etc/UTC")
     (locale "en_US.utf8")
     (bootloader (bootloader-configuration
-                 (bootloader u-boot-starfive-visionfive2-bootloader)
-                 (targets '("/dev/mmcblk0"))))
+                  (bootloader u-boot-starfive-visionfive2-bootloader)))
     (file-systems (cons (file-system
                           (device (file-system-label "Guix_image"))
                           (mount-point "/")
diff --git a/gnu/system/images/wsl2.scm b/gnu/system/images/wsl2.scm
index d9aaa1a271..1501cb9a90 100644
--- a/gnu/system/images/wsl2.scm
+++ b/gnu/system/images/wsl2.scm
@@ -127,16 +127,6 @@ (define dummy-package
     (description #f)
     (license (fsdg-compatible "dummy"))))
 
-(define dummy-bootloader
-  (bootloader
-   (name 'dummy-bootloader)
-   (package dummy-package)
-   (configuration-file "/dev/null")
-   (configuration-file-generator
-    (lambda (. _rest)
-      (plain-file "dummy-bootloader" "")))
-   (installer #~(const #t))))
-
 (define dummy-kernel dummy-package)
 
 (define (dummy-initrd . _rest)
@@ -146,9 +136,7 @@ (define-public wsl-os
   (operating-system
     (host-name "gnu")
     (timezone "Etc/UTC")
-    (bootloader
-     (bootloader-configuration
-      (bootloader dummy-bootloader)))
+    ;; no bootloader
     (kernel dummy-kernel)
     (initrd dummy-initrd)
     (initrd-modules '())
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 0195a0804d..e76d12e95a 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -77,8 +77,7 @@ (define-module (gnu system install)
             rock64-installation-os
             rockpro64-installation-os
             rk3399-puma-installation-os
-            wandboard-installation-os
-            os-with-u-boot))
+            wandboard-installation-os))
 
 ;;; Commentary:
 ;;;
@@ -503,9 +502,7 @@ (define installation-os
     (timezone "Europe/Paris")
     (locale "en_US.utf8")
     (name-service-switch %mdns-host-lookup-nss)
-    (bootloader (bootloader-configuration
-                 (bootloader grub-bootloader)
-                 (targets '("/dev/sda"))))
+    (bootloader (bootloader-configuration (bootloader grub-bootloader)))
     (label (string-append "GNU Guix installation "
                           (or (getenv "GUIX_DISPLAYED_VERSION")
                               (package-version guix))))
@@ -555,30 +552,14 @@ (define installation-os
                 %installer-disk-utilities
                 %base-packages))))
 
-(define* (os-with-u-boot os board #:key (bootloader-target "/dev/mmcblk0")
-                         (triplet "arm-linux-gnueabihf"))
-  "Given OS, amend it with the u-boot bootloader for BOARD,
-installed to BOOTLOADER-TARGET (a drive), compiled for TRIPLET.
-
-If you want a serial console, make sure to specify one in your
-operating-system's kernel-arguments (\"console=ttyS0\" or similar)."
-  (operating-system (inherit os)
-    (bootloader (bootloader-configuration
-                 (bootloader (bootloader (inherit u-boot-bootloader)
-                              (package (make-u-boot-package board triplet))))
-                 (targets (list bootloader-target))))))
-
-(define* (embedded-installation-os bootloader bootloader-target tty
-                                   #:key (extra-modules '()))
+(define* (embedded-installation-os bootloader tty #:key (extra-modules '()))
   "Return an installation os for embedded systems.
 The initrd gets the extra modules EXTRA-MODULES.
 A getty is provided on TTY.
 The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET."
   (operating-system
     (inherit installation-os)
-    (bootloader (bootloader-configuration
-                 (bootloader bootloader)
-                 (targets (list bootloader-target))))
+    (bootloader (bootloader-configuration (bootloader bootloader)))
     (kernel linux-libre)
     (kernel-arguments
      (cons (string-append "console=" tty)
@@ -587,7 +568,6 @@ (define* (embedded-installation-os bootloader bootloader-target tty
 
 (define beaglebone-black-installation-os
   (embedded-installation-os u-boot-beaglebone-black-bootloader
-                            "/dev/sda"
                             "ttyO0"
                             #:extra-modules
                             ;; This module is required to mount the sd card.
@@ -596,77 +576,62 @@ (define beaglebone-black-installation-os
 
 (define a20-olinuxino-lime-installation-os
   (embedded-installation-os u-boot-a20-olinuxino-lime-bootloader
-                            "/dev/mmcblk0" ; SD card storage
                             "ttyS0"))
 
 (define a20-olinuxino-lime2-emmc-installation-os
   (embedded-installation-os u-boot-a20-olinuxino-lime2-bootloader
-                            "/dev/mmcblk1" ; eMMC storage
                             "ttyS0"))
 
 (define a20-olinuxino-micro-installation-os
   (embedded-installation-os u-boot-a20-olinuxino-micro-bootloader
-                            "/dev/mmcblk0" ; SD card storage
                             "ttyS0"))
 
 (define bananapi-m2-ultra-installation-os
   (embedded-installation-os u-boot-bananapi-m2-ultra-bootloader
-                            "/dev/mmcblk1" ; eMMC storage
                             "ttyS0"))
 
 (define firefly-rk3399-installation-os
   (embedded-installation-os u-boot-firefly-rk3399-bootloader
-                            "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
                             "ttyS2")) ; UART2 connected on the Pi2 bus
 
 (define mx6cuboxi-installation-os
   (embedded-installation-os u-boot-mx6cuboxi-bootloader
-                            "/dev/mmcblk0" ; SD card storage
                             "ttymxc0"))
 
 (define novena-installation-os
   (embedded-installation-os u-boot-novena-bootloader
-                            "/dev/mmcblk1" ; SD card storage
                             "ttymxc1"))
 
 (define nintendo-nes-classic-edition-installation-os
   (embedded-installation-os u-boot-nintendo-nes-classic-edition-bootloader
-                            "/dev/mmcblk0" ; SD card (solder it yourself)
                             "ttyS0"))
 
 (define orangepi-r1-plus-lts-rk3328-installation-os
   (embedded-installation-os u-boot-orangepi-r1-plus-lts-rk3328-bootloader
-                            "/dev/mmcblk0" ; SD card storage
                             "ttyS0"))
 
 (define pine64-plus-installation-os
   (embedded-installation-os u-boot-pine64-plus-bootloader
-                            "/dev/mmcblk0" ; SD card storage
                             "ttyS0"))
 
 (define pinebook-installation-os
   (embedded-installation-os u-boot-pinebook-bootloader
-                            "/dev/mmcblk0" ; SD card storage
                             "ttyS0"))
 
 (define rock64-installation-os
   (embedded-installation-os u-boot-rock64-rk3328-bootloader
-                            "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
                             "ttyS2")) ; UART2 connected on the Pi2 bus
 
 (define rockpro64-installation-os
   (embedded-installation-os u-boot-rockpro64-rk3399-bootloader
-                            "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
                             "ttyS2")) ; UART2 connected on the Pi2 bus
 
 (define rk3399-puma-installation-os
   (embedded-installation-os u-boot-puma-rk3399-bootloader
-                            "/dev/mmcblk0" ; SD card storage
                             "ttyS0"))
 
 (define wandboard-installation-os
   (embedded-installation-os u-boot-wandboard-bootloader
-                            "/dev/mmcblk0" ; SD card storage
                             "ttymxc0"))
 
 ;; Return the default os here so 'guix system' can consume it directly.
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index a2743453e7..be12ae6b6c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -172,17 +172,6 @@ (define* (virtualized-operating-system os
 
   (operating-system
     (inherit os)
-    ;; XXX: Until we run QEMU with UEFI support (with the OVMF firmware),
-    ;; force the traditional i386/BIOS method.
-    ;; See <https://bugs.gnu.org/28768>.
-    (bootloader (bootloader-configuration
-                 (inherit (operating-system-bootloader os))
-                 (bootloader
-                  (if (target-riscv64? (or target system))
-                      u-boot-qemu-riscv64-bootloader
-                      grub-bootloader))
-                 (targets '("/dev/vda"))))
-
     (initrd (lambda (file-systems . rest)
               (apply (operating-system-initrd os)
                      file-systems
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 36dbd9111f..18a2fc119b 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -140,7 +140,7 @@ (define-os-with-source (%minimal-extlinux-os
     (locale "en_US.UTF-8")
 
     (bootloader (bootloader-configuration
-                 (bootloader extlinux-bootloader-gpt)
+                 (bootloader extlinux-gpt-bootloader)
                  (targets (list "/dev/vdb"))))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons (file-system
@@ -1464,9 +1464,11 @@ (define-os-with-source (%btrfs-raid10-root-os
     (host-name "hurd")
     (timezone "Europe/Paris")
     (locale "en_US.UTF-8")
-    (bootloader (bootloader-configuration
-                 (bootloader grub-bootloader)
-                 (targets (list "/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde"))))
+    (bootloader (map (lambda (targ)
+                       (bootloader-configuration
+                         (bootloader grub-bootloader)
+                         (targets (list targ))))
+                     '("/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde")))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons* (file-system
                            (device (uuid "16ff18e2-eb41-4324-8df5-80d3b53c411b"))
diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm
index bcc7645fa3..8aa5311171 100644
--- a/gnu/tests/reconfigure.scm
+++ b/gnu/tests/reconfigure.scm
@@ -30,8 +30,7 @@ (define-module (gnu tests reconfigure)
   #:use-module (guix scripts system reconfigure)
   #:use-module (guix store)
   #:export (%test-switch-to-system
-            %test-upgrade-services
-            %test-install-bootloader))
+            %test-upgrade-services))
 
 ;;; Commentary:
 ;;;
@@ -178,83 +177,6 @@ (define* (run-upgrade-services-test)
           (disable (upgrade-services-program '() '() '(dummy) '())))
      (test enable disable))))
 
-(define* (run-install-bootloader-test)
-  "Run a test of an OS running INSTALL-BOOTLOADER-PROGRAM, which installs a
-bootloader's configuration file."
-  (define os
-    (marionette-operating-system
-     (simple-operating-system)
-     #:imported-modules '((gnu services herd)
-                          (guix combinators))))
-
-  (define vm (virtual-machine
-              (operating-system os)
-              (volatile? #f)))
-
-  (define (test script)
-    (with-imported-modules '((gnu build marionette))
-      #~(begin
-          (use-modules (gnu build marionette)
-                       (ice-9 regex)
-                       (srfi srfi-1)
-                       (srfi srfi-64))
-
-          (define marionette
-            (make-marionette (list #$vm)))
-
-          ;; Return the system generation paths that have GRUB menu entries.
-          (define (generations-in-grub-cfg marionette)
-            (let ((grub-cfg (marionette-eval
-                             '(begin
-                                (use-modules (rnrs io ports))
-                                (call-with-input-file "/boot/grub/grub.cfg"
-                                  get-string-all))
-                             marionette)))
-              (map (lambda (parameter)
-                     (second (string-split (match:substring parameter) #\=)))
-                   (list-matches "system=[^ ]*" grub-cfg))))
-
-          (test-runner-current (system-test-runner #$output))
-          (test-begin "install-bootloader")
-
-          (test-assert "no prior menu entry for system generation"
-            (not (member #$os (generations-in-grub-cfg marionette))))
-
-          (test-assert "script successfully evaluated"
-            (marionette-eval
-             '(primitive-load #$script)
-             marionette))
-
-          (test-assert "menu entry created for system generation"
-            (member #$os (generations-in-grub-cfg marionette)))
-
-          (test-end))))
-
-  (let* ((bootloader ((compose bootloader-configuration-bootloader
-                               operating-system-bootloader)
-                      os))
-         ;; The typical use-case for 'install-bootloader-program' is to read
-         ;; the boot parameters for the existing menu entries on the system,
-         ;; parse them with 'boot-parameters->menu-entry', and pass the
-         ;; results to 'operating-system-bootcfg'. However, to obtain boot
-         ;; parameters, we would need to start the marionette, which we should
-         ;; ideally avoid doing outside of the 'test' G-Expression. Thus, we
-         ;; generate a bootloader configuration for the script as if there
-         ;; were no existing menu entries. In the grand scheme of things, this
-         ;; matters little -- these tests should not make assertions about the
-         ;; behavior of 'operating-system-bootcfg'.
-         (bootcfg (operating-system-bootcfg os '()))
-         (bootcfg-file (bootloader-configuration-file bootloader)))
-    (gexp->derivation
-     "install-bootloader"
-     ;; Due to the read-only nature of the virtual machines used in the system
-     ;; test suite, the bootloader installer script is omitted. 'grub-install'
-     ;; would attempt to write directly to the virtual disk if the
-     ;; installation script were run.
-     (test
-      (install-bootloader-program #f #f #f bootcfg bootcfg-file '(#f) "/")))))
-
-
 (define %test-switch-to-system
   (system-test
    (name "switch-to-system")
@@ -267,9 +189,3 @@ (define %test-upgrade-services
    (description "Upgrade the Shepherd by unloading obsolete services and
 loading new services.")
    (value (run-upgrade-services-test))))
-
-(define %test-install-bootloader
-  (system-test
-   (name "install-bootloader")
-   (description "Install a bootloader and its configuration file.")
-   (value (run-install-bootloader-test))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 344bb74151..aba637f6e3 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -209,7 +209,7 @@ (define* (copy-closure item target
 
 (define* (install os-drv target
                   #:key (log-port (current-output-port))
-                  install-bootloader? bootloader bootcfg)
+                  install-bootloader? bootloaders bootmeta)
   "Copy the closure of BOOTCFG, which includes the output of OS-DRV, to
 directory TARGET.  TARGET must be an absolute directory name since that's what
 'register-path' expects.
@@ -247,24 +247,27 @@ (define* (install os-drv target
   (chmod target #o755)
   (let ((os-dir   (derivation->output-path os-drv))
         (format   (lift format %store-monad))
-        (populate (lift2 populate-root-file-system %store-monad)))
-
-    (mlet %store-monad ((bootcfg (lower-object bootcfg)))
-      (mbegin %store-monad
-        ;; Copy the closure of BOOTCFG, which includes OS-DIR,
-        ;; eventual background image and so on.
-        (maybe-copy (derivation->output-path bootcfg))
-
-        ;; Create a bunch of additional files.
-        (format log-port "populating '~a'...~%" target)
-        (populate os-dir target)
-
+        (populate (lift2 populate-root-file-system %store-monad))
+        (profile  (string-append target "/var/guix/profiles/system")))
+
+    (mbegin %store-monad
+      ;; Create a bunch of system files.
+      (format log-port "populating '~a'...~%" target)
+      (populate os-dir target)
+
+      ;; Copy the bootloader's closure, which includes OS-DIR,
+      ;; eventual background image and so on.
+      (mlet* %store-monad
+             ((alt -> (generation->boot-alternative profile 1))
+              (inst (apply install-bootloader local-eval bootloaders
+                      (list alt) #:dry-run (not install-bootloader?)
+                      #:root-offset target bootmeta)))
+        (maybe-copy (derivation->output-path inst)))
         (mwhen install-bootloader?
-          (install-bootloader local-eval bootloader bootcfg
-                              #:target target)
           (return
            (info (G_ "bootloader successfully installed on~{ ~a~}~%")
-                 (bootloader-configuration-targets bootloader))))))))
+                 (fold append '()
+                   (map bootloader-configuration-targets bootloaders))))))))
 
 
 ;;;
@@ -389,20 +392,13 @@ (define (install-bootloader-from-provenance store number)
   (let* ((generation (generation-file-name %system-profile number))
          (os (receive (_ os) (system-provenance generation)
                       (and=> os read-operating-system)))
-         (bootloader-config (operating-system-bootloader os))
-         (bootloader (bootloader-configuration-bootloader bootloader-config))
+         (new (generation->boot-alternative %system-profile number))
          (numbers (delv number (reverse (generation-numbers %system-profile))))
          (old (profile->boot-alternatives %system-profile numbers)))
     (if os
       (run-with-store store
-        (mlet* %store-monad
-            ((bootcfg (lower-object (operating-system-bootcfg os old)))
-             (drvs -> (list bootcfg)))
-          (mbegin %store-monad
-            (built-derivations drvs)
-            ;; Only install bootloader configuration file.
-            (install-bootloader local-eval bootloader-config bootcfg
-                                #:run-installer? #f))))
+        (apply install-bootloader local-eval (operating-system-bootloader os)
+          (cons new old) (operating-system-bootmeta os)))
       (leave (G_ "cannot rollback to provenanceless generation '~a'~%")
         number))))
 
@@ -489,7 +485,8 @@ (define* (display-system-generation number
       (format #t (G_ "  canonical file name: ~a~%") (readlink* generation))
       ;; TRANSLATORS: Please preserve the two-space indentation.
       (format #t (G_ "  label: ~a~%") label)
-      (format #t (G_ "  bootloader: ~a~%") bootloader-name)
+      (format #t (G_ "  bootloader: ~a~%")
+        (string-join (map symbol->string bootloader-name)))
 
       ;; TRANSLATORS: The '~[', '~;', and '~]' sequences in this string must
       ;; be preserved.  They denote conditionals, such that the result will
@@ -775,18 +772,11 @@ (define* (perform-action action image
   (define os
     (image-operating-system image))
 
-  (define bootloader
+  (define bootloaders
     (operating-system-bootloader os))
 
-  (define bootcfg
-    (and (memq action '(init reconfigure))
-         (operating-system-bootcfg
-          os
-          (if (eq? action 'init)
-              '()
-              (map boot-parameters->menu-entry
-                   (map boot-alternative-parameters
-                        (profile->boot-alternatives)))))))
+  (define bootmeta
+    (operating-system-bootmeta os))
 
   (when (eq? action 'reconfigure)
     (maybe-suggest-running-guix-pull)
@@ -817,10 +807,7 @@ (define* (perform-action action image
        ;; For 'init' and 'reconfigure', always build BOOTCFG, even if
        ;; --no-bootloader is passed, because we then use it as a GC root.
        ;; See <http://bugs.gnu.org/21068>.
-       (drvs      (mapm/accumulate-builds lower-object
-                                          (if (memq action '(init reconfigure))
-                                              (list sys bootcfg)
-                                              (list sys))))
+       (drvs      (mapm/accumulate-builds lower-object (list sys)))
        (%         (if derivations-only?
                       (return (for-each (compose println derivation-file-name)
                                         drvs))
@@ -838,12 +825,16 @@ (define* (perform-action action image
              (format #t (G_ "activating system...~%"))
              (mbegin %store-monad
                (switch-to-system local-eval os)
+               (apply install-bootloader local-eval bootloaders
+                 (profile->boot-alternatives)
+                 #:dry-run? (not install-bootloader?)
+                 (if target (cons* #:root-offset target bootmeta) bootmeta))
                (mwhen install-bootloader?
-                 (install-bootloader local-eval bootloader bootcfg
-                                     #:target (or target "/"))
                  (return
                   (info (G_ "bootloader successfully installed on '~a'~%")
-                        (bootloader-configuration-targets bootloader))))
+                    (map bootloader-target-path
+                      (fold append '()
+                        (map bootloader-configuration-targets bootloaders))))))
                (with-shepherd-error-handling
                 (upgrade-shepherd-services local-eval os)
                 (return (format #t (G_ "\
@@ -857,8 +848,8 @@ (define* (perform-action action image
                      target)
              (install sys (canonicalize-path target)
                       #:install-bootloader? install-bootloader?
-                      #:bootloader bootloader
-                      #:bootcfg bootcfg))
+                      #:bootloaders bootloaders
+                      #:bootmeta bootmeta))
             (else
              ;; All we had to do was to build SYS and maybe register an
              ;; indirect GC root.
@@ -1254,11 +1245,7 @@ (define (process-action action args opts)
                             (G_ "image lacks an operating-system")))))
          (target-file (match args
                         ((first second) second)
-                        (_ #f)))
-         (bootloader-targets
-                      (and bootloader?
-                           (bootloader-configuration-targets
-                            (operating-system-bootloader os)))))
+                        (_ #f))))
 
     (define (graph-backend)
       (lookup-backend (assoc-ref opts 'graph-backend)))
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 604ba08fee..8add639e6a 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
 ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
 ;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -209,101 +210,83 @@ (define* (upgrade-shepherd-services eval os)
 ;;; Bootloader configuration.
 ;;;
 
-(define (install-bootloader-program installer disk-installer
-                                    bootloader-package bootcfg
-                                    bootcfg-file devices target)
+(define (install-bootloader-program configs offset chosen-alt old-alts locale
+                                    store-crypto-devices store-directory-prefix)
   "Return an executable store item that, upon being evaluated, will install
 BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICES, a list of file system
 devices, at TARGET, a mount point, and subsequently run INSTALLER from
 BOOTLOADER-PACKAGE."
   (program-file
-   "install-bootloader.scm"
-   (with-extensions (list guile-gcrypt)
-     (with-imported-modules `(,@(source-module-closure
-                                 '((gnu build bootloader)
-                                   (gnu build install)
-                                   (guix store)
-                                   (guix utils))
-                                 #:select? not-config?)
-                              ((guix config) => ,(make-config.scm)))
-       #~(begin
-           (use-modules (gnu build bootloader)
-                        (gnu build install)
-                        (guix build utils)
-                        (guix store)
-                        (guix utils)
-                        (ice-9 binary-ports)
-                        (ice-9 match)
-                        (srfi srfi-34)
-                        (srfi srfi-35))
-
-           (let* ((gc-root (string-append #$target %gc-roots-directory "/bootcfg"))
-                  (new-gc-root (string-append gc-root ".new")))
-             ;; #$bootcfg has dependencies.
-             ;; The bootloader magically loads the configuration from
-             ;; (string-append #$target #$bootcfg-file) (for example
-             ;; "/boot/grub/grub.cfg").
-             ;; If we didn't do something special, the garbage collector
-             ;; would remove the dependencies of #$bootcfg.
-             ;; Register #$bootcfg as a GC root.
-             ;; Preserve the previous activation's garbage collector root
-             ;; until the bootloader installer has run, so that a failure in
-             ;; the bootloader's installer script doesn't leave the user with
-             ;; a broken installation.
-             (switch-symlinks new-gc-root #$bootcfg)
-             (install-boot-config #$bootcfg #$bootcfg-file #$target)
-             (when (or #$installer #$disk-installer)
-               (catch #t
-                 (lambda ()
-                   ;; The bootloader might not support installation on a
-                   ;; mounted directory using the BOOTLOADER-INSTALLER
-                   ;; procedure. In that case, fallback to installing the
-                   ;; bootloader directly on DEVICES using the
-                   ;; BOOTLOADER-DISK-IMAGE-INSTALLER procedure.
-                   (if #$installer
-                       (for-each (lambda (device)
-                                   (#$installer #$bootloader-package device
-                                                #$target))
-                                 '#$devices)
-                       (for-each (lambda (device)
-                                   (#$disk-installer #$bootloader-package
-                                                     0 device))
-                                 '#$devices)))
-                 (lambda args
-                   (delete-file new-gc-root)
-                   (match args
-                     (('%exception exception)     ;Guile 3 SRFI-34 or similar
-                      (raise-exception exception))
-                     ((key . args)
-                      (apply throw key args))))))
-             ;; We are sure that the installation of the bootloader
-             ;; succeeded, so we can replace the old GC root by the new
-             ;; GC root now.
-             (rename-file new-gc-root gc-root)))))))
+    "install-bootloader.scm"
+    ;; three sources of boot entries: bootloader-configuration-menu-entries,
+    ;; current-boot-alternative, and old-boot-alternatives.
+    (let ((args (list #:current-boot-alternative chosen-alt
+                      #:old-boot-alternatives old-alts
+                      #:locale locale
+                      #:store-directory-prefix store-directory-prefix
+                      #:store-crypto-devices store-crypto-devices)))
+      (with-extensions (list guile-gcrypt)
+        (with-imported-modules
+          `(,@(source-module-closure '((gnu build bootloader)
+                                       (gnu build install)
+                                       (guix store)
+                                       (guix utils))
+                                     #:select? not-config?)
+            ((guix config) => ,(make-config.scm)))
+          #~(begin
+              (use-modules (gnu build bootloader)
+                           (gnu build install)
+                           (guix build utils)
+                           (guix store)
+                           (guix utils)
+                           (ice-9 binary-ports)
+                           (ice-9 match)
+                           (srfi srfi-34)
+                           (srfi srfi-35))
+              ;; bootloader-installer is passed an additional #:target argument
+              ;; denoting the specific target currently being installed to.
+              ;; bootloaders should determine when to fully reinstall themselves.
+              #$(bootloader-configurations->gexp configs args
+                                                 #:root-offset offset)))))))
 
-(define* (install-bootloader eval configuration bootcfg
-                             #:key
-                             (run-installer? #t)
-                             (target "/"))
+(define* (install-bootloader eval configs alts #:key locale
+                             store-crypto-devices store-directory-prefix
+                             (root-offset "/") (dry-run? #f))
   "Using EVAL, a monadic procedure taking a single G-Expression as an argument,
-configure the bootloader on TARGET such that OS will be booted by default and
-additional configurations specified by MENU-ENTRIES can be selected."
-  (let* ((bootloader (bootloader-configuration-bootloader configuration))
-         (installer (and run-installer?
-                         (bootloader-installer bootloader)))
-         (disk-installer (and run-installer?
-                              (bootloader-disk-image-installer bootloader)))
-         (package (bootloader-package bootloader))
-         (devices (bootloader-configuration-targets configuration))
-         (bootcfg-file (bootloader-configuration-file bootloader)))
-    (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
-              (primitive-load #$(install-bootloader-program installer
-                                                            disk-installer
-                                                            package
-                                                            bootcfg
-                                                            bootcfg-file
-                                                            devices
-                                                            target))))))
+configure the bootloader with bootloader-configuration CONFIG such that
+ALTS may be selected, with the first element being the default.  If QUICK? only
+the bootloader config is reinstalled.  Returns the config installer drv."
+  (mlet* %store-monad
+         ((program (lower-object
+                     (install-bootloader-program configs root-offset
+                       (car alts) (cdr alts) locale
+                       store-crypto-devices store-directory-prefix))))
+    (mbegin %store-monad
+      (eval
+        (with-imported-modules `(,@(source-module-closure '((guix build utils)
+                                                            (guix store))
+                                                          #:select? not-config?)
+                                 ((guix config) => ,(make-config.scm)))
+          #~(begin
+              (use-modules (guix build utils) (guix store))
+              (parameterize ((current-warning-port (%make-void-port "w")))
+                (let* ((gc-root (string-append
+                                  #$root-offset %gc-roots-directory "/bootcfg"))
+                       (new-gc-root (string-append gc-root ".new")))
+                  ;; since the installers are gexps directly included, we add
+                  ;; the installer runner as a gc root.  this should make sure
+                  ;; no bootloader files get gc'd.  only remove the old one on
+                  ;; success.
+                  ;; XXX: is this still necessary?
+                  (switch-symlinks new-gc-root #$program)
+                  (dynamic-wind (const #t)
+                    (lambda ()
+                      (unless #$dry-run? (primitive-load #$program))
+                      (rename-file new-gc-root gc-root))
+                    (lambda () ; delete new root if failed
+                      (when (file-exists? new-gc-root)
+                        (delete-file new-gc-root)))))))))
+      (return program))))
 
 
 ;;;
