{-# LANGUAGE ForeignFunctionInterface #-}
--------------------------------------------------------------------
-- |
-- Module    :  System.IO.Posix.MMap
-- Copyright :  (c) Galois, Inc. 2007
-- License   :  BSD3
--
-- Maintainer:  Don Stewart <dons@galois.com>
-- Stability :  provisional
-- 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:
-- 
-- * <http://opengroup.org/onlinepubs/009695399/functions/mmap.html>
--
-- * <http://www.gnu.org/software/libc/manual/html_node/Memory_002dmapped-I_002fO.html>
--
-- * <http://www.ecst.csuchico.edu/~beej/guide/ipc/mmap.html>
--
module System.IO.Posix.MMap (

      mmapFile -- :: FilePath -> IO ByteString

    ) where

import System.IO
import Foreign.C.Types
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 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.
--
-- 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
       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 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 ()