{-# LINE 1 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Foundation.Foreign.MemoryMap.Posix
-- Copyright   :  (c) Vincent Hanquez 2014
-- License     :  BSD-style
--
-- Maintainer  :  Vincent Hanquez
-- Stability   :  provisional
-- Portability :  non-portable (requires POSIX)
--
-- Functions defined by the POSIX standards for manipulating memory maps
--
-- When a function that calls an underlying POSIX function fails, the errno
-- code is converted to an 'IOError' using 'Foreign.C.Error.errnoToIOError'.
-- For a list of which errno codes may be generated, consult the POSIX
-- documentation for the underlying function.
--
-----------------------------------------------------------------------------




{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CPP #-}
module Foundation.Foreign.MemoryMap.Posix
    ( memoryMap
    , memoryUnmap
    , memoryAdvise
    , memoryLock
    , memoryUnlock
    , memoryProtect
    , memorySync
    -- * Flags types
    , MemoryMapFlag(..)
    , MemoryProtection(..)
    , MemoryAdvice(..)
    , MemorySyncFlag(..)
    -- * system page size
    , sysconfPageSize
    -- * High level
    , fileMapRead
    ) where

import Basement.Compat.Base
import Basement.Compat.C.Types
import Basement.Types.OffsetSize
import System.Posix.Types
import Foreign.Ptr
import Foreign.C.Error
import Data.Bits

import Foundation.Collection.Foldable
import Foundation.VFS
import qualified Prelude (fromIntegral)
import Foundation.Foreign.MemoryMap.Types
import Control.Exception

import           GHC.IO.FD
import           GHC.IO.IOMode
import qualified GHC.IO.Device as IO

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 69 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
foreign import ccall unsafe "posix_madvise"
    c_madvise :: Ptr a -> CSize -> CInt -> IO CInt

{-# LINE 75 "Foundation/Foreign/MemoryMap/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 83 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
foreign import ccall unsafe "mlock"
    c_mlock :: Ptr a -> CSize -> IO CInt

{-# LINE 89 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}


{-# LINE 91 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
foreign import ccall unsafe "munlock"
    c_munlock :: Ptr a -> CSize -> IO CInt

{-# LINE 97 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

foreign import ccall unsafe "sysconf"
    c_sysconf :: CInt -> CLong

-- | Mapping flag
data MemoryMapFlag =
      MemoryMapShared  -- ^ memory changes are shared between process
    | MemoryMapPrivate -- ^ memory changes are private to process
    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,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)

-- | Memory protection
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,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)

-- | Advice to put on memory.
--
-- only define the posix one.
data MemoryAdvice =
      MemoryAdviceNormal     -- ^ no specific advice, the default.
    | MemoryAdviceRandom     -- ^ Expect page references in random order. No readahead should occur.
    | MemoryAdviceSequential -- ^ Expect page references in sequential order. Page should be readahead aggressively.
    | MemoryAdviceWillNeed   -- ^ Expect access in the near future. Probably a good idea to readahead early
    | MemoryAdviceDontNeed   -- ^ Do not expect access in the near future.
    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,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)

-- | Memory synchronization flags
data MemorySyncFlag =
      MemorySyncAsync      -- ^ perform asynchronous write.
    | MemorySyncSync       -- ^ perform synchronous write.
    | MemorySyncInvalidate -- ^ invalidate cache data.
    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,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 -> Element [CInt] -> CInt) -> CInt -> [CInt] -> CInt
forall collection a.
Foldable collection =>
(a -> Element collection -> a) -> a -> collection -> a
forall a. (a -> Element [CInt] -> a) -> a -> [CInt] -> a
foldl' CInt -> CInt -> CInt
CInt -> Element [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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (MemoryProtection -> CInt) -> [MemoryProtection] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MemoryProtection -> CInt
toProt
  where toProt :: MemoryProtection -> CInt
        toProt :: MemoryProtection -> CInt
toProt MemoryProtection
MemoryProtectionNone    = (CInt
0)
{-# LINE 137 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
        toProt MemoryProtection
MemoryProtectionRead    = (CInt
1)
{-# LINE 138 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
        toProt MemoryProtection
MemoryProtectionWrite   = (CInt
2)
{-# LINE 139 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
        toProt MemoryProtection
MemoryProtectionExecute = (CInt
4)
{-# LINE 140 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

cvalueOfMemorySync :: [MemorySyncFlag] -> CInt
cvalueOfMemorySync :: [MemorySyncFlag] -> CInt
cvalueOfMemorySync = (CInt -> Element [CInt] -> CInt) -> CInt -> [CInt] -> CInt
forall collection a.
Foldable collection =>
(a -> Element collection -> a) -> a -> collection -> a
forall a. (a -> Element [CInt] -> a) -> a -> [CInt] -> a
foldl' CInt -> CInt -> CInt
CInt -> Element [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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (MemorySyncFlag -> CInt) -> [MemorySyncFlag] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MemorySyncFlag -> CInt
forall {a}. Integral a => MemorySyncFlag -> a
toSync
  where toSync :: MemorySyncFlag -> a
toSync MemorySyncFlag
MemorySyncAsync      = (a
1)
{-# LINE 144 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
        toSync MemorySyncFlag
MemorySyncSync       = (a
4)
{-# LINE 145 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
        toSync MemorySyncFlag
MemorySyncInvalidate = (a
2)
{-# LINE 146 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

-- | Map pages of memory.
--
-- If fd is present, this memory will represent the file associated.
-- Otherwise, the memory will be an anonymous mapping.
--
-- use 'mmap'
memoryMap :: Maybe (Ptr a)      -- ^ The address to map to if MapFixed is used.
          -> CSize              -- ^ The length of the mapping
          -> [MemoryProtection] -- ^ the memory protection associated with the mapping
          -> 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
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat 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}. Integral a => MemoryMapFlag -> a
toMapFlag MemoryMapFlag
flag


{-# LINE 172 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
        cMapAnon :: CInt
cMapAnon  = (CInt
32)
{-# LINE 173 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

{-# LINE 174 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
        cMapFixed :: CInt
cMapFixed = (CInt
16)
{-# LINE 175 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

        toMapFlag :: MemoryMapFlag -> a
toMapFlag MemoryMapFlag
MemoryMapShared  = (a
1)
{-# LINE 177 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
        toMapFlag MemoryMapFlag
MemoryMapPrivate = (a
2)
{-# LINE 178 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

-- | Unmap pages of memory
--
-- use 'munmap'
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)

-- | give advice to the operating system about use of memory
--
-- call 'madvise'
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}. Integral a => MemoryAdvice -> a
toAdvice MemoryAdvice
adv

{-# LINE 192 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
        toAdvice :: MemoryAdvice -> a
toAdvice MemoryAdvice
MemoryAdviceNormal = (a
0)
{-# LINE 193 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
        toAdvice MemoryAdvice
MemoryAdviceRandom = (a
1)
{-# LINE 194 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
        toAdvice MemoryAdvice
MemoryAdviceSequential = (a
2)
{-# LINE 195 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
        toAdvice MemoryAdvice
MemoryAdviceWillNeed = (a
3)
{-# LINE 196 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
        toAdvice MemoryAdvice
MemoryAdviceDontNeed = (a
4)
{-# LINE 197 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

{-# LINE 204 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

-- | lock a range of process address space
--
-- call 'mlock'
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)

-- | unlock a range of process address space
--
-- call 'munlock'
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)

-- | set protection of memory mapping
--
-- call 'mprotect'
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 synchronize memory with physical storage.
--
-- On an anonymous mapping this function does not have any effect.
-- call 'msync'
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

-- | Return the operating system page size.
--
-- call 'sysconf'
sysconfPageSize :: Int
sysconfPageSize :: Int
sysconfPageSize = CLong -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (CLong -> Int) -> CLong -> Int
forall a b. (a -> b) -> a -> b
$ CInt -> CLong
c_sysconf (CInt
30)
{-# LINE 237 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

--------------------------------------------------------------------------------

fileSizeToCSize :: FileSize -> CSize
fileSizeToCSize :: FileSize -> CSize
fileSizeToCSize (FileSize Word64
sz) = Word64 -> CSize
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
sz

fileSizeFromInteger :: Integer -> FileSize
fileSizeFromInteger :: Integer -> FileSize
fileSizeFromInteger = Word64 -> FileSize
FileSize (Word64 -> FileSize) -> (Integer -> Word64) -> Integer -> FileSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral

fileMapRead :: FileMapReadF
fileMapRead :: FileMapReadF
fileMapRead FilePath
fp = IO (FD, IODeviceType)
-> ((FD, IODeviceType) -> IO ())
-> ((FD, IODeviceType) -> IO FileMapping)
-> IO FileMapping
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> IOMode -> Bool -> IO (FD, IODeviceType)
openFile (FilePath -> String
filePathToLString FilePath
fp) IOMode
ReadMode Bool
True) (FD -> IO ()
forall a. IODevice a => a -> IO ()
IO.close (FD -> IO ())
-> ((FD, IODeviceType) -> FD) -> (FD, IODeviceType) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (FD, IODeviceType) -> FD
forall a b. (a, b) -> a
fst) (((FD, IODeviceType) -> IO FileMapping) -> IO FileMapping)
-> ((FD, IODeviceType) -> IO FileMapping) -> IO FileMapping
forall a b. (a -> b) -> a -> b
$ \(FD
fd,IODeviceType
_) -> do
    FileSize
sz   <- Integer -> FileSize
fileSizeFromInteger (Integer -> FileSize) -> IO Integer -> IO FileSize
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FD -> IO Integer
forall a. IODevice a => a -> IO Integer
IO.getSize FD
fd
    let csz :: CSize
csz = FileSize -> CSize
fileSizeToCSize FileSize
sz
    Ptr Word8
p    <- Maybe (Ptr Word8)
-> CSize
-> [MemoryProtection]
-> MemoryMapFlag
-> Maybe Fd
-> COff
-> IO (Ptr Word8)
forall a.
Maybe (Ptr a)
-> CSize
-> [MemoryProtection]
-> MemoryMapFlag
-> Maybe Fd
-> COff
-> IO (Ptr a)
memoryMap Maybe (Ptr Word8)
forall a. Maybe a
Nothing CSize
csz [MemoryProtection
MemoryProtectionRead] MemoryMapFlag
MemoryMapPrivate (Fd -> Maybe Fd
forall a. a -> Maybe a
Just (Fd -> Maybe Fd) -> Fd -> Maybe Fd
forall a b. (a -> b) -> a -> b
$ CInt -> Fd
Fd (CInt -> Fd) -> CInt -> Fd
forall a b. (a -> b) -> a -> b
$ FD -> CInt
fdFD FD
fd) COff
0
    FileMapping -> IO FileMapping
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileMapping -> IO FileMapping) -> FileMapping -> IO FileMapping
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> FileSize -> IO () -> FileMapping
FileMapping Ptr Word8
p FileSize
sz (Ptr Word8 -> CSize -> IO ()
forall a. Ptr a -> CSize -> IO ()
memoryUnmap Ptr Word8
p CSize
csz)