1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
|
-----------------------------------------------------------------------------
-- |
-- 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 <sys/mman.h>
#include <unistd.h>
{-# 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)
|
