guix_mirror_bot pushed a commit to branch master
in repository guix.
commit 3ae5c9f2a78ce85beceb7467479c741e4c046830
Author: Maxim Cournoyer <[email protected]>
AuthorDate: Thu Oct 30 16:19:51 2025 +0900
Revert "syscalls: Add mmap support."
This reverts commit e1994a021437b3fd73089c08d7e8db876fad698d.
---
Makefile.am | 1 -
guix/build/io.scm | 58 -------------------------
guix/build/syscalls.scm | 112 +-----------------------------------------------
tests/syscalls.scm | 70 +-----------------------------
4 files changed, 3 insertions(+), 238 deletions(-)
diff --git a/Makefile.am b/Makefile.am
index a6c2e73388..a4e7277d6d 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -265,7 +265,6 @@ MODULES = \
guix/build/kconfig.scm \
guix/build/linux-module-build-system.scm \
guix/build/store-copy.scm \
- guix/build/io.scm \
guix/build/json.scm \
guix/build/pack.scm \
guix/build/utils.scm \
diff --git a/guix/build/io.scm b/guix/build/io.scm
deleted file mode 100644
index 1dddbf239c..0000000000
--- a/guix/build/io.scm
+++ /dev/null
@@ -1,58 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2025 Maxim Cournoyer <[email protected]>
-;;;
-;;; 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 (guix build io)
- #:use-module (guix build syscalls)
- #:use-module (ice-9 format)
- #:use-module (rnrs bytevectors)
- #:use-module (rnrs io ports)
- #:use-module (system foreign)
- #:export (file->bytevector)
- ;; For convenience.
- #:re-export (PROT_READ
- PROT_NONE
- PROT_READ
- PROT_WRITE
- PROT_EXEC
- PROT_SEM
- MAP_SHARED
- MAP_PRIVATE
- MAP_FAILED
- munmap))
-
-;;;
-;;; Memory mapped files.
-;;;
-
-(define* (file->bytevector file #:key
- (protection PROT_READ)
- (flags (if (logtest PROT_WRITE protection)
- MAP_SHARED
- MAP_PRIVATE))
- (offset 0))
- "Return a bytevector object that is backed by a memory mapped FILE. This
-avoids eagerly copying the full file contents into memory, instead letting the
-kernel lazily page it in on demand. The underlying memory map is
-automatically unmapped when the bytevector is no longer referenced."
- (let* ((mode (format #f "rb~:[~;+~]" (and (logtest PROT_WRITE protection)
- (logtest MAP_SHARED flags))))
- (port (open-file file mode)))
- (call-with-port port
- (lambda (port)
- (mmap (fileno port) (- (stat:size (stat file)) offset)
- #:protection protection #:flags flags #:offset offset)))))
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index ef67875470..d40b1ae5d9 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -42,23 +42,8 @@
#:use-module (ice-9 regex)
#:use-module (ice-9 match)
#:use-module (ice-9 ftw)
- #:export (PROT_NONE
- PROT_READ
- PROT_WRITE
- PROT_EXEC
- PROT_SEM
- MAP_SHARED
- MAP_PRIVATE
- MAP_FAILED
- mmap
- munmap
-
- MS_ASYNC
- MS_INVALIDATE
- MS_SYNC
- msync
-
- MS_RDONLY
+ #:use-module (ice-9 threads)
+ #:export (MS_RDONLY
MS_NOSUID
MS_NODEV
MS_NOEXEC
@@ -1122,99 +1107,6 @@ backend device."
(list err)))))))
-;;;
-;;; Memory maps.
-;;;
-
-;;; Constants from <sys/mman.h>
-(define PROT_NONE #x0) ;page can not be accessed
-(define PROT_READ #x1) ;page can be read
-(define PROT_WRITE #x2) ;page can be written
-(define PROT_EXEC #x4) ;page can be executed
-(define PROT_SEM #x8) ;page can be used for atomic operations
-
-(define MAP_SHARED #x01) ;share changes with other processes
-(define MAP_PRIVATE #x02) ;private copy-on-write mapping
-(define MAP_FAILED #xffffffffffffffff) ;mmap failure sentinel
-
-(define %mmap
- (syscall->procedure '* "mmap" (list '* size_t int int int long)))
-
-(define %mmap-guardian
- (make-guardian))
-
-(define %unmapped-bytevectors
- (make-weak-key-hash-table))
-
-(define (unmapped-bytevector? bv)
- "True if the bytevector BV was already munmap'd."
- (hashq-ref %unmapped-bytevectors bv #f))
-
-(define (pump-mmap-guardian)
- (let ((bv (%mmap-guardian)))
- (when bv
- (if (unmapped-bytevector? bv)
- (hashq-remove! %unmapped-bytevectors bv)
- (munmap bv))
- (pump-mmap-guardian))))
-
-(add-hook! after-gc-hook pump-mmap-guardian)
-
-(define* (mmap fd len #:key
- (protection PROT_READ)
- (flags (if (logtest PROT_WRITE protection)
- MAP_SHARED
- MAP_PRIVATE))
- (offset 0))
- "Return a bytevector to a memory-mapped region of length LEN bytes
-for the open file descriptor FD. The mapping is created with the given memory
-PROTECTION and FLAGS, biwise-or of PROT_* and MAP_* constants which
-determine whether updates are visible to other processes and/or carried
-through to the underlying file. Raise a 'system-error' exception on error.
-The memory is automatically unmapped with `munmap' when the bytevector object
-is no longer referenced."
- (let-values (((ptr err) (%mmap %null-pointer len protection flags fd
offset)))
- (when (= MAP_FAILED (pointer-address ptr))
- (throw 'system-error "mmap" "mmap ~S with len ~S: ~A"
- (list fd len (strerror err))
- (list err)))
- (let ((bv (pointer->bytevector ptr len)))
- (%mmap-guardian bv)
- bv)))
-
-(define %munmap
- (syscall->procedure int "munmap" (list '* size_t)))
-
-(define (munmap bv)
- "Unmap the memory region described by BV, a bytevector object."
- (let*-values (((ptr) (bytevector->pointer bv))
- ((len) (bytevector-length bv))
- ((ret err) (%munmap ptr len)))
- (unless (zero? ret)
- (throw 'system-error "munmap" "munmap ~S with len ~S: ~A"
- (list ptr len (strerror err))
- (list err)))
- (hashq-set! %unmapped-bytevectors bv #t)))
-
-(define MS_ASYNC 1) ;sync memory asynchronously
-(define MS_INVALIDATE 2) ;invalidate the caches
-(define MS_SYNC 4) ;synchronous memory sync
-
-(define %msync
- (syscall->procedure int "msync" (list '* size_t int)))
-
-(define* (msync bv #:key (flags MS_SYNC))
- "Flush changes made to the in-core copy of a file that was mapped into memory
-using `mmap' back to the file system."
- (let*-values (((ptr) (bytevector->pointer bv))
- ((len) (bytevector-length bv))
- ((ret err) (%msync ptr len flags)))
- (unless (zero? ret)
- (throw 'system-error "msync" "msync ~S with len ~S: ~A"
- (list ptr len (strerror err))
- (list err)))))
-
-
;;;
;;; Random.
;;;
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 1ea49b0acc..a0483e68f0 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -22,11 +22,8 @@
(define-module (test-syscalls)
#:use-module (guix utils)
- #:use-module (guix build io)
#:use-module (guix build syscalls)
- #:use-module (guix build utils)
#:use-module (gnu build linux-container)
- #:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
@@ -34,7 +31,7 @@
#:use-module (system foreign)
#:use-module ((ice-9 ftw) #:select (scandir))
#:use-module (ice-9 match)
- #:use-module (ice-9 textual-ports))
+ #:use-module (ice-9 threads))
;; Test the (guix build syscalls) module, although there's not much that can
;; actually be tested without being root.
@@ -42,9 +39,6 @@
(define temp-file
(string-append "t-utils-" (number->string (getpid))))
-(define strace-output
- (string-append "t-utils-strace" (number->string (getpid))))
-
(test-begin "syscalls")
@@ -741,68 +735,6 @@
(member (system-error-errno args)
(list EPERM ENOSYS)))))
-(test-assert "mmap and munmap"
- (begin
- (call-with-output-file temp-file
- (lambda (p)
- (display "abcdefghij")))
- (let* ((len 5)
- (bv (mmap (open-fdes temp-file O_RDONLY) len)))
- (munmap bv))))
-
-(test-equal "file->bytevector, reading"
- #\6
- (begin
- (call-with-output-file temp-file
- (lambda (p)
- (display "0123456789\n" p)))
- (sync)
- (integer->char
- (bytevector-u8-ref (file->bytevector temp-file) 6))))
-
-(test-equal "file->bytevector, writing"
- "0000000700"
- (begin
- (call-with-output-file temp-file
- (lambda (p)
- (display "0000000000" p)))
- (sync)
- (let ((bv (file->bytevector temp-file
- #:protection PROT_WRITE)))
-
- (bytevector-u8-set! bv 7 (char->integer #\7))
- (msync bv)) ;ensure the file gets written
- (call-with-input-file temp-file get-string-all)))
-
-(unless (which "strace")
- (test-skip 1))
-;;; This test currently fails, due to protected items in a guardian being
-;;; dropped from weak hash tables (see:
-;;; <https://codeberg.org/guile/guile/issues/44>).
-(test-expect-fail 1)
-(test-equal "manual munmap does not lead to double free"
- 1 ;single munmap call
- (begin
- (call-with-output-file temp-file
- (lambda (p)
- (display "something interesting\n" p)))
- (sync)
- (gc)
- (system (string-append "strace -o " strace-output
- " -p " (number->string (getpid))
- " -e trace=munmap &"))
- (sleep 1) ;allow strace to start
- (let ((bv (file->bytevector temp-file)))
- (munmap bv))
- (gc)
- (sync)
- (let ((text (call-with-input-file strace-output get-string-all)))
- ;; The address seen by strace is not the same as the one seen by Guile,
- ;; so we can't use it in the pattern.
- (length (filter (cut string-prefix? "munmap(0x" <>)
- (string-split text #\newline))))))
-
(test-end)
(false-if-exception (delete-file temp-file))
-(false-if-exception (delete-file strace-output))
