├── .gitattributes ├── LICENSE ├── README.md ├── docs └── index.html ├── documentation.lisp ├── generic.lisp ├── mmap-test.asd ├── mmap.asd ├── package.lisp ├── posix.lisp ├── test.lisp └── windows.lisp /.gitattributes: -------------------------------------------------------------------------------- 1 | doc/ linguist-vendored -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017 Yukari Hafner 2 | 3 | This software is provided 'as-is', without any express or implied 4 | warranty. In no event will the authors be held liable for any damages 5 | arising from the use of this software. 6 | 7 | Permission is granted to anyone to use this software for any purpose, 8 | including commercial applications, and to alter it and redistribute it 9 | freely, subject to the following restrictions: 10 | 11 | 1. The origin of this software must not be misrepresented; you must not 12 | claim that you wrote the original software. If you use this software 13 | in a product, an acknowledgment in the product documentation would be 14 | appreciated but is not required. 15 | 2. Altered source versions must be plainly marked as such, and must not be 16 | misrepresented as being the original software. 17 | 3. This notice may not be removed or altered from any source distribution. 18 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## About MMAP 2 | This is a utility library providing access to the `mmap` family of functions in a portable way. It should work on Posix and Windows systems. `mmap` allows you to directly map a file into the address space of your process without having to manually read it into memory sequentially. Typically this is much more efficient for files that are larger than a few Kb. 3 | 4 | ## Supported operations 5 | The library offers access to the following functions: 6 | 7 | * `mmap` 8 | * `munmap` 9 | * `msync` 10 | * `mprotect` 11 | 12 | It also provides a convenience macro called `with-mmap` to perform safe, local mappings of files. 13 | 14 | (mmap:with-mmap (addr fd size #p"/etc/lsb-release") 15 | (with-output-to-string (out) 16 | (loop for i from 0 below size 17 | for char = (code-char (cffi:mem-aref addr :char i)) 18 | do (write-char char out)))) 19 | 20 | If you're on a system where mmap is supported, `:mmap` will be in `*features*`. 21 | -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | Mmap

mmap

1.1.0

Portable mmap (file memory mapping) utility library.

Table of Contents

About MMAP

This is a utility library providing access to the mmap family of functions in a portable way. It should work on Posix and Windows systems. mmap allows you to directly map a file into the address space of your process without having to manually read it into memory sequentially. Typically this is much more efficient for files that are larger than a few Kb.

Supported operations

The library offers access to the following functions:

It also provides a convenience macro called with-mmap to perform safe, local mappings of files.

