From d5073fd113c621fe0b55382f7dd336ee118e759f Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Mon, 30 Aug 2021 18:24:27 +0200
Subject: gnu: Add platform support.

* gnu/platform.scm: New file.
* gnu/platforms/arm.scm: Ditto.
* gnu/platforms/hurd.scm: Ditto.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add them.

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
---
 gnu/system/image.scm               | 51 +++++++++++++++++++++++---------------
 gnu/system/images/hurd.scm         |  8 +++---
 gnu/system/images/novena.scm       |  6 +++--
 gnu/system/images/pine64.scm       |  6 +++--
 gnu/system/images/pinebook-pro.scm |  6 +++--
 gnu/system/images/rock64.scm       |  8 ++++--
 6 files changed, 54 insertions(+), 31 deletions(-)

(limited to 'gnu/system')

diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 1012fa6158..7a807b8226 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -31,6 +31,7 @@
   #:use-module (gnu bootloader)
   #:use-module (gnu bootloader grub)
   #:use-module (gnu image)
+  #:use-module (gnu platform)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
@@ -66,16 +67,14 @@
 
             efi-disk-image
             iso9660-image
-            arm32-disk-image
-            arm64-disk-image
+            raw-with-offset-disk-image
 
             image-with-os
             efi-raw-image-type
             qcow2-image-type
             iso-image-type
             uncompressed-iso-image-type
-            arm32-image-type
-            arm64-image-type
+            raw-with-offset-image-type
 
             image-with-label
             system-image
