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,7 +10,24 @@ -- 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, +-- 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. +-- +-- For more details about mmap, and its consequences, see: +-- +-- * +-- +-- * +-- +-- * +-- module System.IO.Posix.MMap ( mmapFile -- :: FilePath -> IO ByteString @@ -33,38 +50,32 @@ -- If the mmap fails for some reason, an attempt is made -- to copy the file into memory instead. -- --- Finally, the storage manager is used to free the mapped memory. When +-- 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. -- --- If the file size is less than 16*1024, it is more efficient to simply --- copy the file, so an mmap is not performed for small files. --- In the normal case, the file need never be copied. +-- Memory mapped files will behave as if they were read lazily -- +-- pages from the file will be loaded into memory on demand. -- mmapFile :: FilePath -> IO ByteString mmapFile f = do h <- openBinaryFile f ReadMode always (hClose h) $ do - n <- fromIntegral `fmap` hFileSize h - if n < mmap_threshold - then hGet h n - else do 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 + 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 - where - mmap_threshold = 16*1024 - always = flip finally + where always = flip finally foreign import ccall unsafe "hs_bytestring_mmap.h hs_bytestring_mmap" c_mmap :: CSize -> CInt -> IO (Ptr Word8) diff --git a/bytestring-mmap.cabal b/bytestring-mmap.cabal --- a/bytestring-mmap.cabal +++ b/bytestring-mmap.cabal @@ -1,10 +1,11 @@ name: bytestring-mmap -version: 0.1.1 +version: 0.1.2 synopsis: mmap support for strict ByteStrings description: . This library provides a wrapper to mmap(2), allowing files or - devices to be efficiently mapped into memory as a strict ByteString. + devices to be lazily loaded into memory as a strict ByteString, + using the virtual memory subsystem to do on-demand loading. . category: System homepage: http://code.haskell.org/~dons/code/bytestring-mmap/ diff --git a/tests/big.hs b/tests/big.hs new file mode 100644 --- /dev/null +++ b/tests/big.hs @@ -0,0 +1,12 @@ +import qualified Data.ByteString as S +import System.IO.Posix.MMap +import Control.Monad +import Text.Printf + +main = do + s <- mmapFile "/usr/obj/data/1G" + print "This program should touch only 1 page per 100k" + + forM_ [0, (1024) .. S.length s-1] $ \n -> do + printf "n=%d := %d\n" n (S.index s n) + diff --git a/tests/files.hs b/tests/files.hs new file mode 100644 --- /dev/null +++ b/tests/files.hs @@ -0,0 +1,40 @@ +import qualified Data.ByteString as S +import qualified Data.ByteString.Lazy as L +import System.IO.Posix.MMap + +import System.Directory +import System.Posix.Files +import System.FilePath +import Control.Monad +import Control.Applicative +import Text.Printf +import System.Cmd +import System.Exit +import System.Mem +import Control.Exception + +main = do + system "find /usr/src -type f > files_to_read" + always (removeFile "files_to_read") $ do + fs <- lines <$> readFile "files_to_read" + + {- + ss <- getDirectoryContents dir + fs <- filterM (\f -> do st <- getFileStatus (dir f) + return (not $ isDirectory st)) ss + -} + + printf "Comparing %d files\n" (length fs) + forM_ (zip [1..] fs) $ \(i,f) -> do + t <- eq f + if t + then when (i `mod` 100 == 0) $ print i + else exitWith (ExitFailure 1) + + where + always = flip finally + +eq f = do + m <- mmapFile f + s <- S.readFile f + return (m == s) diff --git a/tests/small.hs b/tests/small.hs new file mode 100644 --- /dev/null +++ b/tests/small.hs @@ -0,0 +1,15 @@ +import System.Directory +import System.IO.Posix.MMap +import System.Posix.Files +import System.FilePath +import Control.Monad +import Control.Applicative + +main = do +-- let dir = "/home/dons/lambdabot/_darcs/patches" +-- ss <- getDirectoryContents dir +-- fs <- filterM (\f -> do st <- getFileStatus (dir f) +-- return (not $ isDirectory st)) ss + + fs <- lines <$> readFile "/tmp/files" + mapM_ mmapFile fs