mmap-0.5.9/0000755000000000000000000000000012212127243010641 5ustar0000000000000000mmap-0.5.9/LICENSE0000644000000000000000000000265012212127243011651 0ustar0000000000000000Copyright (c) Gracjan Polak All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. mmap-0.5.9/mmap.cabal0000644000000000000000000000301312212127243012554 0ustar0000000000000000Name: mmap Version: 0.5.9 Stability: stable License: BSD3 License-File: LICENSE Copyright: 2008-2012, Gracjan Polak Author: Gracjan Polak Maintainer: Gracjan Polak 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. Modifications are also supported. Cabal-version: >= 1.6 Category: System Build-type: Simple Extra-Source-Files: cbits/HsMmap.h Flag mmaptest Description: Generate mmaptest executable Default: False Source-repository head Type: darcs Location: http://code.haskell.org/mmap Library Build-depends: base<5, bytestring Extensions: ForeignFunctionInterface Exposed-modules: System.IO.MMap Hs-source-dirs: . Include-dirs: cbits GHC-options: -Wall 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 Build-depends: base<5, bytestring, HUnit, directory else Buildable: False Extensions: ForeignFunctionInterface, ScopedTypeVariables, CPP Hs-source-dirs: . CC-options: -Wall -D_DEBUG Include-dirs: cbits if os(mingw32) cpp-options: -DWINDOWS C-sources: cbits/win32.c Build-depends: Win32 else C-sources: cbits/posix.c mmap-0.5.9/Setup.hs0000644000000000000000000000005512212127243012275 0ustar0000000000000000import Distribution.Simple main = defaultMainmmap-0.5.9/cbits/0000755000000000000000000000000012212127243011745 5ustar0000000000000000mmap-0.5.9/cbits/HsMmap.h0000644000000000000000000000107612212127243013307 0ustar0000000000000000#ifndef __HSMMAP_H__ #define __HSMMAP_H__ #include 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_extend_file_size(void *handle, long long size); int system_io_mmap_granularity(); // this is only implemented in _DEBUG builds int system_io_mmap_counters(); #endif /* __HSMMAP_H__ */ mmap-0.5.9/cbits/posix.c0000644000000000000000000000626412212127243013263 0ustar0000000000000000#include "HsMmap.h" #define _LARGEFILE64_SOURCE 1 #define _FILE_OFFSET_BITS 64 #include #include #include #include #include #include #include #include #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(); } mmap-0.5.9/cbits/win32.c0000644000000000000000000001311712212127243013056 0ustar0000000000000000#include "HsMmap.h" #include #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-0.5.9/System/0000755000000000000000000000000012212127243012125 5ustar0000000000000000mmap-0.5.9/System/IO/0000755000000000000000000000000012212127243012434 5ustar0000000000000000mmap-0.5.9/System/IO/MMap.hs0000644000000000000000000004553412212127243013635 0ustar0000000000000000{-# 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,castPtr) import Foreign.C.Types (CInt(..),CLLong(..),CSize(..)) import Foreign.C.String (CString,withCString) import Foreign.ForeignPtr (ForeignPtr,withForeignPtr,finalizeForeignPtr,newForeignPtr,newForeignPtrEnv) import Foreign.C.Error import System.IO.Unsafe (unsafePerformIO) import qualified Data.ByteString.Internal as BS (fromForeignPtr) import Data.Int (Int64) import Control.Monad (when) import qualified Control.Exception as E (bracketOnError, bracket, finally) import qualified Data.ByteString as BS (ByteString) import qualified Data.ByteString.Lazy as BSL (ByteString,fromChunks) import Prelude hiding (length) --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: -- -- * -- -- * -- -- * -- -- 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 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 E.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) `E.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'. -- -- Chunks are really mapped into memory at the first inspection of a -- chunk. They are kept in memory while they are referenced, garbage -- collector takes care of the later. -- 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 E.bracketOnError (mmapFileOpen filepath mode) (finalizeForeignPtr) mmap where mmap handle = do (offset,size) <- sanitizeFileRegion filepath handle mode offsetsize return $ map (mmapFileForeignPtrLazyChunk filepath mode handle) (chunks offset size) {-# NOINLINE mmapFileForeignPtrLazyChunk #-} mmapFileForeignPtrLazyChunk :: FilePath -> Mode -> ForeignPtr () -> (Int64, Int) -> (ForeignPtr a, Int, Int) mmapFileForeignPtrLazyChunk filepath mode 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 + chunkSizeLong * 2 - 1) `div` chunkSizeLong) * chunkSizeLong size2 = offset2 - offset chunkSizeLong = fromIntegral chunkSize 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 :: Int chunkSize = (128*1024 `div` fromIntegral c_system_io_granularity) * fromIntegral 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 mmap-0.5.9/tests/0000755000000000000000000000000012212127243012003 5ustar0000000000000000mmap-0.5.9/tests/mmaptest.hs0000644000000000000000000003143612212127243014200 0ustar0000000000000000{-# 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 import Control.Exception as E #ifdef WINDOWS import qualified System.Win32.File as W #endif ignoreExceptions doit = (doit >> return ()) `E.catch` (\(e :: IOError) -> 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 (setOwnerReadable True . setOwnerWritable True . setOwnerExecutable True . setOwnerSearchable True $ emptyPermissions) BSC.writeFile filename content setPermissions filename (emptyPermissions) permissions <- getPermissions filename -- no way to clear read flag under Windows, skip the test if not (readable permissions) 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 -}