1{-# LANGUAGE CApiFFI #-}
2
3module Regress.Mmap (regressions) where
4
5#include <sys/mman.h>
6
7import Control.Exception (bracket, evaluate)
8import Control.Monad (forM_)
9import Data.Bits ((.|.))
10import Data.ByteString.Internal (ByteString(..))
11import Data.Hashable (hash)
12import Foreign.C.Error (throwErrnoIf, throwErrnoIfMinus1, throwErrnoIfMinus1_)
13import Foreign.C.Types (CInt(..), CSize(..))
14import Foreign.Ptr (Ptr, intPtrToPtr, nullPtr, plusPtr)
15import GHC.ForeignPtr (newForeignPtr_)
16import System.Posix.Types (COff(..))
17import Test.Framework (Test)
18import Test.Framework.Providers.HUnit (testCase)
19import qualified Data.ByteString as B
20
21withMapping :: (Ptr a -> Int -> IO ()) -> IO ()
22withMapping go = do
23  pageSize <- fromIntegral `fmap` getPageSize
24  let mappingSize = pageSize * 2
25  bracket (mmap
26           nullPtr
27           mappingSize
28           ((#const PROT_READ) .|. (#const PROT_WRITE))
29           ((#const MAP_ANON) .|. (#const MAP_PRIVATE))
30           (-1)
31           0)
32           (flip munmap mappingSize) $ \mappingPtr -> do
33    go mappingPtr (fromIntegral pageSize)
34    mprotect (mappingPtr `plusPtr` fromIntegral pageSize)
35             pageSize (#const PROT_NONE)
36
37hashNearPageBoundary :: IO ()
38hashNearPageBoundary =
39  withMapping $ \ptr pageSize -> do
40    let initialSize = 16
41    fp <- newForeignPtr_ (ptr `plusPtr` (pageSize - initialSize))
42    let bs0 = PS fp 0 initialSize
43    forM_ (B.tails bs0) $ \bs -> do
44      evaluate (hash bs)
45
46regressions :: [Test]
47regressions = [
48   testCase "hashNearPageBoundary" hashNearPageBoundary
49 ]
50
51mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)
52mmap addr len prot flags fd offset =
53    throwErrnoIf (== intPtrToPtr (#const MAP_FAILED)) "mmap" $
54    c_mmap addr len prot flags fd offset
55
56munmap :: Ptr a -> CSize -> IO CInt
57munmap addr len = throwErrnoIfMinus1 "munmap" $ c_munmap addr len
58
59mprotect :: Ptr a -> CSize -> CInt -> IO ()
60mprotect addr len prot =
61    throwErrnoIfMinus1_ "mprotect" $ c_mprotect addr len prot
62
63foreign import capi unsafe "sys/mman.h mmap"
64    c_mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)
65
66foreign import capi unsafe "sys/mman.h munmap"
67    c_munmap :: Ptr a -> CSize -> IO CInt
68
69foreign import capi unsafe "sys/mman.h mprotect"
70    c_mprotect :: Ptr a -> CSize -> CInt -> IO CInt
71
72foreign import capi unsafe "unistd.h getpagesize"
73    getPageSize :: IO CInt
74