diff --git a/cbits/siphash-sse2.c b/cbits/siphash-sse2.c --- a/cbits/siphash-sse2.c +++ b/cbits/siphash-sse2.c @@ -18,6 +18,7 @@ __m128i mi, mask, len; size_t i, k; union { u64 gpr; __m128i xmm; } hash; + const u8 *p; /* We used to use the _mm_seti_epi32 intrinsic to initialize SSE2 registers. This compiles to a movdqa instruction, @@ -76,7 +77,26 @@ v0 = _mm_xor_si128(v0, mi); } - mi = _mm_loadl_epi64((__m128i*)(m + i)); + p = m + n; + + /* We must be careful to not trigger a segfault by reading an + unmapped page. So where is the end of our input? */ + + if (((uintptr_t) p & 4095) == 0) + /* Exactly at a page boundary: do not read past the end. */ + mi = _mm_setzero_si128(); + else if (((uintptr_t) p & 4095) <= 4088) + /* Inside a page: safe to read past the end, as we'll + mask out any bits we shouldn't have looked at below. */ + mi = _mm_loadl_epi64((__m128i*)(m + i)); + else + /* Within 8 bytes of the end of a page: ensure that + our final read re-reads some bytes so that we do + not cross the page boundary, then shift our result + right so that the re-read bytes vanish. */ + mi = _mm_srli_epi64(_mm_loadl_epi64((__m128i*)(((uintptr_t) m + i) & ~7)), + 8 * (((uintptr_t) m + i) % 8)); + len = _mm_set_epi32(0, 0, (n&0xff) << 24, 0); mask = _mm_srli_epi64(_mm_loadu_si128((__m128i*) &iv[4]), 8*(8-n%8)); mi = _mm_xor_si128(_mm_and_si128(mi, mask), len); @@ -84,7 +104,7 @@ v3 = _mm_xor_si128(v3, mi); if (SIPHASH_ROUNDS == 2) { COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3); - } else { + } else { for (k = 0; k < SIPHASH_ROUNDS; ++k) COMPRESS(v0,v1,v2,v3); } diff --git a/hashable.cabal b/hashable.cabal --- a/hashable.cabal +++ b/hashable.cabal @@ -1,5 +1,5 @@ Name: hashable -Version: 1.2.0.5 +Version: 1.2.0.6 Synopsis: A class for types that can be converted to a hash value Description: This package defines a class, 'Hashable', for types that can be converted to a hash value. This class @@ -74,16 +74,23 @@ Test-suite tests Type: exitcode-stdio-1.0 Hs-source-dirs: tests - Main-is: Properties.hs + Main-is: Main.hs + Other-modules: Properties Regress Build-depends: base >= 4.0 && < 5.0, bytestring, ghc-prim, hashable, test-framework >= 0.3.3, + test-framework-hunit, test-framework-quickcheck2 >= 0.2.9, + HUnit, QuickCheck >= 2.4.0.1, random == 1.0.*, text >= 0.11.0.5 + if !os(windows) + Build-depends: unix + CPP-options: -DHAVE_MMAP + Other-modules: Regress.Mmap Ghc-options: -Wall -fno-warn-orphans if impl(ghc >= 7.2.1) diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,14 @@ +-- | Tests for the 'Data.Hashable' module. We test functions by +-- comparing the C and Haskell implementations. + +module Main (main) where + +import Properties (properties) +import Regress (regressions) +import Test.Framework (defaultMain, testGroup) + +main :: IO () +main = defaultMain [ + testGroup "properties" properties + , testGroup "regressions" regressions + ] diff --git a/tests/Properties.hs b/tests/Properties.hs --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -4,10 +4,10 @@ {-# LANGUAGE DeriveGeneric, ScopedTypeVariables #-} #endif --- | Tests for the 'Data.Hashable' module. We test functions by --- comparing the C and Haskell implementations. +-- | QuickCheck tests for the 'Data.Hashable' module. We test +-- functions by comparing the C and Haskell implementations. -module Main (main) where +module Properties (properties) where import Data.Hashable (Hashable, hash, hashByteArray, hashPtr) import qualified Data.ByteString as B @@ -23,7 +23,7 @@ import GHC.ST (ST(..), runST) import GHC.Word (Word8(..)) import Test.QuickCheck hiding ((.&.)) -import Test.Framework (Test, defaultMain, testGroup) +import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) #ifdef GENERICS import GHC.Generics @@ -193,14 +193,8 @@ #endif ------------------------------------------------------------------------- --- Test harness - -main :: IO () -main = defaultMain tests - -tests :: [Test] -tests = +properties :: [Test] +properties = [ testProperty "bernstein" pHash , testGroup "text" [ testProperty "text/strict" pText @@ -234,4 +228,3 @@ #else fromStrict b = BL.fromChunks [b] #endif - diff --git a/tests/Regress.hs b/tests/Regress.hs new file mode 100644 --- /dev/null +++ b/tests/Regress.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module Regress (regressions) where + +import qualified Test.Framework as F + +#ifdef HAVE_MMAP +import qualified Regress.Mmap as Mmap +#endif + +regressions :: [F.Test] +regressions = [] +#ifdef HAVE_MMAP + ++ Mmap.regressions +#endif diff --git a/tests/Regress/Mmap.hsc b/tests/Regress/Mmap.hsc new file mode 100644 --- /dev/null +++ b/tests/Regress/Mmap.hsc @@ -0,0 +1,73 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module Regress.Mmap (regressions) where + +#include + +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