aboutsummaryrefslogtreecommitdiff
path: root/gnu/build
diff options
context:
space:
mode:
authorJosselin Poiret <dev@jpoiret.xyz>2021-11-15 20:26:29 +0000
committerLudovic Courtès <ludo@gnu.org>2021-11-23 10:24:27 +0100
commit0831dfab75b4db9c8bcbc9b2d1e52d8db54d0ad9 (patch)
treeaef9cfe9d813c6ddbada36230eb07fa8fe9c4bea /gnu/build
parentf574dbd163f8b2d417c6d7ee08559626ae52b7c5 (diff)
downloadguix-0831dfab75b4db9c8bcbc9b2d1e52d8db54d0ad9.tar
guix-0831dfab75b4db9c8bcbc9b2d1e52d8db54d0ad9.tar.gz
system: Add swap flags.
* gnu/system/file-systems.scm (swap-space)[priority, discard?]: Add them. * guix/build/syscalls.scm (SWAP_FLAG_PREFER, SWAP_FLAG_PRIO_MASK, SWAP_FLAG_PRIO_SHIFT, SWAP_FLAG_DISCARD): Add them. * gnu/build/file-systems.scm (swap-space->flags-bit-mask): Add it. * gnu/services/base.scm (swap-service-type): Use it. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'gnu/build')
-rw-r--r--gnu/build/file-systems.scm36
1 files changed, 35 insertions, 1 deletions
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index d8a5ddf1e5..d95340df83 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -29,6 +29,8 @@
#:use-module (guix build bournish)
#:use-module ((guix build syscalls)
#:hide (file-system-type))
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
@@ -54,7 +56,9 @@
mount-flags->bit-mask
check-file-system
- mount-file-system))
+ mount-file-system
+
+ swap-space->flags-bit-mask))
;;; Commentary:
;;;
@@ -227,6 +231,36 @@ if DEVICE does not contain an linux-swap file system."
"Return the label of Linux-swap superblock SBLOCK as a string."
(null-terminated-latin1->string
(sub-bytevector sblock (+ 1024 4 4 4 16) 16)))
+
+(define (swap-space->flags-bit-mask swap)
+ "Return the number suitable for the 'flags' argument of 'mount'
+that corresponds to the swap-space SWAP."
+ (define prio-flag
+ (let ((p (swap-space-priority swap))
+ (max (ash SWAP_FLAG_PRIO_MASK (- SWAP_FLAG_PRIO_SHIFT))))
+ (if p
+ (logior SWAP_FLAG_PREFER
+ (ash (cond
+ ((< p 0)
+ (begin (warning
+ (G_ "Given swap priority ~a is
+negative, defaulting to 0.~%") p)
+ 0))
+ ((> p max)
+ (begin (warning
+ (G_ "Limiting swap priority ~a to
+~a.~%")
+ p max)
+ max))
+ (else p))
+ SWAP_FLAG_PRIO_SHIFT))
+ 0)))
+ (define delayed-flag
+ (if (swap-space-discard? swap)
+ SWAP_FLAG_DISCARD
+ 0))
+ (logior prio-flag delayed-flag))
+
;;;