(mmap:with-mmap (addr fd size #p"/etc/lsb-release")
  2 |   (with-output-to-string (out)
  3 |     (loop for i from 0 below size
  4 |           for char = (code-char (cffi:mem-aref addr :char i))
  5 |           do (write-char char out))))
  6 | 

If you're on a system where mmap is supported, :mmap will be in *features*.

System Information

1.1.0
Yukari Hafner
zlib

Definition Index

-------------------------------------------------------------------------------- /documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.fraf.trial.mmap) 2 | 3 | (docs:define-docs 4 | (type mmap-error 5 | "Error signalled if the mmap attempt fails for some reason. 6 | 7 | Possible reasons include, but are not limited to: 8 | - File not found 9 | - File access denied 10 | - Out of memory 11 | - Out of address space 12 | - Mapping not allowed 13 | - Invalid combination of flags 14 | 15 | See MMAP 16 | See CODE 17 | See MESSAGE") 18 | 19 | (function code 20 | "The OS-specific error code returned for the mmap failure. 21 | 22 | See MMAP-ERROR") 23 | 24 | (function message 25 | "The (hopefully) user-readable error message for the mmap failure. 26 | 27 | See MMAP-ERROR") 28 | 29 | (function mmap 30 | "Map the given path or number of bytes into the address space. 31 | 32 | PATH can be either a pathname designator, FD, or NIL. If it is NIL, an 33 | anonymous file is mapped and the MMAP flag list must include the flag 34 | :ANONYMOUS. If it is a path or an open POSIX file descriptor, then the 35 | contents of the given file on the file system are mapped into the 36 | address space. The file contents can then be read, written, or 37 | executed depending on the given flags as if normal memory was 38 | accessed. If the file is NIL or its size cannot be automatically 39 | determined, you must pass a valid SIZE. You may optionally pass an 40 | OFFSET (in bytes) into the file from which the mapping begins. 41 | 42 | [POSIX] PATH may also be the symbol :ANONYMOUS, in which case an anonymous 43 | file descriptor is created and returned for you. This can be useful when 44 | sharing a file descriptor with another process without needing to involve 45 | a disk-backed file. 46 | 47 | If the map attempt fails, an error of type MMAP-ERROR is signalled. 48 | If the call succeeds, three values are returned: 49 | 50 | PTR --- A CFFI:FOREIGN-POINTER that points to the start of the place in 51 | memory where the file contents have been mapped. The contents 52 | should be placed in increasing address order, unless the flag 53 | :GROWS-DOWN is active. 54 | FD --- An opaque file descriptor. You should not touch this. 55 | SIZE --- The size of the region of memory that has been mapped in bytes. 56 | 57 | All three values need to be passed on to MUNMAP completely unchanged. Any 58 | change could cause severe issues. 59 | 60 | The three options OPEN, PROTECTION, and MMAP are lists of flags. Not all of 61 | those flags are portable, some are only allowed on Linux, some only on non- 62 | Windows systems. To indicate support, the flags are marked as EVERY, POSIX 63 | \(non-Windows), LINUX, or WINDOWS. 64 | 65 | OPEN 66 | :READ --- [EVERY] Opens the file for read access. 67 | :WRITE --- [EVERY] Opens the file for write access. 68 | :CREATE --- [EVERY] Creates the file if it does not exist yet. 69 | :ENSURE-CREATE --- [EVERY] Creates the file if it does not exist yet and 70 | errors if it does. 71 | :TRUNCATE --- [EVERY] Truncates the file and replaces it if it exists. 72 | :DIRECT --- [EVERY] Causes system buffers to be bypassed. 73 | :FILE-SYNC --- [EVERY] Causes writes to the file to be flushed asap. 74 | :DATA-SYNC --- [POSIX] Similar to FILE-SYNC, but uses data integrity 75 | semantics rather than file integrity semantics. 76 | :DONT-CLAIM-TTY--- [POSIX] If the file is a tty and the process does not 77 | already have a controlling tty, this file will 78 | not become the process' controlling tty. 79 | :NON-BLOCK --- [POSIX] Attempt to open the file in non-blocking mode, 80 | causing operations on the fd to return asap. 81 | :NO-FOLLOW --- [LINUX] Errors if the file is a symlink. 82 | :ASYNC --- [LINUX] Enable signal driven IO. 83 | :DIRECTORY --- [LINUX] Errors if the file is not a directory. 84 | :LARGE-FILE --- [LINUX] Allows opening files with size not representable 85 | by a 32 bit unsigned integer. 86 | 87 | PROTECTION 88 | :READ --- [EVERY] Allows reading from the memory region. The OPEN 89 | flag :READ is required for this protection mode. 90 | This flag is required on windows. 91 | :WRITE --- [EVERY] Allows writing to the memory region. 92 | :EXEC --- [EVERY] Allows executing code in the memory region. 93 | :NONE --- [POSIX] Prevents accessing the memory region. 94 | 95 | MMAP 96 | :PRIVATE --- [EVERY] The underlying file is not changed if the memory 97 | area is written to. Copy-on-write is employed to 98 | ensure separation. 99 | :SHARED --- [EVERY] The underlying file is changed if the memory 100 | area is written to and the change will be 101 | visible to other processes. In this case the 102 | OPEN flag :WRITE must be specified. 103 | :ANONYMOUS --- [LINUX/WINDOWS] The path should be a number of bytes to 104 | map to memory. The memory region is then mapped 105 | against an \"anonymous\" file. 106 | :NO-RESERVE --- [LINUX] Don't reserve swap for this mapping. If memory 107 | runs out, a segfault will be generated instead. 108 | :LOCKED --- [LINUX] Locks the region to RAM, preventing it from 109 | being swapped out. 110 | :GROWS-DOWN --- [LINUX] Causes the memory region to be mapped with a 111 | decreasing address, like in a stack. 112 | :POPULATE --- [LINUX] Pre-populate the memory region with the file 113 | contents, which can help performance. 114 | :NON-BLOCK --- [LINUX] Only useful with :POPULATE -- do not perform a 115 | read-ahead. 116 | 117 | The default values for the flags are: 118 | :OPEN (:READ) :PROTECTION (:READ) :MMAP (:PRIVATE) 119 | 120 | Note that if you are intending to use MPROTECT to change the protection of 121 | the mapped file at a later date, you need to call MMAP with the maximal 122 | combination of protection flags first. If this is not the protection that 123 | you want to start out with, call MPROTECT with the correct combination 124 | immediately after. For instance, if you would like to start with (:READ) and 125 | later want to change it to (:READ :WRITE), call MMAP with (:READ :WRITE), 126 | and immediately after call MPROTECT with (:READ). 127 | 128 | See MUNMAP 129 | See WITH-MMAP 130 | See MMAP-ERROR 131 | See http://pubs.opengroup.org/onlinepubs/7908799/xsh/mmap.html 132 | See http://pubs.opengroup.org/onlinepubs/009604499/functions/stat.html 133 | See http://man7.org/linux/man-pages/man2/mmap.2.html 134 | See http://man7.org/linux/man-pages/man2/stat.2.html 135 | See https://docs.microsoft.com/en-us/windows/desktop/api/fileapi/nf-fileapi-createfilew 136 | See https://docs.microsoft.com/en-us/windows/desktop/api/fileapi/nf-fileapi-getfilesize 137 | See https://docs.microsoft.com/en-us/windows/desktop/api/winbase/nf-winbase-createfilemappinga 138 | See https://msdn.microsoft.com/en-us/library/windows/desktop/aa366761(v=vs.85).aspx") 139 | 140 | (function munmap 141 | "Unmaps the memory region, freeing the address space and its file. 142 | 143 | The values passed to this function must be the ones retrieved from a call 144 | to MMAP. Calling MUNMAP with the same values more than once will lead to 145 | undefined consequences and may very well corrupt your system to crash. The 146 | same goes for calling MUNMAP with values not directly returned by MMAP, 147 | calling it with changed values returned by MMAP, or attempting to 148 | dereference the PTR after a call to MUNMAP. 149 | 150 | This function returns nothing useful. 151 | 152 | On POSIX systems you may pass NIL for the FD argument, in which case 153 | the file descriptor is not closed. It is then your responsibility to 154 | close it appropriately at a later point. 155 | 156 | This function may signal an MMAP-ERROR in case the operating system notices 157 | a problem. 158 | 159 | See MMAP 160 | See MMAP-ERROR 161 | See WITH-MMAP 162 | See http://pubs.opengroup.org/onlinepubs/9699919799/functions/mprotect.html 163 | See http://man7.org/linux/man-pages/man2/mprotect.2.html 164 | See https://msdn.microsoft.com/en-us/library/windows/desktop/aa366882(v=vs.85).aspx 165 | See https://msdn.microsoft.com/en-us/library/windows/desktop/ms724211(v=vs.85).aspx") 166 | 167 | (function msync 168 | "Causes writes to the mapped file area to be written to disk. 169 | 170 | The values passed to this function must be the ones retrieved from a call 171 | to MMAP. 172 | 173 | The following flags are supported: 174 | 175 | :SYNC --- [EVERY] Writing is synchronous. A call to this function 176 | will not return until the data is flushed to 177 | disk. 178 | :ASYNC --- [EVERY] Writing is asynchronous and a call will return 179 | immediately. 180 | :INVALIDATE --- [POSIX] Asks to invalidate other mappings of the same 181 | file, ensuring the view is synchronised. 182 | 183 | This function returns nothing useful. 184 | 185 | This function may signal an MMAP-ERROR in case the operating system notices 186 | a problem. 187 | 188 | See MMAP 189 | See MMAP-ERROR 190 | See http://pubs.opengroup.org/onlinepubs/000095399/functions/msync.html 191 | See http://man7.org/linux/man-pages/man2/msync.2.html 192 | See https://msdn.microsoft.com/en-us/library/windows/desktop/aa366563(v=vs.85).aspx 193 | See https://docs.microsoft.com/en-us/windows/desktop/api/fileapi/nf-fileapi-flushfilebuffers") 194 | 195 | (function mprotect 196 | "Changes the access protection of the mapped memory region. 197 | 198 | The values passed to this function must be the ones retrieved from a call 199 | to MMAP. 200 | 201 | The following protection flags are supported: 202 | 203 | :READ --- [EVERY] Allows reading from the memory region. The OPEN 204 | flag :READ is required for this protection mode. 205 | This flag is required on windows. 206 | :WRITE --- [EVERY] Allows writing to the memory region. 207 | :EXEC --- [EVERY] Allows executing code in the memory region. 208 | :NONE --- [POSIX] Prevents accessing the memory region. 209 | 210 | This function returns nothing useful. 211 | 212 | This function may signal an MMAP-ERROR in case the operating system notices 213 | a problem. 214 | 215 | See MMAP 216 | See MMAP-ERROR 217 | See http://pubs.opengroup.org/onlinepubs/9699919799/functions/mprotect.html 218 | See http://man7.org/linux/man-pages/man2/mprotect.2.html 219 | See https://msdn.microsoft.com/en-us/library/windows/desktop/aa366898(v=vs.85).aspx") 220 | 221 | (function madvise 222 | "Gives hints about the usage patterns of the memory to better tune mapping behaviour. 223 | 224 | The values passed to this function must be the ones retrieved from a call 225 | to MMAP. 226 | 227 | The following advice hints are supported: 228 | 229 | :NORMAL --- [POSIX] This is the default. 230 | :SEQUENTIAL --- [POSIX] Expect memory to be addressed sequentially. 231 | :RANDOM --- [POSIX] Expect memory to be addressed randomly. 232 | :WILL-NEED --- [POSIX] Expect the memory to be used very soon. 233 | :DONT-NEED --- [POSIX] Expect the memory to not be needed any 234 | time soon. This will most likely cause 235 | pages to be offloaded until they are 236 | accessed again. 237 | :FREE --- [LINUX] The pages in the specified range are no 238 | longer needed and can be freed at any 239 | time, for instance to make space in case 240 | of memory pressure. 241 | :REMOVE --- [LINUX] Free the given pages and the associated 242 | backing store. 243 | :DONT-FORK --- [LINUX] Don't make changes available in children. 244 | :DO-FORK --- [LINUX] Undo :DONT-FORK behaviour. 245 | :MERGEABLE --- [LINUX] The pages in the specified range may be 246 | merged with ones with identical content. 247 | :UNMERGEABLE --- [LINUX] Undo :MERGEABLE behaviour. 248 | :HUGE-PAGE --- [LINUX] Enable transparent huge pages for the 249 | specified page range. 250 | :NO-HUGE-PAGE --- [LINUX] Ensure that the memory in the given 251 | range is not backed by transparent huge 252 | pages. 253 | :DONT-DUMP --- [LINUX] The pages in the specified range should 254 | be excluded from core dumps. 255 | :DO-DUMP --- [LINUX] Undo :DONT-DUMP behaviour. 256 | :WIPE-ON-FORK --- [LINUX] Memory in the given range is zeroed out 257 | for children. 258 | :KEEP-ON-FORK --- [LINUX] Undo :WIPE-ON-FORK behaviour. 259 | :COLD --- [LINUX] Deactivate the given range of 260 | pages. This makes them a more likely 261 | target for reclamation in the presence 262 | of memory pressure. 263 | :PAGEOUT --- [LINUX] The pages in the specified range should 264 | be reclaimed and their data flushed out. 265 | 266 | This function returns nothing useful. 267 | 268 | This function may signal an MMAP-ERROR in case the operating system notices 269 | a problem. 270 | 271 | See MMAP 272 | See MMAP-ERROR 273 | See https://pubs.opengroup.org/onlinepubs/007904875/functions/posix_madvise.html 274 | See https://man7.org/linux/man-pages/man2/madvise.2.html") 275 | 276 | (function mremap 277 | "Changes the size of the mapped segment. 278 | 279 | The values passed to this function must be the ones retrieved from a 280 | call to MMAP. 281 | 282 | The values returned from this function are the same kind as returned 283 | from MMAP and should be used in place of the original values for 284 | further operations. 285 | 286 | When the mapped segment is backed by a file, the file is truncated to 287 | fit the newly requested size. 288 | 289 | See MMAP 290 | See MUNMAP 291 | See MMAP-ERROR 292 | See https://man7.org/linux/man-pages/man2/mremap.2.html") 293 | 294 | (function with-mmap 295 | "Map the file or number of bytes to a memory region within the body. 296 | 297 | This is a convenience macro that calls MMAP with the given arguments, 298 | binds the results to the variables ADDR, FD, and SIZE, and automatically 299 | ensures that MUNMAP is called with the correct values when the body is 300 | exited. 301 | 302 | If the flag DONT-CLOSE is set, WITH-MMAP will not free the file 303 | descriptor on unwind. This is useful primarily if you pass in an FD 304 | for the path yourself and are either not responsible for closing it, 305 | or would like to continue using it for other purposes. 306 | 307 | It is safe to change the ADDR, FD, and SIZE bindings, though probably not 308 | very good style to do so. It is NOT safe to save the ADDR and SIZE values 309 | somewhere and use them outside of the dynamic scope of the body. Attempting 310 | to do so is very likely going to burn your process to the ground. 311 | 312 | See MMAP 313 | See MUNMAP")) 314 | -------------------------------------------------------------------------------- /generic.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.fraf.trial.mmap) 2 | 3 | (define-condition mmap-error (simple-error) 4 | ((code :initarg :code :reader code) 5 | (message :initarg :message :reader message)) 6 | (:report (lambda (c s) (format s "Failed to mmap file (E~d):~% ~a" 7 | (code c) (message c))))) 8 | 9 | (defun error-mmap (code message) 10 | (error 'mmap-error :code code :message message)) 11 | 12 | (defun cfold (env form &rest vars) 13 | (if (loop for var in vars 14 | always (constantp var env)) 15 | `(load-time-value ,form) 16 | form)) 17 | 18 | (defun translate-path (path) 19 | (etypecase path 20 | #+windows 21 | (cffi:foreign-pointer path) 22 | #+(or unix windows) 23 | ((unsigned-byte #+64-bit 64 #-64-bit 32) path) 24 | #+unix 25 | ((eql :anonymous) path) 26 | (string path) 27 | (pathname (pathname-utils:native-namestring path)) 28 | (null))) 29 | 30 | #-(or unix windows) 31 | (defun mmap (path &key open protection mmap) 32 | (error "Platform not supported.")) 33 | 34 | #-(or unix windows) 35 | (defun munmap (addr fd size) 36 | (error "Platform not supported.")) 37 | 38 | #-(or unix windows) 39 | (defun msync (addr size &key flags) 40 | (error "Platform not supported.")) 41 | 42 | #-(or unix windows) 43 | (defun mprotect (addr size protection) 44 | (error "Platform not supported.")) 45 | 46 | #-(or unix windows) 47 | (defun madvise (addr size advice) 48 | (error "Platform not supported.")) 49 | 50 | (defmacro with-mmap ((addr fd size path &rest args &key dont-close &allow-other-keys) &body body) 51 | (let ((addrg (gensym "ADDR")) 52 | (fdg (gensym "FD")) 53 | (sizeg (gensym "SIZE")) 54 | (args (copy-list args))) 55 | (remf args :dont-close) 56 | `(multiple-value-bind (,addrg ,fdg ,sizeg) (mmap ,path ,@args) 57 | (unwind-protect 58 | (let ((,addr ,addrg) 59 | (,fd ,fdg) 60 | (,size ,sizeg)) 61 | (declare (ignorable ,fd ,size)) 62 | ,@body) 63 | (munmap ,addrg ,(unless dont-close fdg) ,sizeg))))) 64 | -------------------------------------------------------------------------------- /mmap-test.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem mmap-test 2 | :version "1.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Tests for the mmap system." 7 | :homepage "https://shinmera.github.io/mmap/" 8 | :bug-tracker "https://github.com/Shinmera/mmap/issues" 9 | :source-control (:git "https://github.com/Shinmera/mmap.git") 10 | :serial T 11 | :components ((:file "test")) 12 | :depends-on (:mmap :cffi :alexandria :parachute) 13 | :perform (asdf:test-op (op c) (uiop:symbol-call :parachute :test :mmap-test))) 14 | -------------------------------------------------------------------------------- /mmap.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem mmap 2 | :version "1.1.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Portable mmap (file memory mapping) utility library." 7 | :homepage "https://shinmera.github.io/mmap/" 8 | :bug-tracker "https://github.com/Shinmera/mmap/issues" 9 | :source-control (:git "https://github.com/Shinmera/mmap.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "generic") 13 | (:file "posix" :if-feature :unix) 14 | (:file "windows" :if-feature :windows) 15 | (:file "documentation")) 16 | :defsystem-depends-on (:trivial-features) 17 | :depends-on (:documentation-utils 18 | :pathname-utils 19 | :cffi) 20 | :in-order-to ((asdf:test-op (asdf:test-op :mmap-test)))) 21 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:mmap 2 | (:nicknames #:org.shirakumo.fraf.trial.mmap) 3 | (:use #:cl) 4 | (:export 5 | #:mmap-error 6 | #:code 7 | #:message 8 | #:mmap 9 | #:munmap 10 | #:msync 11 | #:mprotect 12 | #:madvise 13 | #:with-mmap)) 14 | -------------------------------------------------------------------------------- /posix.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.fraf.trial.mmap) 2 | 3 | (pushnew :mmap *features*) 4 | 5 | (cffi:defbitfield protection-flag 6 | (:none #x0) 7 | (:read #x1) 8 | (:write #x2) 9 | (:exec #x4) 10 | (:atomic #x8)) 11 | 12 | (cffi:defbitfield mmap-flag 13 | (:shared #x0000001) 14 | (:private #x0000002) 15 | (:fixed #x0000010) 16 | (:anonymous #x0000020) 17 | (:grows-down #x0000100) 18 | (:locked #x0002000) 19 | (:no-reserve #x0004000) 20 | (:populate #x0008000) 21 | (:non-block #x0010000) 22 | (:stack #x0020000) 23 | (:huge-table #x0040000) 24 | (:sync #x0080000) 25 | (:no-replace #x0100000) 26 | (:uninitialized #x4000000)) 27 | 28 | (cffi:defbitfield msync-flag 29 | (:async #x1) 30 | (:invalidate #x2) 31 | (:sync #x4)) 32 | 33 | (cffi:defcenum madvise-flag 34 | (:normal 0) 35 | (:random 1) 36 | (:sequential 2) 37 | (:will-need 3) 38 | (:dont-need 4) 39 | (:free 8) 40 | (:remove 9) 41 | (:dont-fork 10) 42 | (:do-fork 11) 43 | (:mergeable 12) 44 | (:unmergeable 13) 45 | (:huge-page 14) 46 | (:no-huge-page 15) 47 | (:dont-dump 16) 48 | (:do-dump 17) 49 | (:wipe-on-fork 18) 50 | (:keep-on-fork 19) 51 | (:cold 20) 52 | (:pageout 21)) 53 | 54 | (cffi:defbitfield open-flag 55 | (:read #o0000000) 56 | (:write #o0000002) 57 | (:create #o0000100) 58 | (:ensure-create #o0000200) 59 | (:dont-claim-tty#o0000400) 60 | (:truncate #o0001000) 61 | (:non-block #o0004000) 62 | (:data-sync #o0010000) 63 | (:async #o0020000) 64 | (:direct #o0040000) 65 | (:large-file #o0100000) 66 | (:directory #o0200000) 67 | (:no-follow #o0400000) 68 | (:no-atime #o1000000) 69 | (:close-exec #o2000000) 70 | (:file-sync #o4010000)) 71 | 72 | (cffi:defbitfield remap-flag 73 | (:may-move #x1) 74 | (:fixed #x2) 75 | (:dont-unmap #x4)) 76 | 77 | (cffi:defbitfield memfd-flag 78 | (:close-exec #x01) 79 | (:allow-sealing #x02) 80 | (:huge-table #x04) 81 | (:no-exec-seal #x08) 82 | (:executable #x10)) 83 | 84 | (cffi:defctype size-t 85 | #+64-bit :uint64 86 | #+32-bit :uint32) 87 | 88 | (cffi:defctype offset-t 89 | #+(or 64-bit bsd) :int64 90 | #-(or 64-bit bsd) :int32) 91 | 92 | (cffi:defcfun strerror :string 93 | (errnum :int)) 94 | 95 | (cffi:defcvar errno :int) 96 | 97 | (cffi:defcfun (u-open "open") :int 98 | (pathname :string) 99 | (mode open-flag)) 100 | 101 | (cffi:defcfun (u-close "close") :int 102 | (fd :int)) 103 | 104 | (cffi:defcfun (u-unlink "unlink") :int 105 | (fd :int)) 106 | 107 | ;; (cffi:defcfun (u-fstat "fstat") :int 108 | ;; (fd :int) 109 | ;; (buffer :pointer)) 110 | 111 | ;; (cffi:defcstruct stat 112 | ;; (device )) 113 | 114 | (cffi:defcfun (u-mmap "mmap") :pointer 115 | (address :pointer) 116 | (length size-t) 117 | (protection protection-flag) 118 | (flags mmap-flag) 119 | (fd :int) 120 | (offset offset-t)) 121 | 122 | (cffi:defcfun (u-munmap "munmap") :int 123 | (address :pointer) 124 | (length size-t)) 125 | 126 | (cffi:defcfun (u-msync "msync") :int 127 | (address :pointer) 128 | (length size-t) 129 | (flags msync-flag)) 130 | 131 | (cffi:defcfun (u-mprotect "mprotect") :int 132 | (address :pointer) 133 | (length size-t) 134 | (flags protection-flag)) 135 | 136 | (cffi:defcfun (u-madvise "madvise") :int 137 | (address :pointer) 138 | (length size-t) 139 | (advice madvise-flag)) 140 | 141 | (cffi:defcfun (u-mremap "mremap") :pointer 142 | (old-address :pointer) 143 | (old-length size-t) 144 | (new-size size-t) 145 | (flags remap-flag)) 146 | 147 | (cffi:defcfun (u-ftruncate "ftruncate") :int 148 | (fd :int) 149 | (new-size size-t)) 150 | 151 | (cffi:defcfun (memfd-create "memfd_create") :int 152 | (name :string) 153 | (flags memfd-flag)) 154 | 155 | (cffi:defcfun (shm-open "shm_open") :int 156 | (name :size) 157 | (flags open-flag) 158 | (mode :int)) 159 | 160 | (cffi:defcfun (getenv "getenv") :string 161 | (name :string)) 162 | 163 | (cffi:defcfun (mkostemp "mkostemp") :int 164 | (name :string) 165 | (flags open-flag)) 166 | 167 | (defun check-posix (result) 168 | (unless result 169 | (error-mmap errno (strerror errno)))) 170 | 171 | (defun create-anonymous-fd () 172 | (or 173 | (ignore-errors 174 | (let ((fd (memfd-create "mmap" '(:close-exec)))) 175 | (check-posix (<= 0 fd)) 176 | fd)) 177 | (ignore-errors ;; Special value SHM_ANON is 1. 178 | (let ((fd (shm-open 1 '(:write :close-exec) #o600))) 179 | (check-posix (<= 0 fd)) 180 | fd)) 181 | (let ((runtime-dir (getenv "XDG_RUNTIME_DIR"))) 182 | (when (or (null runtime-dir) (string= "" runtime-dir)) 183 | (setf runtime-dir "/run/")) 184 | (cffi:with-foreign-string (str (format NIL "~a/mmap-XXXXXX" runtime-dir)) 185 | (let ((fd (mkostemp str '(:close-exec)))) 186 | (check-posix (<= 0 fd)) 187 | (u-unlink str) 188 | fd))))) 189 | 190 | (declaim (notinline %mmap)) 191 | (defun %mmap (path size offset open protection mmap) 192 | (declare (type fixnum open protection mmap)) 193 | (declare (optimize speed)) 194 | (let ((fd -1) 195 | (error-handler (constantly nil))) 196 | (etypecase path 197 | ((eql :anonymous) 198 | (setf fd (create-anonymous-fd))) 199 | ((and fixnum unsigned-byte) 200 | (setf fd path) 201 | ;; If an fd is provided, the burden ought to be on the caller to 202 | ;; provide the size as well 203 | (check-type size unsigned-byte)) 204 | (string 205 | (setf fd (u-open path open) 206 | error-handler (lambda (e) 207 | (declare (ignore e)) 208 | (check-posix (= 0 (u-close fd))))) 209 | (check-posix (<= 0 fd)) 210 | (unless size 211 | (with-open-file (stream path :direction :input :element-type '(unsigned-byte 8)) 212 | (setf size (- (file-length stream) offset))))) 213 | (null)) 214 | (handler-bind ((error error-handler)) 215 | (let ((addr (u-mmap (cffi:null-pointer) 216 | size 217 | protection 218 | mmap 219 | fd 220 | offset))) 221 | (check-posix (/= (1- (ash 1 64)) (cffi:pointer-address addr))) 222 | (values addr fd size))))) 223 | 224 | (defun mmap (path &key (open '(:read)) (protection '(:read)) (mmap '(:private)) size (offset 0)) 225 | (%mmap (translate-path path) 226 | size offset 227 | (cffi:foreign-bitfield-value 'open-flag open) 228 | (cffi:foreign-bitfield-value 'protection-flag protection) 229 | (cffi:foreign-bitfield-value 'mmap-flag mmap))) 230 | 231 | (define-compiler-macro mmap (&environment env path &key (open ''(:read)) (protection ''(:read)) (mmap ''(:private)) size (offset 0)) 232 | `(%mmap ,(cfold env `(translate-path ,path) path) 233 | ,size ,offset 234 | ,(cfold env `(cffi:foreign-bitfield-value 'open-flag ,open) open) 235 | ,(cfold env `(cffi:foreign-bitfield-value 'protection-flag ,protection) protection) 236 | ,(cfold env `(cffi:foreign-bitfield-value 'mmap-flag ,mmap) mmap))) 237 | 238 | (defun munmap (addr fd size) 239 | (check-posix (= 0 (u-munmap addr size))) 240 | (when fd (u-close fd)) 241 | NIL) 242 | 243 | (defun msync (addr fd size &key (flags '(:sync))) 244 | (declare (ignore fd)) 245 | (check-posix (= 0 (u-msync addr size (cffi:foreign-bitfield-value 'msync-flag flags)))) 246 | NIL) 247 | 248 | (define-compiler-macro msync (&environment env addr fd size &key (flags ''(:sync))) 249 | (declare (ignore fd)) 250 | `(progn 251 | (check-posix (= 0 (u-msync ,addr ,size ,(cfold env `(cffi:foreign-bitfield-value 'msync-flag ,flags) flags)))) 252 | NIL)) 253 | 254 | (defun mprotect (addr size protection) 255 | (check-posix (= 0 (u-mprotect addr size (cffi:foreign-bitfield-value 'protection-flag protection)))) 256 | NIL) 257 | 258 | (define-compiler-macro mprotect (&environment env addr size protection) 259 | `(progn 260 | (check-posix (= 0 (u-mprotect ,addr ,size ,(cfold env `(cffi:foreign-bitfield-value 'protection-flag ,protection) protection)))) 261 | NIL)) 262 | 263 | (defun madvise (addr size advice) 264 | (check-posix (= 0 (u-madvise addr size advice))) 265 | NIL) 266 | 267 | (define-compiler-macro madvise (&environment env addr size advice) 268 | `(progn 269 | (check-posix (= 0 (u-madvise ,addr ,size ,(cfold env `(cffi:foreign-enum-value 'madvise-flag ,advice) advice)))) 270 | NIL)) 271 | 272 | (defun mremap (addr fd size new-size) 273 | (if (ignore-errors (cffi:foreign-symbol-pointer "mremap")) 274 | (let ((addr (u-mremap addr 275 | size 276 | new-size 277 | '(:may-move)))) 278 | (check-posix (/= (1- (ash 1 64)) (cffi:pointer-address addr))) 279 | (check-posix (= 0 (u-ftruncate fd new-size))) 280 | (values addr fd new-size)) 281 | (progn 282 | ;; FIXME: how to keep the right flags? 283 | (munmap addr NIL size) 284 | (check-posix (= 0 (u-ftruncate fd new-size))) 285 | (mmap fd :size new-size)))) 286 | -------------------------------------------------------------------------------- /test.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:mmap-test 2 | (:nicknames #:org.shirakumo.fraf.trial.mmap.test) 3 | (:use :cl :parachute)) 4 | (in-package #:org.shirakumo.fraf.trial.mmap.test) 5 | 6 | (defvar *this* #.(or *compile-file-pathname* *load-pathname* 7 | (error "COMPILE-FILE or LOAD this file."))) 8 | 9 | (define-test mmap) 10 | 11 | (define-test read-file 12 | :parent mmap 13 | (let (mmapped read) 14 | (finish 15 | (setf read (alexandria:read-file-into-string *this* :external-format :utf-8))) 16 | (finish 17 | (mmap:with-mmap (addr fd size *this*) 18 | (setf mmapped (cffi:foreign-string-to-lisp addr :count size :encoding :utf-8)))) 19 | (is string= read mmapped))) 20 | 21 | #+unix 22 | (define-test read-fd 23 | :parent mmap 24 | (let (fd mmapped read) 25 | (finish 26 | (setf read (alexandria:read-file-into-string *this* :external-format :utf-8))) 27 | (of-type unsigned-byte 28 | (setf fd (mmap::u-open (uiop:native-namestring *this*) '(:read)))) 29 | (finish 30 | (mmap:with-mmap (addr fd* size fd :size (length read) :dont-close t) 31 | (setf mmapped (cffi:foreign-string-to-lisp addr :count size :encoding :utf-8)))) 32 | (is = 0 (mmap::u-close fd)) 33 | (is string= read mmapped))) 34 | -------------------------------------------------------------------------------- /windows.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.fraf.trial.mmap) 2 | 3 | (pushnew :mmap *features*) 4 | 5 | (defconstant create-new 1) 6 | (defconstant file-attribute-normal 128) 7 | (defconstant file-flag-no-buffering 536870912) 8 | (defconstant file-flag-write-through 2147483648) 9 | (defconstant file-map-copy 1) 10 | (defconstant file-map-execute 32) 11 | (defconstant file-map-read 4) 12 | (defconstant file-map-write 2) 13 | (defconstant file-share-delete 4) 14 | (defconstant file-share-read 1) 15 | (defconstant file-share-write 2) 16 | (defconstant format-message-from-system 4096) 17 | (defconstant format-message-ignore-inserts 512) 18 | (defconstant generic-read 2147483648) 19 | (defconstant generic-write 1073741824) 20 | (defconstant invalid-file-size 4294967295) 21 | (defconstant invalid-handle-value 22 | (if (boundp 'invalid-handle-value) 23 | invalid-handle-value 24 | (if (= 8 (cffi:foreign-type-size :pointer)) 25 | (cffi:make-pointer (ldb (byte 64 0) -1)) 26 | (cffi:make-pointer (ldb (byte 32 0) -1))))) 27 | (defconstant open-always 4) 28 | (defconstant open-existing 3) 29 | (defconstant page-execute-read 32) 30 | (defconstant page-execute-readwrite 64) 31 | (defconstant page-readonly 2) 32 | (defconstant page-readwrite 4) 33 | (defconstant truncate-existing 5) 34 | 35 | (cffi:defctype wchar_t :uint16) 36 | (cffi:defctype handle :pointer) 37 | (cffi:defctype lpsecurity-attributes :pointer) 38 | (cffi:defctype dword :uint32) 39 | (cffi:defctype large-integer :uint64) 40 | (cffi:defctype size_t #+x86-64 :uint64 #+x86 :uint32) 41 | 42 | ;; https://docs.microsoft.com/en-us/windows/desktop/api/fileapi/nf-fileapi-createfilew 43 | (cffi:defcfun (create-file "CreateFileW") handle 44 | (path :pointer) 45 | (access dword) 46 | (share-mode dword) 47 | (attributes lpsecurity-attributes) 48 | (creation-disposition dword) 49 | (flags-and-attributes dword) 50 | (template-file handle)) 51 | 52 | ;; https://docs.microsoft.com/en-us/windows/desktop/api/fileapi/nf-fileapi-getfilesize 53 | (cffi:defcfun (get-file-size-ex "GetFileSizeEx") :boolean 54 | (file handle) 55 | (file-size :pointer)) 56 | 57 | ;; https://docs.microsoft.com/en-us/windows/desktop/api/winbase/nf-winbase-createfilemappinga 58 | (cffi:defcfun (create-file-mapping "CreateFileMappingA") handle 59 | (file handle) 60 | (attributes lpsecurity-attributes) 61 | (protect dword) 62 | (maximum-size-high dword) 63 | (maximum-size-low dword) 64 | (name :pointer)) 65 | 66 | (cffi:defcfun (close-handle "CloseHandle") :boolean 67 | (object handle)) 68 | 69 | ;; https://msdn.microsoft.com/en-us/library/windows/desktop/aa366761(v=vs.85).aspx 70 | (cffi:defcfun (map-view-of-file "MapViewOfFile") :pointer 71 | (file-mapping-object handle) 72 | (desired-access dword) 73 | (file-offset-high dword) 74 | (file-offset-low dword) 75 | (number-of-bytes-to-map size_t)) 76 | 77 | ;; https://msdn.microsoft.com/en-us/library/windows/desktop/aa366882(v=vs.85).aspx 78 | (cffi:defcfun (unmap-view-of-file "UnmapViewOfFile") :boolean 79 | (base-address :pointer)) 80 | 81 | ;; https://msdn.microsoft.com/en-us/library/windows/desktop/aa366563(v=vs.85).aspx 82 | (cffi:defcfun (flush-view-of-file "FlushViewOfFile") :boolean 83 | (base-address :pointer) 84 | (number-of-bytes-to-flush size_t)) 85 | 86 | ;; https://docs.microsoft.com/en-us/windows/desktop/api/fileapi/nf-fileapi-flushfilebuffers 87 | (cffi:defcfun (flush-file-buffers "FlushFileBuffers") :boolean 88 | (file handle)) 89 | 90 | ;; https://msdn.microsoft.com/en-us/library/windows/desktop/aa366898(v=vs.85).aspx 91 | (cffi:defcfun (virtual-protect "VirtualProtect") :boolean 92 | (address :pointer) 93 | (size size_t) 94 | (new-protect dword) 95 | (old-protect :pointer)) 96 | 97 | (cffi:defcfun (get-last-error "GetLastError") dword) 98 | 99 | (cffi:defcfun (format-message "FormatMessageW") dword 100 | (flags dword) 101 | (source :pointer) 102 | (message-id dword) 103 | (language-id dword) 104 | (buffer :pointer) 105 | (size dword) 106 | (arguments :pointer)) 107 | 108 | (cffi:defcfun (chsize "_chsize_s") :int 109 | (fd :int) 110 | (size :int64)) 111 | 112 | (defmacro check-windows (condition) 113 | `(unless ,condition 114 | (let ((errno (get-last-error))) 115 | (cffi:with-foreign-object (string 'wchar_t 256) 116 | (format-message (logior format-message-from-system format-message-ignore-inserts) 117 | (cffi:null-pointer) errno 0 string 256 (cffi:null-pointer)) 118 | ;; cffi defaults to BE when decoding without BOM, so specify 119 | ;; LE. Not sure if that is correct for BE windows systems if 120 | ;; they exist? 121 | (error-mmap errno (cffi:foreign-string-to-lisp string :encoding :utf-16le)))))) 122 | 123 | (declaim (inline %mmap)) 124 | (defun %mmap (path size offset open-access open-disposition open-flags protection map-access) 125 | (declare (type fixnum open-access open-disposition open-flags protection map-access offset)) 126 | (declare (optimize speed)) 127 | (let* ((fd invalid-handle-value) 128 | handle pointer 129 | (error-handler (lambda (e) 130 | (declare (ignore e)) 131 | (when handle (close-handle handle))))) 132 | (declare (type (or null (unsigned-byte 64)) size)) 133 | (declare (type cffi:foreign-pointer fd)) 134 | (etypecase path 135 | ((and fixnum unsigned-byte) 136 | (setf fd (cffi:make-pointer path)) 137 | ;; If an fd is provided, the burden ought to be on the caller to 138 | ;; provide the size as well 139 | (check-type size unsigned-byte)) 140 | (cffi:foreign-pointer 141 | (setf fd path) 142 | (check-type size unsigned-byte)) 143 | (string 144 | (cffi:with-foreign-string (string path :encoding :utf-16) 145 | (setf fd (create-file string 146 | open-access 147 | (logior file-share-delete 148 | file-share-read 149 | file-share-write) 150 | (cffi:null-pointer) 151 | open-disposition 152 | open-flags 153 | (cffi:null-pointer)) 154 | error-handler (lambda (e) 155 | (declare (ignore e)) 156 | (close-handle handle) 157 | (unless (cffi:pointer-eq invalid-handle-value fd) 158 | (close-handle fd))))) 159 | (check-windows (not (cffi:pointer-eq fd invalid-handle-value))) 160 | (unless size 161 | (cffi:with-foreign-object (tmp 'large-integer) 162 | (let ((ret (get-file-size-ex fd tmp))) 163 | (check-windows ret) 164 | (setf size (- (cffi:mem-ref tmp 'large-integer) offset)))))) 165 | (null)) 166 | (let ((end (+ (the (unsigned-byte 64) size) offset))) 167 | (declare (type (unsigned-byte 64) end)) 168 | (setf handle (create-file-mapping fd 169 | (cffi:null-pointer) 170 | protection 171 | (ldb (byte 32 32) end) 172 | (ldb (byte 32 0) end) 173 | (cffi:null-pointer))) 174 | (setf pointer (map-view-of-file handle 175 | map-access 176 | (ldb (byte 32 32) offset) 177 | (ldb (byte 32 0) offset) 178 | size)) 179 | (handler-bind ((error error-handler)) 180 | (check-windows (not (cffi:null-pointer-p pointer))) 181 | (values pointer (cons fd handle) size))))) 182 | 183 | (defun flagp (flags &rest tests) 184 | (loop for test in tests 185 | always (find test flags))) 186 | 187 | (defmacro set-flag (var flags test value) 188 | `(when (flagp ,flags ,test) 189 | (setf ,var (logior ,var ,value)))) 190 | 191 | (defun translate-open-access (flags) 192 | (let ((flag 0)) 193 | (or (set-flag flag flags :read generic-read) 194 | (error "OPEN flags must include :READ.")) 195 | (set-flag flag flags :write generic-write) 196 | flag)) 197 | 198 | (defun translate-open-disposition (flags) 199 | (if (flagp flags :create) 200 | (if (flagp flags :ensure-create) 201 | create-new 202 | open-always) 203 | (if (flagp flags :truncate) 204 | truncate-existing 205 | open-existing))) 206 | 207 | (defun translate-open-flags (flags) 208 | (let ((flag file-attribute-normal)) 209 | (set-flag flag flags :direct file-flag-no-buffering) 210 | (set-flag flag flags :file-sync file-flag-write-through) 211 | flag)) 212 | 213 | (defun translate-protection-flags (flags) 214 | (cond ((flagp flags :read :write :exec) 215 | page-execute-readwrite) 216 | ((flagp flags :read :write) 217 | page-readwrite) 218 | ((flagp flags :read :exec) 219 | page-execute-read) 220 | ((flagp flags :read) 221 | page-readonly) 222 | (T 223 | (error "PROTECTION flags must include :READ.")))) 224 | 225 | (defun translate-access-flags (protection flags) 226 | (let ((flag (if (flagp protection :write) 227 | file-map-write 228 | file-map-read))) 229 | (set-flag flag protection :exec file-map-execute) 230 | (unless (or (set-flag flag flags :private file-map-copy) 231 | (flagp flags :shared)) 232 | (error "MMAP flags must include either :PRIVATE or :SHARED.")) 233 | flag)) 234 | 235 | (defun mmap (path &key (open '(:read)) (protection '(:read)) (mmap '(:private)) size (offset 0)) 236 | (%mmap (translate-path path) 237 | size offset 238 | (translate-open-access open) 239 | (translate-open-disposition open) 240 | (translate-open-flags open) 241 | (translate-protection-flags protection) 242 | (translate-access-flags protection mmap))) 243 | 244 | (define-compiler-macro mmap (&environment env path &key (open ''(:read)) (protection ''(:read)) (mmap ''(:private)) size (offset 0)) 245 | `(%mmap ,(cfold env `(translate-path ,path) path) 246 | ,size ,offset 247 | ,(cfold env `(translate-open-access ,open) open) 248 | ,(cfold env `(translate-open-disposition ,open) open) 249 | ,(cfold env `(translate-open-flags ,open) open) 250 | ,(cfold env `(translate-protection-flags ,protection) protection) 251 | ,(cfold env `(translate-access-flags ,protection ,mmap) protection mmap))) 252 | 253 | (defun munmap (addr fd size) 254 | (declare (ignore size)) 255 | (check-windows (unmap-view-of-file addr)) 256 | (when fd 257 | (destructuring-bind (fd . handle) fd 258 | (check-windows (close-handle handle)) 259 | (check-windows (close-handle fd)))) 260 | NIL) 261 | 262 | (defun msync (addr fd size &key (flags '(:sync))) 263 | (check-windows (flush-view-of-file addr size)) 264 | (when (find :sync flags) 265 | (check-windows (flush-file-buffers (car fd)))) 266 | NIL) 267 | 268 | (defun mprotect (addr size protection) 269 | (cffi:with-foreign-object (oldprotect 'dword) 270 | (check-windows (virtual-protect addr size (translate-protection-flags protection) oldprotect)) 271 | NIL)) 272 | 273 | (define-compiler-macro mprotect (&environment env addr size protection) 274 | `(cffi:with-foreign-object (oldprotect 'dword) 275 | (check-windows (virtual-protect ,addr ,size ,(cfold env `(translate-protection-flags ,protection) protection) oldprotect)) 276 | NIL)) 277 | 278 | (defun mremap (addr fd size new-size) 279 | ;; FIXME: how to keep the right flags? 280 | (munmap addr NIL size) 281 | (check-windows (close-handle (cdr fd))) 282 | (check-windows (= 0 (chsize (car fd) size))) 283 | (mmap (car fd) :size new-size)) 284 | --------------------------------------------------------------------------------