diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2011-2012, Google, Inc. +Copyright (c) 2011-2013, Google, Inc. All rights reserved. diff --git a/benchmark/hashtable-benchmark.cabal b/benchmark/hashtable-benchmark.cabal --- a/benchmark/hashtable-benchmark.cabal +++ b/benchmark/hashtable-benchmark.cabal @@ -15,20 +15,20 @@ Executable hashtable-benchmark main-is: Main.hs - hs-source-dirs: src ../src + hs-source-dirs: src build-depends: base >= 4 && <5, base16-bytestring == 0.1.*, bytestring >= 0.9 && <0.11, containers >= 0.4 && <0.6, - criterion >= 0.5 && <0.7, + criterion >= 0.8 && <0.9, csv == 0.1.*, deepseq >= 1.1 && <1.4, filepath == 1.*, - hashable >= 1.1 && <1.2 || >= 1.2.1 && <1.3, - hashtables >= 1.0 && <1.3, + hashable >= 1.1 && <1.2 || >= 1.2.1 && <1.3, + hashtables >= 1.2 && <1.3, mtl == 2.*, - mwc-random >= 0.8 && <0.13, + mwc-random >= 0.8 && <0.14, primitive, statistics >= 0.8 && <0.11, threads >= 0.4 && <0.6, diff --git a/benchmark/src/Criterion/Collection/Sample.hs b/benchmark/src/Criterion/Collection/Sample.hs --- a/benchmark/src/Criterion/Collection/Sample.hs +++ b/benchmark/src/Criterion/Collection/Sample.hs @@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RankNTypes #-} module Criterion.Collection.Sample ( Benchmark(..) @@ -16,23 +16,23 @@ import Control.DeepSeq import Control.Monad import Control.Monad.Trans -import Criterion hiding (Benchmark) +import Criterion hiding (Benchmark) +import Criterion.Collection.Internal.Types import Criterion.Config import Criterion.Environment -import Criterion.IO +import Criterion.IO.Printf import Criterion.Measurement import Criterion.Monad -import Criterion.Collection.Internal.Types import Data.IORef -import Data.List (foldl') +import Data.List (foldl') import Data.Monoid -import qualified Data.Vector as V -import qualified Data.Vector.Unboxed as U -import Statistics.Quantile (continuousBy, cadpw) +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as U +import Statistics.Quantile (cadpw, continuousBy) import Statistics.Sample -import System.Mem (performGC) +import System.Mem (performGC) import System.Random.MWC -import Text.Printf (printf) +import Text.Printf (printf) ------------------------------------------------------------------------------ data MeasurementMode = PerBatch | PerOperation diff --git a/cbits/Makefile b/cbits/Makefile new file mode 100644 --- /dev/null +++ b/cbits/Makefile @@ -0,0 +1,14 @@ +check: default.c common.c check.c sse-42.c + @echo "Testing portable version..." + @gcc -o check -O3 default.c common.c check.c + @./check + @rm check + + @echo + @echo "Testing SSE 4.2 version..." + @gcc -o check -O3 -msse4.2 sse-42.c common.c check.c sse-42-check.c + @./check + @rm check + +clean: + rm -f *.o check diff --git a/cbits/cfuncs.c b/cbits/cfuncs.c deleted file mode 100644 --- a/cbits/cfuncs.c +++ /dev/null @@ -1,517 +0,0 @@ -#include -#include -#include -#ifdef WIN32 -#include -#else -#include -#endif - -#if defined(USE_SSE_4_1) -#include -#endif - -#if defined(__GNUC__) -#define PREFETCH_READ(x) (__builtin_prefetch(x, 0, 3)) -#define PREFETCH_WRITE(x) (__builtin_prefetch(x, 1, 3)) -#else -#define PREFETCH_READ(x) -#define PREFETCH_WRITE(x) -#endif - -void prefetchCacheLine32_write(uint32_t* line, int start) -{ - PREFETCH_WRITE((void*)(&line[start])); -} - - -void prefetchCacheLine64_write(uint64_t* line, int start) -{ - PREFETCH_WRITE((void*)(&line[start])); -} - - -void prefetchCacheLine32_read(uint32_t* line, int start) -{ - PREFETCH_READ((void*)(&line[start])); -} - - -void prefetchCacheLine64_read(uint64_t* line, int start) -{ - PREFETCH_READ((void*)(&line[start])); -} - - -int forwardSearch32_2(uint32_t* array, int start, int end, - uint32_t x1, uint32_t x2) { - uint32_t* ep = array + end; - uint32_t* p = array + start; - int wrapped = 0; - while (1) { - if (p == ep) { - if (wrapped) return -1; - ep = array + start; - p = array; - wrapped = 1; - } - if (*p == x1 || *p == x2) return p - array; - ++p; - } -} - - -int forwardSearch32_3(uint32_t* array, int start, int end, - uint32_t x1, uint32_t x2, uint32_t x3) { - uint32_t* ep = array + end; - uint32_t* p = array + start; - int wrapped = 0; - while (1) { - if (p == ep) { - if (wrapped) return -1; - ep = array + start; - p = array; - wrapped = 1; - } - if (*p == x1 || *p == x2 || *p == x3) return p - array; - ++p; - } -} - - -int forwardSearch64_2(uint64_t* array, int start, int end, - uint64_t x1, uint64_t x2) { - uint64_t* ep = array + end; - uint64_t* p = array + start; - int wrapped = 0; - while (1) { - if (p == ep) { - if (wrapped) return -1; - ep = array + start; - p = array; - wrapped = 1; - } - if (*p == x1 || *p == x2) return p - array; - ++p; - } -} - - -int forwardSearch64_3(uint64_t* array, int start, int end, - uint64_t x1, uint64_t x2, uint64_t x3) { - uint64_t* ep = array + end; - uint64_t* p = array + start; - int wrapped = 0; - while (1) { - if (p == ep) { - if (wrapped) return -1; - ep = array + start; - p = array; - wrapped = 1; - } - if (*p == x1 || *p == x2 || *p == x3) return p - array; - ++p; - } -} - - -//---------------------------------------------------------------------------- -// cache line search functions -// First: 32 bit - -inline int mask(int a, int b) { return -(a == b); } - - -uint8_t deBruijnBitPositions[] = { - 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8, - 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9 -}; - - -int firstBitSet(int a) { - int zeroCase = mask(0, a); - uint32_t x = (uint32_t) (a & -a); - x *= 0x077CB531; - x >>= 27; - return zeroCase | deBruijnBitPositions[x]; -} - - -int32_t lineResult32(int m, int start) { - int p = firstBitSet(m); - int32_t mm = mask(p, -1); - return mm | (~mm & (start + p)); -} - - -uint32_t lineMask32(uint32_t* array, int start, uint32_t value) { - uint32_t* p = array + start; - uint32_t m = 0; - int offset = start & 0xf; - - switch (offset) { - case 0: m |= mask(*p++, value) & 0x1; - case 1: m |= mask(*p++, value) & 0x2; - case 2: m |= mask(*p++, value) & 0x4; - case 3: m |= mask(*p++, value) & 0x8; - case 4: m |= mask(*p++, value) & 0x10; - case 5: m |= mask(*p++, value) & 0x20; - case 6: m |= mask(*p++, value) & 0x40; - case 7: m |= mask(*p++, value) & 0x80; - case 8: m |= mask(*p++, value) & 0x100; - case 9: m |= mask(*p++, value) & 0x200; - case 10: m |= mask(*p++, value) & 0x400; - case 11: m |= mask(*p++, value) & 0x800; - case 12: m |= mask(*p++, value) & 0x1000; - case 13: m |= mask(*p++, value) & 0x2000; - case 14: m |= mask(*p++, value) & 0x4000; - case 15: m |= mask(*p++, value) & 0x8000; - } - - return m >> offset; -} - - -int lineSearch32(uint32_t* array, int start, uint32_t value) { - uint32_t m = lineMask32(array, start, value); - return lineResult32((int)m, start); -} - - -uint32_t lineMask32_2(uint32_t* array, int start, uint32_t x1, uint32_t x2) { - uint32_t* p = array + start; - uint32_t m = 0; - int offset = start & 0xf; - - switch (offset) { - case 0: m |= (mask(*p, x1) | mask(*p, x2)) & 0x1; ++p; - case 1: m |= (mask(*p, x1) | mask(*p, x2)) & 0x2; ++p; - case 2: m |= (mask(*p, x1) | mask(*p, x2)) & 0x4; ++p; - case 3: m |= (mask(*p, x1) | mask(*p, x2)) & 0x8; ++p; - case 4: m |= (mask(*p, x1) | mask(*p, x2)) & 0x10; ++p; - case 5: m |= (mask(*p, x1) | mask(*p, x2)) & 0x20; ++p; - case 6: m |= (mask(*p, x1) | mask(*p, x2)) & 0x40; ++p; - case 7: m |= (mask(*p, x1) | mask(*p, x2)) & 0x80; ++p; - case 8: m |= (mask(*p, x1) | mask(*p, x2)) & 0x100; ++p; - case 9: m |= (mask(*p, x1) | mask(*p, x2)) & 0x200; ++p; - case 10: m |= (mask(*p, x1) | mask(*p, x2)) & 0x400; ++p; - case 11: m |= (mask(*p, x1) | mask(*p, x2)) & 0x800; ++p; - case 12: m |= (mask(*p, x1) | mask(*p, x2)) & 0x1000; ++p; - case 13: m |= (mask(*p, x1) | mask(*p, x2)) & 0x2000; ++p; - case 14: m |= (mask(*p, x1) | mask(*p, x2)) & 0x4000; ++p; - case 15: m |= (mask(*p, x1) | mask(*p, x2)) & 0x8000; ++p; - } - - return m >> offset; -} - - -int lineSearch32_2(uint32_t* array, int start, uint32_t x1, uint32_t x2) { - uint32_t m = lineMask32_2(array, start, x1, x2); - return lineResult32((int)m, start); -} - - -uint32_t lineMask32_3(uint32_t* array, int start, - uint32_t x1, uint32_t x2, uint32_t x3) { - uint32_t* p = array + start; - uint32_t m = 0; - int offset = start & 0xf; - - switch (offset) { - case 0: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x1; ++p; - case 1: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x2; ++p; - case 2: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x4; ++p; - case 3: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x8; ++p; - case 4: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x10; ++p; - case 5: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x20; ++p; - case 6: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x40; ++p; - case 7: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x80; ++p; - case 8: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x100; ++p; - case 9: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x200; ++p; - case 10: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x400; ++p; - case 11: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x800; ++p; - case 12: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x1000; ++p; - case 13: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x2000; ++p; - case 14: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x4000; ++p; - case 15: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x8000; ++p; - } - - return m >> offset; -} - - -int lineSearch32_3(uint32_t* array, int start, - uint32_t x1, uint32_t x2, uint32_t x3) { - uint32_t m = lineMask32_3(array, start, x1, x2, x3); - return lineResult32((int)m, start); -} - - -//---------------------------------------------------------------------------- -// Now: 64-bit. If USE_SSE_4_1 is on, we will use SSE4.1 SIMD instructions to -// search the cache line super-efficiently. - -#if defined(USE_SSE_4_1) - -inline uint64_t mask_to_mask2(__m128i m) { - int mask16 = _mm_movemask_epi8(m); - // output of _mm_movemask_epi8 is a 16-bit word where bit i is 1 iff the - // most significant bit of byte i of the mask is 1 - int m1 = mask16 & 0x1; - int m2 = (mask16 & 0x100) >> 7; - return (uint64_t) (m1 | m2); -} - - -inline uint64_t cmp_and_mask(__m128i val, __m128i x0) { - __m128i mask1 = _mm_cmpeq_epi64(val, x0); - return mask_to_mask2(mask1); -} - - -inline uint64_t cmp_and_mask_2(__m128i val, __m128i x0, __m128i x1) { - __m128i mask1 = _mm_cmpeq_epi64(val, x0); - __m128i mask2 = _mm_cmpeq_epi64(val, x1); - mask1 = _mm_or_si128(mask1, mask2); - return mask_to_mask2(mask1); -} - - -inline uint64_t cmp_and_mask_3(__m128i val, __m128i x0, __m128i x1, - __m128i x2) { - __m128i mask1 = _mm_cmpeq_epi64(val, x0); - __m128i mask2 = _mm_cmpeq_epi64(val, x1); - __m128i mask3 = _mm_cmpeq_epi64(val, x2); - mask1 = _mm_or_si128(mask1, mask2); - mask1 = _mm_or_si128(mask1, mask3); - return mask_to_mask2(mask1); -} - - -uint64_t lineMask64(uint64_t* array, int start0, uint64_t v1) { - int offset = start0 & 0x7; - int start = start0 & ~0x7; - - __m128i* p = (__m128i*) (&array[start]); - __m128i x1 = _mm_cvtsi32_si128(0); - x1 = _mm_insert_epi64(x1, v1, 0); - x1 = _mm_insert_epi64(x1, v1, 1); - uint64_t dest_mask = 0; - - // x1 contains two 64-bit copies of the value to look for - - // words 0, 1 - __m128i x = _mm_load_si128(p); - dest_mask = cmp_and_mask(x, x1); - p = (__m128i*) (&array[start+2]); - - // words 2, 3 - x = _mm_load_si128(p); - dest_mask |= (cmp_and_mask(x, x1) << 2); - p = (__m128i*) (&array[start+4]); - - // words 4, 5 - x = _mm_load_si128(p); - dest_mask |= (cmp_and_mask(x, x1) << 4); - p = (__m128i*) (&array[start+6]); - - // words 6, 7 - x = _mm_load_si128(p); - dest_mask |= (cmp_and_mask(x, x1) << 6); - - return dest_mask >> offset; -} - - -uint64_t lineMask64_2(uint64_t* array, int start0, uint64_t v1, uint64_t v2) { - int offset = start0 & 0x7; - int start = start0 & ~0x7; - - __m128i* p = (__m128i*) (&array[start]); - __m128i x1 = _mm_cvtsi32_si128(0); - x1 = _mm_insert_epi64(x1, v1, 0); - x1 = _mm_insert_epi64(x1, v1, 1); - - __m128i x2 = _mm_cvtsi32_si128(0); - x2 = _mm_insert_epi64(x2, v2, 0); - x2 = _mm_insert_epi64(x2, v2, 1); - - uint64_t dest_mask = 0; - - // words 0, 1 - __m128i x = _mm_load_si128(p); - dest_mask = cmp_and_mask_2(x, x1, x2); - p = (__m128i*) (&array[start+2]); - - // words 2, 3 - x = _mm_load_si128(p); - dest_mask |= (cmp_and_mask_2(x, x1, x2) << 2); - p = (__m128i*) (&array[start+4]); - - // words 4, 5 - x = _mm_load_si128(p); - dest_mask |= (cmp_and_mask_2(x, x1, x2) << 4); - p = (__m128i*) (&array[start+6]); - - // words 6, 7 - x = _mm_load_si128(p); - dest_mask |= (cmp_and_mask_2(x, x1, x2) << 6); - - return dest_mask >> offset; -} - - -uint64_t lineMask64_3(uint64_t* array, int start0, - uint64_t v1, uint64_t v2, uint64_t v3) { - int offset = start0 & 0x7; - int start = start0 & ~0x7; - - __m128i* p = (__m128i*) (&array[start]); - __m128i x1 = _mm_cvtsi32_si128(0); - x1 = _mm_insert_epi64(x1, v1, 0); - x1 = _mm_insert_epi64(x1, v1, 1); - - __m128i x2 = _mm_cvtsi32_si128(0); - x2 = _mm_insert_epi64(x2, v2, 0); - x2 = _mm_insert_epi64(x2, v2, 1); - - __m128i x3 = _mm_cvtsi32_si128(0); - x3 = _mm_insert_epi64(x3, v3, 0); - x3 = _mm_insert_epi64(x3, v3, 1); - - uint64_t dest_mask = 0; - - // words 0, 1 - __m128i x = _mm_load_si128(p); - dest_mask = cmp_and_mask_3(x, x1, x2, x3); - p = (__m128i*) (&array[start+2]); - - // words 2, 3 - x = _mm_load_si128(p); - dest_mask |= (cmp_and_mask_3(x, x1, x2, x3) << 2); - p = (__m128i*) (&array[start+4]); - - // words 4, 5 - x = _mm_load_si128(p); - dest_mask |= (cmp_and_mask_3(x, x1, x2, x3) << 4); - p = (__m128i*) (&array[start+6]); - - // words 6, 7 - x = _mm_load_si128(p); - dest_mask |= (cmp_and_mask_3(x, x1, x2, x3) << 6); - - return dest_mask >> offset; -} - - -#else - - - -uint64_t lineMask64(uint64_t* array, int start, uint64_t value) { - uint64_t* p = array + start; - uint64_t m = 0; - int offset = start & 0x7; - - switch (offset) { - case 0: m |= mask(*p++, value) & 0x1; - case 1: m |= mask(*p++, value) & 0x2; - case 2: m |= mask(*p++, value) & 0x4; - case 3: m |= mask(*p++, value) & 0x8; - case 4: m |= mask(*p++, value) & 0x10; - case 5: m |= mask(*p++, value) & 0x20; - case 6: m |= mask(*p++, value) & 0x40; - case 7: m |= mask(*p++, value) & 0x80; - } - - return m >> offset; -} - - -uint64_t lineMask64_2(uint64_t* array, int start, uint64_t x1, uint64_t x2) { - uint64_t* p = array + start; - uint64_t m = 0; - int offset = start & 0x7; - - switch (offset) { - case 0: m |= (mask(*p, x1) | mask(*p, x2)) & 0x1; ++p; - case 1: m |= (mask(*p, x1) | mask(*p, x2)) & 0x2; ++p; - case 2: m |= (mask(*p, x1) | mask(*p, x2)) & 0x4; ++p; - case 3: m |= (mask(*p, x1) | mask(*p, x2)) & 0x8; ++p; - case 4: m |= (mask(*p, x1) | mask(*p, x2)) & 0x10; ++p; - case 5: m |= (mask(*p, x1) | mask(*p, x2)) & 0x20; ++p; - case 6: m |= (mask(*p, x1) | mask(*p, x2)) & 0x40; ++p; - case 7: m |= (mask(*p, x1) | mask(*p, x2)) & 0x80; ++p; - } - - return m >> offset; -} - - -uint64_t lineMask64_3(uint64_t* array, int start, - uint64_t x1, uint64_t x2, uint64_t x3) { - uint64_t* p = array + start; - uint64_t m = 0; - int offset = start & 0x7; - - switch (offset) { - case 0: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x1; ++p; - case 1: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x2; ++p; - case 2: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x4; ++p; - case 3: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x8; ++p; - case 4: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x10; ++p; - case 5: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x20; ++p; - case 6: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x40; ++p; - case 7: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x80; ++p; - } - - return m >> offset; -} - - -#endif // USE_SSE_4_1 - - -int64_t lineResult64(int64_t m, int64_t start) { - int p = firstBitSet((int)m); - int64_t mm = (int64_t) mask(p, -1); - return mm | (~mm & (start + p)); -} - - -int lineSearch64(uint64_t* array, int start, uint64_t value) { - uint64_t m = lineMask64(array, start, value); - return lineResult64((int)m, start); -} - - -int lineSearch64_2(uint64_t* array, int start, uint64_t x1, uint64_t x2) { - uint64_t m = lineMask64_2(array, start, x1, x2); - return lineResult64((int)m, start); -} - - -int lineSearch64_3(uint64_t* array, int start, - uint64_t x1, uint64_t x2, uint64_t x3) { - uint64_t m = lineMask64_3(array, start, x1, x2, x3); - return lineResult64((int)m, start); -} - -void suicide(volatile int* check, int t) { - int secs = (3*t + 999999) / 1000000; - if (secs < 1) secs = 1; -#ifdef WIN32 - Sleep(secs * 1000); -#else - sleep(secs); -#endif - if (*check) { - printf("timeout expired, dying!!\n"); -#ifdef WIN32 - abort(); -#else - raise(SIGKILL); -#endif - } -} diff --git a/cbits/check.c b/cbits/check.c new file mode 100644 --- /dev/null +++ b/cbits/check.c @@ -0,0 +1,185 @@ +#include +#include +#include "defs.h" + +static const int NUMH = 64 / sizeof(small_hash_t); + +static small_hash_t t_sevens[32] = + { 7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7 }; + +static small_hash_t t_zeroes[32] = + { 0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0 }; + +static small_hash_t t_mixed[32] = + { 7,1,7,7,2,7,7,7, + 7,7,3,7,7,7,7,7, + 7,7,7,7,1,7,7,7, + 7,7,7,7,3,7,7,9 }; + +static int num_tests = 0; +static int num_errors = 0; + +void CHECK(int actual, int expected, char* what) { + ++num_tests; + if (actual != expected) { + fprintf(stderr, "%s: expected %d, got %d\n", what, expected, actual); + + ++num_errors; + } +} + + +void check_forward_search_2() { + /* forward_search_2 */ + /* - offset zero */ + CHECK(forward_search_2(t_sevens, 0, NUMH, 0, 7 ), 0, "fs2-sevens-ok-1" ); + CHECK(forward_search_2(t_sevens, 0, NUMH, 7, 0 ), 0, "fs2-sevens-ok-2" ); + CHECK(forward_search_2(t_sevens, 0, NUMH, 7, 7 ), 0, "fs2-sevens-ok-3" ); + CHECK(forward_search_2(t_sevens, 0, NUMH, 3, 0 ), -1, "fs2-sevens-fail-1"); + CHECK(forward_search_2(t_zeroes, 0, NUMH, 0, 1 ), 0, "fs2-zeroes-ok-1" ); + CHECK(forward_search_2(t_zeroes, 0, NUMH, 2, 0 ), 0, "fs2-zeroes-ok-2" ); + CHECK(forward_search_2(t_zeroes, 0, NUMH, 2, 0xf0), -1, "fs2-zeroes-fail-1"); + + /* - offset 5 */ + CHECK(forward_search_2(t_sevens, 5, NUMH, 0, 7), 5, "fs2-o-sevens-ok-1" ); + CHECK(forward_search_2(t_sevens, 5, NUMH, 7, 0), 5, "fs2-o-sevens-ok-2" ); + CHECK(forward_search_2(t_sevens, 5, NUMH, 7, 7), 5, "fs2-o-sevens-ok-3" ); + CHECK(forward_search_2(t_sevens, 5, NUMH, 3, 0), -1, "fs2-o-sevens-fail-1"); + CHECK(forward_search_2(t_zeroes, 5, NUMH, 0, 1), 5, "fs2-o-zeroes-ok-1" ); + CHECK(forward_search_2(t_zeroes, 5, NUMH, 2, 0), 5, "fs2-o-zeroes-ok-2" ); + CHECK(forward_search_2(t_zeroes, 5, NUMH, 2, 0xf0), -1, "fs2-o-zeroes-fail-1"); + + /* - mixed, offset zero */ + CHECK(forward_search_2(t_mixed, 0, NUMH, 2, 0xf0), 4, "fs2-mixed-ok-1" ); + CHECK(forward_search_2(t_mixed, 0, NUMH, 4, 0xf0), -1, "fs2-mixed-fail-1"); + CHECK(forward_search_2(t_mixed, 0, NUMH, 2, 1), 1, "fs2-mixed-ok-2" ); + CHECK(forward_search_2(t_mixed, 0, NUMH, 2, 7), 0, "fs2-mixed-ok-3" ); + CHECK(forward_search_2(t_mixed, 0, NUMH, 2, 3), 4, "fs2-mixed-ok-4" ); + CHECK(forward_search_2(t_mixed, 0, NUMH, 9, 3), 10, "fs2-mixed-ok-5" ); + CHECK(forward_search_2(t_mixed, 0, NUMH, 3, 9), 10, "fs2-mixed-ok-5" ); + CHECK(forward_search_2(t_mixed, 0, NUMH, 8, 9), 31, "fs2-mixed-ok-6" ); + + /* - mixed, offset 16 */ + CHECK(forward_search_2(t_mixed, 16, NUMH, 2, 0xf0), 4, "fs2-o-mixed-ok-1" ); + CHECK(forward_search_2(t_mixed, 16, NUMH, 4, 0xf0), -1, "fs2-o-mixed-fail-1"); + CHECK(forward_search_2(t_mixed, 16, NUMH, 2, 1), 20, "fs2-o-mixed-ok-2" ); + CHECK(forward_search_2(t_mixed, 16, NUMH, 2, 7), 16, "fs2-o-mixed-ok-3" ); + CHECK(forward_search_2(t_mixed, 16, NUMH, 2, 3), 28, "fs2-o-mixed-ok-4" ); + CHECK(forward_search_2(t_mixed, 16, NUMH, 9, 3), 28, "fs2-o-mixed-ok-5" ); + CHECK(forward_search_2(t_mixed, 16, NUMH, 3, 9), 28, "fs2-o-mixed-ok-5" ); + CHECK(forward_search_2(t_mixed, 16, NUMH, 8, 9), 31, "fs2-o-mixed-ok-6" ); +} + +void check_forward_search_3() { + /* forward_search_3 */ + /* - offset zero */ + CHECK(forward_search_3(t_sevens, 0, NUMH, 0, 7, 88), 0, "fs3-sevens-ok-1" ); + CHECK(forward_search_3(t_sevens, 0, NUMH, 7, 0, 88), 0, "fs3-sevens-ok-2" ); + CHECK(forward_search_3(t_sevens, 0, NUMH, 7, 7, 88), 0, "fs3-sevens-ok-3" ); + CHECK(forward_search_3(t_sevens, 0, NUMH, 3, 0, 88), -1, "fs3-sevens-fail-1"); + CHECK(forward_search_3(t_zeroes, 0, NUMH, 0, 1, 88), 0, "fs3-zeroes-ok-1" ); + CHECK(forward_search_3(t_zeroes, 0, NUMH, 2, 0, 88), 0, "fs3-zeroes-ok-2" ); + CHECK(forward_search_3(t_zeroes, 0, NUMH, 2, 11, 0 ), 0, "fs3-zeroes-ok-3" ); + CHECK(forward_search_3(t_zeroes, 0, NUMH, 2, 32, 88), -1, "fs3-zeroes-fail-1"); + + /* - offset 5 */ + CHECK(forward_search_3(t_sevens, 5, NUMH, 0, 7, 7 ), 5, "fs3-o-sevens-ok-1" ); + CHECK(forward_search_3(t_sevens, 5, NUMH, 7, 0, 21), 5, "fs3-o-sevens-ok-2" ); + CHECK(forward_search_3(t_sevens, 5, NUMH, 7, 7, 21), 5, "fs3-o-sevens-ok-3" ); + CHECK(forward_search_3(t_sevens, 5, NUMH, 3, 0, 21), -1, "fs3-o-sevens-fail-1"); + CHECK(forward_search_3(t_zeroes, 5, NUMH, 0, 1, 21), 5, "fs3-o-zeroes-ok-1" ); + CHECK(forward_search_3(t_zeroes, 5, NUMH, 2, 0, 21), 5, "fs3-o-zeroes-ok-2" ); + CHECK(forward_search_3(t_zeroes, 5, NUMH, 2, 0xf0, 21), -1, "fs3-o-zeroes-fail-1"); + + /* - mixed, offset zero */ + CHECK(forward_search_3(t_mixed, 0, NUMH, 2, 0xf0, -1), 4, "fs3-mixed-ok-1" ); + CHECK(forward_search_3(t_mixed, 0, NUMH, 4, 0xf0, -1), -1, "fs3-mixed-fail-1"); + CHECK(forward_search_3(t_mixed, 0, NUMH, 2, 1, -1), 1, "fs3-mixed-ok-2" ); + CHECK(forward_search_3(t_mixed, 0, NUMH, 2, 7, -1), 0, "fs3-mixed-ok-3" ); + CHECK(forward_search_3(t_mixed, 0, NUMH, 2, 3, -1), 4, "fs3-mixed-ok-4" ); + CHECK(forward_search_3(t_mixed, 0, NUMH, 9, 3, -1), 10, "fs3-mixed-ok-5" ); + CHECK(forward_search_3(t_mixed, 0, NUMH, 3, 9, -1), 10, "fs3-mixed-ok-5" ); + CHECK(forward_search_3(t_mixed, 0, NUMH, 8, 9, -1), 31, "fs3-mixed-ok-6" ); + + /* - mixed, offset 16 */ + CHECK(forward_search_3(t_mixed, 16, NUMH, 2, 96, 33), 4, "fs3-o-mixed-ok-1" ); + CHECK(forward_search_3(t_mixed, 16, NUMH, 4, 96, 33), -1, "fs3-o-mixed-fail-1"); + CHECK(forward_search_3(t_mixed, 16, NUMH, 2, 1, 33), 20, "fs3-o-mixed-ok-2" ); + CHECK(forward_search_3(t_mixed, 16, NUMH, 2, 7, 33), 16, "fs3-o-mixed-ok-3" ); + CHECK(forward_search_3(t_mixed, 16, NUMH, 2, 3, 33), 28, "fs3-o-mixed-ok-4" ); + CHECK(forward_search_3(t_mixed, 16, NUMH, 9, 3, 33), 28, "fs3-o-mixed-ok-5" ); + CHECK(forward_search_3(t_mixed, 16, NUMH, 3, 9, 33), 28, "fs3-o-mixed-ok-5" ); + CHECK(forward_search_3(t_mixed, 16, NUMH, 8, 9, 33), 31, "fs3-o-mixed-ok-6" ); + CHECK(forward_search_3(t_mixed, 16, NUMH, 8, 33, 9 ), 31, "fs3-o-mixed-ok-7" ); +} + +void check_line_search() { + CHECK(line_search(t_sevens, 0, 7), 0, "ls-7s-ok-1"); + CHECK(line_search(t_sevens, 5, 7), 5, "ls-7s-ok-2"); + CHECK(line_search(t_sevens, 31, 7), 31, "ls-7s-ok-3"); + CHECK(line_search(t_sevens, 0, 1), -1, "ls-7s-fail-1"); + CHECK(line_search(t_sevens, 31, 1), -1, "ls-7s-fail-2"); + + CHECK(line_search(t_mixed, 0, 7), 0, "ls-m-ok-1"); + CHECK(line_search(t_mixed, 0, 1), 1, "ls-m-ok-2"); + CHECK(line_search(t_mixed, 1, 7), 2, "ls-m-ok-3"); + CHECK(line_search(t_mixed, 0, 9), 31, "ls-m-ok-4"); + CHECK(line_search(t_mixed, 0, 8), -1, "ls-m-fail-1"); + + CHECK(line_search(t_mixed, 16, 1), 20, "ls-m-ok-5"); +} + +void check_line_search_2() { + CHECK(line_search_2(t_sevens, 0, 7, 3), 0, "ls2-7s-ok-1"); + CHECK(line_search_2(t_sevens, 5, 7, 9), 5, "ls2-7s-ok-2"); + CHECK(line_search_2(t_sevens, 31, 0, 7), 31, "ls2-7s-ok-3"); + CHECK(line_search_2(t_sevens, 0, 1, 3), -1, "ls2-7s-fail-1"); + CHECK(line_search_2(t_sevens, 31, 6, 1), -1, "ls2-7s-fail-2"); + + CHECK(line_search_2(t_mixed, 0, 7, 9), 0, "ls2-m-ok-1"); + CHECK(line_search_2(t_mixed, 0, 9, 1), 1, "ls2-m-ok-2"); + CHECK(line_search_2(t_mixed, 1, 7, 9), 2, "ls2-m-ok-3"); + CHECK(line_search_2(t_mixed, 0, 8, 9), 31, "ls2-m-ok-4"); + CHECK(line_search_2(t_mixed, 0, 8, 4), -1, "ls2-m-fail-1"); + + CHECK(line_search_2(t_mixed, 16, 3, 1), 20, "ls2-m-ok-5"); +} + +void check_line_search_3() { + CHECK(line_search_3(t_sevens, 0, 4, 7, 3), 0, "ls2-7s-ok-1"); + CHECK(line_search_3(t_sevens, 5, 7, 4, 9), 5, "ls2-7s-ok-2"); + CHECK(line_search_3(t_sevens, 31, 0, 7, 4), 31, "ls2-7s-ok-3"); + CHECK(line_search_3(t_sevens, 0, 1, 4, 3), -1, "ls2-7s-fail-1"); + CHECK(line_search_3(t_sevens, 31, 4, 6, 1), -1, "ls2-7s-fail-2"); + + CHECK(line_search_3(t_mixed, 0, 4, 7, 9), 0, "ls2-m-ok-1"); + CHECK(line_search_3(t_mixed, 0, 9, 4, 1), 1, "ls2-m-ok-2"); + CHECK(line_search_3(t_mixed, 1, 7, 9, 4), 2, "ls2-m-ok-3"); + CHECK(line_search_3(t_mixed, 0, 8, 4, 9), 31, "ls2-m-ok-4"); + CHECK(line_search_3(t_mixed, 0, 8, 4, 6), -1, "ls2-m-fail-1"); + + CHECK(line_search_3(t_mixed, 16, 3, 1, 6), 20, "ls2-m-ok-5"); +} + + +int main() { + check_forward_search_2(); + check_forward_search_3(); + check_line_search(); + check_line_search_2(); + check_line_search_3(); + check_impl_specific(); + + if (num_errors > 0) { + printf("\n*** %d/%d tests failed.\n", num_errors, num_tests); + } else { + printf("All %d tests passed.\n", num_tests); + } + exit(num_errors < 255 ? num_errors : 255); +} diff --git a/cbits/common.c b/cbits/common.c new file mode 100644 --- /dev/null +++ b/cbits/common.c @@ -0,0 +1,83 @@ +#include "defs.h" + +#ifdef WIN32 +#include +#else +#include +#include +#endif + +#include + +void suicide(volatile int* check, int t) { + int secs = (3*t + 999999) / 1000000; + if (secs < 1) secs = 1; +#ifdef WIN32 + Sleep(secs * 1000); +#else + sleep(secs); +#endif + if (*check) { + printf("timeout expired, dying!!\n"); +#ifdef WIN32 + abort(); +#else + raise(SIGKILL); +#endif + } +} + +#if defined(__GNUC__) +#define PREFETCH_READ(x) (__builtin_prefetch(x, 0, 3)) +#define PREFETCH_WRITE(x) (__builtin_prefetch(x, 1, 3)) +#else +#define PREFETCH_READ(x) +#define PREFETCH_WRITE(x) +#endif + +void prefetch_cacheline_read(small_hash_t* line, int start) +{ + PREFETCH_READ((void*)(&line[start])); +} + +void prefetch_cacheline_write(small_hash_t* line, int start) +{ + PREFETCH_WRITE((void*)(&line[start])); +} + +int forward_search_2(small_hash_t* array, int start, int end, + small_hash_t x1, small_hash_t x2) { + small_hash_t* ep = array + end; + small_hash_t* p = array + start; + int wrapped = 0; + while (1) { + if (p >= ep) { + if (wrapped) return -1; + ep = array + start; + p = array; + wrapped = 1; + continue; + } + if (*p == x1 || *p == x2) return p - array; + ++p; + } +} + +int forward_search_3(small_hash_t* array, int start, int end, + small_hash_t x1, small_hash_t x2, small_hash_t x3) { + small_hash_t* ep = array + end; + small_hash_t* p = array + start; + int wrapped = 0; + while (1) { + if (p >= ep) { + if (wrapped) return -1; + ep = array + start; + p = array; + wrapped = 1; + continue; + } + if (*p == x1 || *p == x2 || *p == x3) return p - array; + ++p; + } +} + diff --git a/cbits/default.c b/cbits/default.c new file mode 100644 --- /dev/null +++ b/cbits/default.c @@ -0,0 +1,202 @@ +// Specialized i686 versions of the cache line search functions. + +#include "defs.h" + +inline int32_t mask(int32_t a, int32_t b) { return -(a == b); } + +#if defined(__GNUC__) +inline int32_t first_bit_set(int32_t a) { + return __builtin_ffs(a) - 1; +} +#else +static uint8_t de_bruijn_table[] = { + 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8, + 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9 +}; + +inline int32_t first_bit_set(int32_t a) { + int32_t zero_case = mask(0, a); + uint32_t x = (uint32_t) (a & -a); + x *= 0x077CB531; + x >>= 27; + return zero_case | de_bruijn_table[x]; +} +#endif + +inline uint32_t line_mask(small_hash_t* array, int start, small_hash_t x1) { + small_hash_t* p = array + start; + uint32_t m1 = 0; + uint32_t m2 = 0; + uint32_t m3 = 0; + int offset = start & 0x1f; + +#define M (mask(*p, x1)) + + switch (offset) { + case 0: m1 |= M & 0x1; ++p; + case 1: m2 |= M & 0x2; ++p; + case 2: m3 |= M & 0x4; ++p; + case 3: m1 |= M & 0x8; ++p; + case 4: m2 |= M & 0x10; ++p; + case 5: m3 |= M & 0x20; ++p; + case 6: m1 |= M & 0x40; ++p; + case 7: m2 |= M & 0x80; ++p; + case 8: m3 |= M & 0x100; ++p; + case 9: m1 |= M & 0x200; ++p; + case 10: m2 |= M & 0x400; ++p; + case 11: m3 |= M & 0x800; ++p; + case 12: m1 |= M & 0x1000; ++p; + case 13: m2 |= M & 0x2000; ++p; + case 14: m3 |= M & 0x4000; ++p; + case 15: m1 |= M & 0x8000; ++p; + case 16: m2 |= M & 0x10000; ++p; + case 17: m3 |= M & 0x20000; ++p; + case 18: m1 |= M & 0x40000; ++p; + case 19: m2 |= M & 0x80000; ++p; + case 20: m3 |= M & 0x100000; ++p; + case 21: m1 |= M & 0x200000; ++p; + case 22: m2 |= M & 0x400000; ++p; + case 23: m3 |= M & 0x800000; ++p; + case 24: m1 |= M & 0x1000000; ++p; + case 25: m2 |= M & 0x2000000; ++p; + case 26: m3 |= M & 0x4000000; ++p; + case 27: m1 |= M & 0x8000000; ++p; + case 28: m2 |= M & 0x10000000; ++p; + case 29: m3 |= M & 0x20000000; ++p; + case 30: m1 |= M & 0x40000000; ++p; + case 31: m2 |= M & 0x80000000; ++p; + } + +#undef M + + return (m1 | m2 | m3) >> offset; +} + +inline uint32_t line_mask_2(small_hash_t* array, int start, + small_hash_t x1, small_hash_t x2) { + small_hash_t* p = array + start; + uint32_t m1 = 0; + uint32_t m2 = 0; + uint32_t m3 = 0; + int offset = start & 0x1f; + +#define M (mask(*p, x1) | mask(*p, x2)) + + switch (offset) { + case 0: m1 |= M & 0x1; ++p; + case 1: m2 |= M & 0x2; ++p; + case 2: m3 |= M & 0x4; ++p; + case 3: m1 |= M & 0x8; ++p; + case 4: m2 |= M & 0x10; ++p; + case 5: m3 |= M & 0x20; ++p; + case 6: m1 |= M & 0x40; ++p; + case 7: m2 |= M & 0x80; ++p; + case 8: m3 |= M & 0x100; ++p; + case 9: m1 |= M & 0x200; ++p; + case 10: m2 |= M & 0x400; ++p; + case 11: m3 |= M & 0x800; ++p; + case 12: m1 |= M & 0x1000; ++p; + case 13: m2 |= M & 0x2000; ++p; + case 14: m3 |= M & 0x4000; ++p; + case 15: m1 |= M & 0x8000; ++p; + case 16: m2 |= M & 0x10000; ++p; + case 17: m3 |= M & 0x20000; ++p; + case 18: m1 |= M & 0x40000; ++p; + case 19: m2 |= M & 0x80000; ++p; + case 20: m3 |= M & 0x100000; ++p; + case 21: m1 |= M & 0x200000; ++p; + case 22: m2 |= M & 0x400000; ++p; + case 23: m3 |= M & 0x800000; ++p; + case 24: m1 |= M & 0x1000000; ++p; + case 25: m2 |= M & 0x2000000; ++p; + case 26: m3 |= M & 0x4000000; ++p; + case 27: m1 |= M & 0x8000000; ++p; + case 28: m2 |= M & 0x10000000; ++p; + case 29: m3 |= M & 0x20000000; ++p; + case 30: m1 |= M & 0x40000000; ++p; + case 31: m2 |= M & 0x80000000; ++p; + } + +#undef M + + return (m1 | m2 | m3) >> offset; +} + +inline uint32_t line_mask_3(small_hash_t* array, int start, + small_hash_t x1, small_hash_t x2, + small_hash_t x3) { + small_hash_t* p = array + start; + uint32_t m1 = 0; + uint32_t m2 = 0; + uint32_t m3 = 0; + int offset = start & 0x1f; + +#define M (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) + + switch (offset) { + case 0: m1 |= M & 0x1; ++p; + case 1: m2 |= M & 0x2; ++p; + case 2: m3 |= M & 0x4; ++p; + case 3: m1 |= M & 0x8; ++p; + case 4: m2 |= M & 0x10; ++p; + case 5: m3 |= M & 0x20; ++p; + case 6: m1 |= M & 0x40; ++p; + case 7: m2 |= M & 0x80; ++p; + case 8: m3 |= M & 0x100; ++p; + case 9: m1 |= M & 0x200; ++p; + case 10: m2 |= M & 0x400; ++p; + case 11: m3 |= M & 0x800; ++p; + case 12: m1 |= M & 0x1000; ++p; + case 13: m2 |= M & 0x2000; ++p; + case 14: m3 |= M & 0x4000; ++p; + case 15: m1 |= M & 0x8000; ++p; + case 16: m2 |= M & 0x10000; ++p; + case 17: m3 |= M & 0x20000; ++p; + case 18: m1 |= M & 0x40000; ++p; + case 19: m2 |= M & 0x80000; ++p; + case 20: m3 |= M & 0x100000; ++p; + case 21: m1 |= M & 0x200000; ++p; + case 22: m2 |= M & 0x400000; ++p; + case 23: m3 |= M & 0x800000; ++p; + case 24: m1 |= M & 0x1000000; ++p; + case 25: m2 |= M & 0x2000000; ++p; + case 26: m3 |= M & 0x4000000; ++p; + case 27: m1 |= M & 0x8000000; ++p; + case 28: m2 |= M & 0x10000000; ++p; + case 29: m3 |= M & 0x20000000; ++p; + case 30: m1 |= M & 0x40000000; ++p; + case 31: m2 |= M & 0x80000000; ++p; + } +#undef M + + return (m1 | m2 | m3) >> offset; +} + + +inline int32_t line_result(uint32_t m, int start) { + int32_t p = first_bit_set((int32_t) m); + int32_t mm = mask(p, -1); + return mm | (start + p); +} + + +int line_search(small_hash_t* array, int start, small_hash_t x1) { + uint32_t m = line_mask(array, start, x1); + return line_result(m, start); +} + +int line_search_2(small_hash_t* array, int start, small_hash_t x1, + small_hash_t x2) { + uint32_t m = line_mask_2(array, start, x1, x2); + return line_result(m, start); +} + +int line_search_3(small_hash_t* array, int start, small_hash_t x1, + small_hash_t x2, small_hash_t x3) { + uint32_t m = line_mask_3(array, start, x1, x2, x3); + return line_result(m, start); +} + +void check_impl_specific(int* num_tests, int* num_errors) { + +} diff --git a/cbits/defs.h b/cbits/defs.h new file mode 100644 --- /dev/null +++ b/cbits/defs.h @@ -0,0 +1,35 @@ +#ifndef HASHTABLES_DEFS_H +#define HASHTABLES_DEFS_H + +#include +#include + +typedef uintptr_t full_hash_t; +typedef uint16_t small_hash_t; + +void prefetch_cacheline_write(small_hash_t* line, int start); +void prefetch_cacheline_read(small_hash_t* line, int start); + +int forward_search_2(small_hash_t* array, + int start, + int end, + small_hash_t x1, + small_hash_t x2); +int forward_search_3(small_hash_t* array, + int start, + int end, + small_hash_t x1, + small_hash_t x2, + small_hash_t x3); + +int line_search(small_hash_t* array, int start, small_hash_t x1); +int line_search_2(small_hash_t* array, int start, small_hash_t x1, + small_hash_t x2); +int line_search_3(small_hash_t* array, int start, small_hash_t x1, + small_hash_t x2, small_hash_t x3); +void suicide(volatile int* check, int i); + +void CHECK(int actual, int expected, char* what); +void check_impl_specific(); + +#endif /* HASHTABLES_DEFS_H */ diff --git a/cbits/sse-42-check.c b/cbits/sse-42-check.c new file mode 100644 --- /dev/null +++ b/cbits/sse-42-check.c @@ -0,0 +1,38 @@ +#include "defs.h" + +#include +#include + +extern __m128i fill(small_hash_t v); + +static void check_fill(small_hash_t v) { + int i; + char buf[256]; + small_hash_t v2; + + __m128i x = fill(v); + +#define F(i) do { \ + v2 = _mm_extract_epi16(x, i); \ + sprintf(buf, "fill-%x-%d-of-8", (int) v, i+1); \ + CHECK(v2, v, buf); \ + } while(0); + + F(0); + F(1); + F(2); + F(3); + F(4); + F(5); + F(6); + F(7); +#undef F +} + +void check_impl_specific() { + check_fill(0); + check_fill((small_hash_t) (-1)); + check_fill((small_hash_t) (-5)); + check_fill(7); + check_fill(0xff); +} diff --git a/cbits/sse-42.c b/cbits/sse-42.c new file mode 100644 --- /dev/null +++ b/cbits/sse-42.c @@ -0,0 +1,172 @@ +#include "defs.h" + +#include +#include + +/* Straight-line branchless SSE 4.2 code for searching an array of uint16_t + hash codes. */ + +static inline int32_t mask(int32_t a, int32_t b) { return -(a == b); } + +#if defined(__GNUC__) +static inline int32_t first_bit_set(int32_t a) { + return __builtin_ffs(a) - 1; +} +#else +static uint8_t de_bruijn_table[] = { + 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8, + 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9 +}; + +static inline int32_t first_bit_set(int32_t a) { + int32_t zero_case = mask(0, a); + uint32_t x = (uint32_t) (a & -a); + x *= 0x077CB531; + x >>= 27; + return zero_case | de_bruijn_table[x]; +} +#endif + +inline __m128i fill(small_hash_t v) { + int32_t v1 = (((int)v) << 16) | v; + __m128i x = _mm_cvtsi32_si128(0); + x = _mm_insert_epi32(x, v1, 0); + return _mm_shuffle_epi32(x, _MM_SHUFFLE(0,0,0,0)); +} + +#ifndef SIDD_UWORD_OPS +#define SIDD_UWORD_OPS _SIDD_UWORD_OPS +#endif + +#ifndef SIDD_CMP_EQUAL_EACH +#define SIDD_CMP_EQUAL_EACH _SIDD_CMP_EQUAL_EACH +#endif + +#ifndef SIDD_BIT_MASK +#define SIDD_BIT_MASK _SIDD_BIT_MASK +#endif + +#define _MODE (SIDD_UWORD_OPS | SIDD_CMP_EQUAL_EACH) + +static inline __m128i cmp_mask(__m128i a, __m128i b) { + const int mode = SIDD_UWORD_OPS | SIDD_CMP_EQUAL_EACH | SIDD_BIT_MASK; + return _mm_cmpistrm(a, b, mode); +} + +static inline int32_t line_result(uint32_t m, int start) { + int32_t p = first_bit_set((int32_t) m); + int32_t mm = mask(p, -1); + return mm | (start + p); +} + +#define DUMP(xval) do { \ + uint16_t xval##_x0 = _mm_extract_epi16(xval, 0); \ + uint16_t xval##_x1 = _mm_extract_epi16(xval, 1); \ + uint16_t xval##_x2 = _mm_extract_epi16(xval, 2); \ + uint16_t xval##_x3 = _mm_extract_epi16(xval, 3); \ + uint16_t xval##_x4 = _mm_extract_epi16(xval, 4); \ + uint16_t xval##_x5 = _mm_extract_epi16(xval, 5); \ + uint16_t xval##_x6 = _mm_extract_epi16(xval, 6); \ + uint16_t xval##_x7 = _mm_extract_epi16(xval, 7); \ + printf(" % 10s: %04x-%04x-%04x-%04x-%04x-%04x-%04x-%04x\n", \ + #xval, xval##_x0, xval##_x1, xval##_x2, xval##_x3, \ + xval##_x4, xval##_x5, xval##_x6, xval##_x7); \ + } while(0); + + +int line_search(small_hash_t* array, int start0, small_hash_t v1) { + int offset = start0 & 31; + int start = start0 & ~31; + __m128i* p = (__m128i*) &array[start]; + __m128i x1, val1, val2, val3, val4; + __m128i m1, m2, m3, m4, dmask; + + x1 = fill(v1); + + val1 = *p++; + m1 = cmp_mask(x1, val1); + val2 = *p++; + m2 = _mm_slli_si128(cmp_mask(x1, val2), 1); + val3 = *p++; + m3 = _mm_slli_si128(cmp_mask(x1, val3), 2); + val4 = *p; + m4 = _mm_slli_si128(cmp_mask(x1, val4), 3); + + dmask = _mm_or_si128(_mm_or_si128(m1, m2), + _mm_or_si128(m3, m4)); + uint32_t imask = _mm_extract_epi32(dmask, 0); + + const uint32_t p2 = 1 << offset; + const uint32_t dest_mask = imask & ~(p2 - 1); + + return line_result(dest_mask, start); +} + +int line_search_2(small_hash_t* array, int start0, small_hash_t v1, + small_hash_t v2) { + int offset = start0 & 31; + int start = start0 & ~31; + __m128i* p = (__m128i*) &array[start]; + __m128i x1, x2, val1, val2, val3, val4; + __m128i m1, m2, m3, m4, dmask; + + x1 = fill(v1); + x2 = fill(v2); + +#define M(v) _mm_or_si128(cmp_mask(x1,(v)), \ + cmp_mask(x2,(v))) + val1 = *p++; + m1 = M(val1); + val2 = *p++; + m2 = _mm_slli_si128(M(val2), 1); + val3 = *p++; + m3 = _mm_slli_si128(M(val3), 2); + val4 = *p; + m4 = _mm_slli_si128(M(val4), 3); +#undef M + + dmask = _mm_or_si128(_mm_or_si128(m1, m2), + _mm_or_si128(m3, m4)); + uint32_t imask = _mm_extract_epi32(dmask, 0); + + const uint32_t p2 = 1 << offset; + const uint32_t dest_mask = imask & ~(p2 - 1); + + return line_result(dest_mask, start); +} + +int line_search_3(small_hash_t* array, int start0, small_hash_t v1, + small_hash_t v2, small_hash_t v3) { + int offset = start0 & 31; + int start = start0 & ~31; + __m128i* p = (__m128i*) &array[start]; + __m128i x1, x2, x3, val1, val2, val3, val4; + __m128i m1, m2, m3, m4, dmask; + + x1 = fill(v1); + x2 = fill(v2); + x3 = fill(v3); + +#define M(v) _mm_or_si128( \ + cmp_mask(x1,(v)), \ + _mm_or_si128(cmp_mask(x2,(v)), \ + cmp_mask(x3,(v)))) + val1 = *p++; + m1 = M(val1); + val2 = *p++; + m2 = _mm_slli_si128(M(val2), 1); + val3 = *p++; + m3 = _mm_slli_si128(M(val3), 2); + val4 = *p; + m4 = _mm_slli_si128(M(val4), 3); +#undef M + + dmask = _mm_or_si128(_mm_or_si128(m1, m2), + _mm_or_si128(m3, m4)); + uint32_t imask = _mm_extract_epi32(dmask, 0); + + const uint32_t p2 = 1 << offset; + const uint32_t dest_mask = imask & ~(p2 - 1); + + return line_result(dest_mask, start); +} diff --git a/hashtables.cabal b/hashtables.cabal --- a/hashtables.cabal +++ b/hashtables.cabal @@ -1,12 +1,12 @@ Name: hashtables -Version: 1.1.2.1 +Version: 1.2.0.0 Synopsis: Mutable hash tables in the ST monad Homepage: http://github.com/gregorycollins/hashtables License: BSD3 License-file: LICENSE Author: Gregory Collins Maintainer: greg@gregorycollins.net -Copyright: (c) 2011-2013, Google, Inc. +Copyright: (c) 2011-2014, Google, Inc. Category: Data Build-type: Simple Cabal-version: >= 1.8 @@ -22,18 +22,11 @@ . This package currently contains three hash table implementations: . - 1. "Data.HashTable.ST.Basic" contains a basic open-addressing hash table - using linear probing as the collision strategy. On a pure speed basis it - should currently be the fastest available Haskell hash table - implementation for lookups, although it has a higher memory overhead - than the other tables and can suffer from long delays when the table is - resized because all of the elements in the table need to be rehashed. - . - 2. "Data.HashTable.ST.Cuckoo" contains an implementation of \"cuckoo + 1. "Data.HashTable.ST.Cuckoo" contains an implementation of \"cuckoo hashing\" as introduced by Pagh and Rodler in 2001 (see ). Cuckoo hashing has worst-case /O(1)/ lookups and can reach a high \"load factor\", in which - the table can perform acceptably well even when more than 90% full. + the table can perform acceptably well even when approaching 90% full. Randomized testing shows this implementation of cuckoo hashing to be slightly faster on insert and slightly slower on lookup than "Data.Hashtable.ST.Basic", while being more space efficient by about a @@ -41,6 +34,13 @@ table implementation using linear probing, can suffer from long delays when the table is resized. . + 2. "Data.HashTable.ST.Basic" contains a basic open-addressing hash table + using linear probing as the collision strategy. On a pure speed basis it + should currently be the fastest available Haskell hash table + implementation for lookups, although it has a higher memory overhead + than the other tables and can suffer from long delays when the table is + resized because all of the elements in the table need to be rehashed. + . 3. "Data.HashTable.ST.Linear" contains a linear hash table (see ), which trades some insert and lookup performance for higher space efficiency and much shorter @@ -76,7 +76,7 @@ dangerous. Caveat emptor. In particular, these techniques are incompatible with HPC code coverage reports. . - * @sse41@, default /OFF/. If this flag is enabled, we use some SSE 4.1 + * @sse42@, default /OFF/. If this flag is enabled, we use some SSE 4.2 instructions (see , first available on Intel Core 2 processors) to speed up cache-line searches for cuckoo hashing. @@ -89,7 +89,7 @@ . * @portable@, default /OFF/. If this flag is enabled, we use only pure Haskell code and try not to use unportable GHC extensions. Turning this - flag on forces @unsafe-tricks@ and @sse41@ /OFF/. + flag on forces @unsafe-tricks@ and @sse42@ /OFF/. . This package has been tested with GHC 7.0.3, on: . @@ -118,6 +118,10 @@ benchmark/src/Data/Vector/Algorithms/Shuffle.hs, benchmark/src/Data/Benchmarks/UnorderedCollections/Distributions.hs, benchmark/src/Data/Benchmarks/UnorderedCollections/Types.hs, + cbits/Makefile, + cbits/check.c, + cbits/defs.h, + cbits/sse-42-check.c, test/compute-overhead/ComputeOverhead.hs, test/hashtables-test.cabal, test/runTestsAndCoverage.sh, @@ -139,8 +143,8 @@ Description: if on, spew debugging output to stdout Default: False -Flag sse41 - Description: if on, use SSE 4.1 extensions to search cache lines very +Flag sse42 + Description: if on, use SSE 4.2 extensions to search cache lines very efficiently. The portable flag forces this off. Default: False @@ -152,8 +156,16 @@ Library hs-source-dirs: src + if flag(sse42) && !flag(portable) + cc-options: -DUSE_SSE_4_2 -msse4.2 + cpp-options: -DUSE_SSE_4_2 + C-sources: cbits/sse-42.c + + if !flag(portable) && !flag(sse42) + C-sources: cbits/default.c + if !flag(portable) - C-sources: cbits/cfuncs.c + C-sources: cbits/common.c Exposed-modules: Data.HashTable.Class, Data.HashTable.IO, @@ -179,7 +191,7 @@ if !flag(portable) && flag(unsafe-tricks) && impl(ghc) build-depends: ghc-prim - cpp-options = -DUNSAFETRICKS + cpp-options: -DUNSAFETRICKS if flag(debug) cpp-options: -DDEBUG @@ -187,10 +199,6 @@ if flag(bounds-checking) cpp-options: -DBOUNDS_CHECKING - if flag(sse41) && !flag(portable) - cc-options: -DUSE_SSE_4_1 -msse4.1 - cpp-options: -DUSE_SSE_4_1 - ghc-prof-options: -prof -auto-all if impl(ghc >= 6.12.0) @@ -198,4 +206,3 @@ -fno-warn-unused-do-bind else ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 - diff --git a/src/Data/HashTable/IO.hs b/src/Data/HashTable/IO.hs --- a/src/Data/HashTable/IO.hs +++ b/src/Data/HashTable/IO.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE ExplicitForAll #-} -- | This module provides wrappers in 'IO' around the functions from -- "Data.HashTable.Class". @@ -61,7 +62,7 @@ import Control.Monad.ST (stToIO) import Control.Monad.ST.Unsafe (unsafeIOToST) #else -import Control.Monad.ST (stToIO, unsafeIOToST) +import Control.Monad.ST (stToIO, unsafeIOToST) #endif import Data.Hashable (Hashable) import qualified Data.HashTable.Class as C @@ -113,7 +114,7 @@ ------------------------------------------------------------------------------ --- | See the documentation for this function in "Data.HashTable.Class#v:update". +-- | See the documentation for this function in "Data.HashTable.Class#v:insert". insert :: (C.HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> v -> IO () insert h k v = stToIO $ C.insert h k v diff --git a/src/Data/HashTable/Internal/CacheLine.hs b/src/Data/HashTable/Internal/CacheLine.hs --- a/src/Data/HashTable/Internal/CacheLine.hs +++ b/src/Data/HashTable/Internal/CacheLine.hs @@ -19,847 +19,809 @@ , maskw# ) where -#if MIN_VERSION_base(4,4,0) -import Control.Monad.ST (ST) -import Control.Monad.ST.Unsafe -#else -import Control.Monad.ST -#endif - -import Data.HashTable.Internal.IntArray (IntArray) -import qualified Data.HashTable.Internal.IntArray as M - -#ifndef NO_C_SEARCH -import Control.Monad -import Foreign.C.Types -#else -import Data.Bits -import Data.Int -import qualified Data.Vector.Unboxed as U -import GHC.Int -#endif - -import Data.HashTable.Internal.Utils -import GHC.Exts - -#if __GLASGOW_HASKELL__ >= 707 -import GHC.Exts (isTrue#) -#else -isTrue# :: Bool -> Bool -isTrue# = id -#endif - - -{-# INLINE prefetchRead #-} -{-# INLINE prefetchWrite #-} -prefetchRead :: IntArray s -> Int -> ST s () -prefetchWrite :: IntArray s -> Int -> ST s () - -#ifndef NO_C_SEARCH -foreign import ccall unsafe "lineSearch32" - c_lineSearch32 :: Ptr a -> CInt -> CUInt -> IO CInt - -foreign import ccall unsafe "lineSearch64" - c_lineSearch64 :: Ptr a -> CInt -> CULong -> IO CInt - -foreign import ccall unsafe "lineSearch32_2" - c_lineSearch32_2 :: Ptr a -> CInt -> CUInt -> CUInt -> IO CInt - -foreign import ccall unsafe "lineSearch64_2" - c_lineSearch64_2 :: Ptr a -> CInt -> CULong -> CULong -> IO CInt - -foreign import ccall unsafe "lineSearch32_3" - c_lineSearch32_3 :: Ptr a -> CInt -> CUInt -> CUInt -> CUInt -> IO CInt - -foreign import ccall unsafe "lineSearch64_3" - c_lineSearch64_3 :: Ptr a -> CInt -> CULong -> CULong -> CULong -> IO CInt - -foreign import ccall unsafe "forwardSearch32_2" - c_forwardSearch32_2 :: Ptr a -> CInt -> CInt -> CUInt -> CUInt -> IO CInt - -foreign import ccall unsafe "forwardSearch32_3" - c_forwardSearch32_3 :: Ptr a -> CInt -> CInt -> CUInt -> CUInt -> CUInt - -> IO CInt - -foreign import ccall unsafe "forwardSearch64_2" - c_forwardSearch64_2 :: Ptr a -> CInt -> CInt -> CULong -> CULong -> IO CInt - -foreign import ccall unsafe "forwardSearch64_3" - c_forwardSearch64_3 :: Ptr a -> CInt -> CInt -> CULong -> CULong -> CULong - -> IO CInt - -foreign import ccall unsafe "prefetchCacheLine32_read" - prefetchCacheLine32_read :: Ptr a -> CInt -> IO () - -foreign import ccall unsafe "prefetchCacheLine64_read" - prefetchCacheLine64_read :: Ptr a -> CInt -> IO () - -foreign import ccall unsafe "prefetchCacheLine32_write" - prefetchCacheLine32_write :: Ptr a -> CInt -> IO () - -foreign import ccall unsafe "prefetchCacheLine64_write" - prefetchCacheLine64_write :: Ptr a -> CInt -> IO () - - -fI :: (Num b, Integral a) => a -> b -fI = fromIntegral - - -prefetchRead a i = unsafeIOToST c - where - v = M.toPtr a - x = fI i - c32 = prefetchCacheLine32_read v x - c64 = prefetchCacheLine64_read v x - c = if wordSize == 32 then c32 else c64 - - -prefetchWrite a i = unsafeIOToST c - where - v = M.toPtr a - x = fI i - c32 = prefetchCacheLine32_write v x - c64 = prefetchCacheLine64_write v x - c = if wordSize == 32 then c32 else c64 - - -{-# INLINE forwardSearch2 #-} -forwardSearch2 :: IntArray s -> Int -> Int -> Int -> Int -> ST s Int -forwardSearch2 !vec !start !end !x1 !x2 = - liftM fromEnum $! unsafeIOToST c - where - c32 = c_forwardSearch32_2 (M.toPtr vec) (fI start) (fI end) (fI x1) (fI x2) - c64 = c_forwardSearch64_2 (M.toPtr vec) (fI start) (fI end) (fI x1) (fI x2) - c = if wordSize == 32 then c32 else c64 - - -{-# INLINE forwardSearch3 #-} -forwardSearch3 :: IntArray s -> Int -> Int -> Int -> Int -> Int -> ST s Int -forwardSearch3 !vec !start !end !x1 !x2 !x3 = - liftM fromEnum $! unsafeIOToST c - where - c32 = c_forwardSearch32_3 (M.toPtr vec) (fI start) (fI end) - (fI x1) (fI x2) (fI x3) - c64 = c_forwardSearch64_3 (M.toPtr vec) (fI start) (fI end) - (fI x1) (fI x2) (fI x3) - c = if wordSize == 32 then c32 else c64 - - -{-# INLINE lineSearch #-} -lineSearch :: IntArray s -> Int -> Int -> ST s Int -lineSearch !vec !start !value = - liftM fromEnum $! unsafeIOToST c - where - c32 = c_lineSearch32 (M.toPtr vec) (fI start) (fI value) - c64 = c_lineSearch64 (M.toPtr vec) (fI start) (fI value) - c = if wordSize == 32 then c32 else c64 - -{-# INLINE lineSearch2 #-} -lineSearch2 :: IntArray s -> Int -> Int -> Int -> ST s Int -lineSearch2 !vec !start !x1 !x2 = - liftM fromEnum $! unsafeIOToST c - where - c32 = c_lineSearch32_2 (M.toPtr vec) (fI start) (fI x1) (fI x2) - c64 = c_lineSearch64_2 (M.toPtr vec) (fI start) (fI x1) (fI x2) - c = if wordSize == 32 then c32 else c64 - -{-# INLINE lineSearch3 #-} -lineSearch3 :: IntArray s -> Int -> Int -> Int -> Int -> ST s Int -lineSearch3 !vec !start !x1 !x2 !x3 = - liftM fromEnum $! unsafeIOToST c - where - c32 = c_lineSearch32_3 (M.toPtr vec) (fI start) (fI x1) (fI x2) (fI x3) - c64 = c_lineSearch64_3 (M.toPtr vec) (fI start) (fI x1) (fI x2) (fI x3) - c = if wordSize == 32 then c32 else c64 -#endif - -{-# INLINE advanceByCacheLineSize #-} -advanceByCacheLineSize :: Int -> Int -> Int -advanceByCacheLineSize !(I# start0#) !(I# vecSize#) = out - where - !(I# clm#) = cacheLineIntMask - !clmm# = not# (int2Word# clm#) - !start# = word2Int# (clmm# `and#` int2Word# start0#) - !(I# nw#) = numWordsInCacheLine - !start'# = start# +# nw# - !s# = sign# (vecSize# -# start'# -# 1#) - !m# = not# (int2Word# s#) - !r# = int2Word# start'# `and#` m# - !out = I# (word2Int# r#) - - -{-# INLINE isCacheLineAligned #-} -isCacheLineAligned :: Int -> Bool -isCacheLineAligned (I# x#) = isTrue# (r# ==# 0#) - where - !(I# m#) = cacheLineIntMask - !mw# = int2Word# m# - !w# = int2Word# x# - !r# = word2Int# (mw# `and#` w#) - - -{-# INLINE sign# #-} --- | Returns 0 if x is positive, -1 otherwise -sign# :: Int# -> Int# -sign# !x# = x# `uncheckedIShiftRA#` wordSizeMinus1# - where - !(I# wordSizeMinus1#) = wordSize-1 - - -{-# INLINE bl_abs# #-} --- | Abs of an integer, branchless -bl_abs# :: Int# -> Int# -bl_abs# !x# = word2Int# r# - where - !m# = sign# x# - !r# = (int2Word# (m# +# x#)) `xor#` int2Word# m# - - -{-# INLINE mask# #-} --- | Returns 0xfff..fff (aka -1) if a# == b#, 0 otherwise. -mask# :: Int# -> Int# -> Int# -mask# !a# !b# = dest# - where - !d# = a# -# b# - !r# = bl_abs# d# -# 1# - !dest# = sign# r# - - -{- note: this code should be: - -mask# :: Int# -> Int# -> Int# -mask# !a# !b# = let !(I# z#) = fromEnum (a# ==# b#) - !q# = negateInt# z# - in q# - -but GHC doesn't properly optimize this as straight-line code at the moment. - --} - - -{-# INLINE maskw# #-} -maskw# :: Int# -> Int# -> Word# -maskw# !a# !b# = int2Word# (mask# a# b#) - - -#ifdef NO_C_SEARCH -prefetchRead _ _ = return () -prefetchWrite _ _ = return () - -{-# INLINE forwardSearch2 #-} -forwardSearch2 :: IntArray s -> Int -> Int -> Int -> Int -> ST s Int -forwardSearch2 !vec !start !end !x1 !x2 = go start end False - where - next !i !e !b = let !j = i+1 - in if j == e - then (if b then (-1,e,True) else (0,start,True)) - else (j,e,b) - - go !i !e !b = do - h <- M.readArray vec i - if h == x1 || h == x2 - then return i - else do - let (!i',!e',!b') = next i e b - if (i' < 0) then return (-1) else go i' e' b' - - -{-# INLINE forwardSearch3 #-} -forwardSearch3 :: IntArray s -> Int -> Int -> Int -> Int -> Int -> ST s Int -forwardSearch3 !vec !start !end !x1 !x2 !x3 = go start end False - where - next !i !e !b = let !j = i+1 - in if j == e - then (if b then (-1,e,True) else (0,start,True)) - else (j,e,b) - - go !i !e !b = do - h <- M.readArray vec i - if h == x1 || h == x2 || h == x3 - then return i - else do - let (!i',!e',!b') = next i e b - if (i' < 0) then return (-1) else go i' e' b' - - -deBruijnBitPositions :: U.Vector Int8 -deBruijnBitPositions = - U.fromList [ - 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8, - 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9 - ] - - -{-# INLINE firstBitSet# #-} --- only works with 32-bit values -- ok for us here -firstBitSet# :: Int# -> Int# -firstBitSet# i# = word2Int# ((or# zeroCase# posw#)) - where - !zeroCase# = int2Word# (mask# 0# i#) - !w# = int2Word# i# - !iLowest# = word2Int# (and# w# (int2Word# (negateInt# i#))) - !idxW# = uncheckedShiftRL# - (narrow32Word# (timesWord# (int2Word# iLowest#) - (int2Word# 0x077CB531#))) - 27# - !idx = I# (word2Int# idxW#) - !(I8# pos8#) = U.unsafeIndex deBruijnBitPositions idx - !posw# = int2Word# pos8# - -#endif - - ------------------------------------------------------------------------------- --- | Search through a mutable vector for a given int value, cache-line aligned. --- If the start index is cache-line aligned, and there is more than a --- cache-line's room between the start index and the end of the vector, we will --- search the cache-line all at once using an efficient branchless --- bit-twiddling technique. Otherwise, we will use a typical loop. --- -cacheLineSearch :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ value to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -cacheLineSearch !vec !start !value = do -#ifdef NO_C_SEARCH - let !vlen = M.length vec - let !st1 = vlen - start - let !nvlen = numWordsInCacheLine - st1 - let adv = (start + cacheLineIntMask) .&. complement cacheLineIntMask - let st2 = adv - start - - - if nvlen > 0 || not (isCacheLineAligned start) - then naiveSearch vec start (min st1 st2) value - else lineSearch vec start value -#else - lineSearch vec start value -#endif -{-# INLINE cacheLineSearch #-} - - -#ifdef NO_C_SEARCH --- | Search through a mutable vector for a given int value. The number of --- things to search for must be at most the number of things remaining in the --- vector. -naiveSearch :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ number of things to search - -> Int -- ^ value to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -naiveSearch !vec !start !nThings !value = go start - where - !doneIdx = start + nThings - - go !i | i >= doneIdx = return (-1) - | otherwise = do - x <- M.readArray vec i - if x == value then return i else go (i+1) -{-# INLINE naiveSearch #-} - - -lineResult# :: Word# -- ^ mask - -> Int -- ^ start value - -> Int -lineResult# bitmask# (I# start#) = I# (word2Int# rv#) - where - !p# = firstBitSet# (word2Int# bitmask#) - !mm# = maskw# p# (-1#) - !nmm# = not# mm# - !rv# = mm# `or#` (nmm# `and#` (int2Word# (start# +# p#))) -{-# INLINE lineResult# #-} - - -lineSearch :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ value to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -lineSearch | wordSize == 32 = lineSearch32 - | otherwise = lineSearch64 -{-# INLINE lineSearch #-} - - -lineSearch64 :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ value to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -lineSearch64 !vec !start !(I# v#) = do - (I# x1#) <- M.readArray vec $! start + 0 - let !p1# = maskw# x1# v# `and#` int2Word# 0x1# - - (I# x2#) <- M.readArray vec $! start + 1 - let !p2# = p1# `or#` (maskw# x2# v# `and#` int2Word# 0x2#) - - (I# x3#) <- M.readArray vec $! start + 2 - let !p3# = p2# `or#` (maskw# x3# v# `and#` int2Word# 0x4#) - - (I# x4#) <- M.readArray vec $! start + 3 - let !p4# = p3# `or#` (maskw# x4# v# `and#` int2Word# 0x8#) - - (I# x5#) <- M.readArray vec $! start + 4 - let !p5# = p4# `or#` (maskw# x5# v# `and#` int2Word# 0x10#) - - (I# x6#) <- M.readArray vec $! start + 5 - let !p6# = p5# `or#` (maskw# x6# v# `and#` int2Word# 0x20#) - - (I# x7#) <- M.readArray vec $! start + 6 - let !p7# = p6# `or#` (maskw# x7# v# `and#` int2Word# 0x40#) - - (I# x8#) <- M.readArray vec $! start + 7 - let !p8# = p7# `or#` (maskw# x8# v# `and#` int2Word# 0x80#) - - return $! lineResult# p8# start -{-# INLINE lineSearch64 #-} - - - -lineSearch32 :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ value to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -lineSearch32 !vec !start !(I# v#) = do - (I# x1#) <- M.readArray vec $! start + 0 - let !p1# = maskw# x1# v# `and#` int2Word# 0x1# - - (I# x2#) <- M.readArray vec $! start + 1 - let !p2# = p1# `or#` (maskw# x2# v# `and#` int2Word# 0x2#) - - (I# x3#) <- M.readArray vec $! start + 2 - let !p3# = p2# `or#` (maskw# x3# v# `and#` int2Word# 0x4#) - - (I# x4#) <- M.readArray vec $! start + 3 - let !p4# = p3# `or#` (maskw# x4# v# `and#` int2Word# 0x8#) - - (I# x5#) <- M.readArray vec $! start + 4 - let !p5# = p4# `or#` (maskw# x5# v# `and#` int2Word# 0x10#) - - (I# x6#) <- M.readArray vec $! start + 5 - let !p6# = p5# `or#` (maskw# x6# v# `and#` int2Word# 0x20#) - - (I# x7#) <- M.readArray vec $! start + 6 - let !p7# = p6# `or#` (maskw# x7# v# `and#` int2Word# 0x40#) - - (I# x8#) <- M.readArray vec $! start + 7 - let !p8# = p7# `or#` (maskw# x8# v# `and#` int2Word# 0x80#) - - (I# x9#) <- M.readArray vec $! start + 8 - let !p9# = p8# `or#` (maskw# x9# v# `and#` int2Word# 0x100#) - - (I# x10#) <- M.readArray vec $! start + 9 - let !p10# = p9# `or#` (maskw# x10# v# `and#` int2Word# 0x200#) - - (I# x11#) <- M.readArray vec $! start + 10 - let !p11# = p10# `or#` (maskw# x11# v# `and#` int2Word# 0x400#) - - (I# x12#) <- M.readArray vec $! start + 11 - let !p12# = p11# `or#` (maskw# x12# v# `and#` int2Word# 0x800#) - - (I# x13#) <- M.readArray vec $! start + 12 - let !p13# = p12# `or#` (maskw# x13# v# `and#` int2Word# 0x1000#) - - (I# x14#) <- M.readArray vec $! start + 13 - let !p14# = p13# `or#` (maskw# x14# v# `and#` int2Word# 0x2000#) - - (I# x15#) <- M.readArray vec $! start + 14 - let !p15# = p14# `or#` (maskw# x15# v# `and#` int2Word# 0x4000#) - - (I# x16#) <- M.readArray vec $! start + 15 - let !p16# = p15# `or#` (maskw# x16# v# `and#` int2Word# 0x8000#) - - return $! lineResult# p16# start -{-# INLINE lineSearch32 #-} - -#endif - ------------------------------------------------------------------------------- --- | Search through a mutable vector for one of two given int values, --- cache-line aligned. If the start index is cache-line aligned, and there is --- more than a cache-line's room between the start index and the end of the --- vector, we will search the cache-line all at once using an efficient --- branchless bit-twiddling technique. Otherwise, we will use a typical loop. --- -cacheLineSearch2 :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ value to search for - -> Int -- ^ value 2 to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -cacheLineSearch2 !vec !start !value !value2 = do -#ifdef NO_C_SEARCH - let !vlen = M.length vec - let !st1 = vlen - start - let !nvlen = numWordsInCacheLine - st1 - let adv = (start + cacheLineIntMask) .&. complement cacheLineIntMask - let st2 = adv - start - - if nvlen > 0 || not (isCacheLineAligned start) - then naiveSearch2 vec start (min st1 st2) value value2 - else lineSearch2 vec start value value2 -#else - lineSearch2 vec start value value2 -#endif -{-# INLINE cacheLineSearch2 #-} - - -#ifdef NO_C_SEARCH - -naiveSearch2 :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ number of things to search - -> Int -- ^ value to search for - -> Int -- ^ value 2 to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -naiveSearch2 !vec !start !nThings !value1 !value2 = go start - where - !doneIdx = start + nThings - - go !i | i >= doneIdx = return (-1) - | otherwise = do - x <- M.readArray vec i - if x == value1 || x == value2 then return i else go (i+1) -{-# INLINE naiveSearch2 #-} - - -lineSearch2 :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ value to search for - -> Int -- ^ value 2 to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -lineSearch2 | wordSize == 32 = lineSearch32_2 - | otherwise = lineSearch64_2 - - - -lineSearch64_2 :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ value to search for - -> Int -- ^ value 2 to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -lineSearch64_2 !vec !start !(I# v#) !(I# v2#) = do - (I# x1#) <- M.readArray vec $! start + 0 - let !p1# = (maskw# x1# v# `or#` maskw# x1# v2#) `and#` int2Word# 0x1# - - (I# x2#) <- M.readArray vec $! start + 1 - let !p2# = p1# `or#` ((maskw# x2# v# `or#` maskw# x2# v2#) - `and#` int2Word# 0x2#) - - (I# x3#) <- M.readArray vec $! start + 2 - let !p3# = p2# `or#` ((maskw# x3# v# `or#` maskw# x3# v2#) - `and#` int2Word# 0x4#) - - (I# x4#) <- M.readArray vec $! start + 3 - let !p4# = p3# `or#` ((maskw# x4# v# `or#` maskw# x4# v2#) - `and#` int2Word# 0x8#) - - (I# x5#) <- M.readArray vec $! start + 4 - let !p5# = p4# `or#` ((maskw# x5# v# `or#` maskw# x5# v2#) - `and#` int2Word# 0x10#) - - (I# x6#) <- M.readArray vec $! start + 5 - let !p6# = p5# `or#` ((maskw# x6# v# `or#` maskw# x6# v2#) - `and#` int2Word# 0x20#) - - (I# x7#) <- M.readArray vec $! start + 6 - let !p7# = p6# `or#` ((maskw# x7# v# `or#` maskw# x7# v2#) - `and#` int2Word# 0x40#) - - (I# x8#) <- M.readArray vec $! start + 7 - let !p8# = p7# `or#` ((maskw# x8# v# `or#` maskw# x8# v2#) - `and#` int2Word# 0x80#) - - return $! lineResult# p8# start -{-# INLINE lineSearch64_2 #-} - - -lineSearch32_2 :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ value to search for - -> Int -- ^ value 2 to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -lineSearch32_2 !vec !start !(I# v#) !(I# v2#) = do - (I# x1#) <- M.readArray vec $! start + 0 - let !p1# = (maskw# x1# v# `or#` maskw# x1# v2#) `and#` int2Word# 0x1# - - (I# x2#) <- M.readArray vec $! start + 1 - let !p2# = p1# `or#` ((maskw# x2# v# `or#` maskw# x2# v2#) - `and#` int2Word# 0x2#) - - (I# x3#) <- M.readArray vec $! start + 2 - let !p3# = p2# `or#` ((maskw# x3# v# `or#` maskw# x3# v2#) - `and#` int2Word# 0x4#) - - (I# x4#) <- M.readArray vec $! start + 3 - let !p4# = p3# `or#` ((maskw# x4# v# `or#` maskw# x4# v2#) - `and#` int2Word# 0x8#) - - (I# x5#) <- M.readArray vec $! start + 4 - let !p5# = p4# `or#` ((maskw# x5# v# `or#` maskw# x5# v2#) - `and#` int2Word# 0x10#) - - (I# x6#) <- M.readArray vec $! start + 5 - let !p6# = p5# `or#` ((maskw# x6# v# `or#` maskw# x6# v2#) - `and#` int2Word# 0x20#) - - (I# x7#) <- M.readArray vec $! start + 6 - let !p7# = p6# `or#` ((maskw# x7# v# `or#` maskw# x7# v2#) - `and#` int2Word# 0x40#) - - (I# x8#) <- M.readArray vec $! start + 7 - let !p8# = p7# `or#` ((maskw# x8# v# `or#` maskw# x8# v2#) - `and#` int2Word# 0x80#) - - (I# x9#) <- M.readArray vec $! start + 8 - let !p9# = p8# `or#` ((maskw# x9# v# `or#` maskw# x9# v2#) - `and#` int2Word# 0x100#) - - (I# x10#) <- M.readArray vec $! start + 9 - let !p10# = p9# `or#` ((maskw# x10# v# `or#` maskw# x10# v2#) - `and#` int2Word# 0x200#) - - (I# x11#) <- M.readArray vec $! start + 10 - let !p11# = p10# `or#` ((maskw# x11# v# `or#` maskw# x11# v2#) - `and#` int2Word# 0x400#) - - (I# x12#) <- M.readArray vec $! start + 11 - let !p12# = p11# `or#` ((maskw# x12# v# `or#` maskw# x12# v2#) - `and#` int2Word# 0x800#) - - (I# x13#) <- M.readArray vec $! start + 12 - let !p13# = p12# `or#` ((maskw# x13# v# `or#` maskw# x13# v2#) - `and#` int2Word# 0x1000#) - - (I# x14#) <- M.readArray vec $! start + 13 - let !p14# = p13# `or#` ((maskw# x14# v# `or#` maskw# x14# v2#) - `and#` int2Word# 0x2000#) - - (I# x15#) <- M.readArray vec $! start + 14 - let !p15# = p14# `or#` ((maskw# x15# v# `or#` maskw# x15# v2#) - `and#` int2Word# 0x4000#) - - (I# x16#) <- M.readArray vec $! start + 15 - let !p16# = p15# `or#` ((maskw# x16# v# `or#` maskw# x16# v2#) - `and#` int2Word# 0x8000#) - - return $! lineResult# p16# start -{-# INLINE lineSearch32_2 #-} - -#endif - - ------------------------------------------------------------------------------- --- | Search through a mutable vector for one of three given int values, --- cache-line aligned. If the start index is cache-line aligned, and there is --- more than a cache-line's room between the start index and the end of the --- vector, we will search the cache-line all at once using an efficient --- branchless bit-twiddling technique. Otherwise, we will use a typical loop. --- -cacheLineSearch3 :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ value to search for - -> Int -- ^ value 2 to search for - -> Int -- ^ value 3 to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -cacheLineSearch3 !vec !start !value !value2 !value3 = do -#ifdef NO_C_SEARCH - let !vlen = M.length vec - let !st1 = vlen - start - let !nvlen = numWordsInCacheLine - st1 - let adv = (start + cacheLineIntMask) .&. complement cacheLineIntMask - let st2 = adv - start - - if nvlen > 0 || not (isCacheLineAligned start) - then naiveSearch3 vec start (min st1 st2) value value2 value3 - else lineSearch3 vec start value value2 value3 -#else - lineSearch3 vec start value value2 value3 -#endif -{-# INLINE cacheLineSearch3 #-} - - -#ifdef NO_C_SEARCH - -naiveSearch3 :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ number of things to search - -> Int -- ^ value to search for - -> Int -- ^ value 2 to search for - -> Int -- ^ value 3 to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -naiveSearch3 !vec !start !nThings !value1 !value2 !value3 = go start - where - !doneIdx = start + nThings - - go !i | i >= doneIdx = return (-1) - | otherwise = do - x <- M.readArray vec i - if x == value1 || x == value2 || x == value3 - then return i - else go (i+1) -{-# INLINE naiveSearch3 #-} - - -lineSearch3 :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ value to search for - -> Int -- ^ value 2 to search for - -> Int -- ^ value 3 to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -lineSearch3 | wordSize == 32 = lineSearch32_3 - | otherwise = lineSearch64_3 - - - -lineSearch64_3 :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ value to search for - -> Int -- ^ value 2 to search for - -> Int -- ^ value 3 to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -lineSearch64_3 !vec !start !(I# v#) !(I# v2#) !(I# v3#) = do - (I# x1#) <- M.readArray vec $! start + 0 - let !p1# = (maskw# x1# v# `or#` maskw# x1# v2# `or#` maskw# x1# v3#) - `and#` int2Word# 0x1# - - (I# x2#) <- M.readArray vec $! start + 1 - let !p2# = p1# `or#` - ((maskw# x2# v# `or#` maskw# x2# v2# `or#` maskw# x2# v3#) - `and#` int2Word# 0x2#) - - (I# x3#) <- M.readArray vec $! start + 2 - let !p3# = p2# `or#` - ((maskw# x3# v# `or#` maskw# x3# v2# `or#` maskw# x3# v3#) - `and#` int2Word# 0x4#) - - (I# x4#) <- M.readArray vec $! start + 3 - let !p4# = p3# `or#` - ((maskw# x4# v# `or#` maskw# x4# v2# `or#` maskw# x4# v3#) - `and#` int2Word# 0x8#) - - (I# x5#) <- M.readArray vec $! start + 4 - let !p5# = p4# `or#` - ((maskw# x5# v# `or#` maskw# x5# v2# `or#` maskw# x5# v3#) - `and#` int2Word# 0x10#) - - (I# x6#) <- M.readArray vec $! start + 5 - let !p6# = p5# `or#` - ((maskw# x6# v# `or#` maskw# x6# v2# `or#` maskw# x6# v3#) - `and#` int2Word# 0x20#) - - (I# x7#) <- M.readArray vec $! start + 6 - let !p7# = p6# `or#` - ((maskw# x7# v# `or#` maskw# x7# v2# `or#` maskw# x7# v3#) - `and#` int2Word# 0x40#) - - (I# x8#) <- M.readArray vec $! start + 7 - let !p8# = p7# `or#` - ((maskw# x8# v# `or#` maskw# x8# v2# `or#` maskw# x8# v3#) - `and#` int2Word# 0x80#) - - return $! lineResult# p8# start -{-# INLINE lineSearch64_3 #-} - - -lineSearch32_3 :: IntArray s -- ^ vector to search - -> Int -- ^ start index - -> Int -- ^ value to search for - -> Int -- ^ value 2 to search for - -> Int -- ^ value 3 to search for - -> ST s Int -- ^ dest index where it can be found, or - -- \"-1\" if not found -lineSearch32_3 !vec !start !(I# v#) !(I# v2#) !(I# v3#) = do - (I# x1#) <- M.readArray vec $! start + 0 - let !p1# = (maskw# x1# v# `or#` maskw# x1# v2# `or#` maskw# x1# v3#) - `and#` int2Word# 0x1# - - (I# x2#) <- M.readArray vec $! start + 1 - let !p2# = p1# `or#` - ((maskw# x2# v# `or#` maskw# x2# v2# `or#` maskw# x2# v3#) - `and#` int2Word# 0x2#) - - (I# x3#) <- M.readArray vec $! start + 2 - let !p3# = p2# `or#` - ((maskw# x3# v# `or#` maskw# x3# v2# `or#` maskw# x3# v3#) - `and#` int2Word# 0x4#) - - (I# x4#) <- M.readArray vec $! start + 3 - let !p4# = p3# `or#` - ((maskw# x4# v# `or#` maskw# x4# v2# `or#` maskw# x4# v3#) - `and#` int2Word# 0x8#) - - (I# x5#) <- M.readArray vec $! start + 4 - let !p5# = p4# `or#` - ((maskw# x5# v# `or#` maskw# x5# v2# `or#` maskw# x5# v3#) - `and#` int2Word# 0x10#) - - (I# x6#) <- M.readArray vec $! start + 5 - let !p6# = p5# `or#` - ((maskw# x6# v# `or#` maskw# x6# v2# `or#` maskw# x6# v3#) - `and#` int2Word# 0x20#) - - (I# x7#) <- M.readArray vec $! start + 6 - let !p7# = p6# `or#` - ((maskw# x7# v# `or#` maskw# x7# v2# `or#` maskw# x7# v3#) - `and#` int2Word# 0x40#) - - (I# x8#) <- M.readArray vec $! start + 7 - let !p8# = p7# `or#` - ((maskw# x8# v# `or#` maskw# x8# v2# `or#` maskw# x8# v3#) - `and#` int2Word# 0x80#) - - (I# x9#) <- M.readArray vec $! start + 8 - let !p9# = p8# `or#` - ((maskw# x9# v# `or#` maskw# x9# v2# `or#` maskw# x9# v3#) - `and#` int2Word# 0x100#) - - (I# x10#) <- M.readArray vec $! start + 9 - let !p10# = p9# `or#` - ((maskw# x10# v# `or#` maskw# x10# v2# `or#` maskw# x10# v3#) - `and#` int2Word# 0x200#) - - (I# x11#) <- M.readArray vec $! start + 10 - let !p11# = p10# `or#` - ((maskw# x11# v# `or#` maskw# x11# v2# `or#` maskw# x11# v3#) - `and#` int2Word# 0x400#) - - (I# x12#) <- M.readArray vec $! start + 11 - let !p12# = p11# `or#` - ((maskw# x12# v# `or#` maskw# x12# v2# `or#` maskw# x12# v3#) - `and#` int2Word# 0x800#) - - (I# x13#) <- M.readArray vec $! start + 12 - let !p13# = p12# `or#` - ((maskw# x13# v# `or#` maskw# x13# v2# `or#` maskw# x13# v3#) - `and#` int2Word# 0x1000#) - - (I# x14#) <- M.readArray vec $! start + 13 - let !p14# = p13# `or#` - ((maskw# x14# v# `or#` maskw# x14# v2# `or#` maskw# x14# v3#) - `and#` int2Word# 0x2000#) - - (I# x15#) <- M.readArray vec $! start + 14 - let !p15# = p14# `or#` - ((maskw# x15# v# `or#` maskw# x15# v2# `or#` maskw# x15# v3#) - `and#` int2Word# 0x4000#) - - (I# x16#) <- M.readArray vec $! start + 15 - let !p16# = p15# `or#` - ((maskw# x16# v# `or#` maskw# x16# v2# `or#` maskw# x16# v3#) - `and#` int2Word# 0x8000#) - - return $! lineResult# p16# start -{-# INLINE lineSearch32_3 #-} - -#endif +import Control.Monad +#if MIN_VERSION_base(4,4,0) +import Control.Monad.ST (ST) +import Control.Monad.ST.Unsafe +#else +import Control.Monad.ST +#endif + +import Data.HashTable.Internal.IntArray (Elem, IntArray) +import qualified Data.HashTable.Internal.IntArray as M + +#ifndef NO_C_SEARCH +import Foreign.C.Types +#else +import Data.Bits +import Data.Int +import qualified Data.Vector.Unboxed as U +import GHC.Int +#endif + +import Data.HashTable.Internal.Utils +import GHC.Exts + +#if __GLASGOW_HASKELL__ >= 707 +import GHC.Exts (isTrue#) +#else +isTrue# :: Bool -> Bool +isTrue# = id +#endif + +{-# INLINE prefetchRead #-} +{-# INLINE prefetchWrite #-} +prefetchRead :: IntArray s -> Int -> ST s () +prefetchWrite :: IntArray s -> Int -> ST s () + +#ifndef NO_C_SEARCH +foreign import ccall unsafe "line_search" + c_lineSearch :: Ptr a -> CInt -> CUShort -> IO CInt + +foreign import ccall unsafe "line_search_2" + c_lineSearch_2 :: Ptr a -> CInt -> CUShort -> CUShort -> IO CInt + +foreign import ccall unsafe "line_search_2" + c_lineSearch_3 :: Ptr a -> CInt -> CUShort -> CUShort -> CUShort -> IO CInt + +foreign import ccall unsafe "forward_search_2" + c_forwardSearch_2 :: Ptr a -> CInt -> CInt -> CUShort -> CUShort -> IO CInt + +foreign import ccall unsafe "forward_search_3" + c_forwardSearch_3 :: Ptr a -> CInt -> CInt -> CUShort -> CUShort -> CUShort + -> IO CInt + +foreign import ccall unsafe "prefetch_cacheline_read" + prefetchCacheLine_read :: Ptr a -> CInt -> IO () + +foreign import ccall unsafe "prefetch_cacheline_write" + prefetchCacheLine_write :: Ptr a -> CInt -> IO () + + +fI :: (Num b, Integral a) => a -> b +fI = fromIntegral + +prefetchRead a i = unsafeIOToST $ prefetchCacheLine_read v x + where + v = M.toPtr a + x = fI i + +prefetchWrite a i = unsafeIOToST $ prefetchCacheLine_write v x + where + v = M.toPtr a + x = fI i + + +{-# INLINE forwardSearch2 #-} +forwardSearch2 :: IntArray s -> Int -> Int -> Elem -> Elem -> ST s Int +forwardSearch2 !vec !start !end !x1 !x2 = + liftM fromEnum $! unsafeIOToST c + where + c = c_forwardSearch_2 (M.toPtr vec) (fI start) (fI end) (fI x1) (fI x2) + + +{-# INLINE forwardSearch3 #-} +forwardSearch3 :: IntArray s -> Int -> Int -> Elem -> Elem -> Elem -> ST s Int +forwardSearch3 !vec !start !end !x1 !x2 !x3 = + liftM fromEnum $! unsafeIOToST c + where + c = c_forwardSearch_3 (M.toPtr vec) (fI start) (fI end) + (fI x1) (fI x2) (fI x3) + + +{-# INLINE lineSearch #-} +lineSearch :: IntArray s -> Int -> Elem -> ST s Int +lineSearch !vec !start !value = + liftM fromEnum $! unsafeIOToST c + where + c = c_lineSearch (M.toPtr vec) (fI start) (fI value) + + +{-# INLINE lineSearch2 #-} +lineSearch2 :: IntArray s -> Int -> Elem -> Elem -> ST s Int +lineSearch2 !vec !start !x1 !x2 = + liftM fromEnum $! unsafeIOToST c + where + c = c_lineSearch_2 (M.toPtr vec) (fI start) (fI x1) (fI x2) + + +{-# INLINE lineSearch3 #-} +lineSearch3 :: IntArray s -> Int -> Elem -> Elem -> Elem -> ST s Int +lineSearch3 !vec !start !x1 !x2 !x3 = + liftM fromEnum $! unsafeIOToST c + where + c = c_lineSearch_3 (M.toPtr vec) (fI start) (fI x1) (fI x2) (fI x3) +#endif + +{-# INLINE advanceByCacheLineSize #-} +advanceByCacheLineSize :: Int -> Int -> Int +advanceByCacheLineSize !(I# start0#) !(I# vecSize#) = out + where + !(I# clm#) = cacheLineIntMask + !clmm# = not# (int2Word# clm#) + !start# = word2Int# (clmm# `and#` int2Word# start0#) + !(I# nw#) = numElemsInCacheLine + !start'# = start# +# nw# + !s# = sign# (vecSize# -# start'# -# 1#) + !m# = not# (int2Word# s#) + !r# = int2Word# start'# `and#` m# + !out = I# (word2Int# r#) + + +{-# INLINE isCacheLineAligned #-} +isCacheLineAligned :: Int -> Bool +isCacheLineAligned (I# x#) = isTrue# (r# ==# 0#) + where + !(I# m#) = cacheLineIntMask + !mw# = int2Word# m# + !w# = int2Word# x# + !r# = word2Int# (mw# `and#` w#) + + +{-# INLINE sign# #-} +-- | Returns 0 if x is positive, -1 otherwise +sign# :: Int# -> Int# +sign# !x# = x# `uncheckedIShiftRA#` wordSizeMinus1# + where + !(I# wordSizeMinus1#) = wordSize-1 + + +{-# INLINE bl_abs# #-} +-- | Abs of an integer, branchless +bl_abs# :: Int# -> Int# +bl_abs# !x# = word2Int# r# + where + !m# = sign# x# + !r# = (int2Word# (m# +# x#)) `xor#` int2Word# m# + + +{-# INLINE mask# #-} +-- | Returns 0xfff..fff (aka -1) if a# == b#, 0 otherwise. +mask# :: Int# -> Int# -> Int# +mask# !a# !b# = dest# + where + !d# = a# -# b# + !r# = bl_abs# d# -# 1# + !dest# = sign# r# + + +{- note: this code should be: + +mask# :: Int# -> Int# -> Int# +mask# !a# !b# = let !(I# z#) = fromEnum (a# ==# b#) + !q# = negateInt# z# + in q# + +but GHC doesn't properly optimize this as straight-line code at the moment. + +-} + + +{-# INLINE maskw# #-} +maskw# :: Int# -> Int# -> Word# +maskw# !a# !b# = int2Word# (mask# a# b#) + + +#ifdef NO_C_SEARCH +prefetchRead _ _ = return () +prefetchWrite _ _ = return () + +{-# INLINE forwardSearch2 #-} +forwardSearch2 :: IntArray s -> Int -> Int -> Elem -> Elem -> ST s Int +forwardSearch2 !vec !start !end !x1 !x2 = go start end False + where + go !i !e !b = + if i >= e then + if b then return (-1) else go 0 start True + else do + h <- M.readArray vec i + if h == x1 || h == x2 + then return i + else go (i+1) e b + + +{-# INLINE forwardSearch3 #-} +forwardSearch3 :: IntArray s -> Int -> Int -> Elem -> Elem -> Elem -> ST s Int +forwardSearch3 !vec !start !end !x1 !x2 !x3 = go start end False + where + go !i !e !b = + if i >= e then + if b then return (-1) else go 0 start True + else do + h <- M.readArray vec i + if h == x1 || h == x2 || h == x3 + then return i + else go (i+1) e b + + +deBruijnBitPositions :: U.Vector Int8 +deBruijnBitPositions = + U.fromList [ + 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8, + 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9 + ] + + +{-# INLINE firstBitSet# #-} +-- only works with 32-bit values -- ok for us here +firstBitSet# :: Int# -> Int# +firstBitSet# i# = word2Int# ((or# zeroCase# posw#)) + where + !zeroCase# = int2Word# (mask# 0# i#) + !w# = int2Word# i# + !iLowest# = word2Int# (and# w# (int2Word# (negateInt# i#))) + !idxW# = uncheckedShiftRL# + (narrow32Word# (timesWord# (int2Word# iLowest#) + (int2Word# 0x077CB531#))) + 27# + !idx = I# (word2Int# idxW#) + !(I8# pos8#) = U.unsafeIndex deBruijnBitPositions idx + !posw# = int2Word# pos8# + +#endif + + +#ifdef NO_C_SEARCH +lineResult# :: Word# -- ^ mask + -> Int -- ^ start value + -> Int +lineResult# bitmask# (I# start#) = I# (word2Int# rv#) + where + !p# = firstBitSet# (word2Int# bitmask#) + !mm# = maskw# p# (-1#) + !nmm# = not# mm# + !rv# = mm# `or#` (nmm# `and#` (int2Word# (start# +# p#))) +{-# INLINE lineResult# #-} + + +-- Required: unlike in C search, required that the start index is +-- cache-line-aligned and array has at least 32 elements after the start index +lineSearch :: IntArray s -- ^ vector to search + -> Int -- ^ start index + -> Elem -- ^ value to search for + -> ST s Int -- ^ dest index where it can be found, or + -- \"-1\" if not found +lineSearch !vec !start !elem1 = do + let !(I# v1#) = fromIntegral elem1 + + !(I# x1#) <- liftM fromIntegral $ M.readArray vec start + let !p1# = (and# (maskw# x1# v1#) (int2Word# 0x1#)) + + !(I# x2#) <- liftM fromIntegral $ M.readArray vec $! start + 1 + let !p2# = or# p1# (and# (maskw# x2# v1#) (int2Word# 0x2#)) + + !(I# x3#) <- liftM fromIntegral $ M.readArray vec $! start + 2 + let !p3# = or# p2# (and# (maskw# x3# v1#) (int2Word# 0x4#)) + + !(I# x4#) <- liftM fromIntegral $ M.readArray vec $! start + 3 + let !p4# = or# p3# (and# (maskw# x4# v1#) (int2Word# 0x8#)) + + !(I# x5#) <- liftM fromIntegral $ M.readArray vec $! start + 4 + let !p5# = or# p4# (and# (maskw# x5# v1#) (int2Word# 0x10#)) + + !(I# x6#) <- liftM fromIntegral $ M.readArray vec $! start + 5 + let !p6# = or# p5# (and# (maskw# x6# v1#) (int2Word# 0x20#)) + + !(I# x7#) <- liftM fromIntegral $ M.readArray vec $! start + 6 + let !p7# = or# p6# (and# (maskw# x7# v1#) (int2Word# 0x40#)) + + !(I# x8#) <- liftM fromIntegral $ M.readArray vec $! start + 7 + let !p8# = or# p7# (and# (maskw# x8# v1#) (int2Word# 0x80#)) + + !(I# x9#) <- liftM fromIntegral $ M.readArray vec $! start + 8 + let !p9# = or# p8# (and# (maskw# x9# v1#) (int2Word# 0x100#)) + + !(I# x10#) <- liftM fromIntegral $ M.readArray vec $! start + 9 + let !p10# = or# p9# (and# (maskw# x10# v1#) (int2Word# 0x200#)) + + !(I# x11#) <- liftM fromIntegral $ M.readArray vec $! start + 10 + let !p11# = or# p10# (and# (maskw# x11# v1#) (int2Word# 0x400#)) + + !(I# x12#) <- liftM fromIntegral $ M.readArray vec $! start + 11 + let !p12# = or# p11# (and# (maskw# x12# v1#) (int2Word# 0x800#)) + + !(I# x13#) <- liftM fromIntegral $ M.readArray vec $! start + 12 + let !p13# = or# p12# (and# (maskw# x13# v1#) (int2Word# 0x1000#)) + + !(I# x14#) <- liftM fromIntegral $ M.readArray vec $! start + 13 + let !p14# = or# p13# (and# (maskw# x14# v1#) (int2Word# 0x2000#)) + + !(I# x15#) <- liftM fromIntegral $ M.readArray vec $! start + 14 + let !p15# = or# p14# (and# (maskw# x15# v1#) (int2Word# 0x4000#)) + + !(I# x16#) <- liftM fromIntegral $ M.readArray vec $! start + 15 + let !p16# = or# p15# (and# (maskw# x16# v1#) (int2Word# 0x8000#)) + + !(I# x17#) <- liftM fromIntegral $ M.readArray vec $! start + 16 + let !p17# = or# p16# (and# (maskw# x17# v1#) (int2Word# 0x10000#)) + + !(I# x18#) <- liftM fromIntegral $ M.readArray vec $! start + 17 + let !p18# = or# p17# (and# (maskw# x18# v1#) (int2Word# 0x20000#)) + + !(I# x19#) <- liftM fromIntegral $ M.readArray vec $! start + 18 + let !p19# = or# p18# (and# (maskw# x19# v1#) (int2Word# 0x40000#)) + + !(I# x20#) <- liftM fromIntegral $ M.readArray vec $! start + 19 + let !p20# = or# p19# (and# (maskw# x20# v1#) (int2Word# 0x80000#)) + + !(I# x21#) <- liftM fromIntegral $ M.readArray vec $! start + 20 + let !p21# = or# p20# (and# (maskw# x21# v1#) (int2Word# 0x100000#)) + + !(I# x22#) <- liftM fromIntegral $ M.readArray vec $! start + 21 + let !p22# = or# p21# (and# (maskw# x22# v1#) (int2Word# 0x200000#)) + + !(I# x23#) <- liftM fromIntegral $ M.readArray vec $! start + 22 + let !p23# = or# p22# (and# (maskw# x23# v1#) (int2Word# 0x400000#)) + + !(I# x24#) <- liftM fromIntegral $ M.readArray vec $! start + 23 + let !p24# = or# p23# (and# (maskw# x24# v1#) (int2Word# 0x800000#)) + + !(I# x25#) <- liftM fromIntegral $ M.readArray vec $! start + 24 + let !p25# = or# p24# (and# (maskw# x25# v1#) (int2Word# 0x1000000#)) + + !(I# x26#) <- liftM fromIntegral $ M.readArray vec $! start + 25 + let !p26# = or# p25# (and# (maskw# x26# v1#) (int2Word# 0x2000000#)) + + !(I# x27#) <- liftM fromIntegral $ M.readArray vec $! start + 26 + let !p27# = or# p26# (and# (maskw# x27# v1#) (int2Word# 0x4000000#)) + + !(I# x28#) <- liftM fromIntegral $ M.readArray vec $! start + 27 + let !p28# = or# p27# (and# (maskw# x28# v1#) (int2Word# 0x8000000#)) + + !(I# x29#) <- liftM fromIntegral $ M.readArray vec $! start + 28 + let !p29# = or# p28# (and# (maskw# x29# v1#) (int2Word# 0x10000000#)) + + !(I# x30#) <- liftM fromIntegral $ M.readArray vec $! start + 29 + let !p30# = or# p29# (and# (maskw# x30# v1#) (int2Word# 0x20000000#)) + + !(I# x31#) <- liftM fromIntegral $ M.readArray vec $! start + 30 + let !p31# = or# p30# (and# (maskw# x31# v1#) (int2Word# 0x40000000#)) + + !(I# x32#) <- liftM fromIntegral $ M.readArray vec $! start + 31 + let !p32# = or# p31# (and# (maskw# x32# v1#) (int2Word# 0x80000000#)) + + return $! lineResult# p32# start + + +-- Required: unlike in C search, required that the start index is +-- cache-line-aligned and array has at least 32 elements after the start index +lineSearch2 :: IntArray s -- ^ vector to search + -> Int -- ^ start index + -> Elem -- ^ value to search for + -> Elem -- ^ second value to search for + -> ST s Int -- ^ dest index where it can be found, or + -- \"-1\" if not found +lineSearch2 !vec !start !elem1 !elem2 = do + let !(I# v1#) = fromIntegral elem1 + let !(I# v2#) = fromIntegral elem2 + + !(I# x1#) <- liftM fromIntegral $ M.readArray vec start + let !p1# = (and# (int2Word# 0x1#) + (or# (maskw# x1# v1#) (maskw# x1# v2#))) + !(I# x2#) <- liftM fromIntegral $ M.readArray vec $! start + 1 + let !p2# = or# p1# (and# (int2Word# 0x2#) + (or# (maskw# x2# v1#) (maskw# x2# v2#))) + !(I# x3#) <- liftM fromIntegral $ M.readArray vec $! start + 2 + let !p3# = or# p2# (and# (int2Word# 0x4#) + (or# (maskw# x3# v1#) (maskw# x3# v2#))) + !(I# x4#) <- liftM fromIntegral $ M.readArray vec $! start + 3 + let !p4# = or# p3# (and# (int2Word# 0x8#) + (or# (maskw# x4# v1#) (maskw# x4# v2#))) + !(I# x5#) <- liftM fromIntegral $ M.readArray vec $! start + 4 + let !p5# = or# p4# (and# (int2Word# 0x10#) + (or# (maskw# x5# v1#) (maskw# x5# v2#))) + !(I# x6#) <- liftM fromIntegral $ M.readArray vec $! start + 5 + let !p6# = or# p5# (and# (int2Word# 0x20#) + (or# (maskw# x6# v1#) (maskw# x6# v2#))) + !(I# x7#) <- liftM fromIntegral $ M.readArray vec $! start + 6 + let !p7# = or# p6# (and# (int2Word# 0x40#) + (or# (maskw# x7# v1#) (maskw# x7# v2#))) + !(I# x8#) <- liftM fromIntegral $ M.readArray vec $! start + 7 + let !p8# = or# p7# (and# (int2Word# 0x80#) + (or# (maskw# x8# v1#) (maskw# x8# v2#))) + !(I# x9#) <- liftM fromIntegral $ M.readArray vec $! start + 8 + let !p9# = or# p8# (and# (int2Word# 0x100#) + (or# (maskw# x9# v1#) (maskw# x9# v2#))) + !(I# x10#) <- liftM fromIntegral $ M.readArray vec $! start + 9 + let !p10# = or# p9# (and# (int2Word# 0x200#) + (or# (maskw# x10# v1#) (maskw# x10# v2#))) + !(I# x11#) <- liftM fromIntegral $ M.readArray vec $! start + 10 + let !p11# = or# p10# (and# (int2Word# 0x400#) + (or# (maskw# x11# v1#) (maskw# x11# v2#))) + !(I# x12#) <- liftM fromIntegral $ M.readArray vec $! start + 11 + let !p12# = or# p11# (and# (int2Word# 0x800#) + (or# (maskw# x12# v1#) (maskw# x12# v2#))) + !(I# x13#) <- liftM fromIntegral $ M.readArray vec $! start + 12 + let !p13# = or# p12# (and# (int2Word# 0x1000#) + (or# (maskw# x13# v1#) (maskw# x13# v2#))) + !(I# x14#) <- liftM fromIntegral $ M.readArray vec $! start + 13 + let !p14# = or# p13# (and# (int2Word# 0x2000#) + (or# (maskw# x14# v1#) (maskw# x14# v2#))) + !(I# x15#) <- liftM fromIntegral $ M.readArray vec $! start + 14 + let !p15# = or# p14# (and# (int2Word# 0x4000#) + (or# (maskw# x15# v1#) (maskw# x15# v2#))) + !(I# x16#) <- liftM fromIntegral $ M.readArray vec $! start + 15 + let !p16# = or# p15# (and# (int2Word# 0x8000#) + (or# (maskw# x16# v1#) (maskw# x16# v2#))) + !(I# x17#) <- liftM fromIntegral $ M.readArray vec $! start + 16 + let !p17# = or# p16# (and# (int2Word# 0x10000#) + (or# (maskw# x17# v1#) (maskw# x17# v2#))) + !(I# x18#) <- liftM fromIntegral $ M.readArray vec $! start + 17 + let !p18# = or# p17# (and# (int2Word# 0x20000#) + (or# (maskw# x18# v1#) (maskw# x18# v2#))) + !(I# x19#) <- liftM fromIntegral $ M.readArray vec $! start + 18 + let !p19# = or# p18# (and# (int2Word# 0x40000#) + (or# (maskw# x19# v1#) (maskw# x19# v2#))) + !(I# x20#) <- liftM fromIntegral $ M.readArray vec $! start + 19 + let !p20# = or# p19# (and# (int2Word# 0x80000#) + (or# (maskw# x20# v1#) (maskw# x20# v2#))) + !(I# x21#) <- liftM fromIntegral $ M.readArray vec $! start + 20 + let !p21# = or# p20# (and# (int2Word# 0x100000#) + (or# (maskw# x21# v1#) (maskw# x21# v2#))) + !(I# x22#) <- liftM fromIntegral $ M.readArray vec $! start + 21 + let !p22# = or# p21# (and# (int2Word# 0x200000#) + (or# (maskw# x22# v1#) (maskw# x22# v2#))) + !(I# x23#) <- liftM fromIntegral $ M.readArray vec $! start + 22 + let !p23# = or# p22# (and# (int2Word# 0x400000#) + (or# (maskw# x23# v1#) (maskw# x23# v2#))) + !(I# x24#) <- liftM fromIntegral $ M.readArray vec $! start + 23 + let !p24# = or# p23# (and# (int2Word# 0x800000#) + (or# (maskw# x24# v1#) (maskw# x24# v2#))) + !(I# x25#) <- liftM fromIntegral $ M.readArray vec $! start + 24 + let !p25# = or# p24# (and# (int2Word# 0x1000000#) + (or# (maskw# x25# v1#) (maskw# x25# v2#))) + !(I# x26#) <- liftM fromIntegral $ M.readArray vec $! start + 25 + let !p26# = or# p25# (and# (int2Word# 0x2000000#) + (or# (maskw# x26# v1#) (maskw# x26# v2#))) + !(I# x27#) <- liftM fromIntegral $ M.readArray vec $! start + 26 + let !p27# = or# p26# (and# (int2Word# 0x4000000#) + (or# (maskw# x27# v1#) (maskw# x27# v2#))) + !(I# x28#) <- liftM fromIntegral $ M.readArray vec $! start + 27 + let !p28# = or# p27# (and# (int2Word# 0x8000000#) + (or# (maskw# x28# v1#) (maskw# x28# v2#))) + !(I# x29#) <- liftM fromIntegral $ M.readArray vec $! start + 28 + let !p29# = or# p28# (and# (int2Word# 0x10000000#) + (or# (maskw# x29# v1#) (maskw# x29# v2#))) + !(I# x30#) <- liftM fromIntegral $ M.readArray vec $! start + 29 + let !p30# = or# p29# (and# (int2Word# 0x20000000#) + (or# (maskw# x30# v1#) (maskw# x30# v2#))) + !(I# x31#) <- liftM fromIntegral $ M.readArray vec $! start + 30 + let !p31# = or# p30# (and# (int2Word# 0x40000000#) + (or# (maskw# x31# v1#) (maskw# x31# v2#))) + !(I# x32#) <- liftM fromIntegral $ M.readArray vec $! start + 31 + let !p32# = or# p31# (and# (int2Word# 0x80000000#) + (or# (maskw# x32# v1#) (maskw# x32# v2#))) + + return $! lineResult# p32# start + + +-- Required: unlike in C search, required that the start index is +-- cache-line-aligned and array has at least 32 elements after the start index +lineSearch3 :: IntArray s -- ^ vector to search + -> Int -- ^ start index + -> Elem -- ^ value to search for + -> Elem -- ^ second value to search for + -> Elem -- ^ third value to search for + -> ST s Int -- ^ dest index where it can be found, or + -- \"-1\" if not found +lineSearch3 !vec !start !elem1 !elem2 !elem3 = do + let !(I# v1#) = fromIntegral elem1 + let !(I# v2#) = fromIntegral elem2 + let !(I# v3#) = fromIntegral elem3 + + !(I# x1#) <- liftM fromIntegral $ M.readArray vec start + let !p1# = (and# (int2Word# 0x1#) + (or# (maskw# x1# v1#) + (or# (maskw# x1# v2#) (maskw# x1# v3#)))) + + !(I# x2#) <- liftM fromIntegral $ M.readArray vec $! start + 1 + let !p2# = or# p1# (and# (int2Word# 0x2#) + (or# (maskw# x2# v1#) + (or# (maskw# x2# v2#) (maskw# x2# v3#)))) + + !(I# x3#) <- liftM fromIntegral $ M.readArray vec $! start + 2 + let !p3# = or# p2# (and# (int2Word# 0x4#) + (or# (maskw# x3# v1#) + (or# (maskw# x3# v2#) (maskw# x3# v3#)))) + + !(I# x4#) <- liftM fromIntegral $ M.readArray vec $! start + 3 + let !p4# = or# p3# (and# (int2Word# 0x8#) + (or# (maskw# x4# v1#) + (or# (maskw# x4# v2#) (maskw# x4# v3#)))) + + !(I# x5#) <- liftM fromIntegral $ M.readArray vec $! start + 4 + let !p5# = or# p4# (and# (int2Word# 0x10#) + (or# (maskw# x5# v1#) + (or# (maskw# x5# v2#) (maskw# x5# v3#)))) + + !(I# x6#) <- liftM fromIntegral $ M.readArray vec $! start + 5 + let !p6# = or# p5# (and# (int2Word# 0x20#) + (or# (maskw# x6# v1#) + (or# (maskw# x6# v2#) (maskw# x6# v3#)))) + + !(I# x7#) <- liftM fromIntegral $ M.readArray vec $! start + 6 + let !p7# = or# p6# (and# (int2Word# 0x40#) + (or# (maskw# x7# v1#) + (or# (maskw# x7# v2#) (maskw# x7# v3#)))) + + !(I# x8#) <- liftM fromIntegral $ M.readArray vec $! start + 7 + let !p8# = or# p7# (and# (int2Word# 0x80#) + (or# (maskw# x8# v1#) + (or# (maskw# x8# v2#) (maskw# x8# v3#)))) + + !(I# x9#) <- liftM fromIntegral $ M.readArray vec $! start + 8 + let !p9# = or# p8# (and# (int2Word# 0x100#) + (or# (maskw# x9# v1#) + (or# (maskw# x9# v2#) (maskw# x9# v3#)))) + + !(I# x10#) <- liftM fromIntegral $ M.readArray vec $! start + 9 + let !p10# = or# p9# (and# (int2Word# 0x200#) + (or# (maskw# x10# v1#) + (or# (maskw# x10# v2#) (maskw# x10# v3#)))) + + !(I# x11#) <- liftM fromIntegral $ M.readArray vec $! start + 10 + let !p11# = or# p10# (and# (int2Word# 0x400#) + (or# (maskw# x11# v1#) + (or# (maskw# x11# v2#) (maskw# x11# v3#)))) + + !(I# x12#) <- liftM fromIntegral $ M.readArray vec $! start + 11 + let !p12# = or# p11# (and# (int2Word# 0x800#) + (or# (maskw# x12# v1#) + (or# (maskw# x12# v2#) (maskw# x12# v3#)))) + + !(I# x13#) <- liftM fromIntegral $ M.readArray vec $! start + 12 + let !p13# = or# p12# (and# (int2Word# 0x1000#) + (or# (maskw# x13# v1#) + (or# (maskw# x13# v2#) (maskw# x13# v3#)))) + + !(I# x14#) <- liftM fromIntegral $ M.readArray vec $! start + 13 + let !p14# = or# p13# (and# (int2Word# 0x2000#) + (or# (maskw# x14# v1#) + (or# (maskw# x14# v2#) (maskw# x14# v3#)))) + + !(I# x15#) <- liftM fromIntegral $ M.readArray vec $! start + 14 + let !p15# = or# p14# (and# (int2Word# 0x4000#) + (or# (maskw# x15# v1#) + (or# (maskw# x15# v2#) (maskw# x15# v3#)))) + + !(I# x16#) <- liftM fromIntegral $ M.readArray vec $! start + 15 + let !p16# = or# p15# (and# (int2Word# 0x8000#) + (or# (maskw# x16# v1#) + (or# (maskw# x16# v2#) (maskw# x16# v3#)))) + + !(I# x17#) <- liftM fromIntegral $ M.readArray vec $! start + 16 + let !p17# = or# p16# (and# (int2Word# 0x10000#) + (or# (maskw# x17# v1#) + (or# (maskw# x17# v2#) (maskw# x17# v3#)))) + + !(I# x18#) <- liftM fromIntegral $ M.readArray vec $! start + 17 + let !p18# = or# p17# (and# (int2Word# 0x20000#) + (or# (maskw# x18# v1#) + (or# (maskw# x18# v2#) (maskw# x18# v3#)))) + + !(I# x19#) <- liftM fromIntegral $ M.readArray vec $! start + 18 + let !p19# = or# p18# (and# (int2Word# 0x40000#) + (or# (maskw# x19# v1#) + (or# (maskw# x19# v2#) (maskw# x19# v3#)))) + + !(I# x20#) <- liftM fromIntegral $ M.readArray vec $! start + 19 + let !p20# = or# p19# (and# (int2Word# 0x80000#) + (or# (maskw# x20# v1#) + (or# (maskw# x20# v2#) (maskw# x20# v3#)))) + + !(I# x21#) <- liftM fromIntegral $ M.readArray vec $! start + 20 + let !p21# = or# p20# (and# (int2Word# 0x100000#) + (or# (maskw# x21# v1#) + (or# (maskw# x21# v2#) (maskw# x21# v3#)))) + + !(I# x22#) <- liftM fromIntegral $ M.readArray vec $! start + 21 + let !p22# = or# p21# (and# (int2Word# 0x200000#) + (or# (maskw# x22# v1#) + (or# (maskw# x22# v2#) (maskw# x22# v3#)))) + + !(I# x23#) <- liftM fromIntegral $ M.readArray vec $! start + 22 + let !p23# = or# p22# (and# (int2Word# 0x400000#) + (or# (maskw# x23# v1#) + (or# (maskw# x23# v2#) (maskw# x23# v3#)))) + + !(I# x24#) <- liftM fromIntegral $ M.readArray vec $! start + 23 + let !p24# = or# p23# (and# (int2Word# 0x800000#) + (or# (maskw# x24# v1#) + (or# (maskw# x24# v2#) (maskw# x24# v3#)))) + + !(I# x25#) <- liftM fromIntegral $ M.readArray vec $! start + 24 + let !p25# = or# p24# (and# (int2Word# 0x1000000#) + (or# (maskw# x25# v1#) + (or# (maskw# x25# v2#) (maskw# x25# v3#)))) + + !(I# x26#) <- liftM fromIntegral $ M.readArray vec $! start + 25 + let !p26# = or# p25# (and# (int2Word# 0x2000000#) + (or# (maskw# x26# v1#) + (or# (maskw# x26# v2#) (maskw# x26# v3#)))) + + !(I# x27#) <- liftM fromIntegral $ M.readArray vec $! start + 26 + let !p27# = or# p26# (and# (int2Word# 0x4000000#) + (or# (maskw# x27# v1#) + (or# (maskw# x27# v2#) (maskw# x27# v3#)))) + + !(I# x28#) <- liftM fromIntegral $ M.readArray vec $! start + 27 + let !p28# = or# p27# (and# (int2Word# 0x8000000#) + (or# (maskw# x28# v1#) + (or# (maskw# x28# v2#) (maskw# x28# v3#)))) + + !(I# x29#) <- liftM fromIntegral $ M.readArray vec $! start + 28 + let !p29# = or# p28# (and# (int2Word# 0x10000000#) + (or# (maskw# x29# v1#) + (or# (maskw# x29# v2#) (maskw# x29# v3#)))) + + !(I# x30#) <- liftM fromIntegral $ M.readArray vec $! start + 29 + let !p30# = or# p29# (and# (int2Word# 0x20000000#) + (or# (maskw# x30# v1#) + (or# (maskw# x30# v2#) (maskw# x30# v3#)))) + + !(I# x31#) <- liftM fromIntegral $ M.readArray vec $! start + 30 + let !p31# = or# p30# (and# (int2Word# 0x40000000#) + (or# (maskw# x31# v1#) + (or# (maskw# x31# v2#) (maskw# x31# v3#)))) + + !(I# x32#) <- liftM fromIntegral $ M.readArray vec $! start + 31 + let !p32# = or# p31# (and# (int2Word# 0x80000000#) + (or# (maskw# x32# v1#) + (or# (maskw# x32# v2#) (maskw# x32# v3#)))) + + return $! lineResult# p32# start + + +------------------------------------------------------------------------------ +-- | Search through a mutable vector for a given int value. The number of +-- things to search for must be at most the number of things remaining in the +-- vector. +naiveSearch :: IntArray s -- ^ vector to search + -> Int -- ^ start index + -> Int -- ^ number of things to search + -> Elem -- ^ value to search for + -> ST s Int -- ^ dest index where it can be found, or + -- \"-1\" if not found +naiveSearch !vec !start !nThings !value = go start + where + !doneIdx = start + nThings + + go !i | i >= doneIdx = return (-1) + | otherwise = do + x <- M.readArray vec i + if x == value then return i else go (i+1) +{-# INLINE naiveSearch #-} + + +------------------------------------------------------------------------------ +naiveSearch2 :: IntArray s -- ^ vector to search + -> Int -- ^ start index + -> Int -- ^ number of things to search + -> Elem -- ^ value to search for + -> Elem -- ^ value 2 to search for + -> ST s Int -- ^ dest index where it can be found, or + -- \"-1\" if not found +naiveSearch2 !vec !start !nThings !value1 !value2 = go start + where + !doneIdx = start + nThings + + go !i | i >= doneIdx = return (-1) + | otherwise = do + x <- M.readArray vec i + if x == value1 || x == value2 then return i else go (i+1) +{-# INLINE naiveSearch2 #-} + + +------------------------------------------------------------------------------ +naiveSearch3 :: IntArray s -- ^ vector to search + -> Int -- ^ start index + -> Int -- ^ number of things to search + -> Elem -- ^ value to search for + -> Elem -- ^ value 2 to search for + -> Elem -- ^ value 3 to search for + -> ST s Int -- ^ dest index where it can be found, or + -- \"-1\" if not found +naiveSearch3 !vec !start !nThings !value1 !value2 !value3 = go start + where + !doneIdx = start + nThings + + go !i | i >= doneIdx = return (-1) + | otherwise = do + x <- M.readArray vec i + if x == value1 || x == value2 || x == value3 + then return i + else go (i+1) +{-# INLINE naiveSearch3 #-} + +-- end #if NO_C_SEARCH +#endif + +------------------------------------------------------------------------------ +-- | Search through a mutable vector for a given int value, cache-line aligned. +-- If the start index is cache-line aligned, and there is more than a +-- cache-line's room between the start index and the end of the vector, we will +-- search the cache-line all at once using an efficient branchless +-- bit-twiddling technique. Otherwise, we will use a typical loop. +-- +cacheLineSearch :: IntArray s -- ^ vector to search + -> Int -- ^ start index + -> Elem -- ^ value to search for + -> ST s Int -- ^ dest index where it can be found, or + -- \"-1\" if not found +cacheLineSearch !vec !start !value = do +#ifdef NO_C_SEARCH + let !vlen = M.length vec + let !st1 = vlen - start + let !nvlen = numElemsInCacheLine - st1 + let adv = (start + cacheLineIntMask) .&. complement cacheLineIntMask + let st2 = adv - start + + + if nvlen > 0 || not (isCacheLineAligned start) + then naiveSearch vec start (min st1 st2) value + else lineSearch vec start value +#else + lineSearch vec start value +#endif +{-# INLINE cacheLineSearch #-} + + +------------------------------------------------------------------------------ +-- | Search through a mutable vector for one of two given int values, +-- cache-line aligned. If the start index is cache-line aligned, and there is +-- more than a cache-line's room between the start index and the end of the +-- vector, we will search the cache-line all at once using an efficient +-- branchless bit-twiddling technique. Otherwise, we will use a typical loop. +-- +cacheLineSearch2 :: IntArray s -- ^ vector to search + -> Int -- ^ start index + -> Elem -- ^ value to search for + -> Elem -- ^ value 2 to search for + -> ST s Int -- ^ dest index where it can be found, or + -- \"-1\" if not found +cacheLineSearch2 !vec !start !value !value2 = do +#ifdef NO_C_SEARCH + let !vlen = M.length vec + let !st1 = vlen - start + let !nvlen = numElemsInCacheLine - st1 + let adv = (start + cacheLineIntMask) .&. complement cacheLineIntMask + let st2 = adv - start + + if nvlen > 0 || not (isCacheLineAligned start) + then naiveSearch2 vec start (min st1 st2) value value2 + else lineSearch2 vec start value value2 +#else + lineSearch2 vec start value value2 +#endif +{-# INLINE cacheLineSearch2 #-} + + +------------------------------------------------------------------------------ +-- | Search through a mutable vector for one of three given int values, +-- cache-line aligned. If the start index is cache-line aligned, and there is +-- more than a cache-line's room between the start index and the end of the +-- vector, we will search the cache-line all at once using an efficient +-- branchless bit-twiddling technique. Otherwise, we will use a typical loop. +-- +cacheLineSearch3 :: IntArray s -- ^ vector to search + -> Int -- ^ start index + -> Elem -- ^ value to search for + -> Elem -- ^ value 2 to search for + -> Elem -- ^ value 3 to search for + -> ST s Int -- ^ dest index where it can be found, or + -- \"-1\" if not found +cacheLineSearch3 !vec !start !value !value2 !value3 = do +#ifdef NO_C_SEARCH + let !vlen = M.length vec + let !st1 = vlen - start + let !nvlen = numElemsInCacheLine - st1 + let adv = (start + cacheLineIntMask) .&. complement cacheLineIntMask + let st2 = adv - start + + if nvlen > 0 || not (isCacheLineAligned start) + then naiveSearch3 vec start (min st1 st2) value value2 value3 + else lineSearch3 vec start value value2 value3 +#else + lineSearch3 vec start value value2 value3 +#endif +{-# INLINE cacheLineSearch3 #-} diff --git a/src/Data/HashTable/Internal/IntArray.hs b/src/Data/HashTable/Internal/IntArray.hs --- a/src/Data/HashTable/Internal/IntArray.hs +++ b/src/Data/HashTable/Internal/IntArray.hs @@ -4,6 +4,11 @@ module Data.HashTable.Internal.IntArray ( IntArray + , Elem + , elemMask + , primWordToElem + , elemToInt + , elemToInt# , newArray , readArray , writeArray @@ -11,63 +16,99 @@ , toPtr ) where +------------------------------------------------------------------------------ import Control.Monad.ST import Data.Bits import qualified Data.Primitive.ByteArray as A -import Data.Primitive.Types (Addr(..)) +import Data.Primitive.Types (Addr (..)) import GHC.Exts -import Prelude hiding (length) +import GHC.Word +import Prelude hiding (length) +------------------------------------------------------------------------------ + #ifdef BOUNDS_CHECKING -#define BOUNDS_MSG(sz,i) concat [ "[", __FILE__, ":", \ - show (__LINE__ :: Int), \ - "] bounds check exceeded: ",\ +#define BOUNDS_MSG(sz,i) concat [ "[", __FILE__, ":", \ + show (__LINE__ :: Int), \ + "] bounds check exceeded: ", \ "size was ", show (sz), " i was ", show (i) ] -#define BOUNDS_CHECK(arr,i) let sz = (A.sizeofMutableByteArray (arr) \ - `div` wordSizeInBytes) in \ - if (i) < 0 || (i) >= sz \ - then error (BOUNDS_MSG(sz,(i))) \ + +#define BOUNDS_CHECK(arr,i) let sz = (A.sizeofMutableByteArray (arr) \ + `div` wordSizeInBytes) in \ + if (i) < 0 || (i) >= sz \ + then error (BOUNDS_MSG(sz,(i))) \ else return () #else #define BOUNDS_CHECK(arr,i) #endif + +------------------------------------------------------------------------------ newtype IntArray s = IA (A.MutableByteArray s) +type Elem = Word16 +------------------------------------------------------------------------------ +primWordToElem :: Word# -> Elem +primWordToElem = W16# + + +------------------------------------------------------------------------------ +elemToInt :: Elem -> Int +elemToInt e = let !i# = elemToInt# e + in (I# i#) + + +------------------------------------------------------------------------------ +elemToInt# :: Elem -> Int# +elemToInt# (W16# w#) = word2Int# w# + + +------------------------------------------------------------------------------ +elemMask :: Int +elemMask = 0xffff + + +------------------------------------------------------------------------------ wordSizeInBytes :: Int -wordSizeInBytes = bitSize (0::Int) `div` 8 +wordSizeInBytes = bitSize (0::Elem) `div` 8 +------------------------------------------------------------------------------ -- | Cache line size, in bytes cacheLineSize :: Int cacheLineSize = 64 +------------------------------------------------------------------------------ newArray :: Int -> ST s (IntArray s) newArray n = do let !sz = n * wordSizeInBytes - !arr <- A.newAlignedPinnedByteArray sz cacheLineSize + !arr <- A.newAlignedPinnedByteArray sz cacheLineSize A.fillByteArray arr 0 sz 0 return $! IA arr -readArray :: IntArray s -> Int -> ST s Int +------------------------------------------------------------------------------ +readArray :: IntArray s -> Int -> ST s Elem readArray (IA a) idx = do BOUNDS_CHECK(a,idx) A.readByteArray a idx -writeArray :: IntArray s -> Int -> Int -> ST s () +------------------------------------------------------------------------------ +writeArray :: IntArray s -> Int -> Elem -> ST s () writeArray (IA a) idx val = do BOUNDS_CHECK(a,idx) A.writeByteArray a idx val +------------------------------------------------------------------------------ length :: IntArray s -> Int length (IA a) = A.sizeofMutableByteArray a `div` wordSizeInBytes +------------------------------------------------------------------------------ toPtr :: IntArray s -> Ptr a toPtr (IA a) = Ptr a# where diff --git a/src/Data/HashTable/Internal/Linear/Bucket.hs b/src/Data/HashTable/Internal/Linear/Bucket.hs --- a/src/Data/HashTable/Internal/Linear/Bucket.hs +++ b/src/Data/HashTable/Internal/Linear/Bucket.hs @@ -26,6 +26,9 @@ import qualified Control.Monad import Control.Monad hiding (mapM_, foldM) import Control.Monad.ST +#ifdef DEBUG +import Control.Monad.ST.Unsafe +#endif import Data.Maybe (fromMaybe) import Data.HashTable.Internal.Array import Data.STRef diff --git a/src/Data/HashTable/Internal/UnsafeTricks.hs b/src/Data/HashTable/Internal/UnsafeTricks.hs --- a/src/Data/HashTable/Internal/UnsafeTricks.hs +++ b/src/Data/HashTable/Internal/UnsafeTricks.hs @@ -22,9 +22,17 @@ #ifdef UNSAFETRICKS import GHC.Exts import Unsafe.Coerce + +#if __GLASGOW_HASKELL__ >= 707 +import GHC.Exts (isTrue#) +#else +isTrue# :: Bool -> Bool +isTrue# = id #endif +#endif + ------------------------------------------------------------------------------ #ifdef UNSAFETRICKS type Key a = Any @@ -61,12 +69,12 @@ deletedRecord = unsafeCoerce DeletedElement {-# INLINE keyIsEmpty #-} -keyIsEmpty a = x# ==# 1# +keyIsEmpty a = isTrue# (x# ==# 1#) where !x# = reallyUnsafePtrEquality# a emptyRecord {-# INLINE keyIsDeleted #-} -keyIsDeleted a = x# ==# 1# +keyIsDeleted a = isTrue# (x# ==# 1#) where !x# = reallyUnsafePtrEquality# a deletedRecord diff --git a/src/Data/HashTable/Internal/Utils.hs b/src/Data/HashTable/Internal/Utils.hs --- a/src/Data/HashTable/Internal/Utils.hs +++ b/src/Data/HashTable/Internal/Utils.hs @@ -2,7 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} -module Data.HashTable.Internal.Utils +module Data.HashTable.Internal.Utils ( whichBucket , nextBestPrime , bumpSize @@ -15,15 +15,16 @@ , highestBitMask , wordSize , cacheLineSize - , numWordsInCacheLine + , numElemsInCacheLine , cacheLineIntMask , cacheLineIntBits , forceSameType ) where -import Data.Bits hiding (shiftL) -import Data.Vector (Vector) -import qualified Data.Vector as V +import Data.Bits hiding (shiftL) +import Data.HashTable.Internal.IntArray (Elem) +import Data.Vector (Vector) +import qualified Data.Vector as V #if __GLASGOW_HASKELL__ >= 503 import GHC.Exts #else @@ -41,10 +42,10 @@ cacheLineSize = 64 -numWordsInCacheLine :: Int -numWordsInCacheLine = z +numElemsInCacheLine :: Int +numElemsInCacheLine = z where - !z = cacheLineSize `div` (wordSize `div` 8) + !z = cacheLineSize `div` (bitSize (0::Elem) `div` 8) -- | What you have to mask an integer index by to tell if it's @@ -52,11 +53,11 @@ cacheLineIntMask :: Int cacheLineIntMask = z where - !z = numWordsInCacheLine - 1 + !z = numElemsInCacheLine - 1 cacheLineIntBits :: Int -cacheLineIntBits = log2 $ toEnum numWordsInCacheLine +cacheLineIntBits = log2 $ toEnum numElemsInCacheLine ------------------------------------------------------------------------------ @@ -237,12 +238,8 @@ ------------------------------------------------------------------------------ -bumpSize :: Int -> Int -bumpSize !s = nextBestPrime s' - where - -- double at small sizes, then 3/2 thereafter - s' = if s < 24593 then 2*s else (s `div` 2) * 3 - +bumpSize :: Double -> Int -> Int +bumpSize !maxLoad !s = nextBestPrime $! ceiling (fromIntegral s / maxLoad) ------------------------------------------------------------------------------ diff --git a/src/Data/HashTable/ST/Basic.hs b/src/Data/HashTable/ST/Basic.hs --- a/src/Data/HashTable/ST/Basic.hs +++ b/src/Data/HashTable/ST/Basic.hs @@ -18,49 +18,51 @@ with deleted markers and force the table to be completely rehashed fairly often. -/Details:/ - -Of the hash tables in this collection, this hash table has the best insert and -lookup performance, with the following caveats. +Of the hash tables in this collection, this hash table has the best lookup +performance, while maintaining competitive insert performance. /Space overhead/ This table is not especially memory-efficient; firstly, the table has a maximum load factor of 0.83 and will be resized if load exceeds this value. Secondly, -to improve insert and lookup performance, we store the hash code for each key -in the table. +to improve insert and lookup performance, we store a 16-bit hash code for each +key in the table. -Each hash table entry requires three words, two for the pointers to the key and -value and one for the hash code. We don't count key and value pointers as -overhead, because they have to be there -- so the overhead for a full slot is -one word -- but empty slots in the hash table count for a full three words of -overhead. Define @m@ as the number of slots in the table and @n@ as the number -of key value mappings. If the load factor is @k=n\/m@, the amount of space -wasted is: +Each hash table entry requires at least 2.25 words (on a 64-bit machine), two +for the pointers to the key and value and one quarter word for the hash code. +We don't count key and value pointers as overhead, because they have to be +there -- so the overhead for a full slot is at least one quarter word -- but +empty slots in the hash table count for a full 2.25 words of overhead. Define +@m@ as the number of slots in the table, @n@ as the number of key value +mappings, and @ws@ as the machine word size in /bytes/. If the load factor is +@k=n\/m@, the amount of space /wasted/ per mapping in words is: @ -w(n) = 1*n + 3(m-n) +w(n) = (m*(2*ws + 2) - n*(2*ws)) / ws @ Since @m=n\/k@, @ -w(n) = n + 3(n\/k - n) -= n (3\/k-2) +w(n) = n\/k * (2*ws + 2) - n*(2*ws) + = (n * (2 + 2*ws*(1-k)) / k) / ws @ -Solving for @k=0.83@, the maximum load factor, gives a /minimum/ overhead of 2 -words per mapping. If @k=0.5@, under normal usage the /maximum/ overhead -situation, then the overhead would be 4 words per mapping. +Solving for @k=0.83@, the maximum load factor, gives a /minimum/ overhead of +0.71 words per mapping on a 64-bit machine, or 1.01 words per mapping on a +32-bit machine. If @k=0.5@, which should be under normal usage the /maximum/ +overhead situation, then the overhead would be 2.5 words per mapping on a +64-bit machine, or 3.0 words per mapping on a 32-bit machine. /Space overhead: experimental results/ -In randomized testing (see @test\/compute-overhead\/ComputeOverhead.hs@ in the -source distribution), mean overhead (that is, the number of words needed to -store the key-value mapping over and above the two words necessary for the key -and the value pointers) is approximately 2.29 machine words per key-value -mapping with a standard deviation of about 0.44 words, and 3.14 words per -mapping at the 95th percentile. +In randomized testing on a 64-bit machine (see +@test\/compute-overhead\/ComputeOverhead.hs@ in the source distribution), mean +overhead (that is, the number of words needed to store the key-value mapping +over and above the two words necessary for the key and the value pointers) is +approximately 1.24 machine words per key-value mapping with a standard +deviation of about 0.30 words, and 1.70 words per mapping at the 95th +percentile. /Expensive resizes/ @@ -78,7 +80,6 @@ Searching. Addison-Wesley Publishing Company, 1973. -} - module Data.HashTable.ST.Basic ( HashTable , new @@ -93,22 +94,25 @@ ------------------------------------------------------------------------------ -import Control.Exception (assert) -import Control.Monad hiding (mapM_, foldM) +import Control.Exception (assert) +import Control.Monad hiding (foldM, mapM_) import Control.Monad.ST -import Data.Hashable (Hashable) -import qualified Data.Hashable as H +import Control.Monad.ST.Unsafe +import Data.Bits +import Data.Hashable (Hashable) +import qualified Data.Hashable as H import Data.Maybe import Data.Monoid import Data.STRef import GHC.Exts -import Prelude hiding (lookup, read, mapM_) +import Prelude hiding (lookup, mapM_, read) ------------------------------------------------------------------------------ +import qualified Data.HashTable.Class as C import Data.HashTable.Internal.Array -import qualified Data.HashTable.Internal.IntArray as U import Data.HashTable.Internal.CacheLine +import Data.HashTable.Internal.IntArray (Elem) +import qualified Data.HashTable.Internal.IntArray as U import Data.HashTable.Internal.Utils -import qualified Data.HashTable.Class as C ------------------------------------------------------------------------------ @@ -148,7 +152,7 @@ -- | See the documentation for this function in -- "Data.HashTable.Class#v:new". new :: ST s (HashTable s k v) -new = newSized 30 +new = newSized 1 {-# INLINE new #-} @@ -157,6 +161,7 @@ -- "Data.HashTable.Class#v:newSized". newSized :: Int -> ST s (HashTable s k v) newSized n = do + debug $ "entering: newSized " ++ show n let m = nextBestPrime $ ceiling (fromIntegral n / maxLoad) ht <- newSizedReal m newRef ht @@ -168,8 +173,8 @@ newSizedReal m = do -- make sure the hash array is a multiple of cache-line sized so we can -- always search a whole cache line at once - let m' = ((m + numWordsInCacheLine - 1) `div` numWordsInCacheLine) - * numWordsInCacheLine + let m' = ((m + numElemsInCacheLine - 1) `div` numElemsInCacheLine) + * numElemsInCacheLine h <- U.newArray m' k <- newArray m undefined v <- newArray m undefined @@ -186,6 +191,7 @@ -> k -> ST s () delete htRef k = do + debug $ "entered: delete: hash=" ++ show h ht <- readRef htRef _ <- delete' ht True k h return () @@ -204,14 +210,22 @@ where lookup' (HashTable sz _ _ hashes keys values) = do let !b = whichBucket h sz - debug $ "lookup sz=" ++ show sz ++ " h=" ++ show h ++ " b=" ++ show b + debug $ "lookup h=" ++ show h ++ " sz=" ++ show sz ++ " b=" ++ show b go b 0 sz where - !h = hash k + !h = hash k + !he = hashToElem h go !b !start !end = {-# SCC "lookup/go" #-} do - idx <- forwardSearch2 hashes b end h emptyMarker + debug $ concat [ "lookup'/go: " + , show b + , "/" + , show start + , "/" + , show end + ] + idx <- forwardSearch2 hashes b end he emptyMarker debug $ "forwardSearch2 returned " ++ show idx if (idx < 0 || idx < start || idx >= end) then return Nothing @@ -220,7 +234,9 @@ debug $ "h0 was " ++ show h0 if recordIsEmpty h0 - then return Nothing + then do + debug $ "record empty, returning Nothing" + return Nothing else do k' <- readArray keys idx if k == k' @@ -228,9 +244,11 @@ debug $ "value found at " ++ show idx v <- readArray values idx return $! Just v - else if idx < b - then go (idx + 1) (idx + 1) b - else go (idx + 1) start end + else do + debug $ "value not found, recursing" + if idx < b + then go (idx + 1) (idx + 1) b + else go (idx + 1) start end {-# INLINE lookup #-} @@ -252,8 +270,14 @@ debug "insert': calling delete'" b <- delete' ht False k h - debug $ "insert': writing h=" ++ show h ++ " b=" ++ show b - U.writeArray hashes b h + debug $ concat [ "insert': writing h=" + , show h + , " he=" + , show he + , " b=" + , show b + ] + U.writeArray hashes b he writeArray keys b k writeArray values b v @@ -261,6 +285,7 @@ where !h = hash k + !he = hashToElem h hashes = _hashes ht keys = _keys ht values = _values ht @@ -316,12 +341,12 @@ work (HashTable sz' loadRef _ _ _ _) = do !ld <- U.readArray loadRef 0 let k = fromIntegral ld / sz - return $ constOverhead / sz + overhead k + return $ constOverhead/sz + (2 + 2*ws*(1-k)) / (k * ws) where + ws = fromIntegral $! bitSize (0::Int) `div` 8 sz = fromIntegral sz' -- Change these if you change the representation constOverhead = 14 - overhead k = 3 / k - 2 ------------------------------ @@ -345,11 +370,13 @@ probe b where + he = hashToElem h + probe !i = {-# SCC "insertRecord/probe" #-} do !idx <- forwardSearch2 hashes i sz emptyMarker deletedMarker debug $ "forwardSearch2 returned " ++ show idx assert (idx >= 0) $ do - U.writeArray hashes idx h + U.writeArray hashes idx he writeArray keys idx key writeArray values idx value @@ -405,7 +432,7 @@ ------------------------------------------------------------------------------ growTable :: Hashable k => HashTable_ s k v -> ST s (HashTable_ s k v) growTable ht@(HashTable sz _ _ _ _ _) = do - let !sz' = bumpSize sz + let !sz' = bumpSize maxLoad sz rehashAll ht sz' @@ -435,9 +462,10 @@ -> Int -> ST s Int delete' (HashTable sz loadRef delRef hashes keys values) clearOut k h = do - debug $ "delete': sz=" ++ show sz ++ " h=" ++ show h - ++ " b0=" ++ show b0 - (found, slot) <- go mempty b0 False + debug $ "delete': h=" ++ show h ++ " he=" ++ show he + ++ " sz=" ++ show sz ++ " b0=" ++ show b0 + pair@(found, slot) <- go mempty b0 False + debug $ "go returned " ++ show pair let !b' = _slot slot @@ -448,6 +476,7 @@ return b' where + he = hashToElem h bump ref i = do !ld <- U.readArray ref 0 U.writeArray ref 0 $! ld + i @@ -466,11 +495,22 @@ -- * wrap True if we've wrapped around, False otherwise go !fp !b !wrap = do - debug $ "go: fp=" ++ show fp ++ " b=" ++ show b - ++ ", wrap=" ++ show wrap - !idx <- forwardSearch3 hashes b sz h emptyMarker deletedMarker - debug $ "forwardSearch3 returned " ++ show idx + debug $ concat [ "go: fp=" + , show fp + , " b=" + , show b + , ", wrap=" + , show wrap + , ", he=" + , show he + , ", emptyMarker=" + , show emptyMarker + , ", deletedMarker=" + , show deletedMarker ] + !idx <- forwardSearch3 hashes b sz he emptyMarker deletedMarker + debug $ "forwardSearch3 returned " ++ show idx ++ " with sz=" ++ show sz ++ ", b=" ++ show b + if wrap && idx >= b0 -- we wrapped around in the search and didn't find our hash code; -- this means that the table is full of deleted elements. Just return @@ -501,8 +541,9 @@ debug $ "deleted, cont with pl=" ++ show pl go pl (idx + 1) wrap' else - if h == h0 + if he == h0 then do + debug $ "found he == h0 == " ++ show h0 k' <- readArray keys idx if k == k' then do @@ -519,7 +560,7 @@ -- new element here. when (clearOut || not samePlace) $ do bump delRef 1 - U.writeArray hashes idx 1 + U.writeArray hashes idx deletedMarker writeArray keys idx undefined writeArray values idx undefined return (True, fp `mappend` (Slot idx 0)) @@ -532,38 +573,44 @@ ------------------------------------------------------------------------------ -emptyMarker :: Int +emptyMarker :: Elem emptyMarker = 0 ------------------------------------------------------------------------------ -deletedMarker :: Int +deletedMarker :: Elem deletedMarker = 1 ------------------------------------------------------------------------------ {-# INLINE recordIsEmpty #-} -recordIsEmpty :: Int -> Bool +recordIsEmpty :: Elem -> Bool recordIsEmpty = (== emptyMarker) ------------------------------------------------------------------------------ {-# INLINE recordIsDeleted #-} -recordIsDeleted :: Int -> Bool +recordIsDeleted :: Elem -> Bool recordIsDeleted = (== deletedMarker) ------------------------------------------------------------------------------ {-# INLINE hash #-} hash :: (Hashable k) => k -> Int -hash k = out +hash = H.hash + + +------------------------------------------------------------------------------ +{-# INLINE hashToElem #-} +hashToElem :: Int -> Elem +hashToElem !h = out where - !(I# h#) = H.hash k + !(I# lo#) = h .&. U.elemMask - !m# = maskw# h# 0# `or#` maskw# h# 1# + !m# = maskw# lo# 0# `or#` maskw# lo# 1# !nm# = not# m# - !r# = ((int2Word# 2#) `and#` m#) `or#` (int2Word# h# `and#` nm#) - !out = I# (word2Int# r#) + !r# = ((int2Word# 2#) `and#` m#) `or#` (int2Word# lo# `and#` nm#) + !out = U.primWordToElem r# ------------------------------------------------------------------------------ diff --git a/src/Data/HashTable/ST/Cuckoo.hs b/src/Data/HashTable/ST/Cuckoo.hs --- a/src/Data/HashTable/ST/Cuckoo.hs +++ b/src/Data/HashTable/ST/Cuckoo.hs @@ -10,7 +10,7 @@ * want the fastest possible inserts, and very fast lookups. * are conscious of memory usage; this table has less space overhead than - "Data.HashTable.ST.Basic", but more than "Data.HashTable.ST.Linear". + "Data.HashTable.ST.Basic" or "Data.HashTable.ST.Linear". * don't care that a table resize might pause for a long time to rehash all of the key-value mappings. @@ -51,9 +51,8 @@ the basic open-addressing hash table using linear probing, and on average is more space-efficient: in randomized testing on my 64-bit machine (see @test\/compute-overhead\/ComputeOverhead.hs@ in the source distribution), mean -overhead is 1.71 machine words per key-value mapping, with a standard deviation -of 0.30 words, and 2.46 words per mapping at the 95th percentile. - +overhead is 0.77 machine words per key-value mapping, with a standard deviation +of 0.29 words, and 1.23 words per mapping at the 95th percentile. /References:/ @@ -75,21 +74,32 @@ ------------------------------------------------------------------------------ -import Control.Monad hiding (foldM, mapM_) +import Control.Monad hiding + (foldM, + mapM_) import Control.Monad.ST -import Data.Hashable hiding (hash) -import qualified Data.Hashable as H +#ifdef DEBUG +import Control.Monad.ST.Unsafe +#endif +import Data.Bits +import Data.Hashable hiding + (hash) +import qualified Data.Hashable as H import Data.Int import Data.Maybe import Data.Primitive.Array import Data.STRef import GHC.Exts -import Prelude hiding ( lookup, read, mapM_ ) +import Prelude hiding + (lookup, + mapM_, + read) ------------------------------------------------------------------------------ -import qualified Data.HashTable.Class as C -import Data.HashTable.Internal.CheapPseudoRandomBitStream +import qualified Data.HashTable.Class as C import Data.HashTable.Internal.CacheLine -import qualified Data.HashTable.Internal.IntArray as U +import Data.HashTable.Internal.CheapPseudoRandomBitStream +import Data.HashTable.Internal.IntArray (Elem) +import qualified Data.HashTable.Internal.IntArray as U import Data.HashTable.Internal.Utils #ifdef DEBUG @@ -102,12 +112,12 @@ newtype HashTable s k v = HT (STRef s (HashTable_ s k v)) data HashTable_ s k v = HashTable - { _size :: {-# UNPACK #-} !Int -- ^ in buckets, total size is - -- numWordsInCacheLine * _size - , _rng :: {-# UNPACK #-} !(BitStream s) - , _hashes :: {-# UNPACK #-} !(U.IntArray s) - , _keys :: {-# UNPACK #-} !(MutableArray s k) - , _values :: {-# UNPACK #-} !(MutableArray s v) + { _size :: {-# UNPACK #-} !Int -- ^ in buckets, total size is + -- numElemsInCacheLine * _size + , _rng :: {-# UNPACK #-} !(BitStream s) + , _hashes :: {-# UNPACK #-} !(U.IntArray s) + , _keys :: {-# UNPACK #-} !(MutableArray s k) + , _values :: {-# UNPACK #-} !(MutableArray s v) , _maxAttempts :: {-# UNPACK #-} !Int } @@ -142,7 +152,7 @@ -- "Data.HashTable.Class#v:newSized". newSized :: Int -> ST s (HashTable s k v) newSized n = do - let n' = (n + numWordsInCacheLine - 1) `div` numWordsInCacheLine + let n' = (n + numElemsInCacheLine - 1) `div` numElemsInCacheLine let k = nextBestPrime $ ceiling $ fromIntegral n' / maxLoad newSizedReal k >>= newRef {-# INLINE newSized #-} @@ -164,14 +174,16 @@ work (HashTable sz _ _ _ _ _) = do nFilled <- foldM f 0 htRef - let oh = totSz -- one word per element in hashes - + 2 * (totSz - nFilled) -- two words per non-filled entry - + 12 -- fixed overhead + let oh = (totSz `div` hashCodesPerWord) -- one half or quarter word + -- per element in hashes + + 2 * (totSz - nFilled) -- two words per non-filled entry + + 12 -- fixed overhead return $! fromIntegral (oh::Int) / fromIntegral nFilled where - totSz = numWordsInCacheLine * sz + hashCodesPerWord = (bitSize (0 :: Int)) `div` 16 + totSz = numElemsInCacheLine * sz f !a _ = return $! a+1 @@ -218,14 +230,14 @@ lookup' (HashTable sz _ hashes keys values _) !k = do -- Unlike the write case, prefetch doesn't seem to help here for lookup. -- prefetchRead hashes b2 - idx1 <- searchOne keys hashes k b1 h1 + idx1 <- searchOne keys hashes k b1 he1 if idx1 >= 0 then do v <- readArray values idx1 return $! Just v else do - idx2 <- searchOne keys hashes k b2 h2 + idx2 <- searchOne keys hashes k b2 he2 if idx2 >= 0 then do v <- readArray values idx2 @@ -237,6 +249,9 @@ h1 = hash1 k h2 = hash2 k + he1 = hashToElem h1 + he2 = hashToElem h2 + b1 = whichLine h1 sz b2 = whichLine h2 sz {-# INLINE lookup' #-} @@ -248,12 +263,12 @@ -> U.IntArray s -> k -> Int - -> Int + -> Elem -> ST s Int -searchOne !keys !hashes !k = go +searchOne !keys !hashes !k !b0 !h = go b0 where - go !b !h = do - debug $ "searchOne: go " ++ show b ++ " " ++ show h + go !b = do + debug $ "searchOne: go/" ++ show b ++ "/" ++ show h idx <- cacheLineSearch hashes b h debug $ "searchOne: cacheLineSearch returned " ++ show idx @@ -267,7 +282,7 @@ let !idx' = idx + 1 if isCacheLineAligned idx' then return (-1) - else go idx' h + else go idx' {-# INLINE searchOne #-} @@ -290,7 +305,7 @@ -> ST s a foldMWork f seed0 (HashTable sz _ hashes keys values _) = go 0 seed0 where - totSz = numWordsInCacheLine * sz + totSz = numElemsInCacheLine * sz go !i !seed | i >= totSz = return seed | otherwise = do @@ -323,7 +338,7 @@ -> ST s () mapMWork f (HashTable sz _ hashes keys values _) = go 0 where - totSz = numWordsInCacheLine * sz + totSz = numElemsInCacheLine * sz go !i | i >= totSz = return () | otherwise = do @@ -347,7 +362,7 @@ ------------------------------------------------------------------------------ newSizedReal :: Int -> ST s (HashTable_ s k v) newSizedReal nbuckets = do - let !ntotal = nbuckets * numWordsInCacheLine + let !ntotal = nbuckets * numElemsInCacheLine let !maxAttempts = 12 + (log2 $ toEnum nbuckets) debug $ "creating cuckoo hash table with " ++ @@ -421,7 +436,7 @@ ------------------------------------------------------------------------------ --- Returns either (-1,-1) (not found, and both buckets full ==> trigger +-- Returns either (-1, 0) (not found, and both buckets full ==> trigger -- cuckoo), or the slot in the array where it would be safe to write the given -- key, and the hashcode to use there delete' :: (Hashable k, Eq k) => @@ -432,17 +447,19 @@ -> Int -- ^ cache line start address 2 -> Int -- ^ hash1 -> Int -- ^ hash2 - -> ST s (Int, Int) + -> ST s (Int, Elem) delete' (HashTable _ _ hashes keys values _) !updating !k b1 b2 h1 h2 = do debug $ "delete' b1=" ++ show b1 ++ " b2=" ++ show b2 ++ " h1=" ++ show h1 ++ " h2=" ++ show h2 prefetchWrite hashes b2 - idx1 <- searchOne keys hashes k b1 h1 + let !he1 = hashToElem h1 + let !he2 = hashToElem h2 + idx1 <- searchOne keys hashes k b1 he1 if idx1 < 0 then do - idx2 <- searchOne keys hashes k b2 h2 + idx2 <- searchOne keys hashes k b2 he2 if idx2 < 0 then if updating then do @@ -451,16 +468,16 @@ idxE1 <- cacheLineSearch hashes b1 emptyMarker debug $ "delete': idxE1 was " ++ show idxE1 if idxE1 >= 0 - then return (idxE1, h1) + then return (idxE1, he1) else do idxE2 <- cacheLineSearch hashes b2 emptyMarker debug $ "delete': idxE2 was " ++ show idxE1 if idxE2 >= 0 - then return (idxE2, h2) - else return (-1, -1) - else return (-1,-1) - else deleteIt idx2 h2 - else deleteIt idx1 h1 + then return (idxE2, he2) + else return (-1, 0) + else return (-1, 0) + else deleteIt idx2 he2 + else deleteIt idx1 he1 where deleteIt !idx !h = do @@ -520,18 +537,20 @@ return $! b + z bumpIdx !idx !h !k !v = do + let !he = hashToElem h debug $ "bumpIdx idx=" ++ show idx ++ " h=" ++ show h - !h' <- U.readArray hashes idx - debug $ "bumpIdx: h' was " ++ show h' + ++ " he=" ++ show he + !he' <- U.readArray hashes idx + debug $ "bumpIdx: he' was " ++ show he' !k' <- readArray keys idx v' <- readArray values idx - U.writeArray hashes idx h + U.writeArray hashes idx he writeArray keys idx k writeArray values idx v - debug $ "bumped key with h'=" ++ show h' - return $! (h', k', v') + debug $ "bumped key with he'=" ++ show he' + return $! (he', k', v') - otherHash h k = if h2 == h then h1 else h2 + otherHash he k = if hashToElem h1 == he then h2 else h1 where h1 = hash1 k h2 = hash2 k @@ -543,7 +562,7 @@ if idx >= 0 then do - U.writeArray hashes idx h + U.writeArray hashes idx $! hashToElem h writeArray keys idx k writeArray values idx v return Nothing @@ -552,8 +571,8 @@ go !b !h !k v !maxAttempts | maxAttempts == 0 = return $! Just (k,v) | otherwise = do idx <- randomIdx b - (!h0', !k', v') <- bumpIdx idx h k v - let !h' = otherHash h0' k' + (!he0', !k', v') <- bumpIdx idx h k v + let !h' = otherHash he0' k' let !b' = whichLine h' sz tryWrite b' h' k' v' maxAttempts @@ -566,11 +585,11 @@ -> v -> ST s (HashTable_ s k v) grow (HashTable sz _ hashes keys values _) k0 v0 = do - newHt <- grow' $! bumpSize sz + newHt <- grow' $! bumpSize bumpFactor sz mbR <- updateOrFail newHt k0 v0 maybe (return newHt) - (\_ -> grow' $ bumpSize $ _size newHt) + (\_ -> grow' $ bumpSize bumpFactor $ _size newHt) mbR where @@ -583,7 +602,7 @@ rehash !newSz !newHt = go 0 where - totSz = numWordsInCacheLine * sz + totSz = numElemsInCacheLine * sz go !i | i >= totSz = return newHt | otherwise = do @@ -595,7 +614,7 @@ mbR <- updateOrFail newHt k v maybe (go $ i + 1) - (\_ -> grow' $ bumpSize newSz) + (\_ -> grow' $ bumpSize bumpFactor newSz) mbR else go $ i + 1 @@ -610,30 +629,31 @@ ------------------------------------------------------------------------------ hash1 :: Hashable k => k -> Int -hash1 = hashF H.hash +hash1 = H.hash {-# INLINE hash1 #-} hash2 :: Hashable k => k -> Int -hash2 = hashF (H.hashWithSalt hashPrime) +hash2 = H.hashWithSalt hashPrime {-# INLINE hash2 #-} -hashF :: (k -> Int) -> k -> Int -hashF f k = out +------------------------------------------------------------------------------ +hashToElem :: Int -> Elem +hashToElem !h = out where - !(I# h#) = f k + !(I# lo#) = h .&. U.elemMask - !m# = maskw# h# 0# + !m# = maskw# lo# 0# !nm# = not# m# - !r# = ((int2Word# 1#) `and#` m#) `or#` (int2Word# h# `and#` nm#) - !out = I# (word2Int# r#) -{-# INLINE hashF #-} + !r# = ((int2Word# 1#) `and#` m#) `or#` (int2Word# lo# `and#` nm#) + !out = U.primWordToElem r# +{-# INLINE hashToElem #-} ------------------------------------------------------------------------------ -emptyMarker :: Int +emptyMarker :: Elem emptyMarker = 0 @@ -643,6 +663,11 @@ ------------------------------------------------------------------------------ +bumpFactor :: Double +bumpFactor = 0.73 + + +------------------------------------------------------------------------------ debug :: String -> ST s () #ifdef DEBUG debug s = unsafeIOToST (putStrLn s >> hFlush stdout) @@ -670,4 +695,3 @@ readRef :: HashTable s k v -> ST s (HashTable_ s k v) readRef (HT ref) = readSTRef ref {-# INLINE readRef #-} - diff --git a/src/Data/HashTable/ST/Linear.hs b/src/Data/HashTable/ST/Linear.hs --- a/src/Data/HashTable/ST/Linear.hs +++ b/src/Data/HashTable/ST/Linear.hs @@ -6,9 +6,6 @@ {-| An implementation of linear hash tables. (See ). Use this hash table if you... - * care a lot about fitting your data set into memory; of the hash tables - included in this collection, this one has the lowest space overhead - * don't care that inserts and lookups are slower than the other hash table implementations in this collection (this one is slightly faster than @Data.HashTable@ from the base library in most cases) @@ -92,17 +89,20 @@ ) where ------------------------------------------------------------------------------ -import Control.Monad hiding (mapM_, foldM) +import Control.Monad hiding (foldM, mapM_) import Control.Monad.ST +#ifdef DEBUG +import Control.Monad.ST.Unsafe +#endif import Data.Bits import Data.Hashable import Data.STRef -import Prelude hiding (mapM_, lookup) +import Prelude hiding (lookup, mapM_) ------------------------------------------------------------------------------ -import qualified Data.HashTable.Class as C +import qualified Data.HashTable.Class as C import Data.HashTable.Internal.Array -import qualified Data.HashTable.Internal.Linear.Bucket as Bucket import Data.HashTable.Internal.Linear.Bucket (Bucket) +import qualified Data.HashTable.Internal.Linear.Bucket as Bucket import Data.HashTable.Internal.Utils #ifdef DEBUG diff --git a/test/hashtables-test.cabal b/test/hashtables-test.cabal --- a/test/hashtables-test.cabal +++ b/test/hashtables-test.cabal @@ -2,7 +2,7 @@ Version: 0.2 Author: Gregory Collins Maintainer: greg@gregorycollins.net -Copyright: (c) 2011-2012, Google, Inc. +Copyright: (c) 2011-2013, Google, Inc. Category: Data Build-type: Simple Cabal-version: >= 1.8 @@ -22,13 +22,11 @@ Description: if on, use bounds-checking array accesses Default: False - -Flag sse41 - Description: if on, use SSE 4.1 extensions to search cache lines very - efficiently +Flag sse42 + Description: if on, use SSE 4.2 extensions to search cache lines very + efficiently. The portable flag forces this off. Default: False - Flag portable Description: if on, use only pure Haskell code and no GHC extensions. Default: False @@ -38,8 +36,16 @@ hs-source-dirs: ../src suite main-is: TestSuite.hs + if flag(sse42) && !flag(portable) + cc-options: -DUSE_SSE_4_2 -msse4.2 + cpp-options: -DUSE_SSE_4_2 + C-sources: ../cbits/sse-42.c + + if !flag(portable) && !flag(sse42) + C-sources: ../cbits/default.c + if !flag(portable) - C-sources: ../cbits/cfuncs.c + C-sources: ../cbits/common.c ghc-prof-options: -prof -auto-all @@ -59,10 +65,6 @@ if flag(bounds-checking) cpp-options: -DBOUNDS_CHECKING - if !flag(portable) && flag(sse41) - cc-options: -DUSE_SSE_4_1 -msse4.1 - cpp-options: -DUSE_SSE_4_1 - Build-depends: base >= 4 && <5, hashable >= 1.1 && <1.2 || >= 1.2.1 && <1.3, mwc-random >= 0.8 && <0.13, @@ -89,8 +91,18 @@ Executable compute-overhead hs-source-dirs: ../src suite compute-overhead main-is: ComputeOverhead.hs - C-sources: ../cbits/cfuncs.c + if flag(sse42) && !flag(portable) + cc-options: -DUSE_SSE_4_2 -msse4.2 + cpp-options: -DUSE_SSE_4_2 + C-sources: ../cbits/sse-42.c + + if !flag(portable) && !flag(sse42) + C-sources: ../cbits/default.c + + if !flag(portable) + C-sources: ../cbits/common.c + ghc-prof-options: -prof -auto-all if flag(portable) @@ -106,17 +118,13 @@ if flag(bounds-checking) cpp-options: -DBOUNDS_CHECKING - if !flag(portable) && flag(sse41) - cc-options: -DUSE_SSE_4_1 -msse4.1 - cpp-options: -DUSE_SSE_4_1 - Build-depends: base >= 4 && <5, hashable >= 1.1 && <1.2 || >= 1.2.1 && <1.3, mwc-random >= 0.8 && <0.13, QuickCheck >= 2.3.0.2 && <3, HUnit >= 1.2 && <2, - test-framework >= 0.3.1 && <0.7, - test-framework-quickcheck2 >= 0.2.6 && <0.3, + test-framework >= 0.3.1 && <0.9, + test-framework-quickcheck2 >= 0.2.6 && <0.4, test-framework-hunit >= 0.2.6 && <3, statistics >= 0.8 && <0.11, primitive, diff --git a/test/runTestsAndCoverage.sh b/test/runTestsAndCoverage.sh --- a/test/runTestsAndCoverage.sh +++ b/test/runTestsAndCoverage.sh @@ -19,7 +19,7 @@ exit; fi -./dist/build/testsuite/testsuite -j4 -a1000 $* +./dist/build/testsuite/testsuite -a1000 $* DIR=dist/hpc diff --git a/test/suite/Data/HashTable/Test/Common.hs b/test/suite/Data/HashTable/Test/Common.hs --- a/test/suite/Data/HashTable/Test/Common.hs +++ b/test/suite/Data/HashTable/Test/Common.hs @@ -50,6 +50,21 @@ ------------------------------------------------------------------------------ +announce :: Show a => String -> a -> IO () +#ifdef DEBUG +announce nm x = do + putStrLn "\n=============================" + putStrLn $ concat [ "starting " + , nm + , " with " + , show x + ] + putStrLn "=============================" +#else +announce _ _ = return () +#endif + + assertEq :: (Eq a, Show a) => String -> a -> a -> PropertyM IO () assertEq s expected got = @@ -98,6 +113,7 @@ prop :: GenIO -> [(Int, Int)] -> PropertyM IO () prop rng origL = do let l = V.toList $ shuffle rng $ V.fromList $ dedupe origL + run $ announce "fromListToList" l ht <- run $ fromList l l' <- run $ toList ht assertEq "fromList . toList == id" (sort l) (sort l') @@ -114,7 +130,8 @@ where prop :: GenIO -> ([(Int, Int)], (Int,Int)) -> PropertyM IO () - prop rng (origL, (k,v)) = do + prop rng o@(origL, (k,v)) = do + run $ announce "insert" o let l = V.toList $ shuffle rng $ V.fromList $ remove k $ dedupe origL assert $ all (\t -> fst t /= k) l @@ -139,7 +156,8 @@ where prop :: GenIO -> ([(Int, Int)], (Int,Int,Int)) -> PropertyM IO () - prop rng (origL, (k,v,v2)) = do + prop rng o@(origL, (k,v,v2)) = do + run $ announce "insert2" o let l = V.toList $ shuffle rng $ V.fromList $ dedupe origL ht <- run $ fromList l @@ -162,7 +180,8 @@ where prop :: (Int,Int,Int) -> PropertyM IO () - prop (k,v,v2) = do + prop o@(k,v,v2) = do + run $ announce "newAndInsert" o ht <- run new nothing <- run $ lookup ht k @@ -209,6 +228,7 @@ prop :: Int -> PropertyM IO () prop n = do + run $ announce "growTable" n ht <- run $ go n i <- liftM head $ run $ sample' $ choose (0,n-1) @@ -254,6 +274,8 @@ prop :: Int -> PropertyM IO () prop n = do + run $ announce "delete" n + ht <- run $ go n i <- liftM head $ run $ sample' $ choose (4,n-1) @@ -475,4 +497,3 @@ idx <- pickOne k swap k idx f (k-1) -