mmap 0.4.1 → 0.5.2
raw patch · 6 files changed
+693/−219 lines, 6 filesdep +HUnitdep +directorydep ~basenew-component:exe:mmaptest
Dependencies added: HUnit, directory
Dependency ranges changed: base
Files
- System/IO/MMap.hs +281/−182
- cbits/HsMmap.h +22/−0
- cbits/posix.c +78/−18
- cbits/win32.c +79/−13
- mmap.cabal +27/−6
- tests/mmaptest.hs +206/−0
System/IO/MMap.hs view
@@ -1,277 +1,376 @@-{-# OPTIONS_GHC -fglasgow-exts #-} +-- | +-- 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 - mmapFilePtrLazy, mmapFileForeignPtrLazy, - mmapFileByteStringLazy, - - -- * Mapping mode - Mode(..) + mmapFileByteStringLazy ) where import System.IO () -import Foreign.Ptr (Ptr,FunPtr,nullPtr,plusPtr) -import Foreign.C.Types (CInt,CLLong) +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) +import Foreign.ForeignPtr (ForeignPtr,withForeignPtr,finalizeForeignPtr,newForeignPtr,newForeignPtrEnv,newForeignPtr_) import Foreign.Storable( poke ) -import Foreign.Marshal.Alloc( malloc ) -import Foreign.C.Error ( throwErrno ) +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.Unsafe as BS (unsafePackCStringFinalizer) +import qualified Data.ByteString.Internal as BS (fromForeignPtr) import Data.Int (Int64) import Control.Monad (when) -import Control.Exception (bracket) +import Control.Exception import qualified Data.ByteString as BS (ByteString) import qualified Data.ByteString.Lazy as BSL (ByteString,fromChunks) +-- 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. +-- 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. +-- 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. -- --- For more details about mmap, and its consequences, see: +-- In case of IO errors all function use 'throwErrno'. -- +-- 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. Three cases are supported. -data Mode = ReadOnly -- ^ file is mapped read-only - | ReadWrite -- ^ file is mapped read-write - | WriteCopy -- ^ file is mapped read-write, but changes aren't propagated to disk + +-- | 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) +sanitizeFileRegion :: (Integral a,Bounded a) => String -> ForeignPtr () -> Mode -> Maybe (Int64,a) -> IO (Int64,a) +sanitizeFileRegion filepath handle ReadWriteEx (Just region) + = 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) $ + throwErrno $ "mmap of '" ++ filepath ++ "' failed, negative size reguested" + when (offset<0) $ + throwErrno $ "mmap of '" ++ filepath ++ "' failed, negative offset reguested" + when (mode/=ReadWriteEx && (longsize<offset || longsize<(offset + fromIntegral size))) $ + throwErrno $ "mmap of '" ++ filepath ++ "' failed, offset and size beyond end of file" + return (offset,size) + Nothing -> do + when (longsize > fromIntegral (maxBound `asTypeOf` sizetype)) $ + throwErrno $ "mmap of '" ++ filepath ++ "' failed, size is greater then maxBound" + 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 tripple containing pointer that accesses the mapped file, --- the finalizer to run to unmap region and size of mmaped memory. +-- returning a tuple @(ptr,rawsize,offset,size)@ where: -- --- If the mmap fails for some reason, an error is thrown. +-- * @ptr@ is pointer to mmapped region -- --- Memory mapped files will behave as if they were read lazily -- --- pages from the file will be loaded into memory on demand. +-- * @rawsize@ is length (in bytes) of mapped data, rawsize might be +-- greater than size because of alignment -- --- 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. +-- * @offset@ tell where your data lives: @plusPtr ptr offset@ -- --- File must be created with correct attributes prior to mapping it --- into memory. +-- * @size@ your data length (in bytes) -- --- If mode is 'ReadWrite' or 'WriteCopy', the returned memory region may --- be written to with 'Foreign.Storable.poke' and friends. +-- If 'mmapFilePtr' fails for some reason, a 'throwErrno' is used. -- --- Range specified may be 'Nothing', then whole file is mapped. Otherwise --- range should be 'Just (offset,size)' where offsets is the beginning byte --- of file region to map and size tells its length. There are no alignment --- requirements. +-- Use @munmapFilePtr ptr rawsize@ to unmap memory. -- --- If range to map extends beyond end of file, it will be resized accordingly. +-- 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,IO (),Int) -- ^ pointer, finalizer and size -mmapFilePtr fp m range = do - (ptr, size) <- mmapFilePtr' fp m range - sizeptr <- malloc - poke sizeptr (fromIntegral size) - return (ptr, c_system_io_mmap_munmap sizeptr ptr, size) --- | 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) -- ^ foreign pointer to beginning of region and size -mmapFileForeignPtr fp m range = do - (ptr, size) <- mmapFilePtr' fp m range - sizeptr <- malloc - poke sizeptr (fromIntegral size) - foreignptr <- newForeignPtrEnv c_system_io_mmap_munmap_funptr sizeptr ptr - return (foreignptr,size) - -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) -- ^ pointer and size -mmapFilePtr' filepath mode offsetsize = do +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) <- case offsetsize of - Just (offset,size) -> return (offset,size) - Nothing -> do - longsize <- withForeignPtr handle c_system_io_file_size - when (longsize > fromIntegral (maxBound :: Int)) $ - fail ("file is longer (" ++ show longsize ++ ") than maxBound::Int") - return (0,fromIntegral longsize) - 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) $ - throwErrno $ "mmap of '" ++ filepath ++ "' failed" - return (ptr `plusPtr` fromIntegral align,fromIntegral size) + (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) $ + throwErrno $ "mmap of '" ++ filepath ++ "' failed" + return (castPtr ptr,sizeraw,fromIntegral align,size) --- | Maps region of file and returns it as 'Data.ByteString.ByteString'. --- File is mapped in in 'ReadOnly' mode. See 'mmapFilePtr' for details --- --- Note: this operation may break referential transparency! If --- any other process on the system changes the file when it is mapped --- into Haskell, the contents of your 'Data.ByteString.ByteString' may change. --- +-- | 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 content -mmapFileByteString filepath offsetsize = do - (ptr,finalizer,size) <- mmapFilePtr filepath ReadOnly offsetsize - bytestring <- BS.unsafePackCStringFinalizer ptr size finalizer + -> 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 'mmapFilePtrLazy' function maps a file or device into memory, --- returning a list of tripples containing pointer that accesses the mapped file, --- the finalizer to run to unmap that region and size of mapped memory. --- --- If the mmap fails for some reason, an error is thrown. --- --- Memory mapped files will behave as if they were read lazily -- --- pages from the file will be loaded into memory on demand. --- --- 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. --- --- File must be created with correct attributes prior to mapping it --- into memory. --- --- If mode is 'ReadWrite' or 'WriteCopy', the returned memory region may --- be written to with 'Foreign.Storable.poke' and friends. --- --- Range specified may be 'Nothing', then whole file is mapped. Otherwise --- range should be 'Just (offset,size)' where offsets is the beginning byte --- of file region to map and size tells its length. There are no alignment --- requirements. --- --- If range to map extends beyond end of file, it will be resized accordingly. +-- | The 'mmapFileForeignPtrLazy' function maps a file or device into memory, +-- returning a list of tuples with the same meaning as in function +-- 'mmapFileForeignPtr'. -- -mmapFilePtrLazy :: FilePath -- ^ name of file to mmap - -> Mode -- ^ access mode - -> Maybe (Int64,Int64) -- ^ range to map, maps whole file if Nothing - -> IO [(Ptr a,IO (),Int)] -- ^ list of pointer, finalizer and size -mmapFilePtrLazy filepath mode offsetsize = do - handle <- mmapFileOpen filepath mode - mmap handle +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 + bracket (mmapFileOpen filepath mode) + (finalizeForeignPtr) mmap where mmap handle = do - (offset,size) <- case offsetsize of - Just (offset,size) -> return (offset,size) - Nothing -> do - longsize <- withForeignPtr handle c_system_io_file_size - return (0,fromIntegral longsize) + (offset,size) <- sanitizeFileRegion filepath handle mode offsetsize return $ map (mapChunk handle) (chunks offset size) 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) + ptr <- c_system_io_mmap_mmap handle (fromIntegral $ fromEnum mode) + (fromIntegral offsetraw) (fromIntegral sizeraw) when (ptr == nullPtr) $ throwErrno $ "mmap of '" ++ filepath ++ "' failed" - sizeptr <- malloc - poke sizeptr $ fromIntegral sizeraw - let finalizer = c_system_io_mmap_munmap sizeptr ptr - return (ptr `plusPtr` fromIntegral align,finalizer,fromIntegral size) + 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 + fromIntegral chunkSize `div` fromIntegral chunkSize * fromIntegral chunkSize - size2 = fromIntegral (offset2 - offset) - in (offset,size2) : chunks (offset2) (size-fromIntegral size2) - --- | Maps region of file and returns it as list of 'ForeignPtr's. See 'mmapFilePtr' for details. --- Each chunk is mapped in on demand only. -mmapFileForeignPtrLazy :: FilePath -- ^ name of file to map - -> Mode -- ^ access mode - -> Maybe (Int64,Int64) -- ^ range to map, maps whole file if Nothing - -> IO [(ForeignPtr a,Int)] -- ^ foreign pointer to beginning of region and size -mmapFileForeignPtrLazy filepath mode offsetsize = do - list <- mmapFilePtrLazy filepath mode offsetsize - return (map turn list) - where - turn (ptr,finalizer,size) = unsafePerformIO $ do - foreignptr <- Foreign.Concurrent.newForeignPtr ptr finalizer - return (foreignptr,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 'Data.ByteString.Lazy.ByteString'. --- File is mapped in in 'ReadOnly' mode. See 'mmapFilePtrLazy' for details. --- Chunks are mapped in on demand. --- --- Note: this operation may break referential transparency! If --- any other process on the system changes the file when it is mapped --- into Haskell, the contents of your 'Data.ByteString.Lazy.ByteString' may change. --- +-- | 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 <- mmapFilePtrLazy filepath ReadOnly offsetsize + list <- mmapFileForeignPtrLazy filepath ReadOnly offsetsize return (BSL.fromChunks (map turn list)) where - turn (ptr,finalizer,size) = unsafePerformIO $ do - bytestring <- BS.unsafePackCStringFinalizer ptr size finalizer - return bytestring + turn (foreignptr,offset,size) = BS.fromForeignPtr foreignptr offset size -chunkSize :: Int +-- | 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) + ptr <- withCString filepath $ \filepath -> + c_system_io_mmap_file_open filepath (fromIntegral $ fromEnum mode) when (ptr == nullPtr) $ throwErrno $ "opening of '" ++ filepath ++ "' failed" handle <- newForeignPtr c_system_io_mmap_file_close ptr return handle -foreign import ccall unsafe "system_io_mmap_file_open" - c_system_io_mmap_file_open :: CString -> CInt -> IO (Ptr ()) -foreign import ccall unsafe "&system_io_mmap_file_close" - c_system_io_mmap_file_close :: FunPtr(Ptr () -> IO ()) - -foreign import ccall unsafe "system_io_mmap_mmap" - c_system_io_mmap_mmap :: Ptr () -> CInt -> CLLong -> CInt -> IO (Ptr a) -foreign import ccall unsafe "&system_io_mmap_munmap" - c_system_io_mmap_munmap_funptr :: FunPtr(Ptr CInt -> Ptr a -> IO ()) -foreign import ccall unsafe "system_io_mmap_munmap" - c_system_io_mmap_munmap :: Ptr CInt -> Ptr a -> IO () +castPtrToInt :: Ptr a -> Int +castPtrToInt ptr = ptr `minusPtr` nullPtr -foreign import ccall unsafe "system_io_mmap_file_size" - c_system_io_file_size :: Ptr () -> IO (CLLong) -foreign import ccall unsafe "system_io_mmap_granularity" - c_system_io_granularity :: CInt +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 +-- | Memory mapping granularity. +foreign import ccall unsafe "HsMmap.h system_io_mmap_granularity" + c_system_io_granularity :: CInt
+ cbits/HsMmap.h view
@@ -0,0 +1,22 @@+#ifndef __HSMMAP_H__+#define __HSMMAP_H__++#include <stddef.h>++void *system_io_mmap_file_open(const char *filepath, int mode);++void system_io_mmap_file_close(void *handle);++void *system_io_mmap_mmap(void *handle, int mode, long long offset, size_t size);++void system_io_mmap_munmap(void *sizeasptr, void *ptr);++long long system_io_mmap_file_size(void *handle);++int system_io_mmap_granularity();++// this is only implemented in _DEBUG builds+int system_io_mmap_counters();+++#endif /* __HSMMAP_H__ */
cbits/posix.c view
@@ -1,6 +1,6 @@- +#include "HsMmap.h" -#define _LARGEFILE64_SOURCE1 +#define _LARGEFILE64_SOURCE 1 #define _FILE_OFFSET_BITS 64 #include <sys/types.h> @@ -11,6 +11,15 @@ #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) { @@ -23,36 +32,58 @@ access = O_RDONLY; break; case 1: - access = O_RDWR|O_CREAT; + 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); - handle = (void *)fd + 1; 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)handle - 1; + 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, int size) +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)handle - 1; + int fd = (int)(intptr_t)handle - 1; + struct stat st; + switch(mode) { case 0: prot = PROT_READ; @@ -66,34 +97,63 @@ prot = PROT_READ|PROT_WRITE; flags = MAP_PRIVATE; break; + case 3: + prot = PROT_READ|PROT_WRITE; + flags = MAP_SHARED; + break; default: return NULL; } - struct stat st; - fstat(fd,&st); - if( st.st_size<offset+size) { - ftruncate(fd,offset+size); + if( mode==3 ) { + fstat(fd,&st); + if( st.st_size<offset+size) { + ftruncate(fd,offset+size); + } } - ptr = mmap(NULL,size,prot,flags,fd,offset); + if( size>0 ) { + ptr = mmap(NULL,size,prot,flags,fd,offset); - if( ptr == MAP_FAILED ) { - return NULL; + if( ptr == MAP_FAILED ) { + return NULL; + } } + else { + ptr = zerolength; + } +#ifdef _DEBUG + if( ptr ) { + counters++; + } +#endif + return ptr; } -void system_io_mmap_munmap(int *size, void *ptr) // Ptr CInt -> Ptr a -> IO () +void system_io_mmap_munmap(void *sizeasptr, void *ptr) // Ptr CInt -> Ptr a -> IO () { - munmap(ptr,*size); - free(size); + 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)handle - 1; + int fd = (int)(intptr_t)handle - 1; struct stat st; fstat(fd,&st); return st.st_size;
cbits/win32.c view
@@ -1,5 +1,16 @@+#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) { @@ -22,14 +33,18 @@ switch(mode) { case 0: dwDesiredAccess = GENERIC_READ; - dwCreationDisposition = OPEN_ALWAYS; + dwCreationDisposition = OPEN_EXISTING; break; case 1: dwDesiredAccess = GENERIC_WRITE|GENERIC_READ; - dwCreationDisposition = OPEN_ALWAYS; + 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: @@ -44,6 +59,9 @@ NULL); if( handle==INVALID_HANDLE_VALUE ) return NULL; +#ifdef _DEBUG + counters++; +#endif return handle; } @@ -51,10 +69,15 @@ 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, int size) +void *system_io_mmap_mmap(void *handle, int mode, long long offset, size_t size) { /* HANDLE WINAPI CreateFileMapping( @@ -90,25 +113,68 @@ flProtect = PAGE_WRITECOPY; dwDesiredAccess = FILE_MAP_COPY; break; + case 3: + flProtect = PAGE_READWRITE; + dwDesiredAccess = FILE_MAP_WRITE; + break; default: return NULL; } - mapping = CreateFileMapping(handle, NULL, flProtect, (DWORD) ((offset + size)>>32), (DWORD)(offset + size), NULL); - if( !mapping ) { - DWORD dw = GetLastError(); + + 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); } - ptr = MapViewOfFile(mapping,dwDesiredAccess, (DWORD)(offset>>32), (DWORD)(offset), size ); - if( !ptr ) { - DWORD dw = GetLastError(); + else { + ptr = zerolength; } - CloseHandle(mapping); +#ifdef _DEBUG + if( ptr ) { + counters++; + } +#endif return ptr; } -void system_io_mmap_munmap(int *size, void *ptr) // Ptr CInt -> Ptr a -> IO () +/* + * 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 () { - UnmapViewOfFile(ptr); - free(size); + 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)
mmap.cabal view
@@ -1,5 +1,5 @@ Name: mmap-Version: 0.4.1+Version: 0.5.2 Stability: alpha License: BSD3 License-File: LICENSE@@ -8,21 +8,42 @@ Maintainer: Gracjan Polak <gracjanpolak@gmail.com> Synopsis: Memory mapped files for POSIX and Windows Description:- 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. + 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. Cabal-version: >= 1.2 Category: System Build-type: Simple+Extra-Source-Files: cbits/HsMmap.h +Flag mmaptest+ Description: Generate mmaptest executable+ Default: False+ Library Build-depends: base<5, bytestring Extensions: ForeignFunctionInterface Exposed-modules: System.IO.MMap Hs-source-dirs: .- CC-options: -Wall+ Include-dirs: cbits+ if os(mingw32)+ C-sources: cbits/win32.c+ else+ C-sources: cbits/posix.c++Executable mmaptest+ Main-is: tests/mmaptest.hs+ if flag(mmaptest)+ Buildable: True+ else+ Buildable: False+ Build-depends: base<5, bytestring, HUnit, directory+ Extensions: ForeignFunctionInterface, ScopedTypeVariables+ Hs-source-dirs: .+ CC-options: -Wall -D_DEBUG+ Include-dirs: cbits if os(mingw32) C-sources: cbits/win32.c else
+ tests/mmaptest.hs view
@@ -0,0 +1,206 @@+ + +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 + +{- + +Things to test: + +1. Opening an existing file. +2. Opening non exisitng file. +3. Opening a file we don't have rights to. +4. Opening read only file for writting. +5. Opening zero lenght file read only +6. Opening zero lenght file read write +7. Extending file size. +8. MMaping only part of file. +9. MMaping negative offset. +10. Mmaping beyond end of file without extending +11. Mmaping 3GB file. +12. Mmaping 5GB file under 32bit (fail) +13. Mmaping 5GB file under 32bit (success) + +-} + +ignoreExceptions doit = (doit >> return ()) `catch` (\e -> return ()) + +foreign import ccall unsafe "HsMmap.h system_io_mmap_counters" + c_system_io_counters :: IO CInt + + +content = BSC.pack "Memory mapping of files for POSIX and Windows" + +test_normal_readonly = do + BSC.writeFile "test_normal.bin" content + bs <- mmapFileByteString "test_normal.bin" Nothing + bs @?= content + +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_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_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_readwriteex = do + let filename = "test_normal8.bin" + BSC.writeFile filename content + mmapWithFilePtr filename ReadWriteEx (Just (4,5000)) $ \(ptr,size) -> do + size @?= 5000 + bs <- BSC.unsafePackCStringLen (castPtr ptr,size) + bs @?= BSC.take 5000 (BSC.drop 4 (content `BSC.append` BSC.replicate 10000 '\0')) + +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.unsafePackCStringLen (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.unsafePackCStringLen (castPtr ptr,size) + bs @?= BSC.replicate 5000 '\0' + assertFailure "Should throw exception" + x <- doesFileExist filename + x @?= False + +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 + , "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 + , "Should throw error if mmaping readonly beyond end of file" ~: test_normal_offset_beyond_eof_readonly + , "Should throw error if mmaping readonly with size beyond end of file" ~: test_normal_offset_plus_size_beyond_eof_readonly + , "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 + + -- 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 + +-}