diff --git a/System/IO/Posix/MMap.hs b/System/IO/Posix/MMap.hs --- a/System/IO/Posix/MMap.hs +++ b/System/IO/Posix/MMap.hs @@ -10,75 +10,101 @@ -- Portability: non-portable -- posix only -- -- mmap a file or device into memory as a strict ByteString. --- The file is not actually copied strictly into memory, +-- +module System.IO.Posix.MMap ( + + -- $mmap_intro + -- $mmap_unmap + + -- * Memory mapped files + unsafeMMapFile -- :: FilePath -> IO ByteString + +-- $mmap_intro +-- +-- 'unsafeMMapFile' mmaps a file or device into memory as a strict +-- 'ByteString'. The file is not actually copied strictly into memory, -- but instead pages from the file will be loaded into the address -- space on demand. -- --- For example, you can happily mmap a 1G file, as long as you --- only index small parts of it. --- -- We can consider mmap as lazy IO pushed into the virtual memory -- subsystem. -- +-- The file is mapped using MAP_SHARED: modifications to the file +-- will be immediately shared with any other process accessing the +-- file. This has no effect from the Haskell point of view, since +-- ByteStrings are treated as immutable values. +-- +-- However, if the file is written to by any other process on the +-- system while it is in use in Haskell, those changes will be +-- immediately reflected on the Haskell side, destroying referential +-- transparency. +-- +-- It is only safe to mmap a file if you know you are the sole user. +-- -- For more details about mmap, and its consequences, see: -- -- * -- -- * -- --- * --- -module System.IO.Posix.MMap ( - mmapFile -- :: FilePath -> IO ByteString +-- $mmap_unmap +-- +-- When the entire file is out of scope, the Haskell storage manager +-- will call munmap to free the file, using a finaliser. Until then, as +-- much of the file as you access will be allocated. +-- +-- Note that the Haskell storage manager doesn't know how large a +-- resource is associated with an mmapped file. If you allocate many +-- such files, the garbage collector will only see the 'ForeignPtr's +-- that have been allocated, not the corresponding ByteArrays. The +-- result will be that the GC runs less often that you hoped, as it +-- looks like only a few bytes have been allocated on the Haskell heap. +-- +-- Use of 'performGC' or 'finalizeForeignPtr' when you know that +-- the object is going out of scope can ensure that resources are +-- released appropriately. +-- ) where +import System.IO.Posix.MMap.Internal + import System.IO -import Foreign.C.Types +import qualified System.IO as IO import Foreign.Ptr -import qualified Foreign.Concurrent as FC import Control.Exception -import Data.Word -import Data.ByteString.Internal import Data.ByteString import System.Posix --- | The 'mmapFile' function maps a file or device into memory. --- If the mmap fails for some reason, an attempt is made --- to copy the file into memory instead. +-- | The 'unsafeMMapFile' function maps a file or device into memory, +-- returning a strict 'ByteString' that accesses the mapped file. +-- 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. However, in tight memory situations, or if you have --- precise deallocation points, it is possible to call the unmap the --- allocated pointer directly. +-- this yourself. In tight memory situations, it may be profitable to +-- use 'performGC' or 'finalizeForeignPtr' to force an unmap. -- --- Memory mapped files will behave as if they were read lazily -- --- pages from the file will be loaded into memory 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 'ByteString' will change. -- -mmapFile :: FilePath -> IO ByteString -mmapFile f = do - h <- openBinaryFile f ReadMode - always (hClose h) $ do - n <- fromIntegral `fmap` hFileSize h - fd <- handleToFd h - always (closeFd fd) $ do - ptr <- c_mmap (fromIntegral n) (fromIntegral fd) - if ptr == nullPtr - then hGet h n -- read it anyway. mmap failed. - else do fp <- FC.newForeignPtr ptr - (do c_munmap ptr (fromIntegral n) - return ()) - return $! PS fp 0 n +unsafeMMapFile :: FilePath -> IO ByteString +unsafeMMapFile f = do + fd <- openFd f ReadOnly Nothing defaultFileFlags + always (closeFd fd) $ do + stat <- getFdStatus fd + let size = fromIntegral (fileSize stat) + ptr <- c_mmap size (fromIntegral fd) + if ptr == nullPtr + then error "System.IO.Posix.MMap.mmapFile: unable to mmap file" + else unsafePackMMapPtr ptr size where always = flip finally - -foreign import ccall unsafe "hs_bytestring_mmap.h hs_bytestring_mmap" - c_mmap :: CSize -> CInt -> IO (Ptr Word8) - -foreign import ccall unsafe "hs_bytestring_mmap.h munmap" - c_munmap :: Ptr Word8 -> CSize -> IO () diff --git a/System/IO/Posix/MMap/Internal.hs b/System/IO/Posix/MMap/Internal.hs new file mode 100644 --- /dev/null +++ b/System/IO/Posix/MMap/Internal.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +-------------------------------------------------------------------- +-- | +-- Module : System.IO.Posix.MMap.Internal +-- Copyright : (c) Galois, Inc. 2007 +-- License : BSD3 +-- +-- Maintainer: Don Stewart +-- Stability : provisional +-- Portability: non-portable -- posix only +-- +-- Low level mmap access. +-- +module System.IO.Posix.MMap.Internal ( + + -- * Converting an mmapped pointer to a 'ByteString' + unsafePackMMapPtr, -- :: Ptr Word8 -> CSize -> IO ByteString + + -- * Low level bindings + c_mmap, -- :: CSize -> CInt -> IO (Ptr Word8) + c_munmap -- :: Ptr Word8 -> CSize -> IO CInt + + ) where + +import System.IO +import qualified System.IO as IO +import Foreign.C.Types +import Foreign.Ptr +import qualified Foreign.Concurrent as FC + +import Control.Monad +import Data.Word +import Data.ByteString.Internal +import Data.ByteString + +-- | Create a bytestring from a memory mapped Ptr. +-- A finalizer will be associated with the resource, that will call +-- munmap when the storage manager detects that the resource is no longer +-- in use. +unsafePackMMapPtr :: Ptr Word8 -> CSize -> IO ByteString +unsafePackMMapPtr p s = do + fp <- FC.newForeignPtr p $ do + v <- c_munmap p s + when (v == -1) $ IO.hPutStrLn stderr $ + "System.IO.Posix.MMap: warning, failed to unmap " + ++ show s ++" bytes at "++show p + return (fromForeignPtr fp 0 (fromIntegral s)) +{-# INLINE unsafePackMMapPtr #-} + +foreign import ccall unsafe "hs_bytestring_mmap.h hs_bytestring_mmap" + c_mmap :: CSize -> CInt -> IO (Ptr Word8) + +foreign import ccall unsafe "hs_bytestring_mmap.h munmap" + c_munmap :: Ptr Word8 -> CSize -> IO CInt diff --git a/System/IO/Posix/MMap/Lazy.hs b/System/IO/Posix/MMap/Lazy.hs new file mode 100644 --- /dev/null +++ b/System/IO/Posix/MMap/Lazy.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE CPP, BangPatterns, ForeignFunctionInterface #-} +-------------------------------------------------------------------- +-- | +-- Module : System.IO.Posix.MMap +-- Copyright : (c) Galois, Inc. 2007 +-- License : BSD3 +-- +-- Maintainer: Don Stewart +-- Stability : provisional +-- Portability: non-portable -- posix only +-- +-- Lazy, chunk-wise memory mapping. +-- +-- Memory map a file as a lazy ByteString. Finalisers are associated +-- cached-sized portions of the file, which will be deallocated as +-- those chunks go out of scope. +-- +-- Unlike strict Bytestrings, mmapFile for Lazy ByteStrings will +-- deallocate chunks of the file. +-- +-- The storage manager is used to free chunks of the mapped memory. When +-- the garbage collector notices there are no further references to +-- a chunk, a call to munmap is made. +-- +-- In effect, the file is mmapped once, lazily, then covered with finalizers +-- for each chunk. When any chunk goes out of scope, that part is +-- deallocated. We must allocate the spine of the structure strictly +-- though, to ensure finalizers are registered for the entire file. +-- +-- The Haskell garbage collector decides when to run based on heap +-- pressure, however the mmap stores memory outside the Haskell heap, +-- so those resources are not counted when deciding to run the garbage +-- collect. The result is that finalizers run less often than you might +-- expect, and it is possible to write a lazy bytestring mmap program +-- that never deallocates (and thus doesn't run in constant space). +-- 'performGC' or 'finalizerForeignPtr' can be used to trigger collection +-- at sensible points. +-- +-- 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 'ByteString' will change. +-- +module System.IO.Posix.MMap.Lazy ( + + unsafeMMapFile -- :: FilePath -> IO ByteString + + ) where + +import System.IO.Posix.MMap.Internal + +import System.IO +import Foreign.C.Types +import Foreign.Ptr +import Control.Monad + +import Control.Exception +import Data.Word +import Data.ByteString.Lazy.Internal + +import System.Posix + +-- +-- | The 'unsafeMMapFile' function maps a file or device into memory as +-- a lazy ByteString, made of 64*pagesize unmappable chunks of bytes. +-- +-- 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 chunks that go out of scope, +-- and unlike strict bytestrings, memory mapped lazy ByteStrings will +-- be deallocated in chunks (so you can write traversals that run in +-- constant space). +-- +-- However, the size of the mmapped resource is not known by the Haskell +-- GC, it appears only as a small ForeignPtr. This means that the +-- Haskell GC may not not run as often as you'd like, leading to delays +-- in unmapping chunks. +-- +-- Appropriate use of performGC or finalizerForeignPtr may be required +-- to ensure deallocation, as resources allocated by mmap are not +-- tracked by the Haskell garbage collector. +-- +-- For example, when writing out a lazy bytestring allocated with mmap, +-- you may wish to finalizeForeignPtr when each chunk is written, as the +-- chunk goes out of scope, rather than relying on the garbage collector +-- to notice the chunk has gone. +-- +-- This operation is unsafe: if the file is written to by any other +-- process on the system, the 'ByteString' contents will change in +-- Haskell. +-- +unsafeMMapFile :: FilePath -> IO ByteString +unsafeMMapFile path = do + fd <- openFd path ReadOnly Nothing defaultFileFlags + always (closeFd fd) $ do + stat <- getFdStatus fd + let size = fromIntegral (fileSize stat) + ptr <- c_mmap size (fromIntegral fd) + if ptr == nullPtr + then error "System.IO.Posix.MMap.Lazy: unable to mmap file!" + else chunks chunk_size ptr (fromIntegral size) + where + always = flip finally + + -- must be page aligned. + chunk_size = 64 * fromIntegral pagesize -- empircally derived + +-- +-- Break the file up into chunks. + -- Have separate munmap finalizers for each chunk. +-- +chunks :: CSize -> Ptr Word8 -> CSize -> IO ByteString +chunks chunk_size p bytes = loop p bytes +#ifndef __HADDOCK__ + where + loop !ptr !rest + | rest <= 0 = return Empty + | otherwise = let s = min chunk_size rest + ptr' = ptr `plusPtr` fromIntegral s + rest' = rest - s + in do c <- unsafePackMMapPtr ptr s + cs <- loop ptr' rest' -- need to be strict + return (chunk c cs) -- to ensure we cover the whole file + -- with finalizers +#endif + +foreign import ccall unsafe "unistd.h getpagesize" + pagesize :: CInt + diff --git a/bytestring-mmap.cabal b/bytestring-mmap.cabal --- a/bytestring-mmap.cabal +++ b/bytestring-mmap.cabal @@ -1,11 +1,12 @@ name: bytestring-mmap -version: 0.1.2 +version: 0.2.0 synopsis: mmap support for strict ByteStrings description: . This library provides a wrapper to mmap(2), allowing files or - devices to be lazily loaded into memory as a strict ByteString, - using the virtual memory subsystem to do on-demand loading. + devices to be lazily loaded into memory as strict or lazy + ByteStrings, using the virtual memory subsystem to do on-demand + loading. . category: System homepage: http://code.haskell.org/~dons/code/bytestring-mmap/ @@ -25,9 +26,14 @@ build-depends: base >= 3, bytestring >= 0.9 else build-depends: base < 3 - extensions: ForeignFunctionInterface + extensions: CPP, ForeignFunctionInterface, BangPatterns + exposed-modules: System.IO.Posix.MMap - ghc-options: -Wall -fglasgow-exts -O2 + System.IO.Posix.MMap.Lazy + System.IO.Posix.MMap.Internal + + ghc-options: -Wall -O2 -fvia-C + c-sources: cbits/hs_bytestring_mmap.c include-dirs: include includes: hs_bytestring_mmap.h diff --git a/tests/big-lazy.hs b/tests/big-lazy.hs new file mode 100644 --- /dev/null +++ b/tests/big-lazy.hs @@ -0,0 +1,22 @@ +import qualified Data.ByteString.Lazy as L +import System.IO.Posix.MMap.Lazy +import Control.Monad +import Text.Printf +import System.Mem + +main = do + s <- unsafeMMapFile "/usr/obj/data/1G" + go 0 s + where + go n s + | L.null s = return () + | otherwise + = do -- printf "%d\n" + L.head s `seq` return () + when (n `mod` 1000 == 0) $ do + performGC -- tune this value for when to run the GC + go (n+1) (L.drop 4096 s) + + +-- forM_ [0, (1024) .. L.length s-1] $ \n -> do + diff --git a/tests/big.hs b/tests/big.hs --- a/tests/big.hs +++ b/tests/big.hs @@ -4,7 +4,7 @@ import Text.Printf main = do - s <- mmapFile "/usr/obj/data/1G" + s <- unsafeMMapFile "/usr/obj/data/1G" print "This program should touch only 1 page per 100k" forM_ [0, (1024) .. S.length s-1] $ \n -> do diff --git a/tests/cp.hs b/tests/cp.hs --- a/tests/cp.hs +++ b/tests/cp.hs @@ -6,6 +6,8 @@ import Text.Printf import Control.Exception import System.CPUTime +import System.Cmd +import System.Directory import System.Environment @@ -23,9 +25,13 @@ [f] <- getArgs putStrLn "mmap copy" - time $ S.writeFile (f ++ "-1") =<< mmapFile f + time $ S.writeFile "file-1" =<< unsafeMMapFile f putChar '\n' putStrLn "lazy copy" - time $ S.writeFile (f ++ "-2") =<< S.readFile f + time $ S.writeFile "file-2" =<< S.readFile f putChar '\n' + + system $ "diff " ++ "file-1 " ++ "file-2" + removeFile "file-1" + removeFile "file-2" diff --git a/tests/fast-cp.hs b/tests/fast-cp.hs new file mode 100644 --- /dev/null +++ b/tests/fast-cp.hs @@ -0,0 +1,29 @@ +import qualified System.IO.Posix.MMap.Lazy as L +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import qualified Data.ByteString as S + +import Foreign.ForeignPtr +import System.Environment +import System.IO +import Control.Exception + +main = do + [f,g] <- getArgs + writeFile' g =<< L.unsafeMMapFile f + +-- +-- An implementation of writeFile for bytestrings that +-- that finalises chunks as they go out the door. +-- +writeFile' :: FilePath -> L.ByteString -> IO () +writeFile' f txt = bracket (openBinaryFile f WriteMode) hClose (\hdl -> hPut hdl txt) + +hPut :: Handle -> L.ByteString -> IO () +hPut h cs = L.foldrChunks (\chunk rest -> do S.hPut h chunk + unmap chunk + rest) + (return ()) cs + + where unmap c = finalizeForeignPtr fp where (fp,_,_) = S.toForeignPtr c diff --git a/tests/files.hs b/tests/files.hs --- a/tests/files.hs +++ b/tests/files.hs @@ -1,9 +1,11 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import System.IO.Posix.MMap +import qualified System.IO.Posix.MMap.Lazy as LM import System.Directory import System.Posix.Files +import System.IO import System.FilePath import Control.Monad import Control.Applicative @@ -14,7 +16,8 @@ import Control.Exception main = do - system "find /usr/src -type f > files_to_read" + print "Testing Lazy.mmap == Strict.mmap == Strict.ByteString.readFile" + system "find /usr/src/sys -type f > files_to_read" always (removeFile "files_to_read") $ do fs <- lines <$> readFile "files_to_read" @@ -28,13 +31,16 @@ forM_ (zip [1..] fs) $ \(i,f) -> do t <- eq f if t - then when (i `mod` 100 == 0) $ print i + then when (i `mod` 1000 == 0) $ putStr "Ok. " >> hFlush stdout else exitWith (ExitFailure 1) + print "All good." + where always = flip finally eq f = do - m <- mmapFile f - s <- S.readFile f - return (m == s) + m <- unsafeMMapFile f + lm <- LM.unsafeMMapFile f + s <- S.readFile f + return (m == s && L.fromChunks [m] == lm) diff --git a/tests/pressure.hs b/tests/pressure.hs --- a/tests/pressure.hs +++ b/tests/pressure.hs @@ -12,15 +12,13 @@ --should run in constant space, and be faster: time $ forM_ [0..1000] $ \_ -> do - mmapFile "/usr/share/dict/words" - putChar '.' + unsafeMMapFile "/usr/share/dict/words" putStrLn "\nShould be faster than:\n" --should run in constant space: time $ forM_ [0..1000] $ \_ -> do S.readFile "/usr/share/dict/words" - putChar ',' time :: IO t -> IO t diff --git a/tests/small.hs b/tests/small.hs --- a/tests/small.hs +++ b/tests/small.hs @@ -12,4 +12,4 @@ -- return (not $ isDirectory st)) ss fs <- lines <$> readFile "/tmp/files" - mapM_ mmapFile fs + mapM_ unsafeMMapFile fs diff --git a/tests/test b/tests/test new file mode 100644 --- /dev/null +++ b/tests/test @@ -0,0 +1,19 @@ +#!/bin/sh + +set -e + +compile="ghc -no-recomp -O --make " + +$compile files.hs && ./files +rm files + +$compile cp.hs && ./cp /usr/share/dict/words +rm cp + +$compile pressure.hs && ./pressure + +#big-lazy.hs +#big.hs +#fast-cp.hs +#pressure.hs +#small.hs