1
0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00

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>
This commit is contained in:
Josselin Poiret
2021-11-15 20:26:29 +00:00
committed by Ludovic Courtès
parent f574dbd163
commit 0831dfab75
4 changed files with 60 additions and 5 deletions

View File

@@ -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))
;;;