MMap.hsc

module Bio.Util.MMap ( mmapFile, createMmapFile ) where

import BasePrelude
import Foreign.C.Error      ( getErrno, errnoToIOError )
import Foreign.C.Types
import System.Posix.Files   ( fileSize, getFdStatus, setFdSize )
import System.Posix.IO      ( openFd, closeFd, defaultFileFlags, OpenMode(ReadOnly,ReadWrite) )
import System.Posix.Types   ( Fd(..), COff(..) )

#include <sys/mman.h>

-- | Maps a whole file into memory, returns the size in bytes and a
-- 'ForeignPtr' to the contents.
mmapFile :: FilePath -> IO (Int, ForeignPtr a)
mmapFile fp =
    bracket (openFd fp ReadOnly Nothing defaultFileFlags) closeFd $ \fd -> do
        size <- fileSize <$> getFdStatus fd
        if size <= 0
            then (,) 0 <$> newForeignPtr_ nullPtr
            else do
                ptr <- mmap nullPtr (fromIntegral size) (#const PROT_READ) (#const MAP_SHARED) fd 0
                if ptrToIntPtr ptr == #const MAP_FAILED
                    then do errno <- getErrno
                            ioError $ errnoToIOError "mmapFile" errno Nothing (Just fp)
                    else (,) (fromIntegral size) <$> newForeignPtrEnv my_munmap (intPtrToPtr $ fromIntegral size) ptr

-- | Creates a new file of a desired initial size, maps it into memory,
-- and calls a function to fill it.  That function returns a pointer to
-- the first unused byte in the file, and it is truncated accordingly.
createMmapFile :: FilePath -> CSize -> (Ptr a -> IO (Ptr a, b)) -> IO b
createMmapFile fp sz k =
    bracket (openFd fp ReadWrite (Just 0x1b6) defaultFileFlags) closeFd $ \fd -> do
        setFdSize fd (fromIntegral sz)
        bracket (mmap nullPtr sz (#const PROT_READ | PROT_WRITE) (#const MAP_SHARED) fd 0)
                (flip munmap sz) $ \p -> do
            (p',r) <- k p
            setFdSize fd (fromIntegral $ minusPtr p' p)
            return r

foreign import ccall unsafe "&my_munmap"        my_munmap :: FunPtr (Ptr () -> Ptr a -> IO ())
foreign import ccall unsafe "sys/mman.h mmap"   mmap      :: Ptr a -> CSize -> CInt -> CInt -> Fd -> COff -> IO (Ptr a)
foreign import ccall unsafe "sys/mman.h munmap" munmap    :: Ptr a -> CSize -> IO ()