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
|
{-# LANGUAGE ForeignFunctionInterface #-}
module Regress.Mmap (regressions) where
#include <sys/mman.h>
import Control.Exception (bracket, evaluate)
import Control.Monad (forM_)
import Data.Bits ((.|.))
import Data.ByteString.Internal (ByteString(..))
import Data.Hashable (hash)
import Foreign.C.Error (throwErrnoIf, throwErrnoIfMinus1, throwErrnoIfMinus1_)
import Foreign.C.Types (CInt(..), CSize(..))
import Foreign.Ptr (Ptr, intPtrToPtr, nullPtr, plusPtr)
import GHC.ForeignPtr (newForeignPtr_)
import System.Posix.Types (COff(..))
import Test.Framework (Test)
import Test.Framework.Providers.HUnit (testCase)
import qualified Data.ByteString as B
withMapping :: (Ptr a -> Int -> IO ()) -> IO ()
withMapping go = do
pageSize <- fromIntegral `fmap` getPageSize
let mappingSize = pageSize * 2
bracket (mmap
nullPtr
mappingSize
((#const PROT_READ) .|. (#const PROT_WRITE))
((#const MAP_ANON) .|. (#const MAP_PRIVATE))
(-1)
0)
(flip munmap mappingSize) $ \mappingPtr -> do
go mappingPtr (fromIntegral pageSize)
mprotect (mappingPtr `plusPtr` fromIntegral pageSize)
pageSize (#const PROT_NONE)
hashNearPageBoundary :: IO ()
hashNearPageBoundary =
withMapping $ \ptr pageSize -> do
let initialSize = 16
fp <- newForeignPtr_ (ptr `plusPtr` (pageSize - initialSize))
let bs0 = PS fp 0 initialSize
forM_ (B.tails bs0) $ \bs -> do
evaluate (hash bs)
regressions :: [Test]
regressions = [
testCase "hashNearPageBoundary" hashNearPageBoundary
]
mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)
mmap addr len prot flags fd offset =
throwErrnoIf (== intPtrToPtr (#const MAP_FAILED)) "mmap" $
c_mmap addr len prot flags fd offset
munmap :: Ptr a -> CSize -> IO CInt
munmap addr len = throwErrnoIfMinus1 "munmap" $ c_munmap addr len
mprotect :: Ptr a -> CSize -> CInt -> IO ()
mprotect addr len prot =
throwErrnoIfMinus1_ "mprotect" $ c_mprotect addr len prot
foreign import ccall unsafe "sys/mman.h mmap"
c_mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)
foreign import ccall unsafe "sys/mman.h munmap"
c_munmap :: Ptr a -> CSize -> IO CInt
foreign import ccall unsafe "sys/mman.h mprotect"
c_mprotect :: Ptr a -> CSize -> CInt -> IO CInt
foreign import ccall unsafe "unistd.h getpagesize"
getPageSize :: IO CInt
|
