mmap 0.5.6 → 0.5.7
raw patch · 6 files changed
+766/−1112 lines, 6 filessetup-changedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Setup.hs +1/−1
- System/IO/MMap.hs +391/−391
- cbits/posix.c +166/−165
- cbits/win32.c +206/−206
- mmap.cabal +2/−2
- tests/mmaptest.hs +0/−347
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple +import Distribution.Simple main = defaultMain
System/IO/MMap.hs view
@@ -1,391 +1,391 @@-{-# LANGUAGE ForeignFunctionInterface, CPP #-} --- | --- Module : System.IO.MMap --- Copyright : (c) Gracjan Polak 2009 --- License : BSD-style --- --- Stability : experimental --- Portability : portable --- --- This library provides a wrapper to mmap(2) or MapViewOfFile, --- allowing files or devices to be lazily loaded into memory as strict --- or lazy ByteStrings, ForeignPtrs or plain Ptrs, using the virtual --- memory subsystem to do on-demand loading. Modifications are also --- supported. - - -module System.IO.MMap -( - -- $mmap_intro - - -- * Mapping mode - Mode(..), - - -- * Memory mapped files strict interface - mmapFilePtr, - mmapWithFilePtr, - mmapFileForeignPtr, - mmapFileByteString, - - munmapFilePtr, - - -- * Memory mapped files lazy interface - mmapFileForeignPtrLazy, - mmapFileByteStringLazy -) -where - -import System.IO () -import Foreign.Ptr (Ptr,FunPtr,nullPtr,plusPtr,minusPtr,castPtr) -import Foreign.C.Types (CInt,CLLong,CSize) -import Foreign.C.String (CString,withCString) -import Foreign.ForeignPtr (ForeignPtr,withForeignPtr,finalizeForeignPtr,newForeignPtr,newForeignPtrEnv,newForeignPtr_) -import Foreign.Storable( poke ) -import Foreign.Marshal.Alloc( malloc, mallocBytes, free ) -import Foreign.C.Error -import qualified Foreign.Concurrent( newForeignPtr ) -import System.IO.Unsafe (unsafePerformIO) -import qualified Data.ByteString.Internal as BS (fromForeignPtr) -import Data.Int (Int64) -import Control.Monad (when,liftM) -import Control.Exception -import qualified Data.ByteString as BS (ByteString) -import qualified Data.ByteString.Lazy as BSL (ByteString,fromChunks) - -import Debug.Trace - --- TODO: --- - support native characters (Unicode) in FilePath --- - support externally given HANDLEs and FDs --- - support data commit --- - support memory region resize - --- $mmap_intro --- --- This module is an interface to @mmap(2)@ system call under POSIX --- (Unix, Linux, Mac OS X) and @CreateFileMapping@, @MapViewOfFile@ under --- Windows. --- --- We can consider mmap as lazy IO pushed into the virtual memory --- subsystem. --- --- It is only safe to mmap a file if you know you are the sole --- user. Otherwise referential transparency may be or may be not --- compromised. Sadly semantics differ much between operating systems. --- --- In case of IO errors all function use 'throwErrno' or 'throwErrnoPath'. --- --- In case of 'ForeignPtr' or 'BS.ByteString' functions the storage --- manager is used to free the mapped memory. When the garbage --- collector notices there are no further references to the mapped --- memory, a call to @munmap@ is made. It is not necessary to do this --- yourself. In tight memory situations it may be profitable to use --- 'System.Mem.performGC' or 'finalizeForeignPtr' to force an unmap --- action. You can also use 'mmapWithFilePtr' that uses scope based --- resource allocation. --- --- To free resources returned as Ptr use 'munmapFilePtr'. --- --- For modes 'ReadOnly', 'ReadWrite' and 'WriteCopy' file must exist --- before mapping it into memory. It also needs to have correct --- permissions for reading and/or writing (depending on mode). In --- 'ReadWriteEx' the file will be created with default permissions if --- it does not exist. --- --- If mode is 'ReadWrite', 'ReadWriteEx' or 'WriteCopy' the returned --- memory region may be written to with 'Foreign.Storable.poke' and --- friends. In 'WriteCopy' mode changes will not be written to disk. --- It is an error to modify mapped memory in 'ReadOnly' mode. If is --- undefined if and how changes from external changes affect your --- mmapped regions, they may reflect in your memory or may not and --- this note applies equally to all modes. --- --- Range specified may be 'Nothing', in this case whole file will be --- mapped. Otherwise range should be 'Just (offset,size)' where --- offsets is the beginning byte of file region to map and size tells --- mapping length. There are no alignment requirements. Returned Ptr or --- ForeignPtr will be aligned to page size boundary and you'll be --- given offset to your data. Both @offset@ and @size@ must be --- nonnegative. Sum @offset + size@ should not be greater than file --- length, except in 'ReadWriteEx' mode when file will be extended to --- cover whole range. We do allow @size@ to be 0 and we do mmap files --- of 0 length. If your offset is 0 you are guaranteed to receive page --- aligned pointer back. You are required to give explicit range in --- case of 'ReadWriteEx' even if the file exists. --- --- File extension in 'ReadWriteEx' mode seems to use sparse files --- whenever supported by oprating system and therefore returns --- immediatelly as postpones real block allocation for later. --- --- For more details about mmap and its consequences see: --- --- * <http://opengroup.org/onlinepubs/009695399/functions/mmap.html> --- --- * <http://www.gnu.org/software/libc/manual/html_node/Memory_002dmapped-I_002fO.html> --- --- * <http://msdn2.microsoft.com/en-us/library/aa366781(VS.85).aspx> --- --- Questions and Answers --- --- * Q: What happens if somebody writes to my mmapped file? A: --- Undefined. System is free to not synchronize write system call and --- mmap so nothing is sure. So this might be reflected in your memory --- or not. This applies even in 'WriteCopy' mode. --- --- * Q: What happens if I map 'ReadWrite' and change memory? A: After --- some time in will be written to disk. It is unspecified when this --- happens. --- --- * Q: What if somebody removes my file? A: Undefined. File with --- mmapped region is treated by system as open file. Removing such --- file works the same way as removing open file and different systems --- have different ideas what to do in such case. --- --- * Q: Why can't I open my file for writting after mmaping it? A: --- File needs to be unmapped first. Either make sure you don't --- reference memory mapped regions and force garbage collection (this --- is hard to do) or better yet use mmaping with explicit memory --- management. --- --- * Q: Can I map region after end of file? A: You need to use --- 'ReadWriteEx' mode. --- - - --- | Mode of mapping. Four cases are supported. -data Mode = ReadOnly -- ^ file is mapped read-only, file must - -- exist - | ReadWrite -- ^ file is mapped read-write, file must - -- exist - | WriteCopy -- ^ file is mapped read-write, but changes - -- aren't propagated to disk, file must exist - | ReadWriteEx -- ^ file is mapped read-write, if file does - -- not exist it will be created with default - -- permissions, region parameter specifies - -- size, if file size is lower it will be - -- extended with zeros - deriving (Eq,Ord,Enum,Show,Read) - -sanitizeFileRegion :: (Integral a,Bounded a) => String -> ForeignPtr () -> Mode -> Maybe (Int64,a) -> IO (Int64,a) -sanitizeFileRegion filepath handle ReadWriteEx (Just region@(offset,length)) = - withForeignPtr handle $ \handle -> do - longsize <- c_system_io_file_size handle - let needsize = fromIntegral (offset + fromIntegral length) - when (longsize < needsize) - ((throwErrnoPathIfMinus1 "extend file size" filepath $ - c_system_io_extend_file_size handle needsize) >> return ()) - return region -sanitizeFileRegion filepath handle ReadWriteEx _ - = error "sanitizeRegion given ReadWriteEx with no region, please check earlier for this" -sanitizeFileRegion filepath handle mode region = withForeignPtr handle $ \handle -> do - longsize <- c_system_io_file_size handle >>= \x -> return (fromIntegral x) - let Just (_,sizetype) = region - (offset,size) <- case region of - Just (offset,size) -> do - when (size<0) $ - ioError (errnoToIOError "mmap negative size reguested" eINVAL Nothing (Just filepath)) - when (offset<0) $ - ioError (errnoToIOError "mmap negative offset reguested" eINVAL Nothing (Just filepath)) - when (mode/=ReadWriteEx && (longsize<offset || longsize<(offset + fromIntegral size))) $ - ioError (errnoToIOError "mmap offset and size beyond end of file" eINVAL Nothing (Just filepath)) - return (offset,size) - Nothing -> do - when (longsize > fromIntegral (maxBound `asTypeOf` sizetype)) $ - ioError (errnoToIOError "mmap requested size is greater then maxBound" eINVAL Nothing (Just filepath)) - return (0,fromIntegral longsize) - return (offset,size) - -checkModeRegion :: FilePath -> Mode -> Maybe a -> IO () -checkModeRegion filepath ReadWriteEx Nothing = - ioError (errnoToIOError "mmap ReadWriteEx must have explicit region" eINVAL Nothing (Just filepath)) -checkModeRegion _ _ _ = return () - --- | The 'mmapFilePtr' function maps a file or device into memory, --- returning a tuple @(ptr,rawsize,offset,size)@ where: --- --- * @ptr@ is pointer to mmapped region --- --- * @rawsize@ is length (in bytes) of mapped data, rawsize might be --- greater than size because of alignment --- --- * @offset@ tell where your data lives: @plusPtr ptr offset@ --- --- * @size@ your data length (in bytes) --- --- If 'mmapFilePtr' fails for some reason, a 'throwErrno' is used. --- --- Use @munmapFilePtr ptr rawsize@ to unmap memory. --- --- Memory mapped files will behave as if they were read lazily --- pages from the file will be loaded into memory on demand. --- - -mmapFilePtr :: FilePath -- ^ name of file to mmap - -> Mode -- ^ access mode - -> Maybe (Int64,Int) -- ^ range to map, maps whole file if Nothing - -> IO (Ptr a,Int,Int,Int) -- ^ (ptr,rawsize,offset,size) -mmapFilePtr filepath mode offsetsize = do - checkModeRegion filepath mode offsetsize - bracket (mmapFileOpen filepath mode) - (finalizeForeignPtr) mmap - where - mmap handle = do - (offset,size) <- sanitizeFileRegion filepath handle mode offsetsize - let align = offset `mod` fromIntegral c_system_io_granularity - let offsetraw = offset - align - let sizeraw = size + fromIntegral align - ptr <- withForeignPtr handle $ \handle -> - c_system_io_mmap_mmap handle (fromIntegral $ fromEnum mode) - (fromIntegral offsetraw) (fromIntegral sizeraw) - when (ptr == nullPtr) $ - throwErrnoPath ("mmap of '" ++ filepath ++ "' failed") filepath - return (castPtr ptr,sizeraw,fromIntegral align,size) - --- | Memory map region of file using autounmap semantics. See --- 'mmapFilePtr' for description of parameters. The @action@ will be --- executed with tuple @(ptr,size)@ as single argument. This is the --- pointer to mapped data already adjusted and size of requested --- region. Return value is that of action. -mmapWithFilePtr :: FilePath -- ^ name of file to mmap - -> Mode -- ^ access mode - -> Maybe (Int64,Int) -- ^ range to map, maps whole file if Nothing - -> ((Ptr (),Int) -> IO a) -- ^ action to run - -> IO a -- ^ result of action -mmapWithFilePtr filepath mode offsetsize action = do - checkModeRegion filepath mode offsetsize - (ptr,rawsize,offset,size) <- mmapFilePtr filepath mode offsetsize - result <- action (ptr `plusPtr` offset,size) `finally` munmapFilePtr ptr rawsize - return result - --- | Maps region of file and returns it as 'ForeignPtr'. See 'mmapFilePtr' for details. -mmapFileForeignPtr :: FilePath -- ^ name of file to map - -> Mode -- ^ access mode - -> Maybe (Int64,Int) -- ^ range to map, maps whole file if Nothing - -> IO (ForeignPtr a,Int,Int) -- ^ foreign pointer to beginning of raw region, - -- offset to your data and size of your data -mmapFileForeignPtr filepath mode range = do - checkModeRegion filepath mode range - (rawptr,rawsize,offset,size) <- mmapFilePtr filepath mode range - let rawsizeptr = castIntToPtr rawsize - foreignptr <- newForeignPtrEnv c_system_io_mmap_munmap_funptr rawsizeptr rawptr - return (foreignptr,offset,size) - --- | Maps region of file and returns it as 'BS.ByteString'. File is --- mapped in in 'ReadOnly' mode. See 'mmapFilePtr' for details. -mmapFileByteString :: FilePath -- ^ name of file to map - -> Maybe (Int64,Int) -- ^ range to map, maps whole file if Nothing - -> IO BS.ByteString -- ^ bytestring with file contents -mmapFileByteString filepath range = do - (foreignptr,offset,size) <- mmapFileForeignPtr filepath ReadOnly range - let bytestring = BS.fromForeignPtr foreignptr offset size - return bytestring - --- | The 'mmapFileForeignPtrLazy' function maps a file or device into memory, --- returning a list of tuples with the same meaning as in function --- 'mmapFileForeignPtr'. --- -mmapFileForeignPtrLazy :: FilePath -- ^ name of file to mmap - -> Mode -- ^ access mode - -> Maybe (Int64,Int64) -- ^ range to map, maps whole file if Nothing - -> IO [(ForeignPtr a,Int,Int)] -- ^ (ptr,offset,size) -mmapFileForeignPtrLazy filepath mode offsetsize = do - checkModeRegion filepath mode offsetsize - bracketOnError (mmapFileOpen filepath mode) - (finalizeForeignPtr) mmap - where - mmap handle = do - (offset,size) <- sanitizeFileRegion filepath handle mode offsetsize - return $ map (mapChunk handle) (chunks offset size) - -- FIXME: might be we need NOINLINE pragma here, investigate later - mapChunk handle (offset,size) = unsafePerformIO $ - withForeignPtr handle $ \handle -> do - let align = offset `mod` fromIntegral c_system_io_granularity - offsetraw = offset - align - sizeraw = size + fromIntegral align - ptr <- c_system_io_mmap_mmap handle (fromIntegral $ fromEnum mode) - (fromIntegral offsetraw) (fromIntegral sizeraw) - when (ptr == nullPtr) $ - throwErrnoPath ("lazy mmap of '" ++ filepath ++ - "' chunk(" ++ show offset ++ "," ++ show size ++") failed") filepath - let rawsizeptr = castIntToPtr sizeraw - foreignptr <- newForeignPtrEnv c_system_io_mmap_munmap_funptr rawsizeptr ptr - return (foreignptr,fromIntegral offset,size) - -chunks :: Int64 -> Int64 -> [(Int64,Int)] -chunks offset 0 = [] -chunks offset size | size <= fromIntegral chunkSize = [(offset,fromIntegral size)] - | otherwise = let offset2 = ((offset + chunkSize + chunkSize - 1) `div` chunkSize) * chunkSize - size2 = offset2 - offset - in (offset,fromIntegral size2) : chunks offset2 (size-size2) - --- | Maps region of file and returns it as 'BSL.ByteString'. File is --- mapped in in 'ReadOnly' mode. See 'mmapFileForeignPtrLazy' for --- details. -mmapFileByteStringLazy :: FilePath -- ^ name of file to map - -> Maybe (Int64,Int64) -- ^ range to map, maps whole file if Nothing - -> IO BSL.ByteString -- ^ bytestring with file content -mmapFileByteStringLazy filepath offsetsize = do - list <- mmapFileForeignPtrLazy filepath ReadOnly offsetsize - return (BSL.fromChunks (map turn list)) - where - turn (foreignptr,offset,size) = BS.fromForeignPtr foreignptr offset size - --- | Unmaps memory region. As parameters use values marked as ptr and --- rawsize in description of 'mmapFilePtr'. -munmapFilePtr :: Ptr a -- ^ pointer - -> Int -- ^ rawsize - -> IO () -munmapFilePtr ptr rawsize = c_system_io_mmap_munmap (castIntToPtr rawsize) ptr - -chunkSize :: Num a => a -chunkSize = fromIntegral $ (128*1024 `div` c_system_io_granularity) * c_system_io_granularity - -mmapFileOpen :: FilePath -> Mode -> IO (ForeignPtr ()) -mmapFileOpen filepath mode = do - ptr <- withCString filepath $ \filepath -> - c_system_io_mmap_file_open filepath (fromIntegral $ fromEnum mode) - when (ptr == nullPtr) $ - throwErrnoPath ("opening of '" ++ filepath ++ "' failed") filepath - handle <- newForeignPtr c_system_io_mmap_file_close ptr - return handle - -castPtrToInt :: Ptr a -> Int -castPtrToInt ptr = ptr `minusPtr` nullPtr - -castIntToPtr :: Int -> Ptr a -castIntToPtr int = nullPtr `plusPtr` int - - --- | Should open file given as CString in mode given as CInt -foreign import ccall unsafe "HsMmap.h system_io_mmap_file_open" - c_system_io_mmap_file_open :: CString -- ^ file path, system encoding - -> CInt -- ^ mode as 0, 1, 2, fromEnum - -> IO (Ptr ()) -- ^ file handle returned, nullPtr on error (and errno set) --- | Used in finalizers, to close handle -foreign import ccall unsafe "HsMmap.h &system_io_mmap_file_close" - c_system_io_mmap_file_close :: FunPtr(Ptr () -> IO ()) - --- | Mmemory maps file from handle, using mode, starting offset and size -foreign import ccall unsafe "HsMmap.h system_io_mmap_mmap" - c_system_io_mmap_mmap :: Ptr () -- ^ handle from c_system_io_mmap_file_open - -> CInt -- ^ mode - -> CLLong -- ^ starting offset, must be nonegative - -> CSize -- ^ length, must be greater than zero - -> IO (Ptr a) -- ^ starting pointer to byte data, nullPtr on error (plus errno set) --- | Used in finalizers -foreign import ccall unsafe "HsMmap.h &system_io_mmap_munmap" - c_system_io_mmap_munmap_funptr :: FunPtr(Ptr () -> Ptr a -> IO ()) --- | Unmap region of memory. Size must be the same as returned by --- mmap. If size is zero, does nothing (treats pointer as invalid) -foreign import ccall unsafe "HsMmap.h system_io_mmap_munmap" - c_system_io_mmap_munmap :: Ptr () -> Ptr a -> IO () --- | Get file size in system specific manner -foreign import ccall unsafe "HsMmap.h system_io_mmap_file_size" - c_system_io_file_size :: Ptr () -> IO CLLong --- | Set file size in system specific manner. It is guaranteed to be called --- only with new size being at least current size. -foreign import ccall unsafe "HsMmap.h system_io_mmap_extend_file_size" - c_system_io_extend_file_size :: Ptr () -> CLLong -> IO CInt --- | Memory mapping granularity. -foreign import ccall unsafe "HsMmap.h system_io_mmap_granularity" - c_system_io_granularity :: CInt +{-# LANGUAGE ForeignFunctionInterface, CPP #-}+-- |+-- Module : System.IO.MMap+-- Copyright : (c) Gracjan Polak 2009+-- License : BSD-style +-- +-- Stability : experimental+-- Portability : portable+--+-- This library provides a wrapper to mmap(2) or MapViewOfFile,+-- allowing files or devices to be lazily loaded into memory as strict+-- or lazy ByteStrings, ForeignPtrs or plain Ptrs, using the virtual+-- memory subsystem to do on-demand loading. Modifications are also+-- supported.+++module System.IO.MMap+(+ -- $mmap_intro++ -- * Mapping mode+ Mode(..),++ -- * Memory mapped files strict interface+ mmapFilePtr,+ mmapWithFilePtr,+ mmapFileForeignPtr,+ mmapFileByteString,++ munmapFilePtr,++ -- * Memory mapped files lazy interface+ mmapFileForeignPtrLazy,+ mmapFileByteStringLazy+)+where++import System.IO ()+import Foreign.Ptr (Ptr,FunPtr,nullPtr,plusPtr,minusPtr,castPtr)+import Foreign.C.Types (CInt,CLLong,CSize)+import Foreign.C.String (CString,withCString)+import Foreign.ForeignPtr (ForeignPtr,withForeignPtr,finalizeForeignPtr,newForeignPtr,newForeignPtrEnv,newForeignPtr_)+import Foreign.Storable( poke )+import Foreign.Marshal.Alloc( malloc, mallocBytes, free )+import Foreign.C.Error+import qualified Foreign.Concurrent( newForeignPtr )+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.ByteString.Internal as BS (fromForeignPtr)+import Data.Int (Int64)+import Control.Monad (when,liftM)+import Control.Exception+import qualified Data.ByteString as BS (ByteString)+import qualified Data.ByteString.Lazy as BSL (ByteString,fromChunks)++import Debug.Trace++-- TODO:+-- - support native characters (Unicode) in FilePath+-- - support externally given HANDLEs and FDs+-- - support data commit+-- - support memory region resize++-- $mmap_intro+--+-- This module is an interface to @mmap(2)@ system call under POSIX+-- (Unix, Linux, Mac OS X) and @CreateFileMapping@, @MapViewOfFile@ under+-- Windows.+--+-- We can consider mmap as lazy IO pushed into the virtual memory+-- subsystem.+--+-- It is only safe to mmap a file if you know you are the sole+-- user. Otherwise referential transparency may be or may be not+-- compromised. Sadly semantics differ much between operating systems.+--+-- In case of IO errors all function use 'throwErrno' or 'throwErrnoPath'.+--+-- In case of 'ForeignPtr' or 'BS.ByteString' functions the storage+-- manager is used to free the mapped memory. When the garbage+-- collector notices there are no further references to the mapped+-- memory, a call to @munmap@ is made. It is not necessary to do this+-- yourself. In tight memory situations it may be profitable to use+-- 'System.Mem.performGC' or 'finalizeForeignPtr' to force an unmap+-- action. You can also use 'mmapWithFilePtr' that uses scope based+-- resource allocation.+--+-- To free resources returned as Ptr use 'munmapFilePtr'.+--+-- For modes 'ReadOnly', 'ReadWrite' and 'WriteCopy' file must exist+-- before mapping it into memory. It also needs to have correct+-- permissions for reading and/or writing (depending on mode). In+-- 'ReadWriteEx' the file will be created with default permissions if+-- it does not exist.+--+-- If mode is 'ReadWrite', 'ReadWriteEx' or 'WriteCopy' the returned+-- memory region may be written to with 'Foreign.Storable.poke' and+-- friends. In 'WriteCopy' mode changes will not be written to disk.+-- It is an error to modify mapped memory in 'ReadOnly' mode. If is+-- undefined if and how changes from external changes affect your+-- mmapped regions, they may reflect in your memory or may not and+-- this note applies equally to all modes.+--+-- Range specified may be 'Nothing', in this case whole file will be+-- mapped. Otherwise range should be 'Just (offset,size)' where+-- offsets is the beginning byte of file region to map and size tells+-- mapping length. There are no alignment requirements. Returned Ptr or+-- ForeignPtr will be aligned to page size boundary and you'll be+-- given offset to your data. Both @offset@ and @size@ must be+-- nonnegative. Sum @offset + size@ should not be greater than file+-- length, except in 'ReadWriteEx' mode when file will be extended to+-- cover whole range. We do allow @size@ to be 0 and we do mmap files+-- of 0 length. If your offset is 0 you are guaranteed to receive page+-- aligned pointer back. You are required to give explicit range in+-- case of 'ReadWriteEx' even if the file exists.+--+-- File extension in 'ReadWriteEx' mode seems to use sparse files+-- whenever supported by oprating system and therefore returns+-- immediatelly as postpones real block allocation for later.+--+-- For more details about mmap and its consequences see:+--+-- * <http://opengroup.org/onlinepubs/009695399/functions/mmap.html>+--+-- * <http://www.gnu.org/software/libc/manual/html_node/Memory_002dmapped-I_002fO.html>+--+-- * <http://msdn2.microsoft.com/en-us/library/aa366781(VS.85).aspx>+--+-- Questions and Answers+--+-- * Q: What happens if somebody writes to my mmapped file? A:+-- Undefined. System is free to not synchronize write system call and+-- mmap so nothing is sure. So this might be reflected in your memory+-- or not. This applies even in 'WriteCopy' mode.+--+-- * Q: What happens if I map 'ReadWrite' and change memory? A: After+-- some time in will be written to disk. It is unspecified when this+-- happens.+--+-- * Q: What if somebody removes my file? A: Undefined. File with+-- mmapped region is treated by system as open file. Removing such+-- file works the same way as removing open file and different systems+-- have different ideas what to do in such case.+--+-- * Q: Why can't I open my file for writting after mmaping it? A:+-- File needs to be unmapped first. Either make sure you don't+-- reference memory mapped regions and force garbage collection (this+-- is hard to do) or better yet use mmaping with explicit memory+-- management.+--+-- * Q: Can I map region after end of file? A: You need to use+-- 'ReadWriteEx' mode.+--+++-- | Mode of mapping. Four cases are supported.+data Mode = ReadOnly -- ^ file is mapped read-only, file must+ -- exist+ | ReadWrite -- ^ file is mapped read-write, file must+ -- exist+ | WriteCopy -- ^ file is mapped read-write, but changes+ -- aren't propagated to disk, file must exist+ | ReadWriteEx -- ^ file is mapped read-write, if file does+ -- not exist it will be created with default+ -- permissions, region parameter specifies+ -- size, if file size is lower it will be+ -- extended with zeros+ deriving (Eq,Ord,Enum,Show,Read)++sanitizeFileRegion :: (Integral a,Bounded a) => String -> ForeignPtr () -> Mode -> Maybe (Int64,a) -> IO (Int64,a)+sanitizeFileRegion filepath handle ReadWriteEx (Just region@(offset,length)) = + withForeignPtr handle $ \handle -> do+ longsize <- c_system_io_file_size handle+ let needsize = fromIntegral (offset + fromIntegral length)+ when (longsize < needsize) + ((throwErrnoPathIfMinus1 "extend file size" filepath $ + c_system_io_extend_file_size handle needsize) >> return ())+ return region +sanitizeFileRegion filepath handle ReadWriteEx _ + = error "sanitizeRegion given ReadWriteEx with no region, please check earlier for this"+sanitizeFileRegion filepath handle mode region = withForeignPtr handle $ \handle -> do+ longsize <- c_system_io_file_size handle >>= \x -> return (fromIntegral x)+ let Just (_,sizetype) = region+ (offset,size) <- case region of+ Just (offset,size) -> do+ when (size<0) $+ ioError (errnoToIOError "mmap negative size reguested" eINVAL Nothing (Just filepath))+ when (offset<0) $+ ioError (errnoToIOError "mmap negative offset reguested" eINVAL Nothing (Just filepath))+ when (mode/=ReadWriteEx && (longsize<offset || longsize<(offset + fromIntegral size))) $+ ioError (errnoToIOError "mmap offset and size beyond end of file" eINVAL Nothing (Just filepath))+ return (offset,size)+ Nothing -> do+ when (longsize > fromIntegral (maxBound `asTypeOf` sizetype)) $+ ioError (errnoToIOError "mmap requested size is greater then maxBound" eINVAL Nothing (Just filepath))+ return (0,fromIntegral longsize)+ return (offset,size)++checkModeRegion :: FilePath -> Mode -> Maybe a -> IO ()+checkModeRegion filepath ReadWriteEx Nothing = + ioError (errnoToIOError "mmap ReadWriteEx must have explicit region" eINVAL Nothing (Just filepath))+checkModeRegion _ _ _ = return ()++-- | The 'mmapFilePtr' function maps a file or device into memory,+-- returning a tuple @(ptr,rawsize,offset,size)@ where:+--+-- * @ptr@ is pointer to mmapped region+--+-- * @rawsize@ is length (in bytes) of mapped data, rawsize might be+-- greater than size because of alignment+--+-- * @offset@ tell where your data lives: @plusPtr ptr offset@+--+-- * @size@ your data length (in bytes)+--+-- If 'mmapFilePtr' fails for some reason, a 'throwErrno' is used.+--+-- Use @munmapFilePtr ptr rawsize@ to unmap memory.+--+-- Memory mapped files will behave as if they were read lazily +-- pages from the file will be loaded into memory on demand.+--++mmapFilePtr :: FilePath -- ^ name of file to mmap+ -> Mode -- ^ access mode+ -> Maybe (Int64,Int) -- ^ range to map, maps whole file if Nothing+ -> IO (Ptr a,Int,Int,Int) -- ^ (ptr,rawsize,offset,size)+mmapFilePtr filepath mode offsetsize = do+ checkModeRegion filepath mode offsetsize+ bracket (mmapFileOpen filepath mode)+ (finalizeForeignPtr) mmap+ where+ mmap handle = do+ (offset,size) <- sanitizeFileRegion filepath handle mode offsetsize+ let align = offset `mod` fromIntegral c_system_io_granularity+ let offsetraw = offset - align+ let sizeraw = size + fromIntegral align+ ptr <- withForeignPtr handle $ \handle ->+ c_system_io_mmap_mmap handle (fromIntegral $ fromEnum mode) + (fromIntegral offsetraw) (fromIntegral sizeraw)+ when (ptr == nullPtr) $+ throwErrnoPath ("mmap of '" ++ filepath ++ "' failed") filepath+ return (castPtr ptr,sizeraw,fromIntegral align,size)++-- | Memory map region of file using autounmap semantics. See+-- 'mmapFilePtr' for description of parameters. The @action@ will be+-- executed with tuple @(ptr,size)@ as single argument. This is the+-- pointer to mapped data already adjusted and size of requested+-- region. Return value is that of action.+mmapWithFilePtr :: FilePath -- ^ name of file to mmap+ -> Mode -- ^ access mode+ -> Maybe (Int64,Int) -- ^ range to map, maps whole file if Nothing+ -> ((Ptr (),Int) -> IO a) -- ^ action to run+ -> IO a -- ^ result of action+mmapWithFilePtr filepath mode offsetsize action = do+ checkModeRegion filepath mode offsetsize+ (ptr,rawsize,offset,size) <- mmapFilePtr filepath mode offsetsize+ result <- action (ptr `plusPtr` offset,size) `finally` munmapFilePtr ptr rawsize+ return result++-- | Maps region of file and returns it as 'ForeignPtr'. See 'mmapFilePtr' for details.+mmapFileForeignPtr :: FilePath -- ^ name of file to map+ -> Mode -- ^ access mode+ -> Maybe (Int64,Int) -- ^ range to map, maps whole file if Nothing+ -> IO (ForeignPtr a,Int,Int) -- ^ foreign pointer to beginning of raw region, + -- offset to your data and size of your data+mmapFileForeignPtr filepath mode range = do+ checkModeRegion filepath mode range+ (rawptr,rawsize,offset,size) <- mmapFilePtr filepath mode range+ let rawsizeptr = castIntToPtr rawsize+ foreignptr <- newForeignPtrEnv c_system_io_mmap_munmap_funptr rawsizeptr rawptr+ return (foreignptr,offset,size)++-- | Maps region of file and returns it as 'BS.ByteString'. File is+-- mapped in in 'ReadOnly' mode. See 'mmapFilePtr' for details.+mmapFileByteString :: FilePath -- ^ name of file to map+ -> Maybe (Int64,Int) -- ^ range to map, maps whole file if Nothing+ -> IO BS.ByteString -- ^ bytestring with file contents+mmapFileByteString filepath range = do+ (foreignptr,offset,size) <- mmapFileForeignPtr filepath ReadOnly range+ let bytestring = BS.fromForeignPtr foreignptr offset size+ return bytestring++-- | The 'mmapFileForeignPtrLazy' function maps a file or device into memory,+-- returning a list of tuples with the same meaning as in function+-- 'mmapFileForeignPtr'.+--+mmapFileForeignPtrLazy :: FilePath -- ^ name of file to mmap+ -> Mode -- ^ access mode+ -> Maybe (Int64,Int64) -- ^ range to map, maps whole file if Nothing+ -> IO [(ForeignPtr a,Int,Int)] -- ^ (ptr,offset,size)+mmapFileForeignPtrLazy filepath mode offsetsize = do+ checkModeRegion filepath mode offsetsize+ bracketOnError (mmapFileOpen filepath mode)+ (finalizeForeignPtr) mmap+ where+ mmap handle = do+ (offset,size) <- sanitizeFileRegion filepath handle mode offsetsize+ return $ map (mapChunk handle) (chunks offset size)+ -- FIXME: might be we need NOINLINE pragma here, investigate later+ mapChunk handle (offset,size) = unsafePerformIO $+ withForeignPtr handle $ \handle -> do+ let align = offset `mod` fromIntegral c_system_io_granularity+ offsetraw = offset - align+ sizeraw = size + fromIntegral align+ ptr <- c_system_io_mmap_mmap handle (fromIntegral $ fromEnum mode) + (fromIntegral offsetraw) (fromIntegral sizeraw)+ when (ptr == nullPtr) $+ throwErrnoPath ("lazy mmap of '" ++ filepath ++ + "' chunk(" ++ show offset ++ "," ++ show size ++") failed") filepath+ let rawsizeptr = castIntToPtr sizeraw+ foreignptr <- newForeignPtrEnv c_system_io_mmap_munmap_funptr rawsizeptr ptr+ return (foreignptr,fromIntegral offset,size)++chunks :: Int64 -> Int64 -> [(Int64,Int)]+chunks offset 0 = []+chunks offset size | size <= fromIntegral chunkSize = [(offset,fromIntegral size)]+ | otherwise = let offset2 = ((offset + chunkSize + chunkSize - 1) `div` chunkSize) * chunkSize+ size2 = offset2 - offset+ in (offset,fromIntegral size2) : chunks offset2 (size-size2)++-- | Maps region of file and returns it as 'BSL.ByteString'. File is+-- mapped in in 'ReadOnly' mode. See 'mmapFileForeignPtrLazy' for+-- details.+mmapFileByteStringLazy :: FilePath -- ^ name of file to map+ -> Maybe (Int64,Int64) -- ^ range to map, maps whole file if Nothing+ -> IO BSL.ByteString -- ^ bytestring with file content+mmapFileByteStringLazy filepath offsetsize = do+ list <- mmapFileForeignPtrLazy filepath ReadOnly offsetsize+ return (BSL.fromChunks (map turn list))+ where+ turn (foreignptr,offset,size) = BS.fromForeignPtr foreignptr offset size++-- | Unmaps memory region. As parameters use values marked as ptr and+-- rawsize in description of 'mmapFilePtr'.+munmapFilePtr :: Ptr a -- ^ pointer+ -> Int -- ^ rawsize+ -> IO ()+munmapFilePtr ptr rawsize = c_system_io_mmap_munmap (castIntToPtr rawsize) ptr++chunkSize :: Num a => a+chunkSize = fromIntegral $ (128*1024 `div` c_system_io_granularity) * c_system_io_granularity++mmapFileOpen :: FilePath -> Mode -> IO (ForeignPtr ())+mmapFileOpen filepath mode = do+ ptr <- withCString filepath $ \filepath ->+ c_system_io_mmap_file_open filepath (fromIntegral $ fromEnum mode)+ when (ptr == nullPtr) $+ throwErrnoPath ("opening of '" ++ filepath ++ "' failed") filepath+ handle <- newForeignPtr c_system_io_mmap_file_close ptr+ return handle++castPtrToInt :: Ptr a -> Int+castPtrToInt ptr = ptr `minusPtr` nullPtr++castIntToPtr :: Int -> Ptr a+castIntToPtr int = nullPtr `plusPtr` int+++-- | Should open file given as CString in mode given as CInt+foreign import ccall unsafe "HsMmap.h system_io_mmap_file_open"+ c_system_io_mmap_file_open :: CString -- ^ file path, system encoding+ -> CInt -- ^ mode as 0, 1, 2, fromEnum+ -> IO (Ptr ()) -- ^ file handle returned, nullPtr on error (and errno set)+-- | Used in finalizers, to close handle+foreign import ccall unsafe "HsMmap.h &system_io_mmap_file_close"+ c_system_io_mmap_file_close :: FunPtr(Ptr () -> IO ())++-- | Mmemory maps file from handle, using mode, starting offset and size+foreign import ccall unsafe "HsMmap.h system_io_mmap_mmap"+ c_system_io_mmap_mmap :: Ptr () -- ^ handle from c_system_io_mmap_file_open+ -> CInt -- ^ mode+ -> CLLong -- ^ starting offset, must be nonegative+ -> CSize -- ^ length, must be greater than zero+ -> IO (Ptr a) -- ^ starting pointer to byte data, nullPtr on error (plus errno set)+-- | Used in finalizers+foreign import ccall unsafe "HsMmap.h &system_io_mmap_munmap"+ c_system_io_mmap_munmap_funptr :: FunPtr(Ptr () -> Ptr a -> IO ())+-- | Unmap region of memory. Size must be the same as returned by+-- mmap. If size is zero, does nothing (treats pointer as invalid)+foreign import ccall unsafe "HsMmap.h system_io_mmap_munmap"+ c_system_io_mmap_munmap :: Ptr () -> Ptr a -> IO ()+-- | Get file size in system specific manner+foreign import ccall unsafe "HsMmap.h system_io_mmap_file_size"+ c_system_io_file_size :: Ptr () -> IO CLLong+-- | Set file size in system specific manner. It is guaranteed to be called+-- only with new size being at least current size.+foreign import ccall unsafe "HsMmap.h system_io_mmap_extend_file_size"+ c_system_io_extend_file_size :: Ptr () -> CLLong -> IO CInt+-- | Memory mapping granularity.+foreign import ccall unsafe "HsMmap.h system_io_mmap_granularity"+ c_system_io_granularity :: CInt
cbits/posix.c view
@@ -1,165 +1,166 @@-#include "HsMmap.h" - -#define _LARGEFILE64_SOURCE 1 -#define _FILE_OFFSET_BITS 64 - -#include <sys/types.h> -#include <sys/stat.h> -#include <sys/mman.h> -#include <fcntl.h> -#include <unistd.h> -#include <stdlib.h> -#include <sys/errno.h> - -#ifdef _DEBUG -int counters = 0; - -int system_io_mmap_counters() -{ - return counters; -} -#endif - -//foreign import ccall unsafe "system_io_mmap_file_open" c_system_io_mmap_file_open :: CString -> CInt -> IO (Ptr ()) -void *system_io_mmap_file_open(const char *filepath, int mode) -{ - void *handle = NULL; - int access, fd; - if( !filepath ) - return NULL; - switch(mode) { - case 0: - access = O_RDONLY; - break; - case 1: - access = O_RDWR; - break; - case 2: - access = O_RDONLY; - break; - case 3: - access = O_RDWR|O_CREAT; - break; - default: - return NULL; - } -#ifdef O_NOCTTY - access |= O_NOCTTY; -#endif -#ifdef O_LARGEFILE - access |= O_LARGEFILE; -#endif -#ifdef O_NOINHERIT - access |= O_NOINHERIT; -#endif - fd = open(filepath,access,0666); - if( fd == -1 ) { - return NULL; - } -#ifdef _DEBUG - counters++; -#endif - handle = (void *)((intptr_t)fd + 1); - return handle; -} - -//foreign import ccall unsafe "system_io_mmap_file_close" c_system_io_mmap_file_close :: FunPtr(Ptr () -> IO ()) -void system_io_mmap_file_close(void *handle) -{ - int fd = (int)(intptr_t)handle - 1; - close(fd); -#ifdef _DEBUG - counters--; -#endif -} - -static char zerolength[1]; - -//foreign import ccall unsafe "system_io_mmap_mmap" c_system_io_mmap_mmap :: Ptr () -> CInt -> CLLong -> CInt -> IO (Ptr ()) -void *system_io_mmap_mmap(void *handle, int mode, long long offset, size_t size) -{ - void *ptr = NULL; - int prot; - int flags; - int fd = (int)(intptr_t)handle - 1; - - switch(mode) { - case 0: - prot = PROT_READ; - flags = MAP_PRIVATE; - break; - case 1: - prot = PROT_READ|PROT_WRITE; - flags = MAP_SHARED; - break; - case 2: - prot = PROT_READ|PROT_WRITE; - flags = MAP_PRIVATE; - break; - case 3: - prot = PROT_READ|PROT_WRITE; - flags = MAP_SHARED; - break; - default: - return NULL; - } - - if( size>0 ) { - ptr = mmap(NULL,size,prot,flags,fd,offset); - - if( ptr == MAP_FAILED ) { - return NULL; - } - } - else { - ptr = zerolength; - } -#ifdef _DEBUG - if( ptr ) { - counters++; - } -#endif - - return ptr; -} - -void system_io_mmap_munmap(void *sizeasptr, void *ptr) // Ptr CInt -> Ptr a -> IO () -{ - size_t size = (size_t)sizeasptr; - int result = 0; - if( size>0 ) { - result = munmap(ptr,size); -#ifdef _DEBUG - if( result==0 ) { - counters--; - } -#endif - } - else { -#ifdef _DEBUG - counters--; -#endif - } -} - -//foreign import ccall unsafe "system_io_mmap_file_size" c_system_io_file_size :: Ptr () -> IO (CLLong) -long long system_io_mmap_file_size(void *handle) -{ - int fd = (int)(intptr_t)handle - 1; - struct stat st; - fstat(fd,&st); - return st.st_size; -} - -int system_io_mmap_extend_file_size(void *handle, long long size) -{ - int fd = (int)(intptr_t)handle - 1; - return ftruncate(fd,size); -} - - -//foreign import ccall unsafe "system_io_mmap_granularity" c_system_io_granularity :: CInt -int system_io_mmap_granularity() -{ - return getpagesize(); -} +#include "HsMmap.h"++#define _LARGEFILE64_SOURCE 1+#define _FILE_OFFSET_BITS 64++#include <stdint.h>+#include <sys/types.h>+#include <sys/stat.h>+#include <sys/mman.h>+#include <fcntl.h>+#include <unistd.h>+#include <stdlib.h>+#include <sys/errno.h>++#ifdef _DEBUG+int counters = 0;++int system_io_mmap_counters()+{+ return counters;+}+#endif++//foreign import ccall unsafe "system_io_mmap_file_open" c_system_io_mmap_file_open :: CString -> CInt -> IO (Ptr ())+void *system_io_mmap_file_open(const char *filepath, int mode)+{+ void *handle = NULL;+ int access, fd;+ if( !filepath )+ return NULL;+ switch(mode) {+ case 0:+ access = O_RDONLY;+ break;+ case 1:+ access = O_RDWR;+ break;+ case 2:+ access = O_RDONLY;+ break;+ case 3:+ access = O_RDWR|O_CREAT;+ break;+ default:+ return NULL;+ }+#ifdef O_NOCTTY+ access |= O_NOCTTY;+#endif+#ifdef O_LARGEFILE+ access |= O_LARGEFILE;+#endif+#ifdef O_NOINHERIT+ access |= O_NOINHERIT;+#endif+ fd = open(filepath,access,0666);+ if( fd == -1 ) {+ return NULL;+ }+#ifdef _DEBUG+ counters++;+#endif+ handle = (void *)((intptr_t)fd + 1);+ return handle;+}++//foreign import ccall unsafe "system_io_mmap_file_close" c_system_io_mmap_file_close :: FunPtr(Ptr () -> IO ())+void system_io_mmap_file_close(void *handle)+{+ int fd = (int)(intptr_t)handle - 1;+ close(fd);+#ifdef _DEBUG+ counters--;+#endif+}++static char zerolength[1];++//foreign import ccall unsafe "system_io_mmap_mmap" c_system_io_mmap_mmap :: Ptr () -> CInt -> CLLong -> CInt -> IO (Ptr ())+void *system_io_mmap_mmap(void *handle, int mode, long long offset, size_t size)+{+ void *ptr = NULL;+ int prot;+ int flags;+ int fd = (int)(intptr_t)handle - 1;++ switch(mode) {+ case 0:+ prot = PROT_READ;+ flags = MAP_PRIVATE;+ break;+ case 1:+ prot = PROT_READ|PROT_WRITE;+ flags = MAP_SHARED;+ break;+ case 2:+ prot = PROT_READ|PROT_WRITE;+ flags = MAP_PRIVATE;+ break;+ case 3:+ prot = PROT_READ|PROT_WRITE;+ flags = MAP_SHARED;+ break;+ default:+ return NULL;+ }++ if( size>0 ) {+ ptr = mmap(NULL,size,prot,flags,fd,offset);++ if( ptr == MAP_FAILED ) {+ return NULL;+ }+ }+ else {+ ptr = zerolength;+ }+#ifdef _DEBUG+ if( ptr ) {+ counters++;+ }+#endif++ return ptr;+}++void system_io_mmap_munmap(void *sizeasptr, void *ptr) // Ptr CInt -> Ptr a -> IO ()+{+ size_t size = (size_t)sizeasptr;+ int result = 0;+ if( size>0 ) {+ result = munmap(ptr,size);+#ifdef _DEBUG+ if( result==0 ) {+ counters--;+ }+#endif+ }+ else {+#ifdef _DEBUG+ counters--;+#endif+ }+}++//foreign import ccall unsafe "system_io_mmap_file_size" c_system_io_file_size :: Ptr () -> IO (CLLong)+long long system_io_mmap_file_size(void *handle)+{+ int fd = (int)(intptr_t)handle - 1;+ struct stat st;+ fstat(fd,&st);+ return st.st_size;+}++int system_io_mmap_extend_file_size(void *handle, long long size)+{+ int fd = (int)(intptr_t)handle - 1;+ return ftruncate(fd,size);+}+++//foreign import ccall unsafe "system_io_mmap_granularity" c_system_io_granularity :: CInt+int system_io_mmap_granularity()+{+ return getpagesize();+}
cbits/win32.c view
@@ -1,206 +1,206 @@-#include "HsMmap.h" -#include <windows.h> - -#ifdef _DEBUG -int counters = 0; - -int system_io_mmap_counters() -{ - return counters; -} -#endif - - -//foreign import ccall unsafe "system_io_mmap_file_open" c_system_io_mmap_file_open :: CString -> CInt -> IO (Ptr ()) -void *system_io_mmap_file_open(const char *filepath, int mode) -{ - /* - HANDLE WINAPI CreateFileA( - __in LPCTSTR lpFileName, - __in DWORD dwDesiredAccess, - __in DWORD dwShareMode, - __in_opt LPSECURITY_ATTRIBUTES lpSecurityAttributes, - __in DWORD dwCreationDisposition, - __in DWORD dwFlagsAndAttributes, - __in_opt HANDLE hTemplateFile - ); - */ - void *handle = NULL; - DWORD dwDesiredAccess; - DWORD dwCreationDisposition; - if( !filepath ) - return NULL; - switch(mode) { - case 0: - dwDesiredAccess = GENERIC_READ; - dwCreationDisposition = OPEN_EXISTING; - break; - case 1: - dwDesiredAccess = GENERIC_WRITE|GENERIC_READ; - dwCreationDisposition = OPEN_EXISTING; - break; - case 2: - dwDesiredAccess = GENERIC_READ; - dwCreationDisposition = OPEN_EXISTING; - break; - case 3: - dwDesiredAccess = GENERIC_WRITE|GENERIC_READ; - dwCreationDisposition = OPEN_ALWAYS; - break; - default: - return NULL; - } - handle = CreateFileA(filepath, - dwDesiredAccess, - FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE, - NULL, - dwCreationDisposition, - FILE_ATTRIBUTE_NORMAL, - NULL); - if( handle==INVALID_HANDLE_VALUE ) - return NULL; -#ifdef _DEBUG - counters++; -#endif - return handle; -} - -//foreign import ccall unsafe "system_io_mmap_file_close" c_system_io_mmap_file_close :: FunPtr(Ptr () -> IO ()) -void system_io_mmap_file_close(void *handle) -{ - CloseHandle(handle); -#ifdef _DEBUG - counters--; -#endif -} - -static char zerolength[1]; - -//foreign import ccall unsafe "system_io_mmap_mmap" c_system_io_mmap_mmap :: Ptr () -> CInt -> CLLong -> CInt -> IO (Ptr ()) -void *system_io_mmap_mmap(void *handle, int mode, long long offset, size_t size) -{ - /* - HANDLE WINAPI CreateFileMapping( - __in HANDLE hFile, - __in_opt LPSECURITY_ATTRIBUTES lpAttributes, - __in DWORD flProtect, - __in DWORD dwMaximumSizeHigh, - __in DWORD dwMaximumSizeLow, - __in_opt LPCTSTR lpName - ); - LPVOID WINAPI MapViewOfFile( - __in HANDLE hFileMappingObject, - __in DWORD dwDesiredAccess, - __in DWORD dwFileOffsetHigh, - __in DWORD dwFileOffsetLow, - __in SIZE_T dwNumberOfBytesToMap - ); - */ - HANDLE mapping; - void *ptr = NULL; - DWORD flProtect; - DWORD dwDesiredAccess; - switch(mode) { - case 0: - flProtect = PAGE_READONLY; - dwDesiredAccess = FILE_MAP_READ; - break; - case 1: - flProtect = PAGE_READWRITE; - dwDesiredAccess = FILE_MAP_WRITE; - break; - case 2: - flProtect = PAGE_WRITECOPY; - dwDesiredAccess = FILE_MAP_COPY; - break; - case 3: - flProtect = PAGE_READWRITE; - dwDesiredAccess = FILE_MAP_WRITE; - break; - default: - return NULL; - } - - if( size>0 ) { - - mapping = CreateFileMapping(handle, NULL, flProtect, (DWORD) ((offset + size)>>32), (DWORD)(offset + size), NULL); - if( !mapping ) { - // FIXME: check error code and translate this to errno - // DWORD dw = GetLastError(); - } - ptr = MapViewOfFile(mapping,dwDesiredAccess, (DWORD)(offset>>32), (DWORD)(offset), size ); - if( !ptr ) { - // FIXME: check error code and translate this to errno - // DWORD dw = GetLastError(); - } - CloseHandle(mapping); - } - else { - ptr = zerolength; - } -#ifdef _DEBUG - if( ptr ) { - counters++; - } -#endif - return ptr; -} - -/* - * MSDN states: - * - * Although an application may close the file handle used to create a file mapping object, - * the system holds the corresponding file open until the last view of the file is unmapped: - * - * Files for which the last view has not yet been unmapped are held open with no sharing restrictions. - * - * Who knows what this means? - * - * http://msdn.microsoft.com/en-us/library/aa366882(VS.85).aspx - */ -void system_io_mmap_munmap(void *sizeasptr, void *ptr) // Ptr () -> Ptr a -> IO () -{ - size_t size = (size_t)sizeasptr; - BOOL result; - if( size>0 ) { - result = UnmapViewOfFile(ptr); -#ifdef _DEBUG - if( result ) { - counters--; - } -#endif - } - else { -#ifdef _DEBUG - counters--; -#endif - } -} - -//foreign import ccall unsafe "system_io_mmap_file_size" c_system_io_file_size :: Ptr () -> IO (CLLong) -long long system_io_mmap_file_size(void *handle) -{ - DWORD lobits, hibits; - lobits = GetFileSize(handle,&hibits); - return (long long)lobits + ((long long)hibits << 32); -} - -int system_io_mmap_extend_file_size(void *handle, long long size) -{ - DWORD lobits = (DWORD)size, hibits = (DWORD)(size>>32); - HANDLE mapping = CreateFileMapping(handle,NULL,PAGE_READWRITE,hibits,lobits,NULL); - if(mapping==NULL) - return -1; - CloseHandle(mapping); - return 0; -} - -//foreign import ccall unsafe "system_io_mmap_granularity" c_system_io_granularity :: CInt -int system_io_mmap_granularity() -{ - SYSTEM_INFO sysinfo; - GetSystemInfo(&sysinfo); - return sysinfo.dwAllocationGranularity; -} - - +#include "HsMmap.h"+#include <windows.h>++#ifdef _DEBUG+int counters = 0;++int system_io_mmap_counters()+{+ return counters;+}+#endif+++//foreign import ccall unsafe "system_io_mmap_file_open" c_system_io_mmap_file_open :: CString -> CInt -> IO (Ptr ())+void *system_io_mmap_file_open(const char *filepath, int mode)+{+ /*+ HANDLE WINAPI CreateFileA(+ __in LPCTSTR lpFileName,+ __in DWORD dwDesiredAccess,+ __in DWORD dwShareMode,+ __in_opt LPSECURITY_ATTRIBUTES lpSecurityAttributes,+ __in DWORD dwCreationDisposition,+ __in DWORD dwFlagsAndAttributes,+ __in_opt HANDLE hTemplateFile+ );+ */+ void *handle = NULL;+ DWORD dwDesiredAccess;+ DWORD dwCreationDisposition;+ if( !filepath )+ return NULL;+ switch(mode) {+ case 0:+ dwDesiredAccess = GENERIC_READ;+ dwCreationDisposition = OPEN_EXISTING;+ break;+ case 1:+ dwDesiredAccess = GENERIC_WRITE|GENERIC_READ;+ dwCreationDisposition = OPEN_EXISTING;+ break;+ case 2:+ dwDesiredAccess = GENERIC_READ;+ dwCreationDisposition = OPEN_EXISTING;+ break;+ case 3:+ dwDesiredAccess = GENERIC_WRITE|GENERIC_READ;+ dwCreationDisposition = OPEN_ALWAYS;+ break;+ default:+ return NULL;+ }+ handle = CreateFileA(filepath,+ dwDesiredAccess,+ FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE,+ NULL,+ dwCreationDisposition,+ FILE_ATTRIBUTE_NORMAL,+ NULL);+ if( handle==INVALID_HANDLE_VALUE )+ return NULL;+#ifdef _DEBUG+ counters++;+#endif+ return handle;+}++//foreign import ccall unsafe "system_io_mmap_file_close" c_system_io_mmap_file_close :: FunPtr(Ptr () -> IO ())+void system_io_mmap_file_close(void *handle)+{+ CloseHandle(handle);+#ifdef _DEBUG+ counters--;+#endif+}++static char zerolength[1];++//foreign import ccall unsafe "system_io_mmap_mmap" c_system_io_mmap_mmap :: Ptr () -> CInt -> CLLong -> CInt -> IO (Ptr ())+void *system_io_mmap_mmap(void *handle, int mode, long long offset, size_t size)+{+ /*+ HANDLE WINAPI CreateFileMapping(+ __in HANDLE hFile,+ __in_opt LPSECURITY_ATTRIBUTES lpAttributes,+ __in DWORD flProtect,+ __in DWORD dwMaximumSizeHigh,+ __in DWORD dwMaximumSizeLow,+ __in_opt LPCTSTR lpName+ );+ LPVOID WINAPI MapViewOfFile(+ __in HANDLE hFileMappingObject,+ __in DWORD dwDesiredAccess,+ __in DWORD dwFileOffsetHigh,+ __in DWORD dwFileOffsetLow,+ __in SIZE_T dwNumberOfBytesToMap+ );+ */+ HANDLE mapping;+ void *ptr = NULL;+ DWORD flProtect;+ DWORD dwDesiredAccess;+ switch(mode) {+ case 0:+ flProtect = PAGE_READONLY;+ dwDesiredAccess = FILE_MAP_READ;+ break;+ case 1:+ flProtect = PAGE_READWRITE;+ dwDesiredAccess = FILE_MAP_WRITE;+ break;+ case 2:+ flProtect = PAGE_WRITECOPY;+ dwDesiredAccess = FILE_MAP_COPY;+ break;+ case 3:+ flProtect = PAGE_READWRITE;+ dwDesiredAccess = FILE_MAP_WRITE;+ break;+ default:+ return NULL;+ }+ + if( size>0 ) {++ mapping = CreateFileMapping(handle, NULL, flProtect, (DWORD) ((offset + size)>>32), (DWORD)(offset + size), NULL);+ if( !mapping ) {+ // FIXME: check error code and translate this to errno+ // DWORD dw = GetLastError();+ }+ ptr = MapViewOfFile(mapping,dwDesiredAccess, (DWORD)(offset>>32), (DWORD)(offset), size );+ if( !ptr ) {+ // FIXME: check error code and translate this to errno+ // DWORD dw = GetLastError();+ }+ CloseHandle(mapping);+ }+ else {+ ptr = zerolength;+ }+#ifdef _DEBUG+ if( ptr ) {+ counters++;+ }+#endif+ return ptr;+}++/*+ * MSDN states:+ *+ * Although an application may close the file handle used to create a file mapping object,+ * the system holds the corresponding file open until the last view of the file is unmapped:+ *+ * Files for which the last view has not yet been unmapped are held open with no sharing restrictions.+ *+ * Who knows what this means?+ *+ * http://msdn.microsoft.com/en-us/library/aa366882(VS.85).aspx+ */+void system_io_mmap_munmap(void *sizeasptr, void *ptr) // Ptr () -> Ptr a -> IO ()+{+ size_t size = (size_t)sizeasptr;+ BOOL result;+ if( size>0 ) {+ result = UnmapViewOfFile(ptr);+#ifdef _DEBUG+ if( result ) {+ counters--;+ }+#endif+ }+ else {+#ifdef _DEBUG+ counters--;+#endif+ }+}++//foreign import ccall unsafe "system_io_mmap_file_size" c_system_io_file_size :: Ptr () -> IO (CLLong)+long long system_io_mmap_file_size(void *handle)+{+ DWORD lobits, hibits;+ lobits = GetFileSize(handle,&hibits);+ return (long long)lobits + ((long long)hibits << 32);+}++int system_io_mmap_extend_file_size(void *handle, long long size)+{+ DWORD lobits = (DWORD)size, hibits = (DWORD)(size>>32);+ HANDLE mapping = CreateFileMapping(handle,NULL,PAGE_READWRITE,hibits,lobits,NULL);+ if(mapping==NULL)+ return -1;+ CloseHandle(mapping);+ return 0;+}++//foreign import ccall unsafe "system_io_mmap_granularity" c_system_io_granularity :: CInt+int system_io_mmap_granularity()+{+ SYSTEM_INFO sysinfo;+ GetSystemInfo(&sysinfo);+ return sysinfo.dwAllocationGranularity;+}++
mmap.cabal view
@@ -1,5 +1,5 @@ Name: mmap-Version: 0.5.6+Version: 0.5.7 Stability: alpha License: BSD3 License-File: LICENSE@@ -37,9 +37,9 @@ Main-is: tests/mmaptest.hs if flag(mmaptest) Buildable: True+ Build-depends: base<5, bytestring, HUnit, directory else Buildable: False- Build-depends: base<5, bytestring, HUnit, directory Extensions: ForeignFunctionInterface, ScopedTypeVariables, CPP Hs-source-dirs: . CC-options: -Wall -D_DEBUG
− tests/mmaptest.hs
@@ -1,347 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface, CPP #-} - -module Main where - -import System.IO.MMap -import Data.ByteString.Char8 as BSC -import Data.ByteString.Unsafe as BSC -import qualified Data.ByteString.Lazy as BSL -import Data.Word -import Foreign.ForeignPtr -import Foreign.Storable -import Foreign.Ptr -import System.Mem -import Control.Concurrent -import Test.HUnit -import System.Directory -import Foreign.C.Types (CInt,CLLong) -import Control.Monad -import System.IO -import Data.Int -#ifdef WINDOWS -import qualified System.Win32.File as W -#endif - -ignoreExceptions doit = (doit >> return ()) `catch` (\e -> return ()) - -foreign import ccall unsafe "HsMmap.h system_io_mmap_counters" - c_system_io_counters :: IO CInt - -removeFileDelayed :: FilePath -> IO () -#ifdef WINDOWS -removeFileDelayed filepath = do - h <- W.createFile filepath - W.dELETE - W.fILE_SHARE_NONE - Nothing - W.oPEN_ALWAYS - W.fILE_FLAG_DELETE_ON_CLOSE - Nothing - W.closeHandle h -#else -removeFileDelayed filepath = removeFile filepath -#endif - -content = BSC.pack "Memory mapping of files for POSIX and Windows" -contentLazy = BSL.fromChunks [content] - -test_normal_readonly = do - BSC.writeFile "test_normal.bin" content - bs <- mmapFileByteString "test_normal.bin" Nothing - bs @?= content - -test_normal_readonly_many_times = do - BSC.writeFile "test_normal.bin" content - bs1 <- mmapFileByteString "test_normal.bin" Nothing - bs2 <- mmapFileByteString "test_normal.bin" Nothing - bs3 <- mmapFileByteString "test_normal.bin" Nothing - BSC.concat [bs1,bs2,bs3] @?= BSC.concat [content, content, content] - -test_normal_readonly_lazy = do - let filename = "test_normalQ.bin" - BSC.writeFile filename content - bs <- mmapFileByteStringLazy filename Nothing - bs @?= contentLazy - -test_normal_readonly_zero_length = do - BSC.writeFile "test_zerolength.bin" BSC.empty - bs <- mmapFileByteString "test_zerolength.bin" Nothing - bs @?= BSC.empty - -test_non_existing_readonly = do - ignoreExceptions $ removeFile "test_notexists.bin" - ignoreExceptions $ do - mmapFileByteString "test_notexists.bin" Nothing - assertFailure "Should throw exception" - -test_no_permission_readonly = do - let filename = "test_nopermission.bin" - ignoreExceptions $ setPermissions filename (Permissions {readable = True, - writable = True, - executable = True, - searchable = True}) - BSC.writeFile filename content - setPermissions filename (Permissions {readable = False, - writable = False, - executable = False, - searchable = False}) - Permissions {readable = readable} <- getPermissions filename - -- no way to clear read flag under Windows, skip the test - if not readable - then ignoreExceptions $ do - mmapFileByteString filename Nothing - assertFailure "Should throw exception" - else return () - -test_normal_negative_offset_readonly = do - ignoreExceptions $ removeFile "test_normal1.bin" - BSC.writeFile "test_normal1.bin" content - ignoreExceptions $ do - mmapFileByteString "test_normal1.bin" (Just (-20,5)) - assertFailure "Should throw exception" - -test_normal_negative_size_readonly = do - ignoreExceptions $ removeFile "test_normal2.bin" - BSC.writeFile "test_normal2.bin" content - ignoreExceptions $ do - mmapFileByteString "test_normal2.bin" (Just (0,-5)) - assertFailure "Should throw exception" - -test_normal_offset_size_readonly = do - let filename = "test_normal5.bin" - BSC.writeFile filename content - bs <- mmapFileByteString filename (Just (5,5)) - let exp = BSC.take 5 (BSC.drop 5 content) - bs @?= exp - -test_normal_offset_size_zero_readonly = do - let filename = "test_normal6.bin" - BSC.writeFile filename content - bs <- mmapFileByteString filename (Just (5,0)) - let exp = BSC.empty - bs @?= exp - -test_normal_offset_size_zero_readonly_lazy = do - let filename = "test_normal6x.bin" - BSC.writeFile filename content - bs <- mmapFileByteStringLazy filename (Just (5,0)) - let exp = BSL.empty - bs @?= exp - -test_normal_offset_beyond_eof_readonly = do - let filename = "test_normal9.bin" - BSC.writeFile filename content - ignoreExceptions $ do - mmapFileByteString filename (Just (1000,5)) - assertFailure "Should throw exception" - -test_normal_offset_beyond_eof_readonly_lazy = do - -- although lazy, should throw exception - let filename = "test_normal9.bin" - BSC.writeFile filename content - ignoreExceptions $ do - mmapFileByteStringLazy filename (Just (1000,5)) - assertFailure "Should throw exception" - -test_normal_offset_plus_size_beyond_eof_readonly = do - let filename = "test_normal7.bin" - BSC.writeFile filename content - ignoreExceptions $ do - mmapFileByteString filename (Just (4,5000)) - assertFailure "Should throw exception" - -test_normal_offset_plus_size_beyond_eof_readonly_lazy = do - let filename = "test_normal7.bin" - BSC.writeFile filename content - ignoreExceptions $ do - mmapFileByteStringLazy filename (Just (4,5000)) - assertFailure "Should throw exception" - -test_normal_offset_plus_size_beyond_eof_readwriteex = do - let filename = "test_normal8.bin" - BSC.writeFile filename content - mmapWithFilePtr filename ReadWriteEx (Just (4,5000)) $ \(ptr,size) -> do - size @?= 5000 - bs <- BSC.packCStringLen (castPtr ptr,size) - bs @?= BSC.take 5000 (BSC.drop 4 (content `BSC.append` BSC.replicate 10000 '\0')) - -test_delete_while_mmapped = do - let filename = "test_normalU.bin" - BSC.writeFile filename content - mmapWithFilePtr filename ReadOnly Nothing $ \(ptr,size) -> do - removeFileDelayed filename - bs <- BSC.packCStringLen (castPtr ptr,size) - bs @?= content - v <- doesFileExist filename - False @=? v - -test_readwriteex_lazy_make_a_touch = do - let filename = "test_normal8.bin" - BSC.writeFile filename content - let threegb = 3*1000*1000*1000 - ignore <- mmapFileForeignPtrLazy filename ReadWriteEx (Just (4,threegb)) - let size = sum (Prelude.map (\(_,_,s) -> s) ignore) - size @?= fromIntegral threegb - -test_readwriteex_lazy_make_dont_touch = do - let filename = "test_normal86.bin" - BSC.writeFile filename content - let threegb = 3*1000 - mmapFileForeignPtrLazy filename ReadWriteEx (Just (0,threegb)) - System.Mem.performGC - threadDelay 1000 - size <- withFile filename ReadMode hFileSize - size @?= fromIntegral threegb - -test_create_offset_plus_size_readwriteex = do - let filename = "test_normal9.bin" - ignoreExceptions $ removeFile filename - mmapWithFilePtr filename ReadWriteEx (Just (4,5000)) $ \(ptr,size) -> do - size @?= 5000 - bs <- BSC.packCStringLen (castPtr ptr,size) - bs @?= BSC.replicate 5000 '\0' - -test_create_readwriteex_no_way = do - let filename = "zonk/test_normal9.bin" - ignoreExceptions $ mmapWithFilePtr filename ReadWriteEx (Just (4,5000)) $ \(ptr,size) -> do - assertFailure "Should throw exception" - -test_create_nothing_readwriteex_should_throw = do - let filename = "test_normalA.bin" - ignoreExceptions $ removeFile filename - ignoreExceptions $ mmapWithFilePtr filename ReadWriteEx Nothing $ \(ptr,size) -> do - size @?= 5000 - bs <- BSC.packCStringLen (castPtr ptr,size) - bs @?= BSC.replicate 5000 '\0' - assertFailure "Should throw exception" - x <- doesFileExist filename - x @?= False - -test_change_two_places = do - let filename = "test_normalAB.bin" - BSC.writeFile filename content - mmapWithFilePtr filename ReadWrite Nothing $ \(ptr1,size1) -> - do - -- this should change one common memory - let v1 = 0x41414141::Int32 - poke (castPtr ptr1) v1 - v2 <- peek (castPtr ptr1) - v2 @?= v1 - bs2 <- mmapFileByteString filename Nothing - size1 @?= BSC.length bs2 - bs1 <- BSC.packCStringLen (castPtr ptr1,size1) - bs1 @?= bs2 - -test_change_read_write = do - let filename = "test_normalAC.bin" - BSC.writeFile filename content - mmapWithFilePtr filename ReadWrite Nothing $ \(ptr1,size1) -> - do - poke (castPtr ptr1) (0x41414141::Int32) - bs3 <- BSC.readFile filename - bs3 @?= BSC.pack "\x41\x41\x41\x41" `BSC.append` BSC.drop 4 content - -test_writecopy = do - let filename = "test_normalAD.bin" - BSC.writeFile filename content - mmapWithFilePtr filename WriteCopy Nothing $ \(ptr1,size1) -> - do - poke (castPtr ptr1) (0x41414141::Int32) - -- change should NOT be reflected in file on disk - bs3 <- BSC.readFile filename - bs3 @?= content - -test_counters_zero = do - System.Mem.performGC - threadDelay 1000 - counters <- c_system_io_counters - return (counters @?= 0) - -alltests = [ "Normal read only mmap" ~: - test_normal_readonly - , "Normal read only mmap lazy" ~: - test_normal_readonly_lazy - , "Zero length file mmap" ~: - test_normal_readonly_zero_length - , "File does not exist" ~: - test_non_existing_readonly - , "No permission to read file" ~: - test_no_permission_readonly - , "Signal error when negative offset given" ~: - test_normal_negative_offset_readonly - , "Signal error when negative size given" ~: - test_normal_negative_size_readonly - , "Test if we can cut part of file" ~: - test_normal_offset_size_readonly - , "Test if we can cut zero length part of file" ~: - test_normal_offset_size_zero_readonly - , "Test if we can cut zero length part of file lazy" ~: - test_normal_offset_size_zero_readonly_lazy - , "Should throw error if mmaping readonly beyond end of file" ~: - test_normal_offset_beyond_eof_readonly - , "Should throw error if mmaping readonly beyond end of file lazy" ~: - test_normal_offset_beyond_eof_readonly_lazy - , "Should throw error if mmaping readonly with size beyond end of file" ~: - test_normal_offset_plus_size_beyond_eof_readonly - , "Should throw error if mmaping readonly with size beyond end of file lazy" ~: - test_normal_offset_plus_size_beyond_eof_readonly_lazy - , "Should ReadWriteEx mmap existing file and resize" ~: - test_normal_offset_plus_size_beyond_eof_readwriteex - , "Should ReadWriteEx mmap new file and resize" ~: - test_create_offset_plus_size_readwriteex - , "ReadWriteEx must have range specified" ~: - test_create_nothing_readwriteex_should_throw - , "Report error in file creation" ~: - test_create_readwriteex_no_way - , "ReadWriteEx in lazy mode should set file size even if not touching" ~: - test_readwriteex_lazy_make_dont_touch - , "Remove file while mmaped" ~: - test_delete_while_mmapped - , "MMap byte string many times" ~: - test_normal_readonly_many_times - , "Mmap common memory" ~: - test_change_two_places - , "Mmap read write memory" ~: - test_change_read_write - , "Mmap WriteCopy mode" ~: - test_writecopy - - --, "ReadWriteEx in lazy should extend file beyond 3GB when mapped in" ~: - -- Test_readwriteex_lazy_make_a_touch - -- insert tests above this line - , "Counters should be zero" ~: - test_counters_zero - ] - -main = do - runTestTT (test alltests) - -{- -main = do - BSC.writeFile "test.bin" content - bs <- mmapFileByteString "test.bin" Nothing - BSC.putStrLn bs - print (bs == content) - bs2 <- mmapFileByteString "test.bin" (Just (5,5)) - print (bs2 == BSC.take 5 (BSC.drop 5 content)) - - -- create 5 gigabyte file - let l = 1024*1024*1024*5 - (f,s) <- mmapFileForeignPtr "test.bin" ReadWrite (Just (l,5)) - withForeignPtr f $ \f -> poke (castPtr f) (64::Word8) - - E.catch (do - bs3 <- mmapFileByteString "test.bin" Nothing - print (fromIntegral l==BSC.length bs3 + 5 )) - (\E -> print True -- exception here is also ok - ) - bs4 <- mmapFileByteStringLazy "test.bin" Nothing - print (BSL.fromChunks [content] == BSL.take (fromIntegral $ BSC.length content) bs4) - bs5 <- mmapFileByteStringLazy "test.bin" (Just (5,5)) - print (BSC.take 5 (BSC.drop 5 content) == BSC.concat (BSL.toChunks bs5)) - - System.Mem.performGC - threadDelay 10000 - --} -