From d5073fd113c621fe0b55382f7dd336ee118e759f Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe 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 --- gnu/image.scm | 13 +++++++--- gnu/local.mk | 4 +++ gnu/platform.scm | 38 ++++++++++++++++++++++++++++ gnu/platforms/arm.scm | 36 +++++++++++++++++++++++++++ gnu/platforms/hurd.scm | 28 +++++++++++++++++++++ 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 ++++-- 11 files changed, 170 insertions(+), 34 deletions(-) create mode 100644 gnu/platform.scm create mode 100644 gnu/platforms/arm.scm create mode 100644 gnu/platforms/hurd.scm (limited to 'gnu') diff --git a/gnu/image.scm b/gnu/image.scm index 75d489490d..2381efa208 100644 --- a/gnu/image.scm +++ b/gnu/image.scm @@ -17,6 +17,7 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu image) + #:use-module (gnu platform) #:use-module (guix records) #:export (partition partition? @@ -34,7 +35,7 @@ (define-module (gnu image) image? image-name image-format - image-target + image-platform image-size image-operating-system image-partitions @@ -47,7 +48,8 @@ (define-module (gnu image) image-type-name image-type-constructor - os->image)) + os->image + os+platform->image)) ;;; @@ -78,7 +80,7 @@ (define-record-type* (name image-name ;symbol (default #f)) (format image-format) ;symbol - (target image-target + (platform image-platform ; (default #f)) (size image-size ;size in bytes as integer (default 'guess)) @@ -112,3 +114,8 @@ (define-record-type* (define* (os->image os #:key type) (let ((constructor (image-type-constructor type))) (constructor os))) + +(define* (os+platform->image os platform #:key type) + (image + (inherit (os->image os #:type type)) + (platform platform))) diff --git a/gnu/local.mk b/gnu/local.mk index 63ef645deb..502f198c5e 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -83,6 +83,7 @@ GNU_SYSTEM_MODULES = \ %D%/home/services/utils.scm \ %D%/home/services/xdg.scm \ %D%/image.scm \ + %D%/platform.scm \ %D%/packages.scm \ %D%/packages/abduco.scm \ %D%/packages/abiword.scm \ @@ -612,6 +613,9 @@ GNU_SYSTEM_MODULES = \ %D%/packages/zile.scm \ %D%/packages/zwave.scm \ \ + %D%/platforms/arm.scm \ + %D%/platforms/hurd.scm \ + \ %D%/services.scm \ %D%/services/admin.scm \ %D%/services/audio.scm \ diff --git a/gnu/platform.scm b/gnu/platform.scm new file mode 100644 index 0000000000..bb6519c71a --- /dev/null +++ b/gnu/platform.scm @@ -0,0 +1,38 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Mathieu Othacehe +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu platform) + #:use-module (guix records) + #:export (platform + platform? + platform-target + platform-system + platform-linux-architecture)) + + +;;; +;;; Platform record. +;;; + +;; Description of a platform supported by the GNU system. +(define-record-type* platform make-platform + platform? + (target platform-target) ;"x86_64-linux-gnu" + (system platform-system) ;"x86_64-linux" + (linux-architecture platform-linux-architecture ;"amd64" + (default #f))) diff --git a/gnu/platforms/arm.scm b/gnu/platforms/arm.scm new file mode 100644 index 0000000000..1e61741a35 --- /dev/null +++ b/gnu/platforms/arm.scm @@ -0,0 +1,36 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Mathieu Othacehe +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu platforms arm) + #:use-module (gnu platform) + #:use-module (gnu packages linux) + #:use-module (guix records) + #:export (armv7-linux + aarch64-linux)) + +(define armv7-linux + (platform + (target "arm-linux-gnueabihf") + (system "armhf-linux") + (linux-architecture "arm"))) + +(define aarch64-linux + (platform + (target "aarch64-linux-gnu") + (system "aarch64-linux") + (linux-architecture "arm64"))) diff --git a/gnu/platforms/hurd.scm b/gnu/platforms/hurd.scm new file mode 100644 index 0000000000..0e5c58fd08 --- /dev/null +++ b/gnu/platforms/hurd.scm @@ -0,0 +1,28 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Mathieu Othacehe +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu platforms hurd) + #:use-module (gnu platform) + #:use-module (gnu packages linux) + #:use-module (guix records) + #:export (hurd)) + +(define hurd + (platform + (target "i586-pc-gnu") + (system "i586-gnu"))) 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 @@ (define-module (gnu system image) #: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 @@ (define-module (gnu system image) 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 @@ (define iso9660-image (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 @@ (define* (arm32-disk-image #:optional (offset root-offset)) ;; 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 @@ (define uncompressed-iso-image-type (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 @@ (define* (system-image image) "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 @@ (define-module (gnu system images hurd) #: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-initialize-root-partition (define hurd-disk-image (image (format 'disk-image) - (target "i586-pc-gnu") (partitions (list (partition (size 'guess) @@ -103,13 +103,15 @@ (define hurd-qcow2-image-type (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 @@ (define-module (gnu system images novena) #: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-barebones-os (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 @@ (define-module (gnu system images pine64) #: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-barebones-os (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 @@ (define-module (gnu system images pinebook-pro) #: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 @@ (define pinebook-pro-image-type (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 @@ (define-module (gnu system images rock64) #: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-barebones-os (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