{-# LINE 1 "Data/Memory/MemMap/Posix.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CPP #-}
module Data.Memory.MemMap.Posix
( 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
{-# LINE 55 "Data/Memory/MemMap/Posix.hsc" #-}
foreign import ccall unsafe "posix_madvise"
c_madvise :: Ptr a -> CSize -> CInt -> IO CInt
{-# LINE 61 "Data/Memory/MemMap/Posix.hsc" #-}
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
{-# LINE 69 "Data/Memory/MemMap/Posix.hsc" #-}
foreign import ccall unsafe "mlock"
c_mlock :: Ptr a -> CSize -> IO CInt
{-# LINE 75 "Data/Memory/MemMap/Posix.hsc" #-}
{-# LINE 77 "Data/Memory/MemMap/Posix.hsc" #-}
foreign import ccall unsafe "munlock"
c_munlock :: Ptr a -> CSize -> IO CInt
{-# LINE 83 "Data/Memory/MemMap/Posix.hsc" #-}
foreign import ccall unsafe "sysconf"
c_sysconf :: CInt -> CLong
data MemoryMapFlag =
MemoryMapShared
| MemoryMapPrivate
deriving (Int -> MemoryMapFlag -> ShowS
[MemoryMapFlag] -> ShowS
MemoryMapFlag -> String
(Int -> MemoryMapFlag -> ShowS)
-> (MemoryMapFlag -> String)
-> ([MemoryMapFlag] -> ShowS)
-> Show MemoryMapFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemoryMapFlag -> ShowS
showsPrec :: Int -> MemoryMapFlag -> ShowS
$cshow :: MemoryMapFlag -> String
show :: MemoryMapFlag -> String
$cshowList :: [MemoryMapFlag] -> ShowS
showList :: [MemoryMapFlag] -> ShowS
Show,ReadPrec [MemoryMapFlag]
ReadPrec MemoryMapFlag
Int -> ReadS MemoryMapFlag
ReadS [MemoryMapFlag]
(Int -> ReadS MemoryMapFlag)
-> ReadS [MemoryMapFlag]
-> ReadPrec MemoryMapFlag
-> ReadPrec [MemoryMapFlag]
-> Read MemoryMapFlag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MemoryMapFlag
readsPrec :: Int -> ReadS MemoryMapFlag
$creadList :: ReadS [MemoryMapFlag]
readList :: ReadS [MemoryMapFlag]
$creadPrec :: ReadPrec MemoryMapFlag
readPrec :: ReadPrec MemoryMapFlag
$creadListPrec :: ReadPrec [MemoryMapFlag]
readListPrec :: ReadPrec [MemoryMapFlag]
Read,MemoryMapFlag -> MemoryMapFlag -> Bool
(MemoryMapFlag -> MemoryMapFlag -> Bool)
-> (MemoryMapFlag -> MemoryMapFlag -> Bool) -> Eq MemoryMapFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemoryMapFlag -> MemoryMapFlag -> Bool
== :: MemoryMapFlag -> MemoryMapFlag -> Bool
$c/= :: MemoryMapFlag -> MemoryMapFlag -> Bool
/= :: MemoryMapFlag -> MemoryMapFlag -> Bool
Eq)
data MemoryProtection =
MemoryProtectionNone
| MemoryProtectionRead
| MemoryProtectionWrite
| MemoryProtectionExecute
deriving (Int -> MemoryProtection -> ShowS
[MemoryProtection] -> ShowS
MemoryProtection -> String
(Int -> MemoryProtection -> ShowS)
-> (MemoryProtection -> String)
-> ([MemoryProtection] -> ShowS)
-> Show MemoryProtection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemoryProtection -> ShowS
showsPrec :: Int -> MemoryProtection -> ShowS
$cshow :: MemoryProtection -> String
show :: MemoryProtection -> String
$cshowList :: [MemoryProtection] -> ShowS
showList :: [MemoryProtection] -> ShowS
Show,ReadPrec [MemoryProtection]
ReadPrec MemoryProtection
Int -> ReadS MemoryProtection
ReadS [MemoryProtection]
(Int -> ReadS MemoryProtection)
-> ReadS [MemoryProtection]
-> ReadPrec MemoryProtection
-> ReadPrec [MemoryProtection]
-> Read MemoryProtection
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MemoryProtection
readsPrec :: Int -> ReadS MemoryProtection
$creadList :: ReadS [MemoryProtection]
readList :: ReadS [MemoryProtection]
$creadPrec :: ReadPrec MemoryProtection
readPrec :: ReadPrec MemoryProtection
$creadListPrec :: ReadPrec [MemoryProtection]
readListPrec :: ReadPrec [MemoryProtection]
Read,MemoryProtection -> MemoryProtection -> Bool
(MemoryProtection -> MemoryProtection -> Bool)
-> (MemoryProtection -> MemoryProtection -> Bool)
-> Eq MemoryProtection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemoryProtection -> MemoryProtection -> Bool
== :: MemoryProtection -> MemoryProtection -> Bool
$c/= :: MemoryProtection -> MemoryProtection -> Bool
/= :: MemoryProtection -> MemoryProtection -> Bool
Eq)
data MemoryAdvice =
MemoryAdviceNormal
| MemoryAdviceRandom
| MemoryAdviceSequential
| MemoryAdviceWillNeed
| MemoryAdviceDontNeed
deriving (Int -> MemoryAdvice -> ShowS
[MemoryAdvice] -> ShowS
MemoryAdvice -> String
(Int -> MemoryAdvice -> ShowS)
-> (MemoryAdvice -> String)
-> ([MemoryAdvice] -> ShowS)
-> Show MemoryAdvice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemoryAdvice -> ShowS
showsPrec :: Int -> MemoryAdvice -> ShowS
$cshow :: MemoryAdvice -> String
show :: MemoryAdvice -> String
$cshowList :: [MemoryAdvice] -> ShowS
showList :: [MemoryAdvice] -> ShowS
Show,ReadPrec [MemoryAdvice]
ReadPrec MemoryAdvice
Int -> ReadS MemoryAdvice
ReadS [MemoryAdvice]
(Int -> ReadS MemoryAdvice)
-> ReadS [MemoryAdvice]
-> ReadPrec MemoryAdvice
-> ReadPrec [MemoryAdvice]
-> Read MemoryAdvice
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MemoryAdvice
readsPrec :: Int -> ReadS MemoryAdvice
$creadList :: ReadS [MemoryAdvice]
readList :: ReadS [MemoryAdvice]
$creadPrec :: ReadPrec MemoryAdvice
readPrec :: ReadPrec MemoryAdvice
$creadListPrec :: ReadPrec [MemoryAdvice]
readListPrec :: ReadPrec [MemoryAdvice]
Read,MemoryAdvice -> MemoryAdvice -> Bool
(MemoryAdvice -> MemoryAdvice -> Bool)
-> (MemoryAdvice -> MemoryAdvice -> Bool) -> Eq MemoryAdvice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemoryAdvice -> MemoryAdvice -> Bool
== :: MemoryAdvice -> MemoryAdvice -> Bool
$c/= :: MemoryAdvice -> MemoryAdvice -> Bool
/= :: MemoryAdvice -> MemoryAdvice -> Bool
Eq)
data MemorySyncFlag =
MemorySyncAsync
| MemorySyncSync
| MemorySyncInvalidate
deriving (Int -> MemorySyncFlag -> ShowS
[MemorySyncFlag] -> ShowS
MemorySyncFlag -> String
(Int -> MemorySyncFlag -> ShowS)
-> (MemorySyncFlag -> String)
-> ([MemorySyncFlag] -> ShowS)
-> Show MemorySyncFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemorySyncFlag -> ShowS
showsPrec :: Int -> MemorySyncFlag -> ShowS
$cshow :: MemorySyncFlag -> String
show :: MemorySyncFlag -> String
$cshowList :: [MemorySyncFlag] -> ShowS
showList :: [MemorySyncFlag] -> ShowS
Show,ReadPrec [MemorySyncFlag]
ReadPrec MemorySyncFlag
Int -> ReadS MemorySyncFlag
ReadS [MemorySyncFlag]
(Int -> ReadS MemorySyncFlag)
-> ReadS [MemorySyncFlag]
-> ReadPrec MemorySyncFlag
-> ReadPrec [MemorySyncFlag]
-> Read MemorySyncFlag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MemorySyncFlag
readsPrec :: Int -> ReadS MemorySyncFlag
$creadList :: ReadS [MemorySyncFlag]
readList :: ReadS [MemorySyncFlag]
$creadPrec :: ReadPrec MemorySyncFlag
readPrec :: ReadPrec MemorySyncFlag
$creadListPrec :: ReadPrec [MemorySyncFlag]
readListPrec :: ReadPrec [MemorySyncFlag]
Read,MemorySyncFlag -> MemorySyncFlag -> Bool
(MemorySyncFlag -> MemorySyncFlag -> Bool)
-> (MemorySyncFlag -> MemorySyncFlag -> Bool) -> Eq MemorySyncFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemorySyncFlag -> MemorySyncFlag -> Bool
== :: MemorySyncFlag -> MemorySyncFlag -> Bool
$c/= :: MemorySyncFlag -> MemorySyncFlag -> Bool
/= :: MemorySyncFlag -> MemorySyncFlag -> Bool
Eq)
cvalueOfMemoryProts :: [MemoryProtection] -> CInt
cvalueOfMemoryProts :: [MemoryProtection] -> CInt
cvalueOfMemoryProts = (CInt -> CInt -> CInt) -> CInt -> [CInt] -> CInt
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
(.|.) CInt
0 ([CInt] -> CInt)
-> ([MemoryProtection] -> [CInt]) -> [MemoryProtection] -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemoryProtection -> CInt) -> [MemoryProtection] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map MemoryProtection -> CInt
toProt
where toProt :: MemoryProtection -> CInt
toProt :: MemoryProtection -> CInt
toProt MemoryProtection
MemoryProtectionNone = (CInt
0)
{-# LINE 123 "Data/Memory/MemMap/Posix.hsc" #-}
toProt MemoryProtection
MemoryProtectionRead = (CInt
1)
{-# LINE 124 "Data/Memory/MemMap/Posix.hsc" #-}
toProt MemoryProtection
MemoryProtectionWrite = (CInt
2)
{-# LINE 125 "Data/Memory/MemMap/Posix.hsc" #-}
toProt MemoryProtection
MemoryProtectionExecute = (CInt
4)
{-# LINE 126 "Data/Memory/MemMap/Posix.hsc" #-}
cvalueOfMemorySync :: [MemorySyncFlag] -> CInt
cvalueOfMemorySync :: [MemorySyncFlag] -> CInt
cvalueOfMemorySync = (CInt -> CInt -> CInt) -> CInt -> [CInt] -> CInt
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
(.|.) CInt
0 ([CInt] -> CInt)
-> ([MemorySyncFlag] -> [CInt]) -> [MemorySyncFlag] -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemorySyncFlag -> CInt) -> [MemorySyncFlag] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map MemorySyncFlag -> CInt
forall {a}. Num a => MemorySyncFlag -> a
toSync
where toSync :: MemorySyncFlag -> a
toSync MemorySyncFlag
MemorySyncAsync = (a
1)
{-# LINE 130 "Data/Memory/MemMap/Posix.hsc" #-}
toSync MemorySyncFlag
MemorySyncSync = (a
4)
{-# LINE 131 "Data/Memory/MemMap/Posix.hsc" #-}
toSync MemorySyncFlag
MemorySyncInvalidate = (a
2)
{-# LINE 132 "Data/Memory/MemMap/Posix.hsc" #-}
memoryMap :: Maybe (Ptr a)
-> CSize
-> [MemoryProtection]
-> MemoryMapFlag
-> Maybe Fd
-> COff
-> IO (Ptr a)
memoryMap :: forall a.
Maybe (Ptr a)
-> CSize
-> [MemoryProtection]
-> MemoryMapFlag
-> Maybe Fd
-> COff
-> IO (Ptr a)
memoryMap Maybe (Ptr a)
initPtr CSize
sz [MemoryProtection]
prots MemoryMapFlag
flag Maybe Fd
mfd COff
off =
(Ptr a -> Bool) -> String -> IO (Ptr a) -> IO (Ptr a)
forall a. (a -> Bool) -> String -> IO a -> IO a
throwErrnoIf (Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall {b}. Ptr b
m1ptr) String
"mmap" (Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)
forall a.
Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)
c_mmap (Ptr a -> (Ptr a -> Ptr a) -> Maybe (Ptr a) -> Ptr a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ptr a
forall {b}. Ptr b
nullPtr Ptr a -> Ptr a
forall a. a -> a
id Maybe (Ptr a)
initPtr) CSize
sz CInt
cprot CInt
cflags CInt
fd COff
off)
where m1ptr :: Ptr b
m1ptr = Ptr Any
forall {b}. Ptr b
nullPtr Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)
fd :: CInt
fd = CInt -> (Fd -> CInt) -> Maybe Fd -> CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-CInt
1) (\(Fd CInt
v) -> CInt
v) Maybe Fd
mfd
cprot :: CInt
cprot = [MemoryProtection] -> CInt
cvalueOfMemoryProts [MemoryProtection]
prots
cflags :: CInt
cflags = CInt -> (Fd -> CInt) -> Maybe Fd -> CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CInt
cMapAnon (CInt -> Fd -> CInt
forall a b. a -> b -> a
const CInt
0) Maybe Fd
mfd
CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt -> (Ptr a -> CInt) -> Maybe (Ptr a) -> CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CInt
0 (CInt -> Ptr a -> CInt
forall a b. a -> b -> a
const CInt
cMapFixed) Maybe (Ptr a)
initPtr
CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. MemoryMapFlag -> CInt
forall {a}. Num a => MemoryMapFlag -> a
toMapFlag MemoryMapFlag
flag
{-# LINE 158 "Data/Memory/MemMap/Posix.hsc" #-}
cMapAnon :: CInt
cMapAnon = (CInt
32)
{-# LINE 159 "Data/Memory/MemMap/Posix.hsc" #-}
{-# LINE 160 "Data/Memory/MemMap/Posix.hsc" #-}
cMapFixed :: CInt
cMapFixed = (CInt
16)
{-# LINE 161 "Data/Memory/MemMap/Posix.hsc" #-}
toMapFlag :: MemoryMapFlag -> a
toMapFlag MemoryMapFlag
MemoryMapShared = (a
1)
{-# LINE 163 "Data/Memory/MemMap/Posix.hsc" #-}
toMapFlag MemoryMapFlag
MemoryMapPrivate = (a
2)
{-# LINE 164 "Data/Memory/MemMap/Posix.hsc" #-}
memoryUnmap :: Ptr a -> CSize -> IO ()
memoryUnmap :: forall a. Ptr a -> CSize -> IO ()
memoryUnmap Ptr a
ptr CSize
sz = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"munmap" (Ptr a -> CSize -> IO CInt
forall a. Ptr a -> CSize -> IO CInt
c_munmap Ptr a
ptr CSize
sz)
memoryAdvise :: Ptr a -> CSize -> MemoryAdvice -> IO ()
memoryAdvise :: forall a. Ptr a -> CSize -> MemoryAdvice -> IO ()
memoryAdvise Ptr a
ptr CSize
sz MemoryAdvice
adv = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"madvise" (Ptr a -> CSize -> CInt -> IO CInt
forall a. Ptr a -> CSize -> CInt -> IO CInt
c_madvise Ptr a
ptr CSize
sz CInt
cadv)
where cadv :: CInt
cadv = MemoryAdvice -> CInt
forall {a}. Num a => MemoryAdvice -> a
toAdvice MemoryAdvice
adv
{-# LINE 178 "Data/Memory/MemMap/Posix.hsc" #-}
toAdvice :: MemoryAdvice -> a
toAdvice MemoryAdvice
MemoryAdviceNormal = (a
0)
{-# LINE 179 "Data/Memory/MemMap/Posix.hsc" #-}
toAdvice MemoryAdvice
MemoryAdviceRandom = (a
1)
{-# LINE 180 "Data/Memory/MemMap/Posix.hsc" #-}
toAdvice MemoryAdvice
MemoryAdviceSequential = (a
2)
{-# LINE 181 "Data/Memory/MemMap/Posix.hsc" #-}
toAdvice MemoryAdvice
MemoryAdviceWillNeed = (a
3)
{-# LINE 182 "Data/Memory/MemMap/Posix.hsc" #-}
toAdvice MemoryAdvice
MemoryAdviceDontNeed = (a
4)
{-# LINE 183 "Data/Memory/MemMap/Posix.hsc" #-}
{-# LINE 190 "Data/Memory/MemMap/Posix.hsc" #-}
memoryLock :: Ptr a -> CSize -> IO ()
memoryLock :: forall a. Ptr a -> CSize -> IO ()
memoryLock Ptr a
ptr CSize
sz = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"mlock" (Ptr a -> CSize -> IO CInt
forall a. Ptr a -> CSize -> IO CInt
c_mlock Ptr a
ptr CSize
sz)
memoryUnlock :: Ptr a -> CSize -> IO ()
memoryUnlock :: forall a. Ptr a -> CSize -> IO ()
memoryUnlock Ptr a
ptr CSize
sz = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"munlock" (Ptr a -> CSize -> IO CInt
forall a. Ptr a -> CSize -> IO CInt
c_munlock Ptr a
ptr CSize
sz)
memoryProtect :: Ptr a -> CSize -> [MemoryProtection] -> IO ()
memoryProtect :: forall a. Ptr a -> CSize -> [MemoryProtection] -> IO ()
memoryProtect Ptr a
ptr CSize
sz [MemoryProtection]
prots = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"mprotect" (Ptr a -> CSize -> CInt -> IO CInt
forall a. Ptr a -> CSize -> CInt -> IO CInt
c_mprotect Ptr a
ptr CSize
sz CInt
cprot)
where cprot :: CInt
cprot = [MemoryProtection] -> CInt
cvalueOfMemoryProts [MemoryProtection]
prots
memorySync :: Ptr a -> CSize -> [MemorySyncFlag] -> IO ()
memorySync :: forall a. Ptr a -> CSize -> [MemorySyncFlag] -> IO ()
memorySync Ptr a
ptr CSize
sz [MemorySyncFlag]
flags = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"msync" (Ptr a -> CSize -> CInt -> IO CInt
forall a. Ptr a -> CSize -> CInt -> IO CInt
c_msync Ptr a
ptr CSize
sz CInt
cflags)
where cflags :: CInt
cflags = [MemorySyncFlag] -> CInt
cvalueOfMemorySync [MemorySyncFlag]
flags
sysconfPageSize :: Int
sysconfPageSize :: Int
sysconfPageSize = CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CLong -> Int) -> CLong -> Int
forall a b. (a -> b) -> a -> b
$ CInt -> CLong
c_sysconf (CInt
30)
{-# LINE 223 "Data/Memory/MemMap/Posix.hsc" #-}