mmap 0.2 → 0.3
raw patch · 5 files changed
+21/−166 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- System/IO/MMap.hs +5/−4
- cbits/posix.c +13/−11
- mmap.cabal +3/−4
- tests/CpTest.hs +0/−103
- tests/SimpleMMap.hs +0/−44
System/IO/MMap.hs view
@@ -24,6 +24,7 @@ import Foreign.C.Types (CInt,CLLong) import Foreign.C.String (CString,withCString) import Foreign.ForeignPtr (ForeignPtr,withForeignPtr,finalizeForeignPtr,newForeignPtr) +import Foreign.C.Error ( throwErrno ) import Foreign.Concurrent (newForeignPtr) import System.IO.Unsafe (unsafePerformIO) import qualified Data.ByteString.Unsafe as BS (unsafePackCStringFinalizer) @@ -100,7 +101,7 @@ Nothing -> do longsize <- withForeignPtr handle c_system_io_file_size when (longsize > fromIntegral (maxBound :: Int)) $ - error ("file is longer (" ++ show longsize ++ ") than 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 @@ -108,7 +109,7 @@ sizeraw = size + fromIntegral align ptr <- c_system_io_mmap_mmap handle (fromIntegral $ fromEnum mode) (fromIntegral offsetraw) (fromIntegral sizeraw) when (ptr == nullPtr) $ - error "c_system_io_mmap_mmap returned NULL" + throwErrno $ "mmap of '" ++ filepath ++ "' failed" let finalizer = c_system_io_mmap_munmap ptr (fromIntegral sizeraw) return (ptr `plusPtr` fromIntegral align,finalizer,fromIntegral size) @@ -188,7 +189,7 @@ sizeraw = size + fromIntegral align ptr <- c_system_io_mmap_mmap handle (fromIntegral $ fromEnum mode) (fromIntegral offsetraw) (fromIntegral sizeraw) when (ptr == nullPtr) $ - error "c_system_io_mmap_mmap returned NULL" + throwErrno $ "mmap of '" ++ filepath ++ "' failed" let finalizer = c_system_io_mmap_munmap ptr (fromIntegral sizeraw) return (ptr `plusPtr` fromIntegral align,finalizer,fromIntegral size) @@ -238,7 +239,7 @@ mmapFileOpen filepath mode = do ptr <- withCString filepath $ \filepath -> c_system_io_mmap_file_open filepath (fromIntegral $ fromEnum mode) when (ptr == nullPtr) $ - error "c_system_io_mmap_file_open returned NULL" + throwErrno $ "mmap of '" ++ filepath ++ "' failed" handle <- Foreign.ForeignPtr.newForeignPtr c_system_io_mmap_file_close ptr return handle
cbits/posix.c view
@@ -14,7 +14,7 @@ void *system_io_mmap_file_open(const char *filepath, int mode) { void *handle = NULL; - int access; + int access, fd; if( !filepath ) return NULL; switch(mode) { @@ -30,9 +30,9 @@ default: return NULL; } - handle = (void *)open(filepath,access,0666); - if( handle==(void*)(-1) ) { - //fprintf(stderr,"open errno %d\n",errno); + fd = open(filepath,access,0666); + handle = (void *)fd + 1; + if( fd == -1 ) { return NULL; } return handle; @@ -41,7 +41,8 @@ //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) { - close((int)handle); + int fd = (int)handle - 1; + close(fd); } //foreign import ccall unsafe "system_io_mmap_mmap" c_system_io_mmap_mmap :: Ptr () -> CInt -> CLLong -> CInt -> IO (Ptr ()) @@ -50,6 +51,7 @@ void *ptr = NULL; int prot; int flags; + int fd = (int)handle - 1; switch(mode) { case 0: prot = PROT_READ; @@ -68,15 +70,14 @@ } struct stat st; - fstat((int)handle,&st); + fstat(fd,&st); if( st.st_size<offset+size) { - ftruncate((int)handle,offset+size); + ftruncate(fd,offset+size); } - ptr = mmap(NULL,size,prot,flags,(int)handle,offset); + ptr = mmap(NULL,size,prot,flags,fd,offset); - if( ptr == (void*)(-1)) { - //fprintf(stderr,"mmap errno %d\n",errno); + if( ptr == MAP_FAILED ) { return NULL; } return ptr; @@ -91,8 +92,9 @@ //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; struct stat st; - fstat((int)handle,&st); + fstat(fd,&st); return st.st_size; }
mmap.cabal view
@@ -1,5 +1,5 @@ Name: mmap-Version: 0.2+Version: 0.3 Stability: alpha License: BSD3 License-File: LICENSE@@ -18,12 +18,11 @@ Build-type: Simple Library- Build-depends: base, bytestring+ Build-depends: base<5, bytestring Extensions: ForeignFunctionInterface Exposed-modules: System.IO.MMap Hs-source-dirs: .- Ghc-options: -O2- CC-options: -O2 -Wall+ CC-options: -Wall if os(mingw32) C-sources: cbits/win32.c else
− tests/CpTest.hs
@@ -1,103 +0,0 @@- - -module Main where - -import System.IO.MMap -import qualified Data.ByteString.Char8 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 Control.Exception as E -import Text.Printf -import Control.Exception -import System.CPUTime -import System.Environment -import System.IO -import Data.ByteString.Internal - - -time :: String -> IO t -> IO t -time txt a = do - printf "%s: " txt - start <- getCPUTime - v <- a - v `seq` return () - end <- getCPUTime - let diff = (fromIntegral (end - start)) / (10^12) - printf "%0.3f sec\n" (diff :: Double) - return v - - -main = do - [filename] <- getArgs - - time "Prelude copy" $ do - hin <- openBinaryFile filename ReadMode - hout <- openBinaryFile (filename ++ ".prelude") WriteMode - c <- hGetContents hin - hPutStr hout c - hClose hin - hClose hout - - time "ByteString copy" $ do - hin <- openBinaryFile filename ReadMode - hout <- openBinaryFile (filename ++ ".bytestring") WriteMode - c <- BSC.hGetContents hin - BSC.hPutStr hout c - hClose hin - hClose hout - - time "ByteString.Lazy copy" $ do - hin <- openBinaryFile filename ReadMode - hout <- openBinaryFile (filename ++ ".bytestringlazy") WriteMode - c <- BSL.hGetContents hin - BSL.hPutStr hout c - hClose hin - hClose hout - - time "MMap copy" $ do - (mmapin,fin1,size) <- mmapFilePtr filename ReadOnly Nothing - let newname = filename ++ ".mmap" - writeFile newname "" - (mmapout,fin2,size) <- mmapFilePtr newname ReadWrite (Just (0,size)) - memcpy mmapout mmapin (fromIntegral size) - fin1 - fin2 - - time "MMap copy lazy" $ do - chunksin <- mmapFileByteStringLazy filename Nothing - let newname = filename ++ ".mmaplazy" - hout <- openBinaryFile newname WriteMode - BSL.hPutStr hout chunksin - - {- - 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 - - -}
− tests/SimpleMMap.hs
@@ -1,44 +0,0 @@- - -module Main where - -import System.IO.MMap -import Data.ByteString.Char8 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 Control.Exception as E - - -content = BSC.pack "Memory mapping of files for POSIX and Windows" - -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 -