@@ -128,10 +127,9 @@
            (label "GUIX_IMAGE")
            (flags '(boot)))))))
 
-(define* (arm32-disk-image #:optional (offset root-offset))
+(define* (raw-with-offset-disk-image #:optional (offset root-offset))
   (image
    (format 'disk-image)
-   (target "arm-linux-gnueabihf")
    (partitions
     (list (partition
            (inherit root-partition)
@@ -140,11 +138,6 @@
    ;; fails.
    (volatile-root? #f)))
 
-(define* (arm64-disk-image #:optional (offset root-offset))
-  (image
-   (inherit (arm32-disk-image offset))
-   (target "aarch64-linux-gnu")))
-
 
 ;;;
 ;;; Images types.
@@ -186,15 +179,10 @@ set to the given OS."
                   (compression? #f))
                  <>))))
 
-(define arm32-image-type
-  (image-type
-   (name 'arm32-raw)
-   (constructor (cut image-with-os (arm32-disk-image) <>))))
-
-(define arm64-image-type
+(define raw-with-offset-image-type
   (image-type
-   (name 'arm64-raw)
-   (constructor (cut image-with-os (arm64-disk-image) <>))))
+   (name 'raw-with-offset)
+   (constructor (cut image-with-os (raw-with-offset-disk-image) <>))))
 
 
 ;;
@@ -615,7 +603,30 @@ it can be used for bootloading."
   "Return the derivation of IMAGE.  It can be a raw disk-image or an ISO9660
 image, depending on IMAGE format."
   (define substitutable? (image-substitutable? image))
-  (define target (image-target image))
+  (define platform (image-platform image))
+
+  ;; The image platform definition may provide the appropriate "system"
+  ;; architecture for the image.  If we are already running on this system,
+  ;; the image can be built natively.  If we are running on a different
+  ;; system, then we need to cross-compile, using the "target" provided by the
+  ;; image definition.
+  (define system (and=> platform platform-system))
+  (define target (cond
+                  ;; No defined platform, let's use the user defined
+                  ;; system/target parameters.
+                  ((not platform)
+                   (%current-target-system))
+                  ;; The current system is the same as the platform system, no
+                  ;; need to cross-compile.
+                  ((and system
+                        (string=? system (%current-system)))
+                   #f)
+                  ;; If there is a user defined target let's override the
+                  ;; platform target. Otherwise, we can cross-compile to the
+                  ;; platform target.
+                  (else
+                   (or (%current-target-system)
+                       (and=> platform platform-target)))))
 
   (with-parameters ((%current-target-system target))
     (let* ((os (operating-system-for-image image))
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index fc2dbe3209..77f7ff5e2b 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -23,6 +23,7 @@
   #:use-module (gnu bootloader grub)
   #:use-module (gnu image)
   #:use-module (gnu packages ssh)
+  #:use-module (gnu platforms hurd)
   #:use-module (gnu services)
   #:use-module (gnu services ssh)
   #:use-module (gnu system)
@@ -75,7 +76,6 @@
 (define hurd-disk-image
   (image
    (format 'disk-image)
-   (target "i586-pc-gnu")
    (partitions
     (list (partition
            (size 'guess)
@@ -103,13 +103,15 @@
 (define hurd-barebones-disk-image
   (image
    (inherit
-    (os->image hurd-barebones-os #:type hurd-image-type))
+    (os+platform->image hurd-barebones-os hurd
+                        #:type hurd-image-type))
    (name 'hurd-barebones-disk-image)))
 
 (define hurd-barebones-qcow2-image
   (image
    (inherit
-    (os->image hurd-barebones-os #:type hurd-qcow2-image-type))
+    (os+platform->image hurd-barebones-os hurd
+                        #:type hurd-qcow2-image-type))
    (name 'hurd-barebones.qcow2)))
 
 ;; Return the default image.
diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm
index 63227af509..3ce62fbf3b 100644
--- a/gnu/system/images/novena.scm
+++ b/gnu/system/images/novena.scm
@@ -22,6 +22,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
+  #:use-module (gnu platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
@@ -52,12 +53,13 @@
 (define novena-image-type
   (image-type
    (name 'novena-raw)
-   (constructor (cut image-with-os (arm32-disk-image) <>))))
+   (constructor (cut image-with-os (raw-with-offset-disk-image) <>))))
 
 (define novena-barebones-raw-image
   (image
    (inherit
-    (os->image novena-barebones-os #:type novena-image-type))
+    (os+platform->image novena-barebones-os armv7-linux
+                        #:type novena-image-type))
    (name 'novena-barebones-raw-image)))
 
 ;; Return the default image.
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
index 808c71295f..aaec458766 100644
--- a/gnu/system/images/pine64.scm
+++ b/gnu/system/images/pine64.scm
@@ -21,6 +21,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
+  #:use-module (gnu platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
@@ -57,12 +58,13 @@
 (define pine64-image-type
   (image-type
    (name 'pine64-raw)
-   (constructor (cut image-with-os (arm64-disk-image) <>))))
+   (constructor (cut image-with-os (raw-with-offset-disk-image) <>))))
 
 (define pine64-barebones-raw-image
   (image
    (inherit
-    (os->image pine64-barebones-os #:type pine64-image-type))
+    (os+platform->image pine64-barebones-os aarch64-linux
+                        #:type pine64-image-type))
    (name 'pine64-barebones-raw-image)))
 
 ;; Return the default image.
diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm
index b6b844cef6..1bfac7a8bb 100644
--- a/gnu/system/images/pinebook-pro.scm
+++ b/gnu/system/images/pinebook-pro.scm
@@ -21,6 +21,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
+  #:use-module (gnu platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
@@ -58,13 +59,14 @@
   (image-type
    (name 'pinebook-pro-raw)
    (constructor (cut image-with-os
-                     (arm64-disk-image (* 9 (expt 2 20))) ;9MiB
+                     (raw-with-offset-disk-image (* 9 (expt 2 20))) ;9MiB
                      <>))))
 
 (define pinebook-pro-barebones-raw-image
   (image
    (inherit
-    (os->image pinebook-pro-barebones-os #:type pinebook-pro-image-type))
+    (os+platform->image pinebook-pro-barebones-os aarch64-linux
+                        #:type pinebook-pro-image-type))
    (name 'pinebook-pro-barebones-raw-image)))
 
 ;; Return the default image.
diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm
index 68d3742adc..d25d55e528 100644
--- a/gnu/system/images/rock64.scm
+++ b/gnu/system/images/rock64.scm
@@ -21,6 +21,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
+  #:use-module (gnu platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu services networking)
@@ -53,12 +54,15 @@
 (define rock64-image-type
   (image-type
    (name 'rock64-raw)
-   (constructor (cut image-with-os (arm64-disk-image (expt 2 24)) <>))))
+   (constructor (cut image-with-os
+                     (raw-with-offset-disk-image (expt 2 24))
+                     <>))))
 
 (define rock64-barebones-raw-image
   (image
    (inherit
-    (os->image rock64-barebones-os #:type rock64-image-type))
+    (os+platform->image rock64-barebones-os aarch64-linux
+                        #:type rock64-image-type))
    (name 'rock64-barebones-raw-image)))
 
 rock64-barebones-raw-image
-- 
cgit v1.2.3