{-# LINE 1 "MMAP.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface, DeriveDataTypeable #-}
module MMAP where
import Control.Exception
import Control.Monad
import Data.Bits ((.|.))
import Data.Typeable
import Foreign.C.Types
import Foreign.Ptr
import System.Posix.Types
data MmapException = MmapException
deriving (Eq, Ord, Show, Typeable)
instance Exception MmapException
data MunmapException = MunmapException
{ munmapExceptionSize :: CSize
, munmapExceptionPtr :: Ptr ()
} deriving (Eq, Ord, Show, Typeable)
instance Exception MunmapException
foreign import ccall unsafe "sys/mman.h mmap"
c_mmap :: Ptr ()
-> CSize
-> ProtOption
-> MmapFlags
-> Fd
-> COff
-> IO (Ptr ())
foreign import ccall unsafe "sys/mman.h munmap"
c_munmap :: Ptr ()
-> CSize
-> IO CInt
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
munmap :: Ptr ()
-> CSize
-> IO ()
munmap addr len = do
v <- c_munmap addr len
when (v == -1) . throwIO $ MunmapException len addr
newtype ProtOption = ProtOption { unProtOption :: CInt }
deriving (Eq, Show, Ord)
protExec :: ProtOption
protExec = ProtOption 4
{-# LINE 98 "MMAP.hsc" #-}
protRead :: ProtOption
protRead = ProtOption 1
{-# LINE 102 "MMAP.hsc" #-}
protWrite :: ProtOption
protWrite = ProtOption 2
{-# LINE 106 "MMAP.hsc" #-}
protNone :: ProtOption
protNone = ProtOption 0
{-# LINE 110 "MMAP.hsc" #-}
instance Monoid ProtOption where
mempty = protNone
instance Semigroup ProtOption where
(<>) (ProtOption a) (ProtOption b) = ProtOption (a .|. b)
newtype MmapSharedFlag = MmapSharedFlag { unMmapSharedFlag :: CInt }
deriving (Eq, Show, Ord)
mapShared :: MmapSharedFlag
mapShared = MmapSharedFlag 1
{-# LINE 133 "MMAP.hsc" #-}
mapPrivate :: MmapSharedFlag
mapPrivate = MmapSharedFlag 2
{-# LINE 141 "MMAP.hsc" #-}
newtype MmapOptionalFlag = MmapOptionalFlag { unMmapOptionalFlag :: CInt }
deriving (Eq, Show, Ord)
{-# LINE 149 "MMAP.hsc" #-}
map32Bit :: MmapOptionalFlag
map32Bit = MmapOptionalFlag 64
{-# LINE 152 "MMAP.hsc" #-}
{-# LINE 153 "MMAP.hsc" #-}
{-# LINE 155 "MMAP.hsc" #-}
mapAnonymous :: MmapOptionalFlag
mapAnonymous = MmapOptionalFlag 32
{-# LINE 158 "MMAP.hsc" #-}
{-# LINE 165 "MMAP.hsc" #-}
{-# LINE 167 "MMAP.hsc" #-}
mapDenywrite :: MmapOptionalFlag
mapDenywrite = MmapOptionalFlag 2048
{-# LINE 170 "MMAP.hsc" #-}
{-# LINE 171 "MMAP.hsc" #-}
{-# LINE 173 "MMAP.hsc" #-}
mapFile :: MmapOptionalFlag
mapFile = MmapOptionalFlag 0
{-# LINE 176 "MMAP.hsc" #-}
{-# LINE 177 "MMAP.hsc" #-}
{-# LINE 179 "MMAP.hsc" #-}
mapFixed :: MmapOptionalFlag
mapFixed = MmapOptionalFlag 16
{-# LINE 182 "MMAP.hsc" #-}
{-# LINE 183 "MMAP.hsc" #-}
{-# LINE 185 "MMAP.hsc" #-}
mapHugetlb :: MmapOptionalFlag
mapHugetlb = MmapOptionalFlag 262144
{-# LINE 188 "MMAP.hsc" #-}
{-# LINE 189 "MMAP.hsc" #-}
{-# LINE 191 "MMAP.hsc" #-}
mapLocked :: MmapOptionalFlag
mapLocked = MmapOptionalFlag 8192
{-# LINE 194 "MMAP.hsc" #-}
{-# LINE 195 "MMAP.hsc" #-}
{-# LINE 197 "MMAP.hsc" #-}
mapNonblock :: MmapOptionalFlag
mapNonblock = MmapOptionalFlag 65536
{-# LINE 200 "MMAP.hsc" #-}
{-# LINE 201 "MMAP.hsc" #-}
{-# LINE 203 "MMAP.hsc" #-}
mapNoreserve :: MmapOptionalFlag
mapNoreserve = MmapOptionalFlag 16384
{-# LINE 206 "MMAP.hsc" #-}
{-# LINE 207 "MMAP.hsc" #-}
{-# LINE 209 "MMAP.hsc" #-}
mapStack :: MmapOptionalFlag
mapStack = MmapOptionalFlag 131072
{-# LINE 212 "MMAP.hsc" #-}
{-# LINE 213 "MMAP.hsc" #-}
{-# LINE 219 "MMAP.hsc" #-}
instance Monoid MmapOptionalFlag where
mempty = MmapOptionalFlag 0
instance Semigroup MmapOptionalFlag where
(<>) (MmapOptionalFlag a) (MmapOptionalFlag b) = MmapOptionalFlag (a .|. b)
newtype MmapFlags = MmapFlags { unMmapFlags :: CInt }
deriving (Eq, Show, Ord)
mkMmapFlags :: MmapSharedFlag -> MmapOptionalFlag -> MmapFlags
mkMmapFlags (MmapSharedFlag a) (MmapOptionalFlag b) = MmapFlags (a .|. b)