support read-only mmap

db4
Doug Coleman 2009-04-25 19:22:00 -05:00
parent 22d14b036a
commit 2484ea07b0
5 changed files with 51 additions and 11 deletions

View File

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

View File

@ -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." } ;

View File

@ -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 ] }

View File

@ -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 ]

View 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 ]