M gnu/image.scm => gnu/image.scm +10 -3
@@ 17,6 17,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu image)
+ #:use-module (gnu platform)
#:use-module (guix records)
#:export (partition
partition?
@@ 34,7 35,7 @@
image?
image-name
image-format
- image-target
+ image-platform
image-size
image-operating-system
image-partitions
@@ 47,7 48,8 @@
image-type-name
image-type-constructor
- os->image))
+ os->image
+ os+platform->image))
;;;
@@ 78,7 80,7 @@
(name image-name ;symbol
(default #f))
(format image-format) ;symbol
- (target image-target
+ (platform image-platform ;<platform>
(default #f))
(size image-size ;size in bytes as integer
(default 'guess))
@@ 112,3 114,8 @@
(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)))
M gnu/local.mk => gnu/local.mk +4 -0
@@ 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 \
A gnu/platform.scm => gnu/platform.scm +38 -0
@@ 0,0 1,38 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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> 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)))
A gnu/platforms/arm.scm => gnu/platforms/arm.scm +36 -0
@@ 0,0 1,36 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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")))
A gnu/platforms/hurd.scm => gnu/platforms/hurd.scm +28 -0
@@ 0,0 1,28 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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")))
M gnu/system/image.scm => gnu/system/image.scm +31 -20
@@ 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))
M gnu/system/images/hurd.scm => gnu/system/images/hurd.scm +5 -3
@@ 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.
M gnu/system/images/novena.scm => gnu/system/images/novena.scm +4 -2
@@ 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.
M gnu/system/images/pine64.scm => gnu/system/images/pine64.scm +4 -2
@@ 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.
M gnu/system/images/pinebook-pro.scm => gnu/system/images/pinebook-pro.scm +4 -2
@@ 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.
M gnu/system/images/rock64.scm => gnu/system/images/rock64.scm +6 -2
@@ 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
M guix/scripts/system.scm => guix/scripts/system.scm +2 -3
@@ 64,6 64,7 @@
(device-module-aliases matching-modules)
#:use-module (gnu system linux-initrd)
#:use-module (gnu image)
+ #:use-module (gnu platform)
#:use-module (gnu system)
#:use-module (gnu bootloader)
#:use-module (gnu system file-systems)
@@ 1212,13 1213,11 @@ resulting from command-line parsing."
(base-image (if (operating-system? obj)
(os->image obj
#:type image-type)
- obj))
- (base-target (image-target base-image)))
+ obj)))
(image
(inherit (if label
(image-with-label base-image label)
base-image))
- (target (or base-target target))
(size image-size)
(volatile-root? volatile?))))
(os (image-operating-system image))