18/18: DRAFT system: vm: More cross-build fixes via IRC

[guix-commits]

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

commit 9d9195d8c9e1059206ad209e7f7d9efa53780684
Author: Jan (janneke) Nieuwenhuizen <address@hidden>
AuthorDate: Fri May 15 18:35:36 2020 +0200

    DRAFT system: vm: More cross-build fixes via IRC
---
 gnu/bootloader/grub.scm |  4 ++--
 gnu/system/vm.scm       | 35 +++++++++++++++++++++++------------
 2 files changed, 25 insertions(+), 14 deletions(-)

diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index d9f7199..4e939ac 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -212,8 +212,8 @@ else
   set menu_color_highlight=white/blue
 fi~%"
                  #$setup-gfxterm-body
-                 #$(grub-root-search store-device font-file)
-                 #$(setup-gfxterm config font-file)
+                 #+(grub-root-search store-device font-file)
+                 #+(setup-gfxterm config font-file)
                  #$(grub-setup-io config)
 
                  #$(strip-mount-point store-mount-point image)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 524121c..832c7cb 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -182,19 +182,30 @@ made available under the /xchg CIFS share.
 SUBSTITUTABLE? determines whether the returned derivation should be marked as
 substitutable."
   (define user-builder
-    (program-file "builder-in-linux-vm" exp))
+    (scheme-file "builder-in-linux-vm" exp))
+
+  (define (preserve-target obj)
+    (if target
+        (with-parameters ((%current-target-system target))
+          obj)
+        obj))
 
   (define loader
-    ;; Invoke USER-BUILDER instead using 'primitive-load'.  The reason for
-    ;; this is to allow USER-BUILDER to dlopen stuff by using a full-featured
-    ;; Guile, which it couldn't do using the statically-linked guile used in
-    ;; the initrd.  See example at
+    ;; Instead of using 'primitive-load', evaluate USER-BUILDER in a
+    ;; full-featured Guile so it can use dlopen stuff, which it couldn't do
+    ;; using the statically-linked guile used in the initrd.  See example at
     ;; <https://lists.gnu.org/archive/html/guix-devel/2017-10/msg00233.html>.
     (program-file "linux-vm-loader"
-                  ;; Communicate USER-BUILDER's exit status via /xchg so that
-                  ;; the host can distinguish between success, failure, and
-                  ;; kernel panic.
-                  #~(let ((status (system* #$user-builder)))
+                  ;; When cross-compiling, USER-BUILDER refers to the target
+                  ;; (cross-compiled) system.  Preserve that, even though
+                  ;; LOADER itself is executed as a native program.
+                  #~(let ((status (system* #+(file-append (default-guile)
+                                                          "/bin/guile")
+                                           "--no-auto-compile"
+                                           #$(preserve-target user-builder))))
+                      ;; Communicate USER-BUILDER's exit status via /xchg so
+                      ;; that the host can distinguish between success,
+                      ;; failure, and kernel panic.
                       (call-with-output-file "/xchg/.exit-status"
                         (lambda (port)
                           (write status port)))
@@ -247,7 +258,7 @@ substitutable."
                 (load-in-linux-vm loader
                                   #:output #$output
                                   #:linux linux #:initrd initrd
-                                  #:qemu (qemu-command target)
+                                  #:qemu (qemu-command)
                                   #:memory-size #$memory-size
                                   #:make-disk-image? #$make-disk-image?
                                   #:single-file-output? #$single-file-output?
@@ -428,12 +439,12 @@ system that is passed to 'populate-root-file-system'."
                                      #:partitions partitions
                                      #:grub-efi grub-efi
                                      #:bootloader-package
-                                     #$(bootloader-package bootloader)
+                                     #+(bootloader-package bootloader)
                                      #:bootcfg #$bootcfg-drv
                                      #:bootcfg-location
                                      #$(bootloader-configuration-file 
bootloader)
                                      #:bootloader-installer
-                                     #$(bootloader-installer bootloader)))))))
+                                     #+(bootloader-installer bootloader)))))))
    #:system system
    #:target target
    #:make-disk-image? #t