{-# 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.
--
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.
--
-- Finally, 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.
--
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

  where
    mmap_threshold = 16*1024
    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 ()