hunk ./Data/BloomFilter/Hash.hs 45 +import Foreign.C.String (CString) hunk ./Data/BloomFilter/Hash.hs 47 +import Foreign.ForeignPtr (withForeignPtr) hunk ./Data/BloomFilter/Hash.hs 49 -import Foreign.Marshal.Array (withArrayLen) -import Foreign.Ptr (Ptr, castPtr, plusPtr) +import Foreign.Marshal.Array (allocaArray, withArrayLen) +import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr) hunk ./Data/BloomFilter/Hash.hs 53 +import Data.ByteString.Internal (ByteString(..)) hunk ./Data/BloomFilter/Hash.hs 107 -hashSalt32 salt k = - let !r = unsafePerformIO $ hashIO32 k salt - in r +hashSalt32 salt k = unsafePerformIO $ hashIO32 k salt hunk ./Data/BloomFilter/Hash.hs 114 -hashSalt64 salt k = - let !r = unsafePerformIO $ hashIO64 k salt - in r +hashSalt64 salt k = unsafePerformIO $ hashIO64 k salt hunk ./Data/BloomFilter/Hash.hs 253 - hashIO32 bs salt = SB.useAsCStringLen bs $ \(ptr, len) -> do + hashIO32 bs salt = unsafeUseAsCStringLen bs $ \ptr len -> hunk ./Data/BloomFilter/Hash.hs 257 - hashIO64 bs salt = SB.useAsCStringLen bs $ \(ptr, len) -> do + hashIO64 bs salt = unsafeUseAsCStringLen bs $ \ptr len -> hunk ./Data/BloomFilter/Hash.hs 264 - where repack = SB.concat . LB.toChunks + where repack = SB.concat . LB.toChunks hunk ./Data/BloomFilter/Hash.hs 271 - hashIO64 bs salt = hashStrictStrings (rechunk bs) salt + hashIO64 = hashChunks hunk ./Data/BloomFilter/Hash.hs 330 --- | A more efficient way to hash a list of strict ByteStrings. Used --- by the lazy ByteString hash code. -hashStrictStrings :: [SB.ByteString] -> Word64 -> IO Word64 -hashStrictStrings xs salt = +unsafeUseAsCStringLen :: SB.ByteString -> (CString -> Int -> IO a) -> IO a +unsafeUseAsCStringLen (PS fp o l) action = + withForeignPtr fp $ \p -> action (p `plusPtr` o) l + +type HashState = Ptr Word32 + +foreign import ccall unsafe "lookup3.h _jenkins_little2_begin" c_begin + :: Ptr Word32 -> Ptr Word32 -> HashState -> IO () + +foreign import ccall unsafe "lookup3.h _jenkins_little2_frag" c_frag + :: Ptr a -> CSize -> HashState -> CSize -> IO CSize + +foreign import ccall unsafe "lookup3.h _jenkins_little2_step" c_step + :: Ptr a -> CSize -> HashState -> IO CSize + +foreign import ccall unsafe "lookup3.h _jenkins_little2_end" c_end + :: CInt -> Ptr Word32 -> Ptr Word32 -> HashState -> IO () + +unsafeAdjustCStringLen :: SB.ByteString -> Int -> (CString -> Int -> IO a) + -> IO a +unsafeAdjustCStringLen (PS fp o l) d action + | d > l = action nullPtr 0 + | otherwise = withForeignPtr fp $ \p -> action (p `plusPtr` (o + d)) (l - d) + +hashChunks :: LB.ByteString -> Word64 -> IO Word64 +hashChunks s salt = do hunk ./Data/BloomFilter/Hash.hs 359 - go x = SB.useAsCStringLen x $ \(ptr,len) -> - doubleHash ptr (fromIntegral len) p1 p2 - mapM_ go xs + allocaArray 3 $ \st -> do + let step :: LB.ByteString -> Int -> IO Int + step (LB.Chunk x xs) off = do + unread <- unsafeAdjustCStringLen x off $ \ptr len -> + c_step ptr (fromIntegral len) st + if unread > 0 + then frag xs unread + else step xs 0 + step _ _ = return 0 + + frag :: LB.ByteString -> CSize -> IO Int + frag c@(LB.Chunk x xs) stoff = do + nstoff <- unsafeUseAsCStringLen x $ \ptr len -> do + c_frag ptr (fromIntegral len) st stoff + if nstoff == 12 + then step c (fromIntegral (nstoff - stoff)) + else frag xs nstoff + frag LB.Empty stoff = return (fromIntegral (12 - stoff)) + c_begin p1 p2 st + unread <- step s 0 + c_end (fromIntegral unread) p1 p2 st hunk ./cbits/lookup3.c 54 -/* - * My best guess at if you are big-endian or little-endian. This may - * need adjustment. - */ -#if (defined(__BYTE_ORDER) && defined(__LITTLE_ENDIAN) && \ - __BYTE_ORDER == __LITTLE_ENDIAN) || \ - (defined(i386) || defined(__i386__) || defined(__i486__) || \ - defined(__i586__) || defined(__i686__) || defined(vax) || defined(MIPSEL)) -# define HASH_LITTLE_ENDIAN 1 -# define HASH_BIG_ENDIAN 0 -#elif (defined(__BYTE_ORDER) && defined(__BIG_ENDIAN) && \ - __BYTE_ORDER == __BIG_ENDIAN) || \ - (defined(sparc) || defined(POWERPC) || defined(mc68000) || defined(sel)) -# define HASH_LITTLE_ENDIAN 0 -# define HASH_BIG_ENDIAN 1 -#else -# define HASH_LITTLE_ENDIAN 0 -# define HASH_BIG_ENDIAN 0 -#endif - hunk ./cbits/lookup3.c 56 -#define rot(x,k) (((x)<<(k)) | ((x)>>(32-(k)))) - -/* -------------------------------------------------------------------------------- -mix -- mix 3 32-bit values reversibly. - -This is reversible, so any information in (a,b,c) before mix() is -still in (a,b,c) after mix(). - -If four pairs of (a,b,c) inputs are run through mix(), or through -mix() in reverse, there are at least 32 bits of the output that -are sometimes the same for one pair and different for another pair. -This was tested for: -* pairs that differed by one bit, by two bits, in any combination - of top bits of (a,b,c), or in any combination of bottom bits of - (a,b,c). -* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed - the output delta to a Gray code (a^(a>>1)) so a string of 1's (as - is commonly produced by subtraction) look like a single 1-bit - difference. -* the base values were pseudorandom, all zero but one bit set, or - all zero plus a counter that starts at zero. - -Some k values for my "a-=c; a^=rot(c,k); c+=b;" arrangement that -satisfy this are - 4 6 8 16 19 4 - 9 15 3 18 27 15 - 14 9 3 7 17 3 -Well, "9 15 3 18 27 15" didn't quite get 32 bits diffing -for "differ" defined as + with a one-bit base and a two-bit delta. I -used http://burtleburtle.net/bob/hash/avalanche.html to choose -the operations, constants, and arrangements of the variables. - -This does not achieve avalanche. There are input bits of (a,b,c) -that fail to affect some output bits of (a,b,c), especially of a. The -most thoroughly mixed value is c, but it doesn't really even achieve -avalanche in c. - -This allows some parallelism. Read-after-writes are good at doubling -the number of bits affected, so the goal of mixing pulls in the opposite -direction as the goal of parallelism. I did what I could. Rotates -seem to cost as much as shifts on every machine I could lay my hands -on, and rotates are much kinder to the top and bottom bits, so I used -rotates. -------------------------------------------------------------------------------- -*/ -#define mix(a,b,c) \ -{ \ - a -= c; a ^= rot(c, 4); c += b; \ - b -= a; b ^= rot(a, 6); a += c; \ - c -= b; c ^= rot(b, 8); b += a; \ - a -= c; a ^= rot(c,16); c += b; \ - b -= a; b ^= rot(a,19); a += c; \ - c -= b; c ^= rot(b, 4); b += a; \ -} - -/* -------------------------------------------------------------------------------- -final -- final mixing of 3 32-bit values (a,b,c) into c - -Pairs of (a,b,c) values differing in only a few bits will usually -produce values of c that look totally different. This was tested for -* pairs that differed by one bit, by two bits, in any combination - of top bits of (a,b,c), or in any combination of bottom bits of - (a,b,c). -* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed - the output delta to a Gray code (a^(a>>1)) so a string of 1's (as - is commonly produced by subtraction) look like a single 1-bit - difference. -* the base values were pseudorandom, all zero but one bit set, or - all zero plus a counter that starts at zero. - -These constants passed: - 14 11 25 16 4 14 24 - 12 14 25 16 4 14 24 -and these came close: - 4 8 15 26 3 22 24 - 10 8 15 26 3 22 24 - 11 8 15 26 3 22 24 -------------------------------------------------------------------------------- -*/ -#define final(a,b,c) \ -{ \ - c ^= b; c -= rot(b,14); \ - a ^= c; a -= rot(c,11); \ - b ^= a; b -= rot(a,25); \ - c ^= b; c -= rot(b,16); \ - a ^= c; a -= rot(c,4); \ - b ^= a; b -= rot(a,14); \ - c ^= b; c -= rot(b,24); \ -} hunk ./cbits/lookup3.h 7 +/* + * My best guess at if you are big-endian or little-endian. This may + * need adjustment. + */ +#if (defined(__BYTE_ORDER) && defined(__LITTLE_ENDIAN) && \ + __BYTE_ORDER == __LITTLE_ENDIAN) || \ + (defined(i386) || defined(__i386__) || defined(__i486__) || \ + defined(__i586__) || defined(__i686__) || defined(vax) || defined(MIPSEL)) +# define HASH_LITTLE_ENDIAN 1 +# define HASH_BIG_ENDIAN 0 +#elif (defined(__BYTE_ORDER) && defined(__BIG_ENDIAN) && \ + __BYTE_ORDER == __BIG_ENDIAN) || \ + (defined(sparc) || defined(POWERPC) || defined(mc68000) || defined(sel)) +# define HASH_LITTLE_ENDIAN 0 +# define HASH_BIG_ENDIAN 1 +#else +# define HASH_LITTLE_ENDIAN 0 +# define HASH_BIG_ENDIAN 0 +#endif + +#define rot(x,k) (((x)<<(k)) | ((x)>>(32-(k)))) + +/* +------------------------------------------------------------------------------- +mix -- mix 3 32-bit values reversibly. + +This is reversible, so any information in (a,b,c) before mix() is +still in (a,b,c) after mix(). + +If four pairs of (a,b,c) inputs are run through mix(), or through +mix() in reverse, there are at least 32 bits of the output that +are sometimes the same for one pair and different for another pair. +This was tested for: +* pairs that differed by one bit, by two bits, in any combination + of top bits of (a,b,c), or in any combination of bottom bits of + (a,b,c). +* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed + the output delta to a Gray code (a^(a>>1)) so a string of 1's (as + is commonly produced by subtraction) look like a single 1-bit + difference. +* the base values were pseudorandom, all zero but one bit set, or + all zero plus a counter that starts at zero. + +Some k values for my "a-=c; a^=rot(c,k); c+=b;" arrangement that +satisfy this are + 4 6 8 16 19 4 + 9 15 3 18 27 15 + 14 9 3 7 17 3 +Well, "9 15 3 18 27 15" didn't quite get 32 bits diffing +for "differ" defined as + with a one-bit base and a two-bit delta. I +used http://burtleburtle.net/bob/hash/avalanche.html to choose +the operations, constants, and arrangements of the variables. + +This does not achieve avalanche. There are input bits of (a,b,c) +that fail to affect some output bits of (a,b,c), especially of a. The +most thoroughly mixed value is c, but it doesn't really even achieve +avalanche in c. + +This allows some parallelism. Read-after-writes are good at doubling +the number of bits affected, so the goal of mixing pulls in the opposite +direction as the goal of parallelism. I did what I could. Rotates +seem to cost as much as shifts on every machine I could lay my hands +on, and rotates are much kinder to the top and bottom bits, so I used +rotates. +------------------------------------------------------------------------------- +*/ +#define mix(a,b,c) \ +{ \ + a -= c; a ^= rot(c, 4); c += b; \ + b -= a; b ^= rot(a, 6); a += c; \ + c -= b; c ^= rot(b, 8); b += a; \ + a -= c; a ^= rot(c,16); c += b; \ + b -= a; b ^= rot(a,19); a += c; \ + c -= b; c ^= rot(b, 4); b += a; \ +} + +/* +------------------------------------------------------------------------------- +final -- final mixing of 3 32-bit values (a,b,c) into c + +Pairs of (a,b,c) values differing in only a few bits will usually +produce values of c that look totally different. This was tested for +* pairs that differed by one bit, by two bits, in any combination + of top bits of (a,b,c), or in any combination of bottom bits of + (a,b,c). +* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed + the output delta to a Gray code (a^(a>>1)) so a string of 1's (as + is commonly produced by subtraction) look like a single 1-bit + difference. +* the base values were pseudorandom, all zero but one bit set, or + all zero plus a counter that starts at zero. + +These constants passed: + 14 11 25 16 4 14 24 + 12 14 25 16 4 14 24 +and these came close: + 4 8 15 26 3 22 24 + 10 8 15 26 3 22 24 + 11 8 15 26 3 22 24 +------------------------------------------------------------------------------- +*/ +#define final(a,b,c) \ +{ \ + c ^= b; c -= rot(b,14); \ + a ^= c; a -= rot(c,11); \ + b ^= a; b -= rot(a,25); \ + c ^= b; c -= rot(b,16); \ + a ^= c; a -= rot(c,4); \ + b ^= a; b -= rot(a,14); \ + c ^= b; c -= rot(b,24); \ +} + hunk ./cbits/lookup3.h 129 +static inline void _jenkins_little2_begin(const uint32_t *pc, + const uint32_t *pb, + uint32_t st[3]) +{ + uint32_t a,b,c; + + /* Set up the internal state */ + a = b = c = 0xdeadbeef + *pc; + c += *pb; + + st[0] = a; + st[1] = b; + st[2] = c; +} + +static inline size_t _jenkins_little2_frag(const void *key, + size_t length, + uint32_t st[4], + size_t offset) +{ + const uint8_t *k = key; + size_t i; + + for (i = 0; i < length && offset < 12; i++, offset++) { + st[offset >> 2] += k[i] << (8 * (offset & 3)); + } + + if (offset == 12) { + uint32_t a = st[0], b = st[1], c = st[2]; + + mix(a,b,c); + + st[0] = a; + st[1] = b; + st[2] = c; + } + + return offset; +} + +static inline size_t _jenkins_little2_step(const void *key, + size_t length, + uint32_t st[3]) +{ + uint32_t a = st[0], b = st[1], c = st[2]; /* internal state */ + union { const void *ptr; size_t i; } u; /* needed for Mac Powerbook G4 */ + + u.ptr = key; + if (HASH_LITTLE_ENDIAN && ((u.i & 0x3) == 0)) { + const uint32_t *k = (const uint32_t *)key; /* read 32-bit chunks */ + + /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */ + while (length >= 12) + { + a += k[0]; + b += k[1]; + c += k[2]; + mix(a,b,c); + length -= 12; + k += 3; + } + + /*----------------------------- handle the last (probably partial) block */ + /* + * "k[2]&0xffffff" actually reads beyond the end of the string, but + * then masks off the part it's not allowed to read. Because the + * string is aligned, the masked-off tail is in the same word as the + * rest of the string. Every machine with memory protection I've seen + * does it on word boundaries, so is OK with this. But VALGRIND will + * still catch it and complain. The masking trick does make the hash + * noticably faster for short strings (like English words). + */ +#ifndef VALGRIND + + switch(length) + { + case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; + case 11: c+=k[2]&0xffffff; b+=k[1]; a+=k[0]; break; + case 10: c+=k[2]&0xffff; b+=k[1]; a+=k[0]; break; + case 9 : c+=k[2]&0xff; b+=k[1]; a+=k[0]; break; + case 8 : b+=k[1]; a+=k[0]; break; + case 7 : b+=k[1]&0xffffff; a+=k[0]; break; + case 6 : b+=k[1]&0xffff; a+=k[0]; break; + case 5 : b+=k[1]&0xff; a+=k[0]; break; + case 4 : a+=k[0]; break; + case 3 : a+=k[0]&0xffffff; break; + case 2 : a+=k[0]&0xffff; break; + case 1 : a+=k[0]&0xff; break; + } + +#else /* make valgrind happy */ + + k8 = (const uint8_t *)k; + switch(length) + { + case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; + case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ + case 10: c+=((uint32_t)k8[9])<<8; /* fall through */ + case 9 : c+=k8[8]; /* fall through */ + case 8 : b+=k[1]; a+=k[0]; break; + case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ + case 6 : b+=((uint32_t)k8[5])<<8; /* fall through */ + case 5 : b+=k8[4]; /* fall through */ + case 4 : a+=k[0]; break; + case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ + case 2 : a+=((uint32_t)k8[1])<<8; /* fall through */ + case 1 : a+=k8[0]; break; + } + +#endif /* !valgrind */ + + } else if (HASH_LITTLE_ENDIAN && ((u.i & 0x1) == 0)) { + const uint16_t *k = (const uint16_t *)key; /* read 16-bit chunks */ + const uint8_t *k8; + + /*--------------- all but last block: aligned reads and different mixing */ + while (length >= 12) + { + a += k[0] + (((uint32_t)k[1])<<16); + b += k[2] + (((uint32_t)k[3])<<16); + c += k[4] + (((uint32_t)k[5])<<16); + mix(a,b,c); + length -= 12; + k += 6; + } + + /*----------------------------- handle the last (probably partial) block */ + k8 = (const uint8_t *)k; + switch(length) + { + case 12: c+=k[4]+(((uint32_t)k[5])<<16); + b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ + case 10: c+=k[4]; + b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 9 : c+=k8[8]; /* fall through */ + case 8 : b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ + case 6 : b+=k[2]; + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 5 : b+=k8[4]; /* fall through */ + case 4 : a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ + case 2 : a+=k[0]; + break; + case 1 : a+=k8[0]; + break; + } + + } else { /* need to read the key one byte at a time */ + const uint8_t *k = (const uint8_t *)key; + + /*--------------- all but the last block: affect some 32 bits of (a,b,c) */ + while (length >= 12) + { + a += k[0]; + a += ((uint32_t)k[1])<<8; + a += ((uint32_t)k[2])<<16; + a += ((uint32_t)k[3])<<24; + b += k[4]; + b += ((uint32_t)k[5])<<8; + b += ((uint32_t)k[6])<<16; + b += ((uint32_t)k[7])<<24; + c += k[8]; + c += ((uint32_t)k[9])<<8; + c += ((uint32_t)k[10])<<16; + c += ((uint32_t)k[11])<<24; + mix(a,b,c); + length -= 12; + k += 12; + } + + /*-------------------------------- last block: affect all 32 bits of (c) */ + switch(length) /* all the case statements fall through */ + { + case 12: c+=((uint32_t)k[11])<<24; + case 11: c+=((uint32_t)k[10])<<16; + case 10: c+=((uint32_t)k[9])<<8; + case 9 : c+=k[8]; + case 8 : b+=((uint32_t)k[7])<<24; + case 7 : b+=((uint32_t)k[6])<<16; + case 6 : b+=((uint32_t)k[5])<<8; + case 5 : b+=k[4]; + case 4 : a+=((uint32_t)k[3])<<24; + case 3 : a+=((uint32_t)k[2])<<16; + case 2 : a+=((uint32_t)k[1])<<8; + case 1 : a+=k[0]; + break; + } + } + + st[0] = a; + st[1] = b; + st[2] = c; + + return length; +} + + +static inline void _jenkins_little2_end(int nonempty, + uint32_t *pc, + uint32_t *pb, + const uint32_t st[3]) +{ + uint32_t a = st[0], b = st[1], c = st[2]; + + if (nonempty) + final(a,b,c); + *pc=c; *pb=b; +} + hunk ./tests/Makefile 3 -all: test-$(count).out +all: test-$(count).out timing hunk ./tests/QC.hs 41 - , p "SB.ByteString" $ prop_pai (undefined :: SB.ByteString) - , p "(String,Int)" $ prop_pai (undefined :: (String,Int)) - , p "(Double,Int,SB.ByteString)" $ prop_pai - (undefined :: (Double,Int,SB.ByteString)) - , p "(Ordering,(Char,Int),LB.ByteString,Word64)" $ prop_pai - (undefined :: (Ordering,(Char,Int),LB.ByteString,Word64)) - , (flip limCheck prop_rechunked_eq, "prop_rechunked_eq") + , p "prop_rechunked_eq" prop_rechunked_eq hunk ./tests/QC.hs 45 -rechunk 0 xs = xs -rechunk k xs = LB.fromChunks (go xs) +rechunk k xs | k <= 0 = xs + | otherwise = LB.fromChunks (go xs) hunk ./tests/QC.hs 54 -prop_rechunked :: Eq a => (LB.ByteString -> a) - -> LB.ByteString -> Property +prop_rechunked :: Eq a => (LB.ByteString -> a) -> LB.ByteString -> Property hunk ./tests/QC.hs 61 +prop_rechunked_eq :: LB.ByteString -> Property hunk ./bloomfilter.cabal 2 -version: 1.2.3 +version: 1.2.4