;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2025 Maxim Cournoyer <maxim@guixotic.coop>
;;;
;;; 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 match)
  #:use-module (ice-9 threads)
   #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-9)
  #:use-module (system foreign)

  #:export (file->bytevector))

;;;
;;; Memory mapped files.
;;;
 ;; (define %mmap-bytevector-map
 ;;   (make-hash-table))

 (define mmap-bytevector-guardian
   (make-guardian))

(define (pump-mmap-guardian)
   (let ((bv (mmap-bytevector-guardian)))
    (when bv
       (pk 'got-bv)
       (munmap (bytevector->pointer bv) (bytevector-length bv))
       (format #t "mmap pointer deleted~%")
       (pump-mmap-guardian))))

(add-hook! after-gc-hook pump-mmap-guardian)

(define* (file->mmap-bytevector file #:key
                                (addr %null-pointer)
                                 (prot PROT_NONE)
                                (flags 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 ((size (stat:size (stat file))))
    (call-with-input-file file
      (lambda (port)
        (let* ((fd (port->fdes port))
               (ptr (mmap fd size #:addr addr #:prot prot #:flags flags
                          #:offset offset))
               (bv (pointer->bytevector ptr size)))
          (mmap-bytevector-guardian bv)
           bv)))))
 
 #;(
 scheme@(guix build io)> (let ((bv2 (file->mmap-bytevector "/gnu/store/x00bkpkikw60m9mknl3y1shsj482pxzc-llvm-21.1.1/lib/libLLVM.so.21.1")))
                           #t)
 $6 = #t
 scheme@(guix build io)> ,gc
 
 ;;; (got-bv)
 mmap pointer deleted
 );#

Generated by apteryx using scpaste at Fri Oct 24 22:56:01 2025. JST. (original)