{-# LINE 1 "MMAP.hsc" #-} {-# LANGUAGE CPP, ForeignFunctionInterface, DeriveDataTypeable #-} {-# LINE 2 "MMAP.hsc" #-} -- | Provides @mmap@: mapping files into memory. module MMAP where import Control.Exception import Control.Monad import Data.Bits ((.|.)) import Data.Monoid import Data.Typeable import Foreign.C.Types import Foreign.Ptr import System.Posix.Types {-# LINE 16 "MMAP.hsc" #-} -- | Exception thrown when @mmap@ fails. data MmapException = MmapException deriving (Eq, Ord, Show, Typeable) instance Exception MmapException -- | Exception thrown when @munmap@ fails. data MunmapException = MunmapException { munmapExceptionSize :: CSize , munmapExceptionPtr :: Ptr () } deriving (Eq, Ord, Show, Typeable) instance Exception MunmapException -- | @mmap@ - map files or devices into memory. -- -- The returned memory should be freed with `c_munmap` after use. -- -- This is the raw C function, and its return value must be checked -- according to @man mmap@. -- -- See `mmap` for a variant that turns bad return values into exceptions. foreign import ccall unsafe "sys/mman.h mmap" -- void *mmap(void *addr, size_t length, int prot, int flags, -- int fd, off_t offset) c_mmap :: Ptr () -- ^ void *addr -> CSize -- ^ size_t length -> ProtOption -- ^ int prot -> MmapFlags -- ^ int flags, -> Fd -- ^ int fd -> COff -- ^ off_t offset -> IO (Ptr ()) -- void *mmap -- | @munmap@ - unmap @mmap@'ed memory. -- -- This is the raw C function, and its return value must be checked -- according to @man mmap@. -- -- See `munmap` for a variant that turns bad return values into exceptions. foreign import ccall unsafe "sys/mman.h munmap" -- int munmap(void *addr, size_t length) c_munmap :: Ptr () -- ^ void *addr -> CSize -- ^ size_t length -> IO CInt -- int munmap -- | Convenience around `c_mmap`, throwing a `MmapException` on a negative return value. mmap :: Ptr () -> CSize -> ProtOption -> MmapFlags -> Fd -> COff -> IO (Ptr ()) mmap addr len prot flags fd offset = do ptr <- c_mmap addr len prot flags fd offset when (ptr == intPtrToPtr (-1)) $ throwIO MmapException return ptr -- | Convenience around `c_munmap`, throwing a `MunmapException` on a negative return value. munmap :: Ptr () -> CSize -> IO () munmap addr len = do v <- c_munmap addr len when (v == -1) . throwIO $ MunmapException len addr -- | Describes the desired memory protection of the mapping -- (and must not conflict with the open mode of the file). -- -- Can be combined using the `Monoid` instance `(<>)`. newtype ProtOption = ProtOption { unProtOption :: CInt } deriving (Eq, Show, Ord) -- | Pages may be executed. protExec :: ProtOption protExec = ProtOption 4 {-# LINE 99 "MMAP.hsc" #-} -- | Pages may be read. protRead :: ProtOption protRead = ProtOption 1 {-# LINE 103 "MMAP.hsc" #-} -- | Pages may be written. protWrite :: ProtOption protWrite = ProtOption 2 {-# LINE 107 "MMAP.hsc" #-} -- | Pages may not be accessed. protNone :: ProtOption protNone = ProtOption 0 {-# LINE 111 "MMAP.hsc" #-} instance Monoid ProtOption where mempty = protNone mappend (ProtOption a) (ProtOption b) = ProtOption (a .|. b) -- | Determines whether updates to the mapping are visible -- to other processes mapping the same region, and whether updates -- are carried through to the underlying file. -- -- This behavior is determined by including exactly one of -- `mapShared` and `mapPrivate`. newtype MmapSharedFlag = MmapSharedFlag { unMmapSharedFlag :: CInt } deriving (Eq, Show, Ord) -- | Share this mapping. Updates to the mapping are visible to -- other processes that map the file, and are carried through to -- the underlying file. The file may not actually be updated -- until @msync(2)@ or @munmap()@ is called.. mapShared :: MmapSharedFlag mapShared = MmapSharedFlag 1 {-# LINE 132 "MMAP.hsc" #-} -- | Create a private copy-on-write mapping. Updates to the mapping -- are not visible to other processes mapping the same file, and -- are not carried through to the underlying file. It is unspecified -- whether changes made to the file after the @mmap()@ call are -- visible in the mapped region. mapPrivate :: MmapSharedFlag mapPrivate = MmapSharedFlag 2 {-# LINE 140 "MMAP.hsc" #-} -- | And `MmapSharedFlag` with one or more `MmapOptionalFlag`s. newtype MmapOptionalFlag = MmapOptionalFlag { unMmapOptionalFlag :: CInt } deriving (Eq, Show, Ord) {-# LINE 148 "MMAP.hsc" #-} -- | See @man mmap@ for a description. map32Bit :: MmapOptionalFlag map32Bit = MmapOptionalFlag 64 {-# LINE 151 "MMAP.hsc" #-} {-# LINE 152 "MMAP.hsc" #-} {-# LINE 154 "MMAP.hsc" #-} -- | See @man mmap@ for a description. mapAnonymous :: MmapOptionalFlag mapAnonymous = MmapOptionalFlag 32 {-# LINE 157 "MMAP.hsc" #-} {-# LINE 164 "MMAP.hsc" #-} {-# LINE 166 "MMAP.hsc" #-} -- | See @man mmap@ for a description. mapDenywrite :: MmapOptionalFlag mapDenywrite = MmapOptionalFlag 2048 {-# LINE 169 "MMAP.hsc" #-} {-# LINE 170 "MMAP.hsc" #-} {-# LINE 172 "MMAP.hsc" #-} -- | See @man mmap@ for a description. mapFile :: MmapOptionalFlag mapFile = MmapOptionalFlag 0 {-# LINE 175 "MMAP.hsc" #-} {-# LINE 176 "MMAP.hsc" #-} {-# LINE 178 "MMAP.hsc" #-} -- | See @man mmap@ for a description. mapFixed :: MmapOptionalFlag mapFixed = MmapOptionalFlag 16 {-# LINE 181 "MMAP.hsc" #-} {-# LINE 182 "MMAP.hsc" #-} {-# LINE 184 "MMAP.hsc" #-} -- | See @man mmap@ for a description. mapHugetlb :: MmapOptionalFlag mapHugetlb = MmapOptionalFlag 262144 {-# LINE 187 "MMAP.hsc" #-} {-# LINE 188 "MMAP.hsc" #-} {-# LINE 190 "MMAP.hsc" #-} -- | See @man mmap@ for a description. mapLocked :: MmapOptionalFlag mapLocked = MmapOptionalFlag 8192 {-# LINE 193 "MMAP.hsc" #-} {-# LINE 194 "MMAP.hsc" #-} {-# LINE 196 "MMAP.hsc" #-} -- | See @man mmap@ for a description. mapNonblock :: MmapOptionalFlag mapNonblock = MmapOptionalFlag 65536 {-# LINE 199 "MMAP.hsc" #-} {-# LINE 200 "MMAP.hsc" #-} {-# LINE 202 "MMAP.hsc" #-} -- | See @man mmap@ for a description. mapNoreserve :: MmapOptionalFlag mapNoreserve = MmapOptionalFlag 16384 {-# LINE 205 "MMAP.hsc" #-} {-# LINE 206 "MMAP.hsc" #-} {-# LINE 208 "MMAP.hsc" #-} -- | See @man mmap@ for a description. mapStack :: MmapOptionalFlag mapStack = MmapOptionalFlag 131072 {-# LINE 211 "MMAP.hsc" #-} {-# LINE 212 "MMAP.hsc" #-} {-# LINE 218 "MMAP.hsc" #-} instance Monoid MmapOptionalFlag where mempty = MmapOptionalFlag 0 mappend (MmapOptionalFlag a) (MmapOptionalFlag b) = MmapOptionalFlag (a .|. b) -- | An `MmapSharedFlag` with one or more `MmapOptionalFlag`s. newtype MmapFlags = MmapFlags { unMmapFlags :: CInt } deriving (Eq, Show, Ord) -- | Create `MmapFlags` to be passed to `c_mmap` from an `MmapSharedFlag` -- and one or more `MmapOptionalFlag`s (combine them via `(<>)`, -- `mempty` for none). mkMmapFlags :: MmapSharedFlag -> MmapOptionalFlag -> MmapFlags mkMmapFlags (MmapSharedFlag a) (MmapOptionalFlag b) = MmapFlags (a .|. b)