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