module System.Posix.Memory (
memoryMap,
memoryUnmap,
memoryAdvise,
memoryLock,
memoryUnlock,
memoryProtect,
memorySync,
MemoryMapFlag(..),
MemoryProtection(..),
MemoryAdvice(..),
MemorySyncFlag(..),
sysconfPageSize
) where
import System.Posix.Types
import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.Error
import Data.Bits
foreign import ccall unsafe "mmap"
c_mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)
foreign import ccall unsafe "munmap"
c_munmap :: Ptr a -> CSize -> IO CInt
foreign import ccall unsafe "madvise"
c_madvise :: Ptr a -> CSize -> CInt -> IO CInt
foreign import ccall unsafe "msync"
c_msync :: Ptr a -> CSize -> CInt -> IO CInt
foreign import ccall unsafe "mprotect"
c_mprotect :: Ptr a -> CSize -> CInt -> IO CInt
foreign import ccall unsafe "mlock"
c_mlock :: Ptr a -> CSize -> IO CInt
foreign import ccall unsafe "munlock"
c_munlock :: Ptr a -> CSize -> IO CInt
foreign import ccall unsafe "sysconf"
c_sysconf :: CInt -> CLong
data MemoryMapFlag =
MemoryMapShared
| MemoryMapPrivate
deriving (Show,Read,Eq)
data MemoryProtection =
MemoryProtectionNone
| MemoryProtectionRead
| MemoryProtectionWrite
| MemoryProtectionExecute
deriving (Show,Read,Eq)
data MemoryAdvice =
MemoryAdviceNormal
| MemoryAdviceRandom
| MemoryAdviceSequential
| MemoryAdviceWillNeed
| MemoryAdviceDontNeed
deriving (Show,Read,Eq)
data MemorySyncFlag =
MemorySyncAsync
| MemorySyncSync
| MemorySyncInvalidate
deriving (Show,Read,Eq)
cvalueOfMemoryProts :: [MemoryProtection] -> CInt
cvalueOfMemoryProts = foldl (.|.) 0 . map toProt
where toProt :: MemoryProtection -> CInt
toProt MemoryProtectionNone = (0)
toProt MemoryProtectionRead = (1)
toProt MemoryProtectionWrite = (2)
toProt MemoryProtectionExecute = (4)
cvalueOfMemorySync :: [MemorySyncFlag] -> CInt
cvalueOfMemorySync = foldl (.|.) 0 . map toSync
where toSync MemorySyncAsync = (1)
toSync MemorySyncSync = (4)
toSync MemorySyncInvalidate = (2)
memoryMap :: Maybe (Ptr a)
-> CSize
-> [MemoryProtection]
-> MemoryMapFlag
-> Maybe Fd
-> COff
-> IO (Ptr a)
memoryMap initPtr sz prots flag mfd off =
throwErrnoIf (== m1ptr) "mmap" (c_mmap (maybe nullPtr id initPtr) sz cprot cflags fd off)
where m1ptr = nullPtr `plusPtr` (1)
fd = maybe (1) (\(Fd v) -> v) mfd
cprot = cvalueOfMemoryProts prots
cflags = maybe cMapAnon (const 0) mfd
.|. maybe 0 (const cMapFixed) initPtr
.|. toMapFlag flag
cMapAnon = (32)
cMapFixed = (16)
toMapFlag MemoryMapShared = (1)
toMapFlag MemoryMapPrivate = (2)
memoryUnmap :: Ptr a -> CSize -> IO ()
memoryUnmap ptr sz = throwErrnoIfMinus1_ "munmap" (c_munmap ptr sz)
memoryAdvise :: Ptr a -> CSize -> MemoryAdvice -> IO ()
memoryAdvise ptr sz adv = throwErrnoIfMinus1_ "madvise" (c_madvise ptr sz cadv)
where cadv = toAdvice adv
toAdvice MemoryAdviceNormal = (0)
toAdvice MemoryAdviceRandom = (1)
toAdvice MemoryAdviceSequential = (2)
toAdvice MemoryAdviceWillNeed = (3)
toAdvice MemoryAdviceDontNeed = (4)
memoryLock :: Ptr a -> CSize -> IO ()
memoryLock ptr sz = throwErrnoIfMinus1_ "mlock" (c_mlock ptr sz)
memoryUnlock :: Ptr a -> CSize -> IO ()
memoryUnlock ptr sz = throwErrnoIfMinus1_ "munlock" (c_munlock ptr sz)
memoryProtect :: Ptr a -> CSize -> [MemoryProtection] -> IO ()
memoryProtect ptr sz prots = throwErrnoIfMinus1_ "mprotect" (c_mprotect ptr sz cprot)
where cprot = cvalueOfMemoryProts prots
memorySync :: Ptr a -> CSize -> [MemorySyncFlag] -> IO ()
memorySync ptr sz flags = throwErrnoIfMinus1_ "msync" (c_msync ptr sz cflags)
where cflags = cvalueOfMemorySync flags
sysconfPageSize :: Int
sysconfPageSize = fromIntegral $ c_sysconf (30)