support read-only mmap
parent
22d14b036a
commit
2484ea07b0
|
@ -9,13 +9,14 @@ SLOT: length
|
|||
|
||||
: mapped-file>direct ( mapped-file type -- alien length )
|
||||
[ [ address>> ] [ length>> ] bi ] dip
|
||||
heap-size [ 1- + ] keep /i ;
|
||||
heap-size [ 1 - + ] keep /i ;
|
||||
|
||||
FUNCTOR: define-mapped-array ( T -- )
|
||||
|
||||
<mapped-A> DEFINES <mapped-${T}-array>
|
||||
<A> IS <direct-${T}-array>
|
||||
with-mapped-A-file DEFINES with-mapped-${T}-file
|
||||
<mapped-A> DEFINES <mapped-${T}-array>
|
||||
<A> IS <direct-${T}-array>
|
||||
with-mapped-A-file DEFINES with-mapped-${T}-file
|
||||
with-mapped-A-file-reader DEFINES with-mapped-${T}-file-reader
|
||||
|
||||
WHERE
|
||||
|
||||
|
@ -25,4 +26,7 @@ WHERE
|
|||
: with-mapped-A-file ( path quot -- )
|
||||
'[ <mapped-A> @ ] with-mapped-file ; inline
|
||||
|
||||
: with-mapped-A-file-reader ( path quot -- )
|
||||
'[ <mapped-A> @ ] with-mapped-file-reader ; inline
|
||||
|
||||
;FUNCTOR
|
||||
|
|
|
@ -18,7 +18,13 @@ HELP: <mapped-file>
|
|||
|
||||
HELP: with-mapped-file
|
||||
{ $values { "path" "a pathname string" } { "quot" { $quotation "( mmap -- )" } } }
|
||||
{ $contract "Opens a file and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
|
||||
{ $contract "Opens a file for read/write access and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
|
||||
{ $notes "This is a low-level word, because " { $link mapped-file } " objects simply expose their base address and length. Most applications should use " { $link "io.mmap.arrays" } " instead." }
|
||||
{ $errors "Throws an error if a memory mapping could not be established." } ;
|
||||
|
||||
HELP: with-mapped-file-reader
|
||||
{ $values { "path" "a pathname string" } { "quot" { $quotation "( mmap -- )" } } }
|
||||
{ $contract "Opens a file for read-only access and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
|
||||
{ $notes "This is a low-level word, because " { $link mapped-file } " objects simply expose their base address and length. Most applications should use " { $link "io.mmap.arrays" } " instead." }
|
||||
{ $errors "Throws an error if a memory mapping could not be established." } ;
|
||||
|
||||
|
|
|
@ -8,14 +8,27 @@ IN: io.mmap
|
|||
|
||||
TUPLE: mapped-file address handle length disposed ;
|
||||
|
||||
HOOK: (mapped-file) os ( path length -- address handle )
|
||||
HOOK: (mapped-file-reader) os ( path length -- address handle )
|
||||
HOOK: (mapped-file-r/w) os ( path length -- address handle )
|
||||
|
||||
ERROR: bad-mmap-size path size ;
|
||||
|
||||
: <mapped-file> ( path -- mmap )
|
||||
<PRIVATE
|
||||
|
||||
: prepare-mapped-file ( path -- path' n )
|
||||
[ normalize-path ] [ file-info size>> ] bi
|
||||
dup 0 <= [ bad-mmap-size ] when
|
||||
[ (mapped-file) ] keep
|
||||
dup 0 <= [ bad-mmap-size ] when ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: <mapped-file-reader> ( path -- mmap )
|
||||
prepare-mapped-file
|
||||
[ (mapped-file-reader) ] keep
|
||||
f mapped-file boa ;
|
||||
|
||||
: <mapped-file> ( path -- mmap )
|
||||
prepare-mapped-file
|
||||
[ (mapped-file-r/w) ] keep
|
||||
f mapped-file boa ;
|
||||
|
||||
HOOK: close-mapped-file io-backend ( mmap -- )
|
||||
|
@ -25,6 +38,9 @@ M: mapped-file dispose* ( mmap -- ) close-mapped-file ;
|
|||
: with-mapped-file ( path quot -- )
|
||||
[ <mapped-file> ] dip with-disposal ; inline
|
||||
|
||||
: with-mapped-file-reader ( path quot -- )
|
||||
[ <mapped-file-reader> ] dip with-disposal ; inline
|
||||
|
||||
{
|
||||
{ [ os unix? ] [ "io.mmap.unix" require ] }
|
||||
{ [ os winnt? ] [ "io.mmap.windows" require ] }
|
||||
|
|
|
@ -13,11 +13,16 @@ IN: io.mmap.unix
|
|||
[ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep
|
||||
] with-destructors ;
|
||||
|
||||
M: unix (mapped-file)
|
||||
M: unix (mapped-file-r/w)
|
||||
{ PROT_READ PROT_WRITE } flags
|
||||
{ MAP_FILE MAP_SHARED } flags
|
||||
mmap-open ;
|
||||
|
||||
M: unix (mapped-file-reader)
|
||||
{ PROT_READ } flags
|
||||
{ MAP_FILE MAP_SHARED } flags
|
||||
mmap-open ;
|
||||
|
||||
M: unix close-mapped-file ( mmap -- )
|
||||
[ [ address>> ] [ length>> ] bi munmap io-error ]
|
||||
[ handle>> close-file ]
|
||||
|
|
|
@ -28,7 +28,7 @@ M: win32-mapped-file dispose
|
|||
|
||||
C: <win32-mapped-file> win32-mapped-file
|
||||
|
||||
M: windows (mapped-file)
|
||||
M: windows (mapped-file-r/w)
|
||||
[
|
||||
{ GENERIC_WRITE GENERIC_READ } flags
|
||||
OPEN_ALWAYS
|
||||
|
@ -37,6 +37,15 @@ M: windows (mapped-file)
|
|||
-rot <win32-mapped-file>
|
||||
] with-destructors ;
|
||||
|
||||
M: windows (mapped-file-reader)
|
||||
[
|
||||
GENERIC_READ
|
||||
OPEN_ALWAYS
|
||||
{ PAGE_READONLY SEC_COMMIT } flags
|
||||
FILE_MAP_READ mmap-open
|
||||
-rot <win32-mapped-file>
|
||||
] with-destructors ;
|
||||
|
||||
M: windows close-mapped-file ( mapped-file -- )
|
||||
[
|
||||
[ handle>> &dispose drop ]
|
||||
|
|
Loading…
Reference in New Issue