----------------------------------------------------------------------------- -- | -- Module : Data.Memory.MemMap.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. -- ----------------------------------------------------------------------------- #include #include {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE CPP #-} module Data.Memory.MemMap.Posix ( memoryMap , memoryUnmap , memoryAdvise , memoryLock , memoryUnlock , memoryProtect , memorySync -- * Flags types , MemoryMapFlag(..) , MemoryProtection(..) , MemoryAdvice(..) , MemorySyncFlag(..) -- * system page size , 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 #if defined(POSIX_MADV_NORMAL) foreign import ccall unsafe "posix_madvise" c_madvise :: Ptr a -> CSize -> CInt -> IO CInt #else foreign import ccall unsafe "madvise" c_madvise :: Ptr a -> CSize -> CInt -> IO CInt #endif 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 #ifndef __HAIKU__ foreign import ccall unsafe "mlock" c_mlock :: Ptr a -> CSize -> IO CInt #else c_mlock :: Ptr a -> CSize -> IO CInt c_mlock _ _ = return (-1) #endif #ifndef __HAIKU__ foreign import ccall unsafe "munlock" c_munlock :: Ptr a -> CSize -> IO CInt #else c_munlock :: Ptr a -> CSize -> IO CInt c_munlock _ _ = return (-1) #endif 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 (Show,Read,Eq) -- | Memory protection data MemoryProtection = MemoryProtectionNone | MemoryProtectionRead | MemoryProtectionWrite | MemoryProtectionExecute deriving (Show,Read,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 (Show,Read,Eq) -- | Memory synchronization flags data MemorySyncFlag = MemorySyncAsync -- ^ perform asynchronous write. | MemorySyncSync -- ^ perform synchronous write. | MemorySyncInvalidate -- ^ invalidate cache data. deriving (Show,Read,Eq) cvalueOfMemoryProts :: [MemoryProtection] -> CInt cvalueOfMemoryProts = foldl (.|.) 0 . map toProt where toProt :: MemoryProtection -> CInt toProt MemoryProtectionNone = (#const PROT_NONE) toProt MemoryProtectionRead = (#const PROT_READ) toProt MemoryProtectionWrite = (#const PROT_WRITE) toProt MemoryProtectionExecute = (#const PROT_EXEC) cvalueOfMemorySync :: [MemorySyncFlag] -> CInt cvalueOfMemorySync = foldl (.|.) 0 . map toSync where toSync MemorySyncAsync = (#const MS_ASYNC) toSync MemorySyncSync = (#const MS_SYNC) toSync MemorySyncInvalidate = (#const MS_INVALIDATE) -- | 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 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 #ifdef __APPLE__ cMapAnon = (#const MAP_ANON) #else cMapAnon = (#const MAP_ANONYMOUS) #endif cMapFixed = (#const MAP_FIXED) toMapFlag MemoryMapShared = (#const MAP_SHARED) toMapFlag MemoryMapPrivate = (#const MAP_PRIVATE) -- | Unmap pages of memory -- -- use 'munmap' memoryUnmap :: Ptr a -> CSize -> IO () memoryUnmap ptr sz = throwErrnoIfMinus1_ "munmap" (c_munmap ptr sz) -- | give advice to the operating system about use of memory -- -- call 'madvise' memoryAdvise :: Ptr a -> CSize -> MemoryAdvice -> IO () memoryAdvise ptr sz adv = throwErrnoIfMinus1_ "madvise" (c_madvise ptr sz cadv) where cadv = toAdvice adv #if defined(POSIX_MADV_NORMAL) toAdvice MemoryAdviceNormal = (#const POSIX_MADV_NORMAL) toAdvice MemoryAdviceRandom = (#const POSIX_MADV_RANDOM) toAdvice MemoryAdviceSequential = (#const POSIX_MADV_SEQUENTIAL) toAdvice MemoryAdviceWillNeed = (#const POSIX_MADV_WILLNEED) toAdvice MemoryAdviceDontNeed = (#const POSIX_MADV_DONTNEED) #else toAdvice MemoryAdviceNormal = (#const MADV_NORMAL) toAdvice MemoryAdviceRandom = (#const MADV_RANDOM) toAdvice MemoryAdviceSequential = (#const MADV_SEQUENTIAL) toAdvice MemoryAdviceWillNeed = (#const MADV_WILLNEED) toAdvice MemoryAdviceDontNeed = (#const MADV_DONTNEED) #endif -- | lock a range of process address space -- -- call 'mlock' memoryLock :: Ptr a -> CSize -> IO () memoryLock ptr sz = throwErrnoIfMinus1_ "mlock" (c_mlock ptr sz) -- | unlock a range of process address space -- -- call 'munlock' memoryUnlock :: Ptr a -> CSize -> IO () memoryUnlock ptr sz = throwErrnoIfMinus1_ "munlock" (c_munlock ptr sz) -- | set protection of memory mapping -- -- call 'mprotect' memoryProtect :: Ptr a -> CSize -> [MemoryProtection] -> IO () memoryProtect ptr sz prots = throwErrnoIfMinus1_ "mprotect" (c_mprotect ptr sz cprot) where cprot = cvalueOfMemoryProts prots -- | memorySync synchronize memory with physical storage. -- -- On an anonymous mapping this function doesn't have any effect. -- call 'msync' memorySync :: Ptr a -> CSize -> [MemorySyncFlag] -> IO () memorySync ptr sz flags = throwErrnoIfMinus1_ "msync" (c_msync ptr sz cflags) where cflags = cvalueOfMemorySync flags -- | Return the operating system page size. -- -- call 'sysconf' sysconfPageSize :: Int sysconfPageSize = fromIntegral $ c_sysconf (#const _SC_PAGESIZE)