From 3cd1cf0489dff4389faadb0865658aa6a914a323 Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Sun, 21 May 2023 10:43:13 -0400 Subject: [PATCH 01/17] Perform unaligned writes via FFI when necessary --- Data/ByteString/Builder/Prim/Binary.hs | 41 ++++++++++++++++++------ Data/ByteString/Builder/Prim/Internal.hs | 9 ++---- Data/ByteString/Short/Internal.hs | 22 ++++--------- bytestring.cabal | 8 ++--- cbits/fpstring.c | 19 +++++++++++ include/bytestring-cpp-macros.h | 27 ++++++++++++++++ 6 files changed, 91 insertions(+), 35 deletions(-) create mode 100644 include/bytestring-cpp-macros.h diff --git a/Data/ByteString/Builder/Prim/Binary.hs b/Data/ByteString/Builder/Prim/Binary.hs index 0c90e14e3..837bc4288 100644 --- a/Data/ByteString/Builder/Prim/Binary.hs +++ b/Data/ByteString/Builder/Prim/Binary.hs @@ -1,5 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} + +{-# LANGUAGE TypeApplications #-} + -- | Copyright : (c) 2010-2011 Simon Meier -- License : BSD3-style (see LICENSE) -- @@ -70,7 +73,7 @@ import Foreign -- {-# INLINE word8 #-} word8 :: FixedPrim Word8 -word8 = storableToF +word8 = fixedPrim 1 (flip poke) -- Word8 is always aligned -- -- We rely on the fromIntegral to do the right masking for us. @@ -143,23 +146,43 @@ word64LE = word64Host -- {-# INLINE wordHost #-} wordHost :: FixedPrim Word -wordHost = storableToF +wordHost = case finiteBitSize (0 :: Word) of + 32 -> fromIntegral @Word @Word32 >$< word32Host + 64 -> fromIntegral @Word @Word64 >$< word64Host + _ -> error "Data.ByteString.Builder.Prim.Binary.wordHost: unexpected word size" -- | Encoding 'Word16's in native host order and host endianness. {-# INLINE word16Host #-} word16Host :: FixedPrim Word16 -word16Host = storableToF +word16Host = fixedPrim 2 unaligned_write_u16 -- | Encoding 'Word32's in native host order and host endianness. {-# INLINE word32Host #-} word32Host :: FixedPrim Word32 -word32Host = storableToF +word32Host = fixedPrim 4 unaligned_write_u32 -- | Encoding 'Word64's in native host order and host endianness. {-# INLINE word64Host #-} word64Host :: FixedPrim Word64 -word64Host = storableToF +word64Host = fixedPrim 8 unaligned_write_u64 + +#if HS_BYTESTRING_UNALIGNED_POKES_OK +unaligned_write_u16 :: Word16 -> Ptr Word8 -> IO () +unaligned_write_u16 x p = poke (castPtr p) x +unaligned_write_u32 :: Word32 -> Ptr Word8 -> IO () +unaligned_write_u32 x p = poke (castPtr p) x + +unaligned_write_u64 :: Word64 -> Ptr Word8 -> IO () +unaligned_write_u64 x p = poke (castPtr p) x +#else +foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u16" + unaligned_write_u16 :: Word16 -> Ptr Word8 -> IO () +foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u32" + unaligned_write_u32 :: Word32 -> Ptr Word8 -> IO () +foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u64" + unaligned_write_u64 :: Word64 -> Ptr Word8 -> IO () +#endif ------------------------------------------------------------------------------ -- Int encodings @@ -215,22 +238,22 @@ int64LE = fromIntegral >$< word64LE -- {-# INLINE intHost #-} intHost :: FixedPrim Int -intHost = storableToF +intHost = fromIntegral @Int @Word >$< wordHost -- | Encoding 'Int16's in native host order and host endianness. {-# INLINE int16Host #-} int16Host :: FixedPrim Int16 -int16Host = storableToF +int16Host = fromIntegral @Int16 @Word16 >$< word16Host -- | Encoding 'Int32's in native host order and host endianness. {-# INLINE int32Host #-} int32Host :: FixedPrim Int32 -int32Host = storableToF +int32Host = fromIntegral @Int32 @Word32 >$< word32Host -- | Encoding 'Int64's in native host order and host endianness. {-# INLINE int64Host #-} int64Host :: FixedPrim Int64 -int64Host = storableToF +int64Host = fromIntegral @Int64 @Word64 >$< word64Host -- IEEE Floating Point Numbers ------------------------------ diff --git a/Data/ByteString/Builder/Prim/Internal.hs b/Data/ByteString/Builder/Prim/Internal.hs index 52cf0f5cb..77236d9e3 100644 --- a/Data/ByteString/Builder/Prim/Internal.hs +++ b/Data/ByteString/Builder/Prim/Internal.hs @@ -73,6 +73,7 @@ import Foreign import Prelude hiding (maxBound) #include "MachDeps.h" +#include "bytestring-cpp-macros.h" ------------------------------------------------------------------------------ -- Supporting infrastructure @@ -199,13 +200,7 @@ liftFixedToBounded = toB {-# INLINE CONLIKE storableToF #-} storableToF :: forall a. Storable a => FixedPrim a --- Not all architectures are forgiving of unaligned accesses; whitelist ones --- which are known not to trap (either to the kernel for emulation, or crash). -#if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \ - || ((defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) \ - && defined(__ARM_FEATURE_UNALIGNED)) \ - || defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) +#if HS_UNALIGNED_POKES_OK storableToF = FP (sizeOf (undefined :: a)) (\x op -> poke (castPtr op) x) #else storableToF = FP (sizeOf (undefined :: a)) $ \x op -> diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index 78846b360..b66697299 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -21,15 +21,8 @@ {-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_GHC -fexpose-all-unfoldings #-} --- Not all architectures are forgiving of unaligned accesses; whitelist ones --- which are known not to trap (either to the kernel for emulation, or crash). -#if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \ - || ((defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) \ - && defined(__ARM_FEATURE_UNALIGNED)) \ - || defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) -#define SAFE_UNALIGNED 1 -#endif + +#include "bytestring-cpp-macros.h" -- | -- Module : Data.ByteString.Short.Internal @@ -172,7 +165,7 @@ import Data.Array.Byte import Data.Bits ( FiniteBits (finiteBitSize) , shiftL -#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED) +#if HS_UNALIGNED_ByteArray_OPS_OK , shiftR #endif , (.&.) @@ -231,7 +224,7 @@ import GHC.Exts , indexWord8Array#, indexCharArray# , writeWord8Array# , unsafeFreezeByteArray# -#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED) +#if HS_UNALIGNED_ByteArray_OPS_OK ,writeWord64Array# ,indexWord8ArrayAsWord64# #endif @@ -803,8 +796,7 @@ reverse :: ShortByteString -> ShortByteString reverse = \sbs -> let l = length sbs ba = asBA sbs --- https://gitlab.haskell.org/ghc/ghc/-/issues/21015 -#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED) +#if HS_UNALIGNED_ByteArray_OPS_OK in create l (\mba -> go ba mba l) where go :: forall s. BA -> MBA s -> Int -> ST s () @@ -1607,7 +1599,7 @@ indexCharArray (BA# ba#) (I# i#) = C# (indexCharArray# ba# i#) indexWord8Array :: BA -> Int -> Word8 indexWord8Array (BA# ba#) (I# i#) = W8# (indexWord8Array# ba# i#) -#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED) +#if HS_UNALIGNED_ByteArray_OPS_OK indexWord8ArrayAsWord64 :: BA -> Int -> Word64 indexWord8ArrayAsWord64 (BA# ba#) (I# i#) = W64# (indexWord8ArrayAsWord64# ba# i#) #endif @@ -1632,7 +1624,7 @@ writeWord8Array (MBA# mba#) (I# i#) (W8# w#) = ST $ \s -> case writeWord8Array# mba# i# w# s of s' -> (# s', () #) -#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED) +#if HS_UNALIGNED_ByteArray_OPS_OK writeWord64Array :: MBA s -> Int -> Word64 -> ST s () writeWord64Array (MBA# mba#) (I# i#) (W64# w#) = ST $ \s -> case writeWord64Array# mba# i# w# s of diff --git a/bytestring.cabal b/bytestring.cabal index d93cfb679..ae4dc7056 100644 --- a/bytestring.cabal +++ b/bytestring.cabal @@ -128,19 +128,19 @@ library -fmax-simplifier-iterations=10 -fdicts-cheap -fspec-constr-count=6 - + c-sources: cbits/fpstring.c cbits/itoa.c cbits/shortbytestring.c - + if (arch(aarch64)) c-sources: cbits/aarch64/is-valid-utf8.c else c-sources: cbits/is-valid-utf8.c - + -- DNDEBUG disables asserts in cbits/ cc-options: -std=c11 -DNDEBUG=1 - + -- No need to link to libgcc on ghc-9.4 and later which uses a clang-based -- toolchain. if os(windows) && impl(ghc < 9.3) diff --git a/cbits/fpstring.c b/cbits/fpstring.c index fa261b2e7..56c4af562 100644 --- a/cbits/fpstring.c +++ b/cbits/fpstring.c @@ -43,6 +43,8 @@ #define USE_SIMD_COUNT #endif +#include "bytestring-cpp-macros.h" + /* copy a string in reverse */ void fps_reverse(unsigned char *q, unsigned char *p, size_t n) { p += n-1; @@ -106,6 +108,23 @@ void fps_sort(unsigned char *p, size_t len) { return qsort(p, len, 1, fps_compare); } +#if !HS_UNALIGNED_POKES_OK +void fps_unaligned_write_u16(uint16_t x, uint8_t *p) { + memcpy(p, &x, 2); + return; +} + +void fps_unaligned_write_u32(uint32_t x, uint8_t *p) { + memcpy(p, &x, 4); + return; +} + +void fps_unaligned_write_u64(uint64_t x, uint8_t *p) { + memcpy(p, &x, 8); + return; +} +#endif + /* count the number of occurrences of a char in a string */ size_t fps_count_naive(unsigned char *str, size_t len, unsigned char w) { size_t c; diff --git a/include/bytestring-cpp-macros.h b/include/bytestring-cpp-macros.h new file mode 100644 index 000000000..2d533c128 --- /dev/null +++ b/include/bytestring-cpp-macros.h @@ -0,0 +1,27 @@ +#if 0 +This file gets included in both C and Haskell sources, +so any comments should by guarded by an if 0. +#endif + + + +#define HS_UNALIGNED_POKES_OK \ + defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \ + || ((defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) \ + && defined(__ARM_FEATURE_UNALIGNED)) \ + || defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ + || defined(powerpc64le_HOST_ARCH) +#if 0 +Not all architectures are forgiving of unaligned accesses; whitelist ones +which are known not to trap (either to the kernel for emulation, or crash). +#endif + + +#define HS_UNALIGNED_ByteArray_OPS_OK \ + MIN_VERSION_base(4,12,0) \ + && (MIN_VERSION_base(4,16,1) || UNALIGNED_POKES_OK) +#if 0 +The unaligned ByteArray# primops became available with base-4.12.0, +but require an unaligned-friendly host architecture to be safe to use +until ghc-9.2.2; see https://gitlab.haskell.org/ghc/ghc/-/issues/21015 +#endif From 3369aaa143f7f2fd2c5ff5ca990993d22b8a67c8 Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Sun, 21 May 2023 16:27:09 -0400 Subject: [PATCH 02/17] Be a bit less ignorant about the C preprocessor --- include/bytestring-cpp-macros.h | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/include/bytestring-cpp-macros.h b/include/bytestring-cpp-macros.h index 2d533c128..b9e8c934a 100644 --- a/include/bytestring-cpp-macros.h +++ b/include/bytestring-cpp-macros.h @@ -1,27 +1,23 @@ -#if 0 -This file gets included in both C and Haskell sources, -so any comments should by guarded by an if 0. -#endif - - - -#define HS_UNALIGNED_POKES_OK \ - defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \ +#if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \ || ((defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) \ && defined(__ARM_FEATURE_UNALIGNED)) \ || defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ || defined(powerpc64le_HOST_ARCH) -#if 0 +/* Not all architectures are forgiving of unaligned accesses; whitelist ones which are known not to trap (either to the kernel for emulation, or crash). +*/ +#define HS_UNALIGNED_POKES_OK 1 +#else +#define HS_UNALIGNED_POKES_OK 0 #endif #define HS_UNALIGNED_ByteArray_OPS_OK \ MIN_VERSION_base(4,12,0) \ && (MIN_VERSION_base(4,16,1) || UNALIGNED_POKES_OK) -#if 0 +/* The unaligned ByteArray# primops became available with base-4.12.0, but require an unaligned-friendly host architecture to be safe to use until ghc-9.2.2; see https://gitlab.haskell.org/ghc/ghc/-/issues/21015 -#endif +*/ From 9a54fa1be485c47b0b06542b753c94726df5a7a4 Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Sun, 21 May 2023 16:28:48 -0400 Subject: [PATCH 03/17] Test unaligned uses of Builders a bit more --- Data/ByteString/Builder/Internal.hs | 17 ++++++++++++++--- Data/ByteString/Internal/Type.hs | 2 +- include/bytestring-cpp-macros.h | 1 + tests/builder/Data/ByteString/Builder/Tests.hs | 18 +++++++++--------- 4 files changed, 25 insertions(+), 13 deletions(-) diff --git a/Data/ByteString/Builder/Internal.hs b/Data/ByteString/Builder/Internal.hs index abe0d43b2..bca5e985e 100644 --- a/Data/ByteString/Builder/Internal.hs +++ b/Data/ByteString/Builder/Internal.hs @@ -128,9 +128,7 @@ module Data.ByteString.Builder.Internal ( import Control.Arrow (second) -#if !(MIN_VERSION_base(4,11,0)) -import Data.Semigroup (Semigroup((<>))) -#endif +import Data.Semigroup (Semigroup(..)) import qualified Data.ByteString as S import qualified Data.ByteString.Internal.Type as S @@ -382,9 +380,22 @@ empty = Builder ($) append :: Builder -> Builder -> Builder append (Builder b1) (Builder b2) = Builder $ b1 . b2 +stimesBuilder :: Integral t => t -> Builder -> Builder +{-# INLINABLE stimesBuilder #-} +stimesBuilder n b + | n >= 0 = go n + | otherwise = stimesNegativeErr + where go 0 = empty + go k = b `append` go (k - 1) + +stimesNegativeErr :: Builder +stimesNegativeErr + = errorWithoutStackTrace "stimes @Builder: non-negative multiplier expected" + instance Semigroup Builder where {-# INLINE (<>) #-} (<>) = append + stimes = stimesBuilder instance Monoid Builder where {-# INLINE mempty #-} diff --git a/Data/ByteString/Internal/Type.hs b/Data/ByteString/Internal/Type.hs index e8769788b..eb70e424e 100644 --- a/Data/ByteString/Internal/Type.hs +++ b/Data/ByteString/Internal/Type.hs @@ -835,7 +835,7 @@ stimesPolymorphic nRaw !bs = case checkedIntegerToInt n of stimesNegativeErr :: ByteString stimesNegativeErr - = error "stimes @ByteString: non-negative multiplier expected" + = errorWithoutStackTrace "stimes @ByteString: non-negative multiplier expected" stimesOverflowErr :: ByteString -- Although this only appears once, it is extracted here to prevent it diff --git a/include/bytestring-cpp-macros.h b/include/bytestring-cpp-macros.h index b9e8c934a..cc955693a 100644 --- a/include/bytestring-cpp-macros.h +++ b/include/bytestring-cpp-macros.h @@ -10,6 +10,7 @@ which are known not to trap (either to the kernel for emulation, or crash). #define HS_UNALIGNED_POKES_OK 1 #else #define HS_UNALIGNED_POKES_OK 0 +#warning "tell me which CI jobs reach this" #endif diff --git a/tests/builder/Data/ByteString/Builder/Tests.hs b/tests/builder/Data/ByteString/Builder/Tests.hs index fa58645e4..9419bbf0d 100644 --- a/tests/builder/Data/ByteString/Builder/Tests.hs +++ b/tests/builder/Data/ByteString/Builder/Tests.hs @@ -28,9 +28,7 @@ import Foreign (minusPtr) import Data.Char (chr) import Data.Bits ((.|.), shiftL) import Data.Foldable -#if !MIN_VERSION_base(4,11,0) -import Data.Semigroup -#endif +import Data.Semigroup (Semigroup(..)) import Data.Word import qualified Data.ByteString as S @@ -54,7 +52,7 @@ import System.Posix.Internals (c_unlink) import Test.Tasty (TestTree, TestName, testGroup) import Test.Tasty.QuickCheck - ( Arbitrary(..), oneof, choose, listOf, elements + ( Arbitrary(..), oneof, choose, listOf, elements, forAll , counterexample, ioProperty, UnicodeString(..), Property, testProperty , (===), (.&&.), conjoin ) @@ -547,11 +545,13 @@ testBuilderConstr :: (Arbitrary a, Show a) testBuilderConstr name ref mkBuilder = testProperty name check where - check x = - (ws ++ ws) == - (L.unpack $ toLazyByteString $ mkBuilder x `BI.append` mkBuilder x) - where - ws = ref x + check x = forAll (choose (0, 7)) $ \paddingAmount -> let + -- we use paddingAmount to make sure we test at unaligned positions + ws = ref x + b1 = mkBuilder x + b2 = stimes paddingAmount (char8 ' ') <> b1 <> b1 + in (replicate paddingAmount (S.c2w ' ') ++ ws ++ ws) === + (L.unpack $ toLazyByteString b2) testsBinary :: [TestTree] From 19e3279b060f197bf5a44a4e283fe4f775b0f9d3 Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Sun, 21 May 2023 21:25:32 -0400 Subject: [PATCH 04/17] Attempt to remove Float-related unaligned accesses --- Data/ByteString/Builder/Prim/ASCII.hs | 1 + .../Builder/Prim/Internal/Floating.hs | 56 +++++++++---------- include/bytestring-cpp-macros.h | 19 ++++++- 3 files changed, 46 insertions(+), 30 deletions(-) diff --git a/Data/ByteString/Builder/Prim/ASCII.hs b/Data/ByteString/Builder/Prim/ASCII.hs index 8c5e3d1a2..8a365e086 100644 --- a/Data/ByteString/Builder/Prim/ASCII.hs +++ b/Data/ByteString/Builder/Prim/ASCII.hs @@ -247,6 +247,7 @@ word32HexFixed :: FixedPrim Word32 word32HexFixed = (\x -> (fromIntegral $ x `shiftR` 16, fromIntegral x)) >$< pairF word16HexFixed word16HexFixed + -- | Encode a 'Word64' using 16 nibbles. {-# INLINE word64HexFixed #-} word64HexFixed :: FixedPrim Word64 diff --git a/Data/ByteString/Builder/Prim/Internal/Floating.hs b/Data/ByteString/Builder/Prim/Internal/Floating.hs index 51b80de28..ff649153b 100644 --- a/Data/ByteString/Builder/Prim/Internal/Floating.hs +++ b/Data/ByteString/Builder/Prim/Internal/Floating.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE CPP #-} + +#include "bytestring-cpp-macros.h" + -- | -- Copyright : (c) 2010 Simon Meier -- @@ -12,45 +14,43 @@ -- Conversion of 'Float's and 'Double's to 'Word32's and 'Word64's. -- module Data.ByteString.Builder.Prim.Internal.Floating - ( - -- coerceFloatToWord32 - -- , coerceDoubleToWord64 - encodeFloatViaWord32F + ( encodeFloatViaWord32F , encodeDoubleViaWord64F ) where -import Foreign import Data.ByteString.Builder.Prim.Internal +import Data.Word +#if HS_CAST_FLOAT_WORD_OPS_AVAILABLE +import GHC.Float (castFloatToWord32, castDoubleToWord64) +#else +import Foreign.Marshal.Utils +import Foreign.Storable {- -We work around ticket http://ghc.haskell.org/trac/ghc/ticket/4092 using the -FFI to store the Float/Double in the buffer and peek it out again from there. +We work around ticket http://ghc.haskell.org/trac/ghc/ticket/4092 by +storing the Float/Double in a temp buffer and peeking it out again from there. -} +#endif -- | Encode a 'Float' using a 'Word32' encoding. --- --- PRE: The 'Word32' encoding must have a size of at least 4 bytes. {-# INLINE encodeFloatViaWord32F #-} encodeFloatViaWord32F :: FixedPrim Word32 -> FixedPrim Float -encodeFloatViaWord32F w32fe - | size w32fe < sizeOf (undefined :: Float) = - error "encodeFloatViaWord32F: encoding not wide enough" - | otherwise = fixedPrim (size w32fe) $ \x op -> do - poke (castPtr op) x - x' <- peek (castPtr op) - runF w32fe x' op +#if HS_CAST_FLOAT_WORD_OPS_AVAILABLE +encodeFloatViaWord32F = (castFloatToWord32 >$<) +#else +encodeFloatViaWord32F w32fe = fixedPrim (size w32fe) $ \x op -> do + x' <- with x (peek . castPtr) + runF w32fe x' op +#endif -- | Encode a 'Double' using a 'Word64' encoding. --- --- PRE: The 'Word64' encoding must have a size of at least 8 bytes. {-# INLINE encodeDoubleViaWord64F #-} encodeDoubleViaWord64F :: FixedPrim Word64 -> FixedPrim Double -encodeDoubleViaWord64F w64fe - | size w64fe < sizeOf (undefined :: Float) = - error "encodeDoubleViaWord64F: encoding not wide enough" - | otherwise = fixedPrim (size w64fe) $ \x op -> do - poke (castPtr op) x - x' <- peek (castPtr op) - runF w64fe x' op - +#if HS_CAST_FLOAT_WORD_OPS_AVAILABLE +encodeDoubleViaWord64F = (castDoubleToWord64 >$<) +#else +encodeDoubleViaWord64F = fixedPrim (size w64fe) $ \x op -> do + x' <- with x (peek . castPtr) + runF w64fe x' op +#endif diff --git a/include/bytestring-cpp-macros.h b/include/bytestring-cpp-macros.h index cc955693a..d9cd8128d 100644 --- a/include/bytestring-cpp-macros.h +++ b/include/bytestring-cpp-macros.h @@ -1,4 +1,12 @@ -#if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \ +/* + +Use only C-style block comments in this file; the preprocessor removes them. + +Macros using MIN_VERSION_base etc. are not currently usable in C code. + +*/ + +#if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \ || ((defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) \ && defined(__ARM_FEATURE_UNALIGNED)) \ || defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ @@ -10,7 +18,6 @@ which are known not to trap (either to the kernel for emulation, or crash). #define HS_UNALIGNED_POKES_OK 1 #else #define HS_UNALIGNED_POKES_OK 0 -#warning "tell me which CI jobs reach this" #endif @@ -22,3 +29,11 @@ The unaligned ByteArray# primops became available with base-4.12.0, but require an unaligned-friendly host architecture to be safe to use until ghc-9.2.2; see https://gitlab.haskell.org/ghc/ghc/-/issues/21015 */ + + +#define HS_CAST_FLOAT_WORD_OPS_AVAILABLE MIN_VERSION_base(4,14,0) +/* +These operations were added in base-4.10.0, but due to +https://gitlab.haskell.org/ghc/ghc/-/issues/16617 they +are buggy with negative floats before ghc-8.10. +*/ From 21d46be08230b528a5abbff6e1155c7aed843abb Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Sun, 21 May 2023 22:06:42 -0400 Subject: [PATCH 05/17] fix new old-ghc stuff --- Data/ByteString/Builder/Prim/Internal/Floating.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Data/ByteString/Builder/Prim/Internal/Floating.hs b/Data/ByteString/Builder/Prim/Internal/Floating.hs index ff649153b..1e0cbdbc9 100644 --- a/Data/ByteString/Builder/Prim/Internal/Floating.hs +++ b/Data/ByteString/Builder/Prim/Internal/Floating.hs @@ -26,6 +26,7 @@ import GHC.Float (castFloatToWord32, castDoubleToWord64) #else import Foreign.Marshal.Utils import Foreign.Storable +import Foreign.Ptr {- We work around ticket http://ghc.haskell.org/trac/ghc/ticket/4092 by storing the Float/Double in a temp buffer and peeking it out again from there. @@ -50,7 +51,7 @@ encodeDoubleViaWord64F :: FixedPrim Word64 -> FixedPrim Double #if HS_CAST_FLOAT_WORD_OPS_AVAILABLE encodeDoubleViaWord64F = (castDoubleToWord64 >$<) #else -encodeDoubleViaWord64F = fixedPrim (size w64fe) $ \x op -> do +encodeDoubleViaWord64F w64fe = fixedPrim (size w64fe) $ \x op -> do x' <- with x (peek . castPtr) runF w64fe x' op #endif From 30736f5a86c6d97544c1d118545d2dac23c68773 Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Sun, 21 May 2023 22:16:33 -0400 Subject: [PATCH 06/17] todo: figure out how to get cpp to warn about this mistake --- Data/ByteString/Builder/Prim/Binary.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/Data/ByteString/Builder/Prim/Binary.hs b/Data/ByteString/Builder/Prim/Binary.hs index 837bc4288..e111d2ce6 100644 --- a/Data/ByteString/Builder/Prim/Binary.hs +++ b/Data/ByteString/Builder/Prim/Binary.hs @@ -61,6 +61,7 @@ import Data.ByteString.Builder.Prim.Internal.Floating import Foreign #include "MachDeps.h" +#include "bytestring-cpp-macros.h" ------------------------------------------------------------------------------ -- Binary encoding From 3960a0a9f9101147e1a02cd83298a1b4bcf4fdd2 Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Sun, 4 Jun 2023 11:20:27 -0400 Subject: [PATCH 07/17] Fix CPP mistakes --- Data/ByteString/Builder/Prim/Binary.hs | 8 ++++---- bytestring.cabal | 2 ++ cbits/fpstring.c | 6 ++---- include/bytestring-cpp-macros.h | 9 +++------ 4 files changed, 11 insertions(+), 14 deletions(-) diff --git a/Data/ByteString/Builder/Prim/Binary.hs b/Data/ByteString/Builder/Prim/Binary.hs index e111d2ce6..067edacca 100644 --- a/Data/ByteString/Builder/Prim/Binary.hs +++ b/Data/ByteString/Builder/Prim/Binary.hs @@ -1,6 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} +#include "MachDeps.h" +#include "bytestring-cpp-macros.h" + {-# LANGUAGE TypeApplications #-} -- | Copyright : (c) 2010-2011 Simon Meier @@ -60,9 +63,6 @@ import Data.ByteString.Builder.Prim.Internal.Floating import Foreign -#include "MachDeps.h" -#include "bytestring-cpp-macros.h" - ------------------------------------------------------------------------------ -- Binary encoding ------------------------------------------------------------------------------ @@ -167,7 +167,7 @@ word32Host = fixedPrim 4 unaligned_write_u32 word64Host :: FixedPrim Word64 word64Host = fixedPrim 8 unaligned_write_u64 -#if HS_BYTESTRING_UNALIGNED_POKES_OK +#if HS_UNALIGNED_POKES_OK unaligned_write_u16 :: Word16 -> Ptr Word8 -> IO () unaligned_write_u16 x p = poke (castPtr p) x diff --git a/bytestring.cabal b/bytestring.cabal index ae4dc7056..6fa2889d9 100644 --- a/bytestring.cabal +++ b/bytestring.cabal @@ -141,6 +141,8 @@ library -- DNDEBUG disables asserts in cbits/ cc-options: -std=c11 -DNDEBUG=1 + cpp-options: -Wall -Werror=undef + -- No need to link to libgcc on ghc-9.4 and later which uses a clang-based -- toolchain. if os(windows) && impl(ghc < 9.3) diff --git a/cbits/fpstring.c b/cbits/fpstring.c index 56c4af562..310aa2baf 100644 --- a/cbits/fpstring.c +++ b/cbits/fpstring.c @@ -43,8 +43,6 @@ #define USE_SIMD_COUNT #endif -#include "bytestring-cpp-macros.h" - /* copy a string in reverse */ void fps_reverse(unsigned char *q, unsigned char *p, size_t n) { p += n-1; @@ -108,7 +106,8 @@ void fps_sort(unsigned char *p, size_t len) { return qsort(p, len, 1, fps_compare); } -#if !HS_UNALIGNED_POKES_OK +// We don't actually always use these unaligned write functions on the +// Haskell side, but the macros we check there aren't visible here... void fps_unaligned_write_u16(uint16_t x, uint8_t *p) { memcpy(p, &x, 2); return; @@ -123,7 +122,6 @@ void fps_unaligned_write_u64(uint64_t x, uint8_t *p) { memcpy(p, &x, 8); return; } -#endif /* count the number of occurrences of a char in a string */ size_t fps_count_naive(unsigned char *str, size_t len, unsigned char w) { diff --git a/include/bytestring-cpp-macros.h b/include/bytestring-cpp-macros.h index d9cd8128d..7569eb37e 100644 --- a/include/bytestring-cpp-macros.h +++ b/include/bytestring-cpp-macros.h @@ -1,10 +1,7 @@ -/* - -Use only C-style block comments in this file; the preprocessor removes them. - -Macros using MIN_VERSION_base etc. are not currently usable in C code. +#if defined(__STDC__) || defined(__GNUC__) || defined(__clang__) +#error "bytestring-cpp-macros.h does not work in C code yet" +#endif -*/ #if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \ || ((defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) \ From 47b68ed0d2383f15c09d38580e1d14a67b990b64 Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Sun, 4 Jun 2023 11:28:27 -0400 Subject: [PATCH 08/17] Fix another stupid CPP mistake cpp-options: -Werror=undef is pulling its weight already. --- include/bytestring-cpp-macros.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/include/bytestring-cpp-macros.h b/include/bytestring-cpp-macros.h index 7569eb37e..e2008e5e2 100644 --- a/include/bytestring-cpp-macros.h +++ b/include/bytestring-cpp-macros.h @@ -20,7 +20,7 @@ which are known not to trap (either to the kernel for emulation, or crash). #define HS_UNALIGNED_ByteArray_OPS_OK \ MIN_VERSION_base(4,12,0) \ - && (MIN_VERSION_base(4,16,1) || UNALIGNED_POKES_OK) + && (MIN_VERSION_base(4,16,1) || HS_UNALIGNED_POKES_OK) /* The unaligned ByteArray# primops became available with base-4.12.0, but require an unaligned-friendly host architecture to be safe to use From 7e9568b950aca14d7ca5cdca69a35deaac697369 Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Tue, 29 Aug 2023 20:12:23 -0400 Subject: [PATCH 09/17] Shut up cabal check about -Werror=undef --- bytestring.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bytestring.cabal b/bytestring.cabal index 9dcaaf5ba..2767a87d0 100644 --- a/bytestring.cabal +++ b/bytestring.cabal @@ -124,6 +124,7 @@ library NamedFieldPuns ghc-options: -Wall -fwarn-tabs -Wincomplete-uni-patterns + -optP -Wall -optP -Werror=undef -O2 -fmax-simplifier-iterations=10 -fdicts-cheap @@ -141,8 +142,7 @@ library -- DNDEBUG disables asserts in cbits/ cc-options: -std=c11 -DNDEBUG=1 -fno-strict-aliasing - - cpp-options: -Wall -Werror=undef + -Werror=undef -- No need to link to libgcc on ghc-9.4 and later which uses a clang-based -- toolchain. From 145cdac1604a03fcfee12be1662113a7123316ea Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Tue, 29 Aug 2023 20:24:00 -0400 Subject: [PATCH 10/17] Omit conditionally-used C bindings when unused --- Data/ByteString/Short/Internal.hs | 2 +- cbits/fpstring.c | 30 ++++++++++++++++-------------- cbits/shortbytestring.c | 3 +++ include/bytestring-cpp-macros.h | 19 ++++++++++++++++--- 4 files changed, 36 insertions(+), 18 deletions(-) diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index dec9c6c88..2a5ddb4e6 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -1673,7 +1673,7 @@ compareByteArraysOff :: BA -- ^ array 1 -> Int -- ^ offset for array 2 -> Int -- ^ length to compare -> Int -- ^ like memcmp -#if MIN_VERSION_base(4,11,0) +#if HS_COMPARE_ByteArray_OP_AVAILABLE compareByteArraysOff (BA# ba1#) (I# ba1off#) (BA# ba2#) (I# ba2off#) (I# len#) = I# (compareByteArrays# ba1# ba1off# ba2# ba2off# len#) #else diff --git a/cbits/fpstring.c b/cbits/fpstring.c index 310aa2baf..a624e5f69 100644 --- a/cbits/fpstring.c +++ b/cbits/fpstring.c @@ -43,6 +43,8 @@ #define USE_SIMD_COUNT #endif +#include "bytestring-cpp-macros.h" + /* copy a string in reverse */ void fps_reverse(unsigned char *q, unsigned char *p, size_t n) { p += n-1; @@ -106,22 +108,22 @@ void fps_sort(unsigned char *p, size_t len) { return qsort(p, len, 1, fps_compare); } -// We don't actually always use these unaligned write functions on the -// Haskell side, but the macros we check there aren't visible here... -void fps_unaligned_write_u16(uint16_t x, uint8_t *p) { - memcpy(p, &x, 2); - return; -} +#if !HS_UNALIGNED_POKES_OK + void fps_unaligned_write_u16(uint16_t x, uint8_t *p) { + memcpy(p, &x, 2); + return; + } -void fps_unaligned_write_u32(uint32_t x, uint8_t *p) { - memcpy(p, &x, 4); - return; -} + void fps_unaligned_write_u32(uint32_t x, uint8_t *p) { + memcpy(p, &x, 4); + return; + } -void fps_unaligned_write_u64(uint64_t x, uint8_t *p) { - memcpy(p, &x, 8); - return; -} + void fps_unaligned_write_u64(uint64_t x, uint8_t *p) { + memcpy(p, &x, 8); + return; + } +#endif /* count the number of occurrences of a char in a string */ size_t fps_count_naive(unsigned char *str, size_t len, unsigned char w) { diff --git a/cbits/shortbytestring.c b/cbits/shortbytestring.c index 3cadc94bc..03e3bb279 100644 --- a/cbits/shortbytestring.c +++ b/cbits/shortbytestring.c @@ -2,7 +2,9 @@ #include #include +#include "bytestring-cpp-macros.h" +#if !HS_COMPARE_ByteArray_OP_AVAILABLE int sbs_memcmp_off(const void *s1, size_t off1, @@ -17,6 +19,7 @@ sbs_memcmp_off(const void *s1, return r; } +#endif ptrdiff_t sbs_elem_index(const void *s, diff --git a/include/bytestring-cpp-macros.h b/include/bytestring-cpp-macros.h index e2008e5e2..8cb5c5a8b 100644 --- a/include/bytestring-cpp-macros.h +++ b/include/bytestring-cpp-macros.h @@ -1,6 +1,17 @@ -#if defined(__STDC__) || defined(__GNUC__) || defined(__clang__) -#error "bytestring-cpp-macros.h does not work in C code yet" -#endif +/* +This file gets included in both C and Haskell sources. + +// Single-line comments cause trouble because +-- the syntax differs between the two languages. + +But C block-style comments like this one get removed by the preprocessor. +*/ + +/* Make the appropriate_HOST_ARCH macro visible in C code */ +#include "ghcplatform.h" + +/* Make MIN_VERSION_package macros visible in C code */ +#include "cabal_macros.h" #if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \ @@ -34,3 +45,5 @@ These operations were added in base-4.10.0, but due to https://gitlab.haskell.org/ghc/ghc/-/issues/16617 they are buggy with negative floats before ghc-8.10. */ + +#define HS_COMPARE_ByteArray_OP_AVAILABLE MIN_VERSION_base(4,11,0) From a4935afd1f644fe377df6460481380e7a49c1bcf Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Tue, 29 Aug 2023 20:50:36 -0400 Subject: [PATCH 11/17] Revert stimes-related changes --- Data/ByteString/Builder/Internal.hs | 17 +++-------------- Data/ByteString/Internal/Type.hs | 2 +- tests/builder/Data/ByteString/Builder/Tests.hs | 13 +++++++++---- 3 files changed, 13 insertions(+), 19 deletions(-) diff --git a/Data/ByteString/Builder/Internal.hs b/Data/ByteString/Builder/Internal.hs index 8384def00..938314961 100644 --- a/Data/ByteString/Builder/Internal.hs +++ b/Data/ByteString/Builder/Internal.hs @@ -128,7 +128,9 @@ module Data.ByteString.Builder.Internal ( import Control.Arrow (second) -import Data.Semigroup (Semigroup(..)) +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup (Semigroup((<>))) +#endif import qualified Data.ByteString as S import qualified Data.ByteString.Internal.Type as S @@ -380,22 +382,9 @@ empty = Builder ($) append :: Builder -> Builder -> Builder append (Builder b1) (Builder b2) = Builder $ b1 . b2 -stimesBuilder :: Integral t => t -> Builder -> Builder -{-# INLINABLE stimesBuilder #-} -stimesBuilder n b - | n >= 0 = go n - | otherwise = stimesNegativeErr - where go 0 = empty - go k = b `append` go (k - 1) - -stimesNegativeErr :: Builder -stimesNegativeErr - = errorWithoutStackTrace "stimes @Builder: non-negative multiplier expected" - instance Semigroup Builder where {-# INLINE (<>) #-} (<>) = append - stimes = stimesBuilder instance Monoid Builder where {-# INLINE mempty #-} diff --git a/Data/ByteString/Internal/Type.hs b/Data/ByteString/Internal/Type.hs index fc5052c6b..cc11e9929 100644 --- a/Data/ByteString/Internal/Type.hs +++ b/Data/ByteString/Internal/Type.hs @@ -887,7 +887,7 @@ stimesPolymorphic nRaw !bs = case checkedIntegerToInt n of stimesNegativeErr :: ByteString stimesNegativeErr - = errorWithoutStackTrace "stimes @ByteString: non-negative multiplier expected" + = error "stimes @ByteString: non-negative multiplier expected" stimesOverflowErr :: ByteString -- Although this only appears once, it is extracted here to prevent it diff --git a/tests/builder/Data/ByteString/Builder/Tests.hs b/tests/builder/Data/ByteString/Builder/Tests.hs index 9419bbf0d..2ab927bee 100644 --- a/tests/builder/Data/ByteString/Builder/Tests.hs +++ b/tests/builder/Data/ByteString/Builder/Tests.hs @@ -28,7 +28,9 @@ import Foreign (minusPtr) import Data.Char (chr) import Data.Bits ((.|.), shiftL) import Data.Foldable -import Data.Semigroup (Semigroup(..)) +#if !MIN_VERSION_base(4,11,0) +import Data.Semigroup +#endif import Data.Word import qualified Data.ByteString as S @@ -545,14 +547,17 @@ testBuilderConstr :: (Arbitrary a, Show a) testBuilderConstr name ref mkBuilder = testProperty name check where - check x = forAll (choose (0, 7)) $ \paddingAmount -> let - -- we use paddingAmount to make sure we test at unaligned positions + check x = forAll (choose (0, maxPaddingAmount)) $ \paddingAmount -> let + -- use padding to make sure we test at unaligned positions ws = ref x b1 = mkBuilder x - b2 = stimes paddingAmount (char8 ' ') <> b1 <> b1 + b2 = byteStringCopy (S.take paddingAmount padBuf) <> b1 <> b1 in (replicate paddingAmount (S.c2w ' ') ++ ws ++ ws) === (L.unpack $ toLazyByteString b2) + maxPaddingAmount = 15 + padBuf = S.replicate maxPaddingAmount (S.c2w ' ') + testsBinary :: [TestTree] testsBinary = From 66bdc31d00d6dd8085795bb65f48ab94b5f06dc5 Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Tue, 29 Aug 2023 20:52:38 -0400 Subject: [PATCH 12/17] Add question about lowerTable --- Data/ByteString/Builder/Prim/Internal/Base16.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/Data/ByteString/Builder/Prim/Internal/Base16.hs b/Data/ByteString/Builder/Prim/Internal/Base16.hs index 724f59205..3c0494106 100644 --- a/Data/ByteString/Builder/Prim/Internal/Base16.hs +++ b/Data/ByteString/Builder/Prim/Internal/Base16.hs @@ -35,6 +35,7 @@ data EncodingTable = EncodingTable Addr# -- e.g., deadbeef. {-# NOINLINE lowerTable #-} lowerTable :: EncodingTable +-- Is this buffer guaranteed to be Word16-aligned? lowerTable = EncodingTable "000102030405060708090a0b0c0d0e0f\ \101112131415161718191a1b1c1d1e1f\ From 5cd4d75099542eef58c990ad009577143c8ab109 Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Tue, 29 Aug 2023 21:10:42 -0400 Subject: [PATCH 13/17] Revert "Omit conditionally-used C bindings when unused" This reverts commit 145cdac1604a03fcfee12be1662113a7123316ea. --- Data/ByteString/Short/Internal.hs | 2 +- cbits/fpstring.c | 30 ++++++++++++++---------------- cbits/shortbytestring.c | 3 --- include/bytestring-cpp-macros.h | 19 +++---------------- 4 files changed, 18 insertions(+), 36 deletions(-) diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index 2a5ddb4e6..dec9c6c88 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -1673,7 +1673,7 @@ compareByteArraysOff :: BA -- ^ array 1 -> Int -- ^ offset for array 2 -> Int -- ^ length to compare -> Int -- ^ like memcmp -#if HS_COMPARE_ByteArray_OP_AVAILABLE +#if MIN_VERSION_base(4,11,0) compareByteArraysOff (BA# ba1#) (I# ba1off#) (BA# ba2#) (I# ba2off#) (I# len#) = I# (compareByteArrays# ba1# ba1off# ba2# ba2off# len#) #else diff --git a/cbits/fpstring.c b/cbits/fpstring.c index a624e5f69..310aa2baf 100644 --- a/cbits/fpstring.c +++ b/cbits/fpstring.c @@ -43,8 +43,6 @@ #define USE_SIMD_COUNT #endif -#include "bytestring-cpp-macros.h" - /* copy a string in reverse */ void fps_reverse(unsigned char *q, unsigned char *p, size_t n) { p += n-1; @@ -108,22 +106,22 @@ void fps_sort(unsigned char *p, size_t len) { return qsort(p, len, 1, fps_compare); } -#if !HS_UNALIGNED_POKES_OK - void fps_unaligned_write_u16(uint16_t x, uint8_t *p) { - memcpy(p, &x, 2); - return; - } +// We don't actually always use these unaligned write functions on the +// Haskell side, but the macros we check there aren't visible here... +void fps_unaligned_write_u16(uint16_t x, uint8_t *p) { + memcpy(p, &x, 2); + return; +} - void fps_unaligned_write_u32(uint32_t x, uint8_t *p) { - memcpy(p, &x, 4); - return; - } +void fps_unaligned_write_u32(uint32_t x, uint8_t *p) { + memcpy(p, &x, 4); + return; +} - void fps_unaligned_write_u64(uint64_t x, uint8_t *p) { - memcpy(p, &x, 8); - return; - } -#endif +void fps_unaligned_write_u64(uint64_t x, uint8_t *p) { + memcpy(p, &x, 8); + return; +} /* count the number of occurrences of a char in a string */ size_t fps_count_naive(unsigned char *str, size_t len, unsigned char w) { diff --git a/cbits/shortbytestring.c b/cbits/shortbytestring.c index 03e3bb279..3cadc94bc 100644 --- a/cbits/shortbytestring.c +++ b/cbits/shortbytestring.c @@ -2,9 +2,7 @@ #include #include -#include "bytestring-cpp-macros.h" -#if !HS_COMPARE_ByteArray_OP_AVAILABLE int sbs_memcmp_off(const void *s1, size_t off1, @@ -19,7 +17,6 @@ sbs_memcmp_off(const void *s1, return r; } -#endif ptrdiff_t sbs_elem_index(const void *s, diff --git a/include/bytestring-cpp-macros.h b/include/bytestring-cpp-macros.h index 8cb5c5a8b..e2008e5e2 100644 --- a/include/bytestring-cpp-macros.h +++ b/include/bytestring-cpp-macros.h @@ -1,17 +1,6 @@ -/* -This file gets included in both C and Haskell sources. - -// Single-line comments cause trouble because --- the syntax differs between the two languages. - -But C block-style comments like this one get removed by the preprocessor. -*/ - -/* Make the appropriate_HOST_ARCH macro visible in C code */ -#include "ghcplatform.h" - -/* Make MIN_VERSION_package macros visible in C code */ -#include "cabal_macros.h" +#if defined(__STDC__) || defined(__GNUC__) || defined(__clang__) +#error "bytestring-cpp-macros.h does not work in C code yet" +#endif #if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \ @@ -45,5 +34,3 @@ These operations were added in base-4.10.0, but due to https://gitlab.haskell.org/ghc/ghc/-/issues/16617 they are buggy with negative floats before ghc-8.10. */ - -#define HS_COMPARE_ByteArray_OP_AVAILABLE MIN_VERSION_base(4,11,0) From 167184a3c7b51ba7a04383d7e34a2b07c2f7fc0a Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Fri, 15 Sep 2023 05:42:51 -0400 Subject: [PATCH 14/17] Lots of mostly Float/Double-related tweaks - Haskell unaligned write functions now live in a new module: Data.ByteString.Utils.UnalignedWrite - The word*HexFixed functions now use unaligned writes; likewise Data.ByteString.Builder.RealFloat.Internal.copyWord16. - An FFI workaround for unaligned Float/Double writes was added. - The data tables in Data.ByteString.Builder.Prim.Internal.Base16 and Data.ByteString.Builder.RealFloat.{D,F}2S now live in the new file cbits/aligned-static-hs-data.c so that we can fearlessly perform aligned reads from them. - The static Word64 data tables are now stored in host-byte-order instead of always little-endian. - Data.ByteString.Builder.RealFloat.Internal.digit_table is now a static data blob instead of a CAF. - All CPP around castFloatToWord32/castDoubleToWord64 now lives in Data.ByteString.Builder.Prim.Internal.Floating. --- Data/ByteString/Builder/Prim/ASCII.hs | 6 +- Data/ByteString/Builder/Prim/Binary.hs | 32 +- .../Builder/Prim/Internal/Base16.hs | 30 +- .../Builder/Prim/Internal/Floating.hs | 33 +- Data/ByteString/Builder/RealFloat/D2S.hs | 646 +-------------- Data/ByteString/Builder/RealFloat/F2S.hs | 65 +- Data/ByteString/Builder/RealFloat/Internal.hs | 127 +-- .../Builder/RealFloat/TableGenerator.hs | 65 +- Data/ByteString/Utils/UnalignedWrite.hs | 46 ++ bytestring.cabal | 2 + cbits/aligned-static-hs-data.c | 760 ++++++++++++++++++ cbits/fpstring.c | 11 + 12 files changed, 965 insertions(+), 858 deletions(-) create mode 100644 Data/ByteString/Utils/UnalignedWrite.hs create mode 100644 cbits/aligned-static-hs-data.c diff --git a/Data/ByteString/Builder/Prim/ASCII.hs b/Data/ByteString/Builder/Prim/ASCII.hs index 8a365e086..a62f0a1a5 100644 --- a/Data/ByteString/Builder/Prim/ASCII.hs +++ b/Data/ByteString/Builder/Prim/ASCII.hs @@ -81,6 +81,7 @@ import Data.ByteString.Builder.Prim.Binary import Data.ByteString.Builder.Prim.Internal import Data.ByteString.Builder.Prim.Internal.Floating import Data.ByteString.Builder.Prim.Internal.Base16 +import Data.ByteString.Utils.UnalignedWrite import Data.Char (ord) @@ -231,8 +232,9 @@ wordHex = caseWordSize_32_64 -- | Encode a 'Word8' using 2 nibbles (hexadecimal digits). {-# INLINE word8HexFixed #-} word8HexFixed :: FixedPrim Word8 -word8HexFixed = fixedPrim 2 $ - \x op -> poke (castPtr op) =<< encode8_as_16h lowerTable x +word8HexFixed = fixedPrim 2 $ \x op -> do + enc <- encode8_as_16h lowerTable x + unalignedWriteU16 enc op -- | Encode a 'Word16' using 4 nibbles. {-# INLINE word16HexFixed #-} diff --git a/Data/ByteString/Builder/Prim/Binary.hs b/Data/ByteString/Builder/Prim/Binary.hs index 067edacca..06fc77845 100644 --- a/Data/ByteString/Builder/Prim/Binary.hs +++ b/Data/ByteString/Builder/Prim/Binary.hs @@ -1,10 +1,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeApplications #-} + #include "MachDeps.h" #include "bytestring-cpp-macros.h" -{-# LANGUAGE TypeApplications #-} -- | Copyright : (c) 2010-2011 Simon Meier -- License : BSD3-style (see LICENSE) @@ -60,6 +61,7 @@ module Data.ByteString.Builder.Prim.Binary ( import Data.ByteString.Builder.Prim.Internal import Data.ByteString.Builder.Prim.Internal.Floating +import Data.ByteString.Utils.UnalignedWrite import Foreign @@ -155,35 +157,17 @@ wordHost = case finiteBitSize (0 :: Word) of -- | Encoding 'Word16's in native host order and host endianness. {-# INLINE word16Host #-} word16Host :: FixedPrim Word16 -word16Host = fixedPrim 2 unaligned_write_u16 +word16Host = fixedPrim 2 unalignedWriteU16 -- | Encoding 'Word32's in native host order and host endianness. {-# INLINE word32Host #-} word32Host :: FixedPrim Word32 -word32Host = fixedPrim 4 unaligned_write_u32 +word32Host = fixedPrim 4 unalignedWriteU32 -- | Encoding 'Word64's in native host order and host endianness. {-# INLINE word64Host #-} word64Host :: FixedPrim Word64 -word64Host = fixedPrim 8 unaligned_write_u64 - -#if HS_UNALIGNED_POKES_OK -unaligned_write_u16 :: Word16 -> Ptr Word8 -> IO () -unaligned_write_u16 x p = poke (castPtr p) x - -unaligned_write_u32 :: Word32 -> Ptr Word8 -> IO () -unaligned_write_u32 x p = poke (castPtr p) x - -unaligned_write_u64 :: Word64 -> Ptr Word8 -> IO () -unaligned_write_u64 x p = poke (castPtr p) x -#else -foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u16" - unaligned_write_u16 :: Word16 -> Ptr Word8 -> IO () -foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u32" - unaligned_write_u32 :: Word32 -> Ptr Word8 -> IO () -foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u64" - unaligned_write_u64 :: Word64 -> Ptr Word8 -> IO () -#endif +word64Host = fixedPrim 8 unalignedWriteU64 ------------------------------------------------------------------------------ -- Int encodings @@ -285,9 +269,9 @@ doubleLE = encodeDoubleViaWord64F word64LE -- {-# INLINE floatHost #-} floatHost :: FixedPrim Float -floatHost = storableToF +floatHost = fixedPrim (sizeOf @Float 0) unalignedWriteFloat -- | Encode a 'Double' in native host order and host endianness. {-# INLINE doubleHost #-} doubleHost :: FixedPrim Double -doubleHost = storableToF +doubleHost = fixedPrim (sizeOf @Double 0) unalignedWriteDouble diff --git a/Data/ByteString/Builder/Prim/Internal/Base16.hs b/Data/ByteString/Builder/Prim/Internal/Base16.hs index 3c0494106..8923402ce 100644 --- a/Data/ByteString/Builder/Prim/Internal/Base16.hs +++ b/Data/ByteString/Builder/Prim/Internal/Base16.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE Trustworthy #-} {-# LANGUAGE MagicHash #-} -- | -- Copyright : (c) 2011 Simon Meier @@ -22,8 +21,9 @@ module Data.ByteString.Builder.Prim.Internal.Base16 ( , encode8_as_16h ) where -import Foreign -import GHC.Exts (Addr#, Ptr(..)) +import Foreign +import Foreign.C.Types +import GHC.Exts (Addr#, Ptr(..)) -- Creating the encoding table ------------------------------ @@ -31,29 +31,15 @@ import GHC.Exts (Addr#, Ptr(..)) -- | An encoding table for Base16 encoding. data EncodingTable = EncodingTable Addr# +foreign import ccall "&hs_bytestring_lower_hex_table" + c_lower_hex_table :: Ptr CChar + -- | The encoding table for hexadecimal values with lower-case characters; -- e.g., deadbeef. {-# NOINLINE lowerTable #-} lowerTable :: EncodingTable --- Is this buffer guaranteed to be Word16-aligned? -lowerTable = EncodingTable - "000102030405060708090a0b0c0d0e0f\ - \101112131415161718191a1b1c1d1e1f\ - \202122232425262728292a2b2c2d2e2f\ - \303132333435363738393a3b3c3d3e3f\ - \404142434445464748494a4b4c4d4e4f\ - \505152535455565758595a5b5c5d5e5f\ - \606162636465666768696a6b6c6d6e6f\ - \707172737475767778797a7b7c7d7e7f\ - \808182838485868788898a8b8c8d8e8f\ - \909192939495969798999a9b9c9d9e9f\ - \a0a1a2a3a4a5a6a7a8a9aaabacadaeaf\ - \b0b1b2b3b4b5b6b7b8b9babbbcbdbebf\ - \c0c1c2c3c4c5c6c7c8c9cacbcccdcecf\ - \d0d1d2d3d4d5d6d7d8d9dadbdcdddedf\ - \e0e1e2e3e4e5e6e7e8e9eaebecedeeef\ - \f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"# - +lowerTable = case c_lower_hex_table of + Ptr p# -> EncodingTable p# -- | Encode an octet as 16bit word comprising both encoded nibbles ordered -- according to the host endianness. Writing these 16bit to memory will write diff --git a/Data/ByteString/Builder/Prim/Internal/Floating.hs b/Data/ByteString/Builder/Prim/Internal/Floating.hs index 1e0cbdbc9..a50588231 100644 --- a/Data/ByteString/Builder/Prim/Internal/Floating.hs +++ b/Data/ByteString/Builder/Prim/Internal/Floating.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} +#include "MachDeps.h" #include "bytestring-cpp-macros.h" -- | @@ -14,7 +15,9 @@ -- Conversion of 'Float's and 'Double's to 'Word32's and 'Word64's. -- module Data.ByteString.Builder.Prim.Internal.Floating - ( encodeFloatViaWord32F + ( castFloatToWord32 + , castDoubleToWord64 + , encodeFloatViaWord32F , encodeDoubleViaWord64F ) where @@ -27,10 +30,38 @@ import GHC.Float (castFloatToWord32, castDoubleToWord64) import Foreign.Marshal.Utils import Foreign.Storable import Foreign.Ptr + +import Data.ByteString.Internal.Type (unsafeDupablePerformIO) {- We work around ticket http://ghc.haskell.org/trac/ghc/ticket/4092 by storing the Float/Double in a temp buffer and peeking it out again from there. -} + +-- | Interpret a 'Float' as a 'Word32' as if through a bit-for-bit copy. +-- (fallback if not available through GHC.Float) +-- +-- e.g +-- +-- > showHex (castFloatToWord32 1.0) [] = "3f800000" +{-# NOINLINE castFloatToWord32 #-} +castFloatToWord32 :: Float -> Word32 +#if (SIZEOF_HSFLOAT != SIZEOF_WORD32) || (ALIGNMENT_HSFLOAT < ALIGNMENT_WORD32) + #error "don't know how to cast Float to Word32" +#endif +castFloatToWord32 x = unsafeDupablePerformIO (with x (peek . castPtr)) + +-- | Interpret a 'Double' as a 'Word64' as if through a bit-for-bit copy. +-- (fallback if not available through GHC.Float) +-- +-- e.g +-- +-- > showHex (castDoubleToWord64 1.0) [] = "3ff0000000000000" +{-# NOINLINE castDoubleToWord64 #-} +castDoubleToWord64 :: Double -> Word64 +#if (SIZEOF_HSDOUBLE != SIZEOF_WORD64) || (ALIGNMENT_HSDOUBLE < ALIGNMENT_WORD64) + #error "don't know how to cast Double to Word64" +#endif +castDoubleToWord64 x = unsafeDupablePerformIO (with x (peek . castPtr)) #endif diff --git a/Data/ByteString/Builder/RealFloat/D2S.hs b/Data/ByteString/Builder/RealFloat/D2S.hs index f29b572e9..fb5e8c008 100644 --- a/Data/ByteString/Builder/RealFloat/D2S.hs +++ b/Data/ByteString/Builder/RealFloat/D2S.hs @@ -1,5 +1,6 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE BangPatterns, MagicHash #-} -- | -- Module : Data.ByteString.Builder.RealFloat.D2S -- Copyright : (c) Lawrence Wu 2021 @@ -21,640 +22,23 @@ import Data.ByteString.Builder.Prim (primBounded) import Data.ByteString.Builder.RealFloat.Internal import Data.Maybe (fromMaybe) import GHC.Int (Int32(..)) +import GHC.Ptr (Ptr(..)) import GHC.Word (Word64(..)) -- See Data.ByteString.Builder.RealFloat.TableGenerator for a high-level -- explanation of the ryu algorithm -- | Table of 2^k / 5^q + 1 --- Byte-swapped version of --- > fmap (finv double_pow5_inv_bitcount) [0..double_max_inv_split] -double_pow5_inv_split :: Addr -double_pow5_inv_split = Addr - "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\ - \\x9a\x99\x99\x99\x99\x99\x99\x99\x99\x99\x99\x99\x99\x99\x99\x19\ - \\x15\xae\x47\xe1\x7a\x14\xae\x47\xe1\x7a\x14\xae\x47\xe1\x7a\x14\ - \\xde\x24\x06\x81\x95\x43\x8b\x6c\xe7\xfb\xa9\xf1\xd2\x4d\x62\x10\ - \\x96\xd4\x09\x68\x22\x6c\x78\x7a\xa5\x2c\x43\x1c\xeb\xe2\x36\x1a\ - \\xab\x43\x6e\x86\x1b\xf0\xf9\x61\x84\xf0\x68\xe3\x88\xb5\xf8\x14\ - \\x22\x36\x58\x38\x49\xf3\xc7\xb4\x36\x8d\xed\xb5\xa0\xf7\xc6\x10\ - \\x6a\x23\x8d\xc0\x0e\x52\xa6\x87\x57\x48\xaf\xbc\x9a\xf2\xd7\x1a\ - \\x88\x4f\xd7\x66\xa5\x41\xb8\x9f\xdf\x39\x8c\x30\xe2\x8e\x79\x15\ - \\x07\xa6\x12\x1f\x51\x01\x2d\xe6\xb2\x94\xd6\x26\xe8\x0b\x2e\x11\ - \\xa4\x09\x51\xcb\x81\x68\xae\xd6\xb7\xba\xbd\xd7\xd9\xdf\x7c\x1b\ - \\xea\x3a\xa7\xa2\x34\xed\xf1\xde\x5f\x95\x64\x79\xe1\x7f\xfd\x15\ - \\xbb\xc8\x85\xe8\xf6\xf0\x27\x7f\x19\x11\xea\x2d\x81\x99\x97\x11\ - \\xf8\x0d\xd6\x40\xbe\xb4\x0c\x65\xc2\x81\x76\x49\x68\xc2\x25\x1c\ - \\x93\x71\xde\x33\x98\x90\x70\xea\x01\x9b\x2b\xa1\x86\x9b\x84\x16\ - \\x43\xc1\x7e\x29\xe0\xa6\xf3\x21\x9b\x15\x56\xe7\x9e\xaf\x03\x12\ - \\x37\x35\x31\x0f\xcd\xd7\x85\x69\x2b\xbc\x89\xd8\x97\xb2\xd2\x1c\ - \\xf9\x90\x5a\x3f\xd7\xdf\x37\x21\x89\x96\xd4\x46\x46\xf5\x0e\x17\ - \\xfa\x73\x48\xcc\x45\xe6\x5f\xe7\xa0\xab\x43\xd2\xd1\x5d\x72\x12\ - \\x5d\x86\x0d\x7a\x3c\x3d\x66\xa5\x34\xac\xd2\xb6\x4f\xc9\x83\x1d\ - \\xb1\x9e\xd7\x94\x63\x97\x1e\x51\x5d\x23\x42\x92\x0c\xa1\x9c\x17\ - \\xc1\x4b\x79\xdd\x82\xdf\x7e\xda\x7d\x4f\x9b\x0e\x0a\xb4\xe3\x12\ - \\x68\xac\x5b\x62\xd1\x98\x64\x2a\x96\xe5\x5e\x17\x10\x20\x39\x1e\ - \\x53\xf0\xe2\x81\xa7\xe0\xb6\xee\x44\x51\xb2\x12\x40\xb3\x2d\x18\ - \\xa9\x26\x4f\xce\x52\x4d\x92\x58\x6a\xa7\x8e\xa8\x99\xc2\x57\x13\ - \\x41\xa4\x7e\xb0\xb7\x7b\x50\x27\xaa\xd8\x7d\xda\xf5\xd0\xf2\x1e\ - \\x34\x50\x65\xc0\x5f\xc9\xa6\x52\xbb\x13\xcb\xae\xc4\x40\xc2\x18\ - \\x90\xa6\xea\x99\x4c\xd4\xeb\x0e\xc9\x0f\x3c\xf2\x36\x9a\xce\x13\ - \\x80\x0a\x11\xc3\xad\x53\x79\xb1\x41\x19\x60\x50\xbe\xf6\xb0\x1f\ - \\x67\x08\x74\x02\x8b\xdc\x2d\xc1\x67\x47\xb3\xa6\xfe\x5e\x5a\x19\ - \\x52\xa0\x29\x35\x6f\xb0\x24\x34\x86\x9f\xc2\xeb\xfe\x4b\x48\x14\ - \\xdb\x19\xee\x90\xf2\x59\x1d\x90\x9e\x7f\x68\x89\x65\xd6\x39\x10\ - \\x5f\x29\xb0\xb4\x1d\xc3\xfb\x4c\x97\x32\xa7\xa8\xd5\x23\xf6\x19\ - \\xb2\xba\x59\x5d\xb1\x35\x96\x3d\xac\x5b\x1f\xba\x77\xe9\xc4\x14\ - \\x28\x62\xe1\x7d\x27\x5e\xab\x97\x56\x49\x4c\xfb\x92\x87\x9d\x10\ - \\x0d\x9d\x68\xc9\xd8\xc9\xab\xf2\xf0\x0e\x7a\xf8\xb7\xa5\x95\x1a\ - \\x3e\x17\xba\x3a\x7a\xa1\xbc\x5b\x5a\x72\x2e\x2d\x93\x84\x44\x15\ - \\xcb\x45\xfb\x2e\xc8\x1a\xca\xaf\xae\x8e\x8b\x8a\x42\x9d\x03\x11\ - \\x45\x09\x92\xb1\xa6\xf7\xdc\xb2\x4a\xe4\x78\xaa\x9d\xfb\x38\x1b\ - \\x04\xa1\x41\xc1\xeb\x92\x7d\xf5\x6e\x83\x2d\x55\xb1\x2f\xc7\x15\ - \\x03\xb4\x67\x67\x89\x75\x64\xc4\x58\x9c\x57\x77\x27\x26\x6c\x11\ - \\xd2\xec\xa5\xd8\xdb\x88\x6d\x6d\xf4\xc6\x25\xf2\x0b\x3d\xe0\x1b\ - \\xdb\x23\xeb\x46\x16\x07\xbe\x8a\xc3\x38\x1e\x28\xa3\xfd\x4c\x16\ - \\x49\xb6\x55\xd2\x11\x6c\xfe\x6e\x9c\x60\x4b\x53\x4f\x31\xd7\x11\ - \\x0e\x8a\xef\xb6\x4f\x13\x97\xb1\x60\x67\x45\x85\x18\x82\x8b\x1c\ - \\xa5\xa1\xbf\xf8\x72\x0f\xac\x27\x1a\xb9\x6a\x37\xad\x01\xd6\x16\ - \\x1e\x4e\x99\x60\xc2\x72\x56\xb9\xe1\x60\x55\x2c\x24\xce\x44\x12\ - \\x95\x16\xc2\xcd\x03\x1e\x57\xf5\x35\xce\xbb\x13\x6d\xe3\x3a\x1d\ - \\xab\xab\x01\x0b\x03\x18\xac\x2a\x2b\xd8\x2f\x76\x8a\x4f\x62\x17\ - \\x56\x89\x34\x6f\x02\xe0\xbc\xbb\x55\x13\xf3\xc4\x6e\x0c\xb5\x12\ - \\x89\xa8\xed\xb1\xd0\xcc\xc7\x92\xef\x1e\xb8\xd4\x4a\x7a\xee\x1d\ - \\x07\xba\x57\x8e\x40\x0a\xd3\xdb\xf2\x4b\x93\x10\x6f\xfb\xf1\x17\ - \\x06\xc8\xdf\x71\x00\xd5\xa8\x7c\xf5\x6f\x0f\xda\x58\xfc\x27\x13\ - \\xd6\x0c\x66\xe9\x33\xbb\xa7\xfa\xbb\x4c\xb2\x29\x8e\x60\xa6\x1e\ - \\x11\xd7\x84\x87\x29\xfc\x52\x95\xc9\xa3\x8e\x54\x0b\x1a\x85\x18\ - \\x0e\xac\xd0\xd2\xba\xc9\xa8\xaa\x07\x83\xd8\x76\x6f\xae\x9d\x13\ - \\xe3\xac\x1a\x1e\x5e\xdc\xda\xdd\xa5\xd1\xc0\x57\xb2\xb0\x62\x1f\ - \\x4f\x8a\x48\x4b\x4b\xb0\x48\x7e\x51\x41\x9a\xac\x8e\xc0\x1b\x19\ - \\xd9\xa1\xd3\xd5\xd5\x59\x6d\xcb\xda\xcd\xe1\x56\xa5\x33\x16\x14\ - \\x7b\x81\xdc\x77\x11\x7b\x57\x3c\xe2\xd7\xe7\xab\xea\xc2\x11\x10\ - \\x2a\xcf\x60\x59\x82\x5e\xf2\xc6\x36\x26\xa6\xac\xaa\x04\xb6\x19\ - \\xbb\xa5\x80\x47\x68\x18\xf5\x6b\xc5\x51\xeb\x56\x55\x9d\x91\x14\ - \\x96\x84\x00\x06\xed\x79\x2a\x23\xd1\xa7\x22\xdf\xdd\x7d\x74\x10\ - \\x56\x07\x34\xa3\xe1\x8f\xdd\xd1\x81\x0c\xd1\x31\x96\xfc\x53\x1a\ - \\x45\x6c\xf6\xe8\x1a\x73\xe4\xa7\x34\x3d\xa7\xf4\x44\xfd\x0f\x15\ - \\x9e\x56\xf8\x53\xe2\x28\x1d\x53\x5d\x97\x52\x5d\x6a\x97\xd9\x10\ - \\x62\x57\x8d\xb9\x03\xdb\x61\xeb\x2e\xf2\x50\x95\x10\xbf\xf5\x1a\ - \\xe8\x45\xa4\xc7\xcf\x48\x4e\xbc\x58\x5b\xda\xdd\xa6\x65\x91\x15\ - \\x20\x6b\x83\x6c\xd9\xd3\x71\x63\xad\xe2\xe1\x17\x1f\x1e\x41\x11\ - \\xcd\x11\x9f\xad\x28\x86\x1c\x9f\x48\x04\x03\xf3\x64\x63\x9b\x1b\ - \\x0b\xdb\x18\xbe\x53\x6b\xb0\xe5\x06\x9d\x35\x8f\x1d\xe9\x15\x16\ - \\xa2\x15\x47\xcb\x0f\x89\xf3\xea\x6b\x4a\x91\x72\xe4\x20\xab\x11\ - \\x37\xbc\x71\x78\x4c\xdb\xb8\x44\x46\xaa\x1b\x84\x6d\x01\x45\x1c\ - \\x5f\x63\xc1\xc6\xd6\x15\xc7\x03\x05\x55\x49\x03\xbe\x9a\x9d\x16\ - \\x19\xe9\xcd\x6b\x45\xde\x38\x36\x37\x77\x07\x69\xfe\xae\x17\x12\ - \\xc1\x41\x16\x46\xa2\x63\xc1\x56\x58\x58\x72\x0e\x97\xb1\xf2\x1c\ - \\xce\x67\xab\xd1\x81\x1c\x01\xdf\x79\x13\xf5\x71\x12\x8e\x28\x17\ - \\xa5\xec\x55\x41\xce\x16\x34\x7f\x61\xdc\x90\xc1\x0e\xd8\x86\x12\ - \\x6e\x47\x56\x35\x7d\x24\x20\x65\x02\xc7\xe7\x68\xe4\x8c\xa4\x1d\ - \\x25\x39\x78\xf7\x30\x1d\x80\xea\x01\x6c\xb9\x20\x1d\xd7\xb6\x17\ - \\x84\xfa\x2c\xf9\xf3\xb0\x99\xbb\x34\x23\x61\x4d\x17\xac\xf8\x12\ - \\x39\xf7\x47\x28\x53\x4e\x5c\x5f\x54\x38\x68\x15\xf2\xac\x5a\x1e\ - \\x2e\x2c\xd3\xb9\x75\x0b\x7d\x7f\x43\x60\x53\x44\x5b\x8a\x48\x18\ - \\x58\x23\xdc\xc7\xf7\xd5\x30\x99\xcf\x19\xa9\x36\x7c\x3b\x6d\x13\ - \\x26\xd2\xf9\x72\x8c\x89\xb4\x8e\xb2\x8f\x0e\xf1\xf9\x2b\x15\x1f\ - \\xb8\x41\x2e\x8f\xa3\x07\x2a\x72\x28\xa6\x0b\xf4\xc7\xbc\xdd\x18\ - \\xfa\x9a\xbe\xa5\x4f\x39\xbb\xc1\x86\x1e\xd6\x5c\x06\x97\xe4\x13\ - \\xf6\xf7\x30\x09\x19\xc2\x5e\x9c\xd7\x30\xf0\xfa\xd6\x24\xd4\x1f\ - \\xf8\x5f\x5a\x07\x14\x68\xe5\x49\x79\x8d\x26\x2f\xdf\x83\x76\x19\ - \\x60\xe6\xe1\x05\x10\x20\x51\x6e\xc7\x0a\x52\xbf\xe5\xcf\x5e\x14\ - \\x1a\x85\x81\xd1\x0c\x80\xda\xf1\x05\x6f\x0e\x99\x84\xd9\x4b\x10\ - \\xf5\xd4\x68\x82\x14\x00\xc4\x4f\xd6\xe4\xe3\xf4\xa0\xf5\x12\x1a\ - \\x2b\x77\xed\x01\xaa\x99\x69\xd9\x11\xb7\x1c\xf7\xb3\xf7\xdb\x14\ - \\xbc\xc5\x8a\x01\x88\x14\xee\xad\x74\x92\xb0\xc5\x5c\xf9\xaf\x10\ - \\x2c\x09\xde\x68\xa6\xed\x7c\x49\x54\xea\x80\x6f\x94\x28\xb3\x1a\ - \\x24\xd4\xe4\x53\xb8\x57\xca\x3a\x10\x55\x9a\xbf\x76\x20\x5c\x15\ - \\x83\x76\x1d\x43\x60\x79\x3b\x62\x73\xaa\xae\xff\x5e\x80\x16\x11\ - \\x9e\xbd\xc8\xd1\x66\xf5\x2b\x9d\xb8\x10\xb1\x32\xcb\x33\x57\x1b\ - \\x7f\x64\x6d\x41\x52\xc4\xbc\x7d\x60\x0d\xf4\x8e\xa2\x5c\xdf\x15\ - \\xcc\xb6\x8a\x67\xdb\x69\xfd\xca\xe6\x3d\xc3\xd8\x4e\x7d\x7f\x11\ - \\xdf\x8a\x77\x72\xc5\x0f\x2f\xab\xd7\x2f\x05\x8e\xe4\x2e\xff\x1b\ - \\x80\xd5\x92\x5b\x04\x73\xf2\x88\xac\x8c\x6a\x3e\x1d\xbf\x65\x16\ - \\x66\x44\x42\x49\xd0\x28\xf5\xd3\x56\x3d\x55\x98\x4a\xff\xea\x11\ - \\xa3\xa0\x03\x42\x4d\x41\x88\xb9\x57\x95\xbb\xf3\x10\x32\xab\x1c\ - \\xe9\xe6\x02\x68\xd7\xcd\x39\x61\x79\x77\xfc\xc2\x40\x5b\xef\x16\ - \\x54\x52\x02\x20\x79\x71\x61\xe7\x2d\xf9\xc9\x68\xcd\x15\x59\x12\ - \\x86\x50\x9d\x99\x8e\xb5\x68\xa5\x7c\x5b\x76\x74\x15\x56\x5b\x1d\ - \\xd2\xa6\x4a\xe1\x3e\x91\x20\x51\xfd\x15\xc5\xf6\xdd\x44\x7c\x17\ - \\x0e\x1f\xa2\x1a\xff\x40\x4d\xa7\xca\x44\x37\x92\xb1\xd0\xc9\x12\ - \\x4a\xcb\x69\xf7\x64\xce\xae\x0b\x11\x6e\x58\x50\x4f\xb4\x0f\x1e\ - \\x3b\x3c\xee\xc5\x50\xd8\x8b\x3c\xa7\xf1\x79\x73\x3f\x90\x0c\x18\ - \\xc9\xc9\xf1\x37\xda\x79\x09\xca\x85\xf4\xc7\xc2\x32\x40\x3d\x13\ - \\xdb\x42\xe9\xbf\xf6\xc2\xa8\xa9\x6f\xba\x0c\x9e\xb7\x66\xc8\x1e\ - \\xe3\x9b\xba\xcc\x2b\xcf\x53\x21\x26\x95\x70\x7e\x2c\x52\xa0\x18\ - \\x82\x49\x95\x70\x89\x72\xa9\x1a\xb8\xdd\x26\x65\xf0\x74\xb3\x13\ - \\x9d\x75\x88\x1a\x0f\x84\x75\xf7\x8c\x2f\x3e\x08\xe7\x87\x85\x1f\ - \\x17\x5e\xa0\x7b\x72\x36\x91\x5f\x0a\x26\x98\x06\xec\x9f\x37\x19\ - \\xdf\xe4\x19\x96\x5b\xf8\x40\x19\xd5\x84\x46\x05\xf0\x7f\x2c\x14\ - \\x4c\xea\x47\xab\xaf\xc6\x00\xe1\x10\x37\x05\xd1\x8c\x99\x23\x10\ - \\x47\xdd\x3f\x45\x4c\xa4\x67\xce\xe7\x24\xd5\xb4\x47\x8f\xd2\x19\ - \\x06\xb1\xcc\x9d\xd6\xe9\x52\xd8\x1f\xb7\xdd\xc3\x9f\x72\xa8\x14\ - \\x38\x27\x0a\x4b\x45\xee\xdb\x79\x19\x2c\x7e\x69\x19\xc2\x86\x10\ - \\x59\xd8\xa9\x11\xa2\xe3\x5f\x29\x8f\x46\x30\x0f\x8f\x36\x71\x1a\ - \\x7a\x13\xbb\xa7\x81\x1c\xb3\xba\xa5\x6b\xf3\xd8\xd8\x5e\x27\x15\ - \\x2f\xa9\x95\xec\x9a\xe3\x28\x62\x51\x89\x8f\xad\xe0\x4b\xec\x10\ - \\x17\x75\xef\xe0\xf7\x38\x0e\x9d\xe8\x0e\x4c\xaf\x9a\xac\x13\x1b\ - \\x79\x2a\x59\x1a\x93\x2d\xd8\xb0\x53\x72\xd6\x25\xe2\x56\xa9\x15\ - \\x2e\x55\x47\x48\x0f\xbe\x79\x8d\xdc\xc1\xde\xb7\x81\x45\x54\x11\ - \\x7c\xbb\x0b\xda\x7e\x96\x8f\x15\x94\x9c\x97\x8c\xcf\x08\xba\x1b\ - \\x97\x2f\xd6\x14\xff\x11\xa6\x77\x76\xb0\xdf\xd6\x72\x6d\x2e\x16\ - \\x79\x8c\xde\x43\xff\xa7\x51\xf9\x91\xf3\xb2\x78\xf5\xbd\xbe\x11\ - \\x8e\xad\xfd\xd2\xfe\x3f\x1c\xc2\x1c\xec\xb7\x5a\x22\x63\x64\x1c\ - \\xd8\x8a\x64\x42\x32\x33\xb0\x01\x17\xf0\x5f\x15\xb5\xb5\xb6\x16\ - \\x46\xa2\x83\x9b\x8e\xc2\x59\x01\xac\x59\xe6\xdd\x90\xc4\x2b\x12\ - \\xa3\x03\x39\x5f\x17\x04\xf6\xce\xac\xc2\xa3\xfc\x1a\xd4\x12\x1d\ - \\x83\x9c\x2d\x4c\xac\x69\x5e\x72\xbd\x9b\x1c\xca\x48\x43\x42\x17\ - \\x9c\xe3\x8a\xd6\x89\x54\x18\xf5\xfd\xe2\x16\x08\x07\x69\x9b\x12\ - \\xc6\x05\xab\xbd\x0f\x54\x8d\xee\x2f\x6b\xf1\x0c\xd8\x74\xc5\x1d\ - \\x05\x6b\x22\xfe\x72\x76\xd7\xbe\x8c\x22\xc1\x70\x46\x2a\xd1\x17\ - \\x04\xbc\x4e\xcb\x28\xc5\x12\xff\xd6\x4e\x67\x8d\x6b\xbb\x0d\x13\ - \\xa0\xf9\x7d\x78\x74\x3b\x51\xcb\x24\x7e\xd8\x7b\x12\x5f\x7c\x1e\ - \\x4d\x61\xfe\xf9\x29\xc9\x0d\x09\xb7\x31\xad\xfc\x41\x7f\x63\x18\ - \\x0a\x81\xcb\x94\x21\xd4\xd7\xa0\xc5\x27\x24\xca\x34\xcc\x82\x13\ - \\x77\xce\x78\x54\xcf\xb9\xbf\x67\x6f\x0c\x6d\x43\x21\xad\x37\x1f\ - \\xf9\x71\x2d\xdd\xa5\x94\xcc\x1f\x59\x70\x8a\xcf\x4d\x57\xf9\x18\ - \\xc7\xf4\xbd\x7d\x51\xdd\xd6\x7f\x7a\xf3\xa1\x3f\x3e\xac\xfa\x13\ - \\x0b\xee\x2f\xc9\xe8\x2e\xbe\xff\xc3\xb8\x9c\x32\xfd\x79\xf7\x1f\ - \\xd6\x24\xf3\xa0\x20\xbf\x31\x66\x36\xfa\x16\xc2\xfd\xc7\x92\x19\ - \\x78\x1d\x5c\x1a\x1a\xcc\x27\xb8\x5e\xfb\xab\x01\xcb\x6c\x75\x14\ - \\x60\xe4\x7c\x7b\xae\x09\x53\x93\x18\xc9\xbc\x67\xa2\xf0\x5d\x10\ - \\x99\xa0\x94\xc5\xb0\x42\xeb\x1e\xf4\x74\x94\x3f\x6a\xe7\x2f\x1a\ - \\xe1\xe6\x76\x04\x27\x02\x89\xe5\x5c\x2a\xdd\x32\x88\x1f\xf3\x14\ - \\xe7\xeb\x2b\x9d\x85\xce\xa0\xb7\xb0\xee\xb0\x28\xa0\x7f\xc2\x10\ - \\xd8\xdf\xdf\x61\x6f\x4a\x01\x59\xb4\x4a\x4e\x74\x33\xcc\xd0\x1a\ - \\xad\x4c\xe6\xe7\x25\xd5\xcd\xe0\x29\xa2\x3e\x90\x8f\xd6\x73\x15\ - \\xf1\xd6\x51\x86\x51\x77\x71\x4d\xee\xb4\xcb\xd9\x72\x78\x29\x11\ - \\xe8\x57\xe9\xd6\xe8\xbe\xe8\x7b\xb0\x54\xac\x8f\x84\x8d\x75\x1b\ - \\x20\x13\x21\xdf\x53\x32\xba\xfc\x59\xdd\x89\x0c\x6a\xa4\xf7\x15\ - \\x80\x42\xe7\x18\x43\x28\xc8\x63\xae\x4a\x6e\x70\xee\xe9\x92\x11\ - \\x66\x6a\xd8\x27\x38\x0d\x0d\x06\x17\x11\x4a\x1a\x17\x43\x1e\x1c\ - \\xeb\x21\xad\xec\x2c\xa4\x3d\x6b\x12\x74\x6e\x7b\x12\x9c\x7e\x16\ - \\x56\x4e\x57\xbd\xf0\x1c\xfe\x88\xdb\x5c\x58\xfc\x41\xe3\xfe\x11\ - \\x23\x4a\x25\x62\xb4\x94\x96\x41\x5f\x61\x8d\x60\x36\x05\xcb\x1c\ - \\xe9\xd4\x1d\xe8\x29\xaa\xab\x67\x7f\xe7\x3d\x4d\xf8\xd0\x08\x17\ - \\x87\xdd\x17\x20\xbb\x21\x56\xb9\x32\xb9\x64\xd7\xf9\x73\x6d\x12\ - \\xa5\x95\x8c\x66\x2b\x69\x23\xc2\xea\xc1\x3a\xf2\xc2\xec\x7b\x1d\ - \\x1d\xde\xd6\x1e\x89\xba\x82\xce\xbb\x34\x62\x5b\x02\x57\x96\x17\ - \\x18\x18\xdf\x4b\x07\x62\x35\xa5\xfc\xf6\xb4\xe2\x01\xac\xde\x12\ - \\x59\xf3\x64\x79\xd8\x9c\x88\x3b\x94\xf1\x87\x37\x36\x13\x31\x1e\ - \\xe1\xf5\x83\xc7\x46\x4a\x6d\xfc\xdc\x5a\x06\xc6\x91\x42\x27\x18\ - \\x1a\x2b\x03\x06\x9f\x6e\x57\x30\x17\xaf\x9e\xd1\xa7\x9b\x52\x13\ - \\x90\xde\xd1\x3c\xcb\x7d\x25\x1a\x25\x18\x31\x1c\xa6\x92\xea\x1e\ - \\x40\xe5\xa7\x30\x3c\xfe\x1d\x48\xb7\x79\x5a\xe3\x84\xa8\xbb\x18\ - \\x00\x51\x86\xc0\xc9\x31\x4b\xd3\xc5\xc7\xae\x82\x9d\x53\xc9\x13\ - \\xcd\xb4\xa3\xcd\x42\xe9\x11\x52\x09\xa6\x17\xd1\xc8\x85\xa8\x1f\ - \\xa4\x90\x1c\x3e\x02\x21\xdb\x74\x07\xb8\xdf\x40\x3a\x9e\x53\x19\ - \\x50\x0d\x4a\xcb\x01\xb4\x15\xf7\x05\x60\x19\x67\xfb\xe4\x42\x14\ - \\xa7\x0a\x08\x09\x9b\x29\xde\xf8\x37\xb3\x7a\x52\xfc\x83\x35\x10\ - \\xd7\xdd\x0c\xa8\x91\x42\x30\x8e\x59\xb8\x2a\xb7\x93\x39\xef\x19\ - \\x13\x4b\x0a\x20\x0e\x02\x8d\x3e\xe1\xf9\xee\xf8\x42\x61\xbf\x14\ - \\x0f\x3c\x08\x80\x3e\x9b\x3d\x65\xe7\xc7\x58\xfa\x9b\x1a\x99\x10\ - \\xe4\x2c\x0d\x00\x64\xf8\xc8\x6e\xa5\x0c\x8e\x90\xf9\x90\x8e\x1a\ - \\xea\x23\xa4\x99\xe9\xf9\xd3\x8b\xb7\xa3\x71\x40\x61\xda\x3e\x15\ - \\xbb\x1c\x50\xe1\xba\x94\xa9\x3c\xf9\x82\xf4\x99\x1a\x15\xff\x10\ - \\x2b\x61\xb3\x9b\xc4\xba\x75\xc7\x8e\xd1\x20\xc3\x5d\xbb\x31\x1b\ - \\x89\x1a\x29\x16\x6a\x95\xc4\xd2\x0b\x0e\xe7\x68\xb1\x62\xc1\x15\ - \\xa1\x7b\xba\x11\x88\x77\xd0\xdb\x6f\x3e\x1f\x87\x27\x82\x67\x11\ - \\x9b\x92\x5d\x1c\x40\xbf\x80\x2c\xe6\x63\x98\x3e\x3f\xd0\xd8\x1b\ - \\x49\x75\xe4\x49\x33\xcc\x33\xbd\x51\xb6\x46\x65\xff\x0c\x47\x16\ - \\xd4\x5d\x50\x6e\x8f\xd6\x8f\xca\xa7\x5e\x05\x51\xcc\x70\xd2\x11\ - \\x53\xc9\xb3\xe3\x4b\x57\x19\x44\xd9\xfd\x6e\x4e\xad\xe7\x83\x1c\ - \\xa9\x3a\xf6\x82\x09\x79\x47\x03\xe1\x97\x25\xa5\x8a\xec\xcf\x16\ - \\xba\xfb\xc4\x68\xd4\x60\x6c\xcf\x80\x79\x84\xea\x6e\xf0\x3f\x12\ - \\x2a\xf9\x07\x0e\x87\x34\x7a\xe5\x9a\xf5\xd3\x10\x4b\x1a\x33\x1d\ - \\x22\x94\x39\x0b\x6c\x90\x2e\x51\xe2\x2a\x43\xda\x08\x15\x5c\x17\ - \\xb5\xa9\xc7\xd5\xbc\xa6\x8b\xda\x81\x55\xcf\xe1\xd3\x10\xb0\x12\ - \\x87\x0f\xd9\x22\x2e\x71\xdf\x90\x9c\x55\xe5\x02\x53\x81\xe6\x1d\ - \\x6c\x0c\x14\x4f\x8b\x5a\x4c\xda\x16\xde\x1d\xcf\xa8\x9a\xeb\x17\ - \\x8a\xa3\xa9\xa5\xa2\x7b\xa3\xae\x78\x7e\xb1\xa5\x20\xe2\x22\x13\ - \\xa9\x05\xa9\xa2\x6a\x5f\xd2\x7d\x27\x97\xb5\xa2\x9a\x36\x9e\x1e\ - \\x54\xd1\x20\x82\x88\x7f\xdb\x97\x1f\xac\xf7\x4e\x15\x92\x7e\x18\ - \\x77\xa7\x80\xce\x06\x66\x7c\x79\x4c\x23\xc6\xd8\xdd\x74\x98\x13\ - \\xf1\x0b\x01\xe4\x0a\x70\x2d\x8f\xad\x6b\xa3\x27\x96\x54\x5a\x1f\ - \\x5a\xd6\x00\x50\xa2\x59\x24\x0c\xbe\xef\xb5\x1f\x78\x10\x15\x19\ - \\x15\x45\x9a\xd9\x81\x14\x1d\x70\xfe\xf2\xf7\xb2\xf9\xd9\x10\x14\ - \\x77\x6a\x7b\x14\x9b\x43\x17\xc0\xfe\x5b\xc6\x28\x2e\x7b\x0d\x10\ - \\xf2\x43\x92\xed\xc4\x05\xf2\xcc\xca\x2c\x0a\x0e\x7d\x2b\xaf\x19\ - \\xc2\x9c\x0e\xbe\xd0\x37\x5b\x0a\x6f\xbd\xa1\x71\xca\x22\x8c\x14\ - \\xce\xe3\x3e\xcb\x73\xf9\x48\x08\x8c\x97\xb4\x27\xd5\x1b\x70\x10\ - \\xb0\x9f\x64\x78\xec\x5b\x0e\xda\xac\x25\x54\x0c\x55\xf9\x4c\x1a\ - \\xc0\x7f\x50\x60\xf0\xaf\x3e\x7b\xbd\xb7\xa9\xd6\x10\x61\x0a\x15\ - \\x33\x66\x40\x80\xf3\xbf\xcb\x95\x97\x2c\xee\xde\x73\x1a\xd5\x10\ - \\x52\x70\xcd\x66\x52\x66\xac\xef\x58\x47\xb0\x64\xb9\x90\xee\x1a\ - \\xdb\x59\xa4\xb8\x0e\x85\x23\x26\x47\x6c\xf3\xb6\xfa\xa6\x8b\x15\ - \\x49\xae\xb6\x93\xd8\xd0\x82\x1e\x6c\x23\x29\x5f\x95\x85\x3c\x11\ - \\x75\xb0\x8a\x1f\xf4\x1a\x9e\xfd\xac\x38\xa8\xfe\xee\x08\x94\x1b\ - \\xf7\x59\xd5\xb2\x29\xaf\xb1\x97\xbd\x93\x86\x98\x25\x07\x10\x16\ - \\x2c\x7b\x77\xf5\xba\x25\x8e\xac\x97\xdc\x9e\x13\x1e\x6c\xa6\x11\ - \\x13\xc5\x58\x22\x2b\x09\x7d\x7a\xbf\x2d\xfe\xb8\xc9\x79\x3d\x1c\ - \\x76\x6a\xad\x4e\xef\xa0\xfd\x61\xcc\x57\xcb\x60\xa1\x94\x97\x16\ - \\xc5\xee\xbd\x0b\x59\x1a\xfe\xe7\x09\x13\x09\xe7\x4d\xdd\x12\x12\ - \\x3a\xb1\xfc\x45\x5b\x5d\x63\xa6\xdc\x84\x0e\xd8\xaf\xfb\xea\x1c\ - \\xc8\x8d\x30\x6b\xaf\x4a\x1c\x85\xb0\xd0\x3e\x13\xf3\x62\x22\x17\ - \\xd4\xd7\x26\xbc\xf2\x6e\xe3\xd0\x26\xda\xcb\x75\xc2\xe8\x81\x12\ - \\x86\x8c\xa4\xc6\xea\x17\x9f\xb4\xd7\x29\x46\x89\x9d\xa7\x9c\x1d\ - \\x6b\x70\x50\x05\xef\xdf\x18\x2a\x46\xee\x04\xa1\x17\x86\xb0\x17\ - \\x89\xf3\xd9\x9d\x25\xb3\xe0\x54\x6b\x8b\x9d\x4d\x79\x9e\xf3\x12\ - \\x74\x52\xf6\x62\x6f\xeb\xcd\x87\x78\x45\x2f\x7c\x28\x97\x52\x1e\ - \\x5d\xa8\x5e\x82\xbf\x22\x0b\xd3\xc6\x6a\xbf\xc9\x86\x12\x42\x18\ - \\xe4\xb9\x4b\x68\xcc\x1b\x3c\x0f\x9f\x88\xff\x3a\xd2\x0e\x68\x13\ - \\x6d\x29\x79\x40\x7a\x2c\x60\x18\x98\xda\x98\x91\x83\xe4\x0c\x1f\ - \\x24\x21\x94\x33\xc8\x56\xb3\x46\x13\xe2\x13\x0e\x36\x1d\xd7\x18\ - \\xb6\x4d\x43\x29\xa0\x78\x8f\x38\xdc\xb4\xdc\xa4\x91\x4a\xdf\x13\ - \\x8a\xaf\x6b\xa8\x66\x27\x7f\x5a\x60\x21\x61\xa1\x82\xaa\xcb\x1f\ - \\xa2\xbf\xef\xb9\xeb\x85\x32\x15\x4d\xb4\x4d\xb4\x9b\xbb\x6f\x19\ - \\x4e\x99\x8c\x61\x89\xd1\x8e\xaa\x3d\x90\xa4\xf6\xe2\x62\x59\x14\ - \\x0c\xe1\xd6\x1a\xa1\xa7\xd8\xee\xca\xd9\xb6\x2b\x4f\x82\x47\x10\ - \\x45\x9b\x24\x5e\x9b\x72\x27\x7e\x11\xf6\x8a\xdf\xb1\x03\x0c\x1a\ - \\x04\x49\x1d\x18\x49\xf5\x85\xfe\x0d\xf8\x3b\x19\x5b\x69\xd6\x14\ - \\xd0\xa0\x4a\x13\xd4\x5d\x9e\xcb\xa4\xf9\x2f\x14\x7c\x87\xab\x10\ - \\x4d\x01\x11\x52\x53\xc9\x63\xdf\x3a\x5c\xe6\xb9\xf9\x0b\xac\x1a\ - \\x71\x67\xda\x74\x0f\xa1\x1c\x19\x2f\xb0\x1e\xfb\xfa\x6f\x56\x15\ - \\xc1\x52\x48\x2a\xd9\x80\xb0\xad\x25\xc0\x4b\x2f\x2f\xf3\x11\x11\ - \\x34\x51\x0d\xaa\x8e\x34\xe7\x15\x09\xcd\x12\xb2\x7e\xeb\x4f\x1b\ - \\xc4\x0d\x71\xee\x3e\x5d\x1f\xab\x6d\x0a\x0f\x28\x32\x89\xd9\x15\ - \\x9d\xa4\x8d\x8b\x65\x17\x19\xbc\x57\x08\x0c\x20\x28\xd4\x7a\x11\ - \\x94\x3a\x7c\x12\x3c\xf2\xf4\x2c\x59\x0d\xe0\xcc\xd9\xb9\xf7\x1b\ - \\x43\x95\x96\xdb\xfc\xf4\xc3\xf0\xe0\x3d\xb3\x70\xe1\xc7\x5f\x16\ - \\x03\x11\x12\x16\x97\x5d\x36\x5a\x1a\xcb\xf5\x26\x81\x39\xe6\x11\ - \\x04\xe8\x1c\xf0\x24\xfc\x56\x90\x90\xde\x22\x0b\x35\x8f\xa3\x1c\ - \\xd0\xec\xe3\x8c\x1d\x30\xdf\xd9\xa6\x4b\x82\xa2\x5d\x3f\xe9\x16\ - \\xda\x23\x83\x3d\xb1\x59\x7f\xe1\xeb\xa2\xce\x4e\xb1\x32\x54\x12\ - \\x5c\x39\x38\x2f\xb5\xc2\xcb\x68\x79\xd1\x7d\xe4\x4e\x84\x53\x1d\ - \\xe3\x2d\x60\xbf\x5d\x35\xd6\x53\x94\xa7\x64\x50\x72\x03\x76\x17\ - \\x1c\x8b\xe6\x65\xb1\x2a\x78\xa9\x76\xec\xb6\xa6\x8e\xcf\xc4\x12\ - \\xfa\x44\xd7\x6f\xb5\xaa\x26\x0f\xf1\x13\x8b\xd7\x7d\xb2\x07\x1e\ - \\x62\x6a\xdf\xbf\x2a\x22\x52\x3f\x27\x43\x6f\xac\x64\x28\x06\x18\ - \\x4e\x88\x7f\x99\x88\x4e\xdb\x65\x1f\x9c\xf2\x89\x50\x20\x38\x13\ - \\x4a\x0d\xcc\x28\x74\x4a\xc5\x6f\x65\x93\xea\x0f\xb4\x33\xc0\x1e\ - \\x3b\xa4\x09\x87\xf6\xa1\x6a\x59\x84\x0f\x22\x73\xf6\xc2\x99\x18\ - \\x96\xb6\x07\x6c\xf8\xe7\xee\xad\x36\xd9\xb4\xf5\x91\x35\xae\x13\ - \\x56\x57\x0c\xe0\xf3\x3f\x7e\x49\x24\xf5\xba\x22\x83\x22\x7d\x1f\ - \\x45\xac\xd6\x4c\xf6\xff\x64\xd4\xe9\x90\x95\xe8\x68\xe8\x30\x19\ - \\xd1\x89\x78\x3d\xf8\xff\x83\x43\xee\x73\x44\xed\x53\x20\x27\x14\ - \\x74\xa1\x93\x97\xc6\xcc\x9c\xcf\xf1\x8f\x03\xf1\x0f\x4d\x1f\x10\ - \\x52\x02\xb9\x25\xa4\x47\x61\x7f\x1c\xb3\x05\xe8\x7f\xae\xcb\x19\ - \\x0f\x35\xc7\xb7\xe9\xd2\x4d\xcc\x16\x5c\xd1\xec\xff\xf1\xa2\x14\ - \\xd9\x90\xd2\x5f\x21\x0f\x0b\x3d\x12\xb0\xda\x23\x33\x5b\x82\x10\ - \\xc1\xe7\x50\x99\x68\x4b\xab\x61\x50\xb3\x2a\x06\x85\x2b\x6a\x1a\ - \\x67\xb9\x40\x14\xba\xa2\x22\x4e\x40\x5c\x55\x6b\x6a\xbc\x21\x15\ - \\x53\x94\x00\xdd\x94\xe8\x4e\x0b\xcd\x49\x44\xbc\xee\xc9\xe7\x10\ - \\x51\xed\x00\xc8\x87\xda\x17\x12\x48\xa9\xd3\xc6\x4a\x76\x0c\x1b\ - \\xda\xbd\x00\xa0\x6c\x48\x46\xdb\x6c\x87\xdc\x6b\xd5\x91\xa3\x15\ - \\xaf\x64\xcd\x4c\xbd\x06\x05\x49\x8a\x9f\xe3\xef\xdd\xa7\x4f\x11\ - \\xb1\x3a\xe2\x7a\xc8\x0a\x08\xa8\x43\xff\x38\xe6\x2f\xa6\xb2\x1b\ - \\xf4\x2e\xe8\xfb\x39\xa2\x39\x53\x69\xff\x93\x1e\xf3\x84\x28\x16\ - \\x5d\xf2\xec\x2f\xfb\xb4\xc7\x75\x87\xff\x0f\xb2\xf5\x03\xba\x11\ - \\x2e\xea\x47\xe6\x91\x21\xd9\x22\x3f\xff\x7f\xb6\x22\xd3\x5c\x1c\ - \\xf2\x54\x06\x85\x41\x81\x7a\xb5\x65\xff\xff\x91\xe8\xa8\xb0\x16\ - \\xf5\x43\x38\x37\x01\x01\x62\xc4\xb7\x32\x33\xdb\x86\xed\x26\x12\ - \\xee\x9f\xf3\xf1\x01\x68\x36\x3a\x59\x84\xeb\x91\xa4\x15\x0b\x1d\ - \\x8b\x19\xf6\x27\x9b\xb9\x5e\xfb\xe0\x69\xbc\x74\x50\x11\x3c\x17\ - \\xd6\x7a\x5e\x86\xe2\xfa\x7e\x2f\xe7\x87\x63\x5d\x40\x74\x96\x12\ - \\x56\x91\xfd\xd6\xd0\xf7\x97\xe5\x71\xd9\x38\x62\xcd\x86\xbd\x1d\ - \\xab\xda\xca\x78\x0d\x93\x79\x84\xc1\x7a\x2d\xe8\x3d\xd2\xca\x17\ - \\x56\x15\x6f\x2d\x71\x42\x61\xd0\x9a\xc8\x8a\x86\x31\xa8\x08\x13\ - \\x22\x22\x18\xaf\x4e\x6a\x68\x4d\x91\xda\xaa\x3d\x4f\x40\x74\x1e\ - \\xe8\xb4\x79\xf2\x3e\x88\x53\xa4\xda\xae\x88\x64\x3f\x00\x5d\x18\ - \\x87\x5d\x61\x28\xff\x6c\xdc\xe9\xae\x58\x6d\x50\xcc\x99\x7d\x13\ - \\xa4\x95\x68\x0d\x65\xae\x60\xa9\xe4\x8d\x48\x1a\x7a\x5c\x2f\x1f\ - \\x83\x44\xed\x3d\xb7\xbe\xb3\xba\x83\x71\xa0\xae\x61\xb0\xf2\x18\ - \\x36\x9d\x8a\x31\x2c\x32\xf6\x2e\x36\xc1\xe6\xbe\xe7\x59\xf5\x13"# +-- +-- > splitWord128s $ fmap (finv double_pow5_inv_bitcount) [0..double_max_inv_split] +foreign import ccall "&hs_bytestring_double_pow5_inv_split" + double_pow5_inv_split :: Ptr Word64 -- | Table of 5^(-e2-q) / 2^k + 1 --- Byte-swapped version of --- > fmap (fnorm double_pow5_bitcount) [0..double_max_split] -double_pow5_split :: Addr -double_pow5_split = Addr - "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x1f\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x13\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x18\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x84\x1e\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\x12\x13\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\xd7\x17\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\xcd\x1d\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x5f\xa0\x12\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x76\x48\x17\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x94\x1a\x1d\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\xe5\x9c\x30\x12\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x90\x1e\xc4\xbc\x16\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x26\xf5\x6b\x1c\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xe0\x37\x79\xc3\x11\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\xd8\x85\x57\x34\x16\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc8\x4e\x67\x6d\xc1\x1b\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x91\x60\xe4\x58\x11\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x8c\xb5\x78\x1d\xaf\x15\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\xef\xe2\xd6\xe4\x1a\x1b\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x92\xd5\x4d\x06\xcf\xf0\x10\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x80\xf6\x4a\xe1\xc7\x02\x2d\x15\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x20\xb4\x9d\xd9\x79\x43\x78\x1a\ - \\x00\x00\x00\x00\x00\x00\x00\x00\x94\x90\x02\x28\x2c\x2a\x8b\x10\ - \\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x34\x03\x32\xb7\xf4\xad\x14\ - \\x00\x00\x00\x00\x00\x00\x00\x40\xe7\x01\x84\xfe\xe4\x71\xd9\x19\ - \\x00\x00\x00\x00\x00\x00\x00\x88\x30\x81\x12\x1f\x2f\xe7\x27\x10\ - \\x00\x00\x00\x00\x00\x00\x00\xaa\x7c\x21\xd7\xe6\xfa\xe0\x31\x14\ - \\x00\x00\x00\x00\x00\x00\x80\xd4\xdb\xe9\x8c\xa0\x39\x59\x3e\x19\ - \\x00\x00\x00\x00\x00\x00\xa0\xc9\x52\x24\xb0\x08\x88\xef\x8d\x1f\ - \\x00\x00\x00\x00\x00\x00\x04\xbe\xb3\x16\x6e\x05\xb5\xb5\xb8\x13\ - \\x00\x00\x00\x00\x00\x00\x85\xad\x60\x9c\xc9\x46\x22\xe3\xa6\x18\ - \\x00\x00\x00\x00\x00\x40\xe6\xd8\x78\x03\x7c\xd8\xea\x9b\xd0\x1e\ - \\x00\x00\x00\x00\x00\xe8\x8f\x87\x2b\x82\x4d\xc7\x72\x61\x42\x13\ - \\x00\x00\x00\x00\x00\xe2\x73\x69\xb6\xe2\x20\x79\xcf\xf9\x12\x18\ - \\x00\x00\x00\x00\x80\xda\xd0\x03\x64\x1b\x69\x57\x43\xb8\x17\x1e\ - \\x00\x00\x00\x00\x90\x88\x62\x82\x1e\xb1\xa1\x16\x2a\xd3\xce\x12\ - \\x00\x00\x00\x00\xb4\x2a\xfb\x22\x66\x1d\x4a\x9c\xf4\x87\x82\x17\ - \\x00\x00\x00\x00\x61\xf5\xb9\xab\xbf\xa4\x5c\xc3\xf1\x29\x63\x1d\ - \\x00\x00\x00\xa0\x5c\x39\x54\xcb\xf7\xe6\x19\x1a\x37\xfa\x5d\x12\ - \\x00\x00\x00\xc8\xb3\x47\x29\xbe\xb5\x60\xa0\xe0\xc4\x78\xf5\x16\ - \\x00\x00\x00\xba\xa0\x99\xb3\x2d\xe3\x78\xc8\x18\xf6\xd6\xb2\x1c\ - \\x00\x00\x40\x74\x04\x40\x90\xfc\x8d\x4b\x7d\xcf\x59\xc6\xef\x11\ - \\x00\x00\x50\x91\x05\x50\xb4\x7b\x71\x9e\x5c\x43\xf0\xb7\x6b\x16\ - \\x00\x00\xa4\xf5\x06\x64\xa1\xda\x0d\xc6\x33\x54\xec\xa5\x06\x1c\ - \\x00\x80\x86\x59\x84\xde\xa4\xa8\xc8\x5b\xa0\xb4\xb3\x27\x84\x11\ - \\x00\x20\xe8\x6f\x25\x16\xce\xd2\xba\x72\xc8\xa1\xa0\x31\xe5\x15\ - \\x00\x28\xe2\xcb\xae\x9b\x81\x87\x69\x8f\x3a\xca\x08\x7e\x5e\x1b\ - \\x00\x59\x6d\x3f\x4d\x01\xb1\xf4\xa1\x99\x64\x7e\xc5\x0e\x1b\x11\ - \\x40\xaf\x48\x8f\xa0\x41\xdd\x71\x0a\xc0\xfd\xdd\x76\xd2\x61\x15\ - \\x10\xdb\x1a\xb3\x08\x92\x54\x0e\x0d\x30\x7d\x95\x14\x47\xba\x1a\ - \\xea\xc8\xf0\x6f\x45\xdb\xf4\x28\x08\x3e\x6e\xdd\x6c\x6c\xb4\x10\ - \\x24\xfb\xec\xcb\x16\x12\x32\x33\x8a\xcd\xc9\x14\x88\x87\xe1\x14\ - \\xed\x39\xe8\x7e\x9c\x96\xfe\xbf\xec\x40\xfc\x19\x6a\xe9\x19\x1a\ - \\x34\x24\x51\xcf\x21\x1e\xff\xf7\x93\xa8\x3d\x50\xe2\x31\x50\x10\ - \\x41\x6d\x25\x43\xaa\xe5\xfe\xf5\xb8\x12\x4d\xe4\x5a\x3e\x64\x14\ - \\x92\xc8\xee\xd3\x14\x9f\x7e\x33\x67\x57\x60\x9d\xf1\x4d\x7d\x19\ - \\xb6\x7a\xea\x08\xda\x46\x5e\x00\x41\x6d\xb8\x04\x6e\xa1\xdc\x1f\ - \\xb2\x8c\x92\x45\x48\xec\x3a\xa0\x48\x44\xf3\xc2\xe4\xe4\xe9\x13\ - \\xde\x2f\xf7\x56\x5a\xa7\x49\xc8\x5a\x15\xb0\xf3\x1d\x5e\xe4\x18\ - \\xd6\xfb\xb4\xec\x30\x11\x5c\x7a\xb1\x1a\x9c\x70\xa5\x75\x1d\x1f\ - \\x65\x1d\xf1\x93\xbe\x8a\x79\xec\xae\x90\x61\x66\x87\x69\x72\x13\ - \\xbf\x64\xed\x38\x6e\xed\x97\xa7\xda\xf4\xf9\x3f\xe9\x03\x4f\x18\ - \\xef\xbd\x28\xc7\xc9\xe8\x7d\x51\x11\x72\xf8\x8f\xe3\xc4\x62\x1e\ - \\xb5\x76\x79\x1c\x7e\xb1\xee\xd2\x4a\x47\xfb\x39\x0e\xbb\xfd\x12\ - \\x62\xd4\x97\xa3\xdd\x5d\xaa\x87\x1d\x19\x7a\xc8\xd1\x29\xbd\x17\ - \\x7b\xc9\x7d\x0c\x55\xf5\x94\xe9\x64\x9f\x98\x3a\x46\x74\xac\x1d\ - \\xed\x9d\xce\x27\x55\x19\xfd\x11\x9f\x63\x9f\xe4\xab\xc8\x8b\x12\ - \\x68\x45\xc2\x71\xaa\x5f\x7c\xd6\x86\x3c\xc7\xdd\xd6\xba\x2e\x17\ - \\xc2\xd6\x32\x0e\x95\x77\x1b\x8c\xa8\x0b\x39\x95\x8c\x69\xfa\x1c\ - \\x39\xc6\xdf\x28\xbd\x2a\x91\x57\x49\xa7\x43\xdd\xf7\x81\x1c\x12\ - \\xc8\xb7\x17\x73\x6c\x75\x75\xad\x1b\x91\x94\xd4\x75\xa2\xa3\x16\ - \\xba\xa5\xdd\x8f\xc7\xd2\xd2\x98\x62\xb5\xb9\x49\x13\x8b\x4c\x1c\ - \\x94\x87\xea\xb9\xbc\xc3\x83\x9f\x5d\x11\x14\x0e\xec\xd6\xaf\x11\ - \\x79\x29\x65\xe8\xab\xb4\x64\x07\xb5\x15\x99\x11\xa7\xcc\x1b\x16\ - \\xd7\x73\x7e\xe2\xd6\xe1\x3d\x49\x22\x5b\xff\xd5\xd0\xbf\xa2\x1b\ - \\x66\x08\x8f\x4d\x26\xad\xc6\x6d\xf5\x98\xbf\x85\xe2\xb7\x45\x11\ - \\x80\xca\xf2\xe0\x6f\x58\x38\xc9\x32\x7f\x2f\x27\xdb\x25\x97\x15\ - \\x20\x7d\x2f\xd9\x8b\x6e\x86\x7b\xff\x5e\xfb\xf0\x51\xef\xfc\x1a\ - \\x34\xae\xbd\x67\x17\x05\x34\xad\x5f\x1b\x9d\x36\x93\x15\xde\x10\ - \\xc1\x19\xad\x41\x5d\x06\x81\x98\x37\x62\x44\x04\xf8\x9a\x15\x15\ - \\x32\x60\x18\x92\xf4\x47\xa1\x7e\xc5\x7a\x55\x05\xb6\x01\x5b\x1a\ - \\x1f\x3c\x4f\xdb\xf8\xcc\x24\x6f\xbb\x6c\x55\xc3\x11\xe1\x78\x10\ - \\x27\x0b\x23\x12\x37\x00\xee\x4a\xea\xc7\x2a\x34\x56\x19\x97\x14\ - \\xf0\xcd\xab\xd6\x44\x80\xa9\xdd\xe4\x79\x35\xc1\xab\xdf\xbc\x19\ - \\xb6\x60\x2b\x06\x2b\xf0\x89\x0a\x2f\x6c\xc1\x58\xcb\x0b\x16\x10\ - \\xe4\x38\xb6\xc7\x35\x6c\x2c\xcd\x3a\xc7\xf1\x2e\xbe\x8e\x1b\x14\ - \\x1d\xc7\xa3\x39\x43\x87\x77\x80\x09\x39\xae\xba\x6d\x72\x22\x19\ - \\xe4\xb8\x0c\x08\x14\x69\x95\xe0\x4b\xc7\x59\x29\x09\x0f\x6b\x1f\ - \\x8e\xf3\x07\x85\xac\x61\x5d\x6c\x8f\x1c\xd8\xb9\x65\xe9\xa2\x13\ - \\x72\xf0\x49\xa6\x17\xba\x74\x47\xb3\x23\x4e\x28\xbf\xa3\x8b\x18\ - \\x8f\x6c\xdc\x8f\x9d\xe8\x51\x19\xa0\xac\x61\xf2\xae\x8c\xae\x1e\ - \\xd9\xc3\xe9\x79\x62\x31\xd3\x0f\xe4\x0b\x7d\x57\xed\x17\x2d\x13\ - \\xcf\x34\x64\x18\xbb\xfd\xc7\x13\xdd\x4e\x5c\xad\xe8\x5d\xf8\x17\ - \\x03\x42\x7d\xde\x29\xfd\xb9\x58\x94\x62\xb3\xd8\x62\x75\xf6\x1d\ - \\x42\x49\x0e\x2b\x3a\x3e\x74\xb7\x9c\x1d\x70\xc7\x5d\x09\xba\x12\ - \\x92\xdb\xd1\xb5\xc8\x4d\x51\xe5\x03\x25\x4c\x39\xb5\x8b\x68\x17\ - \\x77\x52\x46\xe3\x3a\xa1\xa5\xde\x44\x2e\x9f\x87\xa2\xae\x42\x1d\ - \\x8a\xf3\x0b\xce\xc4\x84\x27\x0b\xeb\x7c\xc3\x94\x25\xad\x49\x12\ - \\x6d\xf0\x8e\x01\xf6\x65\xf1\xcd\x25\x5c\xf4\xf9\x6e\x18\xdc\x16\ - \\x88\xac\xf2\x81\x73\xbf\x6d\x41\x2f\x73\x71\xb8\x8a\x1e\x93\x1c\ - \\xd5\xab\x37\x31\xa8\x97\xe4\x88\xfd\xe7\x46\xb3\x16\xf3\xdb\x11\ - \\xca\x96\x85\x3d\x92\xbd\x1d\xeb\xfc\xa1\x18\x60\xdc\xef\x52\x16\ - \\x7d\xfc\xe6\xcc\xf6\x2c\xe5\x25\x7c\xca\x1e\x78\xd3\xab\xe7\x1b\ - \\xce\x5d\x10\x40\x1a\x3c\xaf\x97\x8d\x3e\x13\x2b\x64\xcb\x70\x11\ - \\x42\x75\x14\xd0\x20\x0b\x9b\xfd\x30\x0e\xd8\x35\x3d\xfe\xcc\x15\ - \\x92\x92\x19\x04\xe9\xcd\x01\x3d\xbd\x11\x4e\x83\xcc\x3d\x40\x1b\ - \\x9b\xfb\x8f\xa2\xb1\x20\x21\x46\x16\xcb\x10\xd2\x9f\x26\x08\x11\ - \\x82\xfa\x33\x0b\xde\x68\xa9\xd7\xdb\xfd\x94\xc6\x47\x30\x4a\x15\ - \\x23\xf9\x00\x8e\x15\xc3\x93\xcd\x52\x3d\x3a\xb8\x59\xbc\x9c\x1a\ - \\xb6\x9b\xc0\x78\xed\x59\x7c\xc0\x53\x66\x24\x13\xb8\xf5\xa1\x10\ - \\xa3\xc2\xf0\xd6\x68\x70\x9b\xb0\xe8\x7f\xed\x17\x26\x73\xca\x14\ - \\x4c\xf3\xac\x0c\x83\x4c\xc2\xdc\xe2\xdf\xe8\x9d\xef\x0f\xfd\x19\ - \\x0f\x18\xec\xe7\xd1\x6f\xf9\xc9\xed\x8b\xb1\xc2\xf5\x29\x3e\x10\ - \\x13\x1e\xe7\x61\xc6\xcb\x77\x3c\xe9\xee\x5d\x33\x73\xb4\x4d\x14\ - \\x98\xe5\x60\xfa\xb7\xbe\x95\x8b\xa3\x6a\x35\x00\x90\x21\x61\x19\ - \\xfe\x1e\xf9\xf8\x65\x2e\x7b\x6e\x4c\xc5\x42\x00\xf4\x69\xb9\x1f\ - \\x5f\xb3\x9b\xbb\xff\xfc\x0c\xc5\x4f\xbb\x29\x80\x38\xe2\xd3\x13\ - \\x37\xa0\x82\xaa\x3f\x3c\x50\xb6\x23\x2a\x34\xa0\xc6\xda\xc8\x18\ - \\x44\x48\x23\x95\x4f\x4b\xe4\xa3\xac\x34\x41\x48\x78\x11\xfb\x1e\ - \\x2b\x0d\x36\xbd\x11\xaf\x6e\xe6\xeb\xc0\x28\x2d\xeb\xea\x5c\x13\ - \\x75\x90\x83\x2c\xd6\x5a\x0a\xe0\x26\xf1\x72\xf8\xa5\x25\x34\x18\ - \\x93\x74\xa4\xb7\x8b\xf1\x0c\x98\x70\xad\x8f\x76\x0f\x2f\x41\x1e\ - \\xdc\xc8\xc6\x52\xf7\x16\x08\x5f\x66\xcc\x19\xaa\x69\xbd\xe8\x12\ - \\x13\x7b\x78\x27\xb5\x1c\xca\xf6\x7f\x3f\xa0\x14\xc4\xec\xa2\x17\ - \\xd7\x99\x56\x71\xe2\xa3\x7c\xf4\x5f\x4f\xc8\x19\xf5\xa7\x8b\x1d\ - \\x26\x20\xd6\x86\x6d\xe6\xcd\xf8\x9b\x31\x1d\x30\xf9\x48\x77\x12\ - \\x30\xa8\x8b\xe8\x08\x60\x01\xf7\x02\x7e\x24\x7c\x37\x1b\x15\x17\ - \\x3c\x92\xae\x22\x0b\xb8\xc1\xb4\x83\x9d\x2d\x5b\x05\x62\xda\x1c\ - \\x65\x1b\xad\xf5\x06\x13\xf9\x50\x72\x82\xfc\x58\x43\x7d\x08\x12\ - \\x3f\x62\x18\xb3\xc8\x57\x37\xe5\x0e\xa3\x3b\x2f\x94\x9c\x8a\x16\ - \\xcf\x7a\xde\xdf\xba\x2d\x85\x9e\xd2\x8b\x0a\x3b\xb9\x43\x2d\x1c\ - \\xc1\x0c\xeb\xcb\x94\x3c\x13\xa3\x63\x97\xe6\xc4\x53\x4a\x9c\x11\ - \\xf1\xcf\xe5\xfe\xb9\x0b\xd8\x8b\x3c\x3d\x20\xb6\xe8\x5c\x03\x16\ - \\xee\x43\x9f\x7e\xa8\x0e\xce\xae\x8b\x4c\xa8\xe3\x22\x34\x84\x1b\ - \\x75\x8a\x23\x4f\x29\xc9\x40\x4d\xd7\x2f\x49\xce\x95\xa0\x32\x11\ - \\x12\x6d\xec\xa2\x73\xfb\x90\x20\xcd\x7b\xdb\x41\xbb\x48\x7f\x15\ - \\x56\x88\xa7\x8b\x50\x3a\xb5\x68\xc0\x5a\x52\x12\xea\x1a\xdf\x1a\ - \\x36\xb5\x48\x57\x72\x44\x71\x41\xb8\x78\x73\x4b\xd2\x70\xcb\x10\ - \\x83\xe2\x1a\xed\x8e\x95\xcd\x51\xe6\x56\x50\xde\x06\x4d\xfe\x14\ - \\x24\x9b\x61\xa8\xf2\xfa\x40\xe6\x9f\x6c\xe4\x95\x48\xe0\x3d\x1a\ - \\xf7\x00\x3d\xa9\xd7\x9c\xe8\xef\xe3\xc3\xae\x5d\x2d\xac\x66\x10\ - \\x34\x41\x8c\x93\x0d\xc4\xe2\xeb\xdc\x74\x1a\xb5\x38\x57\x80\x14\ - \\x81\x51\x6f\xf8\x10\x75\xdb\x26\x14\x12\x61\xe2\x06\x6d\xa0\x19\ - \\xf1\x92\x45\x9b\x2a\x29\x49\x98\x4c\xab\x7c\x4d\x24\x44\x04\x10\ - \\xad\xf7\x16\x42\x75\x73\x5b\xbe\x1f\xd6\xdb\x60\x2d\x55\x05\x14\ - \\x98\xb5\x9c\x92\x52\x50\xf2\xad\xa7\xcb\x12\xb9\x78\xaa\x06\x19\ - \\xff\xe2\x43\x37\x67\xe4\x6e\x99\x91\x7e\x57\xe7\x16\x55\x48\x1f\ - \\xdf\x6d\x8a\x82\xc0\x4e\xe5\xff\x1a\xaf\x96\x50\x2e\x35\x8d\x13\ - \\x57\x09\x2d\xa3\x70\xa2\xde\xbf\xe1\x5a\xbc\xe4\x79\x82\x70\x18\ - \\xad\x4b\xf8\xcb\x0c\x4b\xd6\x2f\x9a\x71\xeb\x5d\x18\xa3\x8c\x1e\ - \\x4c\x2f\x7b\xff\xe7\xee\xe5\x5d\x00\x27\xb3\x3a\xef\xe5\x17\x13\ - \\x1f\xfb\x59\xff\xa1\x6a\x5f\x75\xc0\xf0\x5f\x09\x6b\xdf\xdd\x17\ - \\xe7\x79\x30\x7f\x4a\x45\xb7\x92\xf0\xec\xb7\xcb\x45\x57\xd5\x1d\ - \\x30\x4c\x7e\x8f\x4e\x8b\xb2\x5b\x16\xf4\x52\x9f\x8b\x56\xa5\x12\ - \\x3c\xdf\x5d\x33\x22\x2e\x9f\xf2\x1b\xb1\x27\x87\x2e\xac\x4e\x17\ - \\x0b\x57\x35\xc0\xaa\xf9\x46\xef\x62\x9d\xf1\x28\x3a\x57\x22\x1d\ - \\x67\x56\x21\xb8\x0a\x5c\x8c\xd5\x5d\x02\x97\x59\x84\x76\x35\x12\ - \\x01\xac\x29\x66\x0d\x73\xef\x4a\xf5\xc2\xfc\x6f\x25\xd4\xc2\x16\ - \\x01\x17\xb4\xbf\xd0\x4f\xab\x9d\xb2\xf3\xfb\xcb\x2e\x89\x73\x1c\ - \\x60\x8e\xd0\x77\xe2\x11\x8b\xa2\x4f\x78\x7d\x3f\xbd\x35\xc8\x11\ - \\xf9\xb1\xc4\x15\x5b\xd6\x2d\x8b\x63\xd6\x5c\x8f\x2c\x43\x3a\x16\ - \\x77\xde\x35\xdb\xf1\x4b\xf9\x6d\xfc\x0b\x34\xb3\xf7\xd3\xc8\x1b\ - \\x0a\xab\x01\x29\x77\xcf\xbb\xc4\x7d\x87\x00\xd0\x7a\x84\x5d\x11\ - \\xcd\x15\x42\xf3\x54\xc3\xea\x35\x5d\xa9\x00\x84\x99\xe5\xb4\x15\ - \\x40\x9b\x12\x30\x2a\x74\x65\x83\xb4\xd3\x00\xe5\xff\x1e\x22\x1b\ - \\x08\xa1\x0b\x5e\x9a\x68\x1f\xd2\x50\x84\x20\xef\x5f\x53\xf5\x10\ - \\x4a\x89\x8e\xf5\xc0\x42\xa7\x06\x65\xa5\xe8\xea\x37\xa8\x32\x15\ - \\x9d\x2b\xf2\x32\x71\x13\x51\x48\xbe\xce\xa2\xe5\x45\x52\x7f\x1a\ - \\x42\x5b\xd7\xbf\x26\xac\x32\xed\x36\xc1\x85\xaf\x6b\x93\x8f\x10\ - \\x12\x32\xcd\x6f\x30\x57\x7f\xa8\x84\x31\x67\x9b\x46\x78\xb3\x14\ - \\x97\x7e\xc0\x8b\xfc\x2c\x9f\xd2\xe5\xfd\x40\x42\x58\x56\xe0\x19\ - \\x1e\x4f\x58\xd7\x1d\x7c\xa3\xa3\xaf\x9e\x68\x29\xf7\x35\x2c\x10\ - \\xe6\x62\x2e\x4d\x25\x5b\x8c\x8c\x5b\xc6\xc2\xf3\x74\x43\x37\x14\ - \\x9f\xfb\x79\xa0\xee\x71\xaf\x6f\xf2\x77\xb3\x30\x52\x14\x45\x19\ - \\x87\x7a\x98\x48\x6a\x4e\x9b\x0b\xef\x55\xe0\xbc\x66\x59\x96\x1f\ - \\x94\x4c\x5f\x6d\x02\x11\x41\x67\xb5\x35\x0c\x36\xe0\xf7\xbd\x13\ - \\xba\x1f\xb7\x08\x43\x55\x11\xc1\x22\x43\x8f\x43\xd8\x75\xad\x18\ - \\xa8\xe7\xe4\xca\x93\xaa\x55\x71\xeb\x13\x73\x54\x4e\xd3\xd8\x1e\ - \\xc9\x10\xcf\x5e\x9c\x8a\xd5\x26\x73\xec\xc7\xf4\x10\x84\x47\x13\ - \\xfb\xd4\x82\x76\x43\xed\x8a\xf0\x8f\xe7\xf9\x31\x15\x65\x19\x18\ - \\x3a\x8a\x23\x54\x94\xa8\xad\xec\x73\x61\x78\x7e\x5a\xbe\x1f\x1e\ - \\x64\x36\x96\xb4\x5c\x89\xec\x73\xe8\x3c\x0b\x8f\xf8\xd6\xd3\x12\ - \\xfd\xc3\xbb\xe1\xb3\xab\xe7\x90\x22\x0c\xce\xb2\xb6\xcc\x88\x17\ - \\xfd\xb4\x2a\xda\xa0\x96\x21\x35\x2b\x8f\x81\x5f\xe4\xff\x6a\x1d\ - \\x1e\xb1\x5a\x88\x24\xfe\x34\x01\x7b\xf9\xb0\xbb\xee\xdf\x62\x12\ - \\x65\x5d\x71\xaa\xad\x3d\x82\xc1\xd9\x37\x9d\x6a\xea\x97\xfb\x16\ - \\xbf\xb4\x0d\x15\x19\xcd\xe2\x31\xd0\x85\x44\x05\xe5\x7d\xba\x1c\ - \\xf7\x90\x28\xad\x2f\xc0\x2d\x1f\xa2\xd3\x4a\x23\xaf\x8e\xf4\x11\ - \\x35\xb5\x72\x98\x3b\x30\xf9\xa6\x8a\x88\x1d\xec\x5a\xb2\x71\x16\ - \\x82\x62\x8f\x7e\x4a\x7c\xb7\x50\xad\xea\x24\xa7\xf1\x1e\x0e\x1c\ - \\x91\x9d\x19\x8f\xae\xad\x72\x52\xac\x12\x77\x08\x57\xd3\x88\x11\ - \\xf6\x04\xe0\x32\x1a\x59\x0f\x67\x57\xd7\x94\xca\x2c\x08\xeb\x15\ - \\x33\x06\x98\xbf\x60\x2f\xd3\x40\x2d\x0d\x3a\xfd\x37\xca\x65\x1b\ - \\xe0\x03\xbf\x77\x9c\xfd\x83\x48\x3c\x48\x44\xfe\x62\x9e\x1f\x11\ - \\xd8\xc4\xae\x95\x03\xfd\xa4\x5a\x4b\x5a\xd5\xbd\xfb\x85\x67\x15\ - \\x0e\x76\x1a\x7b\x44\x3c\x4e\x31\xde\xb0\x4a\xad\x7a\x67\xc1\x1a\ - \\xc9\x89\xf0\xcc\xaa\xe5\xd0\xde\x8a\xae\x4e\xac\xac\xe0\xb8\x10\ - \\x3b\xac\x2c\x80\x15\x1f\x85\x96\x2d\x5a\x62\xd7\xd7\x18\xe7\x14\ - \\x4a\xd7\x37\xe0\xda\x66\x26\xfc\xb8\xf0\x3a\xcd\x0d\xdf\x20\x1a\ - \\x8e\xe6\x22\xcc\x48\x00\x98\x9d\x73\xd6\x44\xa0\x68\x8b\x54\x10\ - \\x32\xa0\x2b\xff\x5a\x00\xfe\x84\x10\x0c\x56\xc8\x42\xae\x69\x14\ - \\x3e\x88\xf6\xbe\x71\x80\x3d\xa6\x14\x8f\x6b\x7a\xd3\x19\x84\x19\ - \\x4e\x2a\xb4\x2e\x8e\xe0\xcc\xcf\xd9\x72\x06\x59\x48\x20\xe5\x1f\ - \\x70\x9a\x30\xdd\x58\x0c\xe0\x21\xc8\x07\xa4\x37\x2d\x34\xef\x13\ - \\x0d\xc1\x7c\x14\x6f\x0f\x58\x2a\xba\x09\x8d\x85\x38\x01\xeb\x18\ - \\x50\xf1\x9b\xd9\x4a\x13\xee\xb4\x28\x4c\xf0\xa6\x86\xc1\x25\x1f\ - \\xd2\x76\x01\xc8\x0e\xcc\x14\x71\x99\x2f\x56\x28\xf4\x98\x77\x13\ - \\x86\xd4\x01\x7a\x12\xff\x59\xcd\x7f\xbb\x6b\x32\x31\x7f\x55\x18\ - \\xa8\x49\x82\x18\xd7\x7e\xb0\xc0\x5f\xaa\x06\x7f\xfd\xde\x6a\x1e\ - \\x09\x6e\x51\x6f\x46\x4f\x6e\xd8\x7b\x2a\x64\x6f\x5e\xcb\x02\x13\ - \\x8b\xc9\x25\x0b\x18\xe3\x89\xce\x1a\x35\x3d\x0b\x36\x7e\xc3\x17\ - \\xee\x3b\xef\x0d\xde\x5b\x2c\x82\x61\x82\x0c\x8e\xc3\x5d\xb4\x1d\ - \\x75\x85\xb5\xc8\x6a\xb9\x5b\xf1\x7c\xd1\xc7\x38\x9a\xba\x90\x12\ - \\xd2\xe6\xe2\x7a\xc5\xa7\xb2\x2d\xdc\xc5\xf9\xc6\x40\xe9\x34\x17\ - \\x86\xa0\x9b\xd9\xb6\x51\x1f\x39\x53\x37\xb8\xf8\x90\x23\x02\x1d\ - \\x54\x44\x01\x48\x12\x93\xb3\x03\x94\x22\x73\x9b\x3a\x56\x21\x12\ - \\x69\x95\x01\xda\xd6\x77\xa0\x04\x39\xeb\x4f\x42\xc9\xab\xa9\x16\ - \\xc3\xfa\x81\x90\xcc\x95\xc8\x45\x07\xe6\xe3\x92\xbb\x16\x54\x1c\ - \\xba\x3c\x51\xda\x9f\x5d\x9d\x8b\xc4\x6f\xce\x3b\x35\x8e\xb4\x11\ - \\xe8\x8b\xe5\xd0\x07\xb5\x84\xae\xb5\x0b\xc2\x8a\xc2\xb1\x21\x16\ - \\xe3\xee\x1e\xc5\x49\xe2\x25\x1a\xa3\x8e\x72\x2d\x33\x1e\xaa\x1b\ - \\x4d\x55\x33\x1b\x6e\xad\x57\xf0\x25\x99\x67\xfc\xdf\x52\x4a\x11\ - \\xa1\x2a\x00\xa2\xc9\x98\x6d\x6c\x6f\x7f\x81\xfb\x97\xe7\x9c\x15\ - \\x49\x35\x80\x0a\xfc\xfe\x88\x47\x4b\xdf\x61\xfa\x7d\x21\x04\x1b\ - \\x4e\x21\x90\x86\x5d\x9f\xb5\x0c\x8f\x2b\x7d\xbc\xee\x94\xe2\x10\ - \\xa1\x29\x34\xe8\x34\x07\xe3\xcf\x72\x76\x9c\x6b\x2a\x3a\x1b\x15\ - \\x0a\x34\x41\x22\x02\xc9\xdb\x83\x0f\x94\x83\x06\xb5\x08\x62\x1a\ - \\x86\xc0\x68\x55\xa1\x5d\x69\xb2\x89\x3c\x12\x24\x71\x45\x7d\x10\ - \\xa7\xf0\xc2\xaa\x09\xb5\x03\x1f\xac\xcb\x16\x6d\xcd\x96\x9c\x14\ - \\xd1\xac\x73\x15\x4c\xa2\xc4\x26\x97\x7e\x5c\xc8\x80\xbc\xc3\x19\ - \\x03\x4c\x68\x8d\x6f\xe5\x3a\x78\x1e\xcf\x39\x7d\xd0\x55\x1a\x10\ - \\x03\x5f\xc2\x70\xcb\x9e\x49\x16\xe6\x42\x88\x9c\x44\xeb\x20\x14\ - \\xc4\xf6\xf2\x4c\x7e\x06\xdc\x9b\x9f\x53\xaa\xc3\x15\x26\x29\x19\ - \\x76\xb4\x2f\xe0\x1d\x08\xd3\x82\x87\xe8\x94\x34\x9b\x6f\x73\x1f\ - \\xc9\xd0\x1d\xac\x12\xe5\xc3\xb1\x54\x11\xdd\x00\xc1\x25\xa8\x13\ - \\xfc\x44\x25\x57\x57\xde\x34\xde\xa9\x55\x14\x41\x31\x2f\x92\x18\ - \\x3b\x96\xee\x2c\xed\x15\xc2\x55\x14\x6b\x59\x91\xfd\xba\xb6\x1e\ - \\xe5\x1d\x15\x3c\xb4\x4d\x99\xb5\xec\xe2\xd7\x7a\xde\x34\x32\x13\ - \\x5e\x65\x1a\x4b\x21\xa1\xff\xe2\xa7\xdb\x8d\x19\x16\xc2\xfe\x17\ - \\xb6\xfe\xe0\x9d\x69\x89\xbf\xdb\x91\x52\xf1\x9f\x9b\x72\xfe\x1d\ - \\x31\x9f\xac\x02\xe2\xb5\x57\x29\x9b\xd3\xf6\x43\xa1\x07\xbf\x12\ - \\xfe\xc6\x57\x83\x5a\xa3\xad\xf3\x81\x88\xf4\x94\x89\xc9\x6e\x17\ - \\xbd\xb8\x2d\x24\x31\x0c\x99\x70\xa2\xaa\x31\xfa\xeb\x7b\x4a\x1d\ - \\x76\x93\x9c\xb6\x9e\xa7\x5f\x86\xa5\x0a\x5f\x7c\x73\x8d\x4e\x12\ - \\x54\xb8\x43\x64\x86\x91\xf7\xe7\x4e\xcd\x76\x5b\xd0\x30\xe2\x16\ - \\x69\xa6\x54\xfd\xe7\x75\xf5\xa1\xa2\x80\x54\x72\x04\xbd\x9a\x1c\ - \\x01\xe8\x54\xfe\xb0\x69\x39\xa5\x65\xd0\x74\xc7\x22\xb6\xe0\x11\ - \\x02\x22\xea\x3d\x1d\xc4\x87\x0e\x7f\x04\x52\x79\xab\xe3\x58\x16\ - \\x82\xaa\x64\x8d\x24\xb5\x29\xd2\x9e\x85\xa6\x57\x96\x1c\xef\x1b\ - \\x91\xea\x5e\xd8\x36\x11\x5a\x43\x83\x13\xc8\xf6\xdd\x71\x75\x11\ - \\x36\xa5\x76\x8e\x84\x95\x30\x14\x64\x18\x7a\x74\x55\xce\xd2\x15\ - \\x83\x4e\x14\xb2\xe5\xba\x3c\x19\x7d\x9e\x98\xd1\xea\x81\x47\x1b\ - \\x12\xb1\x4c\x8f\xcf\xf4\xc5\x2f\x0e\x63\xff\xc2\x32\xb1\x0c\x11\ - \\x56\xdd\x1f\x73\x03\x72\xb7\xbb\xd1\x3b\xbf\x73\x7f\xdd\x4f\x15\ - \\xac\xd4\xe7\x4f\x84\x4e\xa5\x2a\xc6\x0a\xaf\x50\xdf\xd4\xa3\x1a\ - \\xeb\xe4\xf0\xb1\x12\x51\xa7\xda\xbb\x66\x6d\x92\x0b\x65\xa6\x10\ - \\x26\x1e\x6d\x5e\x57\x25\x51\xd1\x6a\xc0\x08\x77\x4e\xfe\xcf\x14\ - \\xb0\x65\x08\x36\xad\x6e\xa5\x85\x85\xf0\xca\x14\xe2\xfd\x03\x1a\ - \\x8e\x3f\xc5\x41\x2c\x65\x87\x73\x53\xd6\xfe\x4c\xad\x7e\x42\x10\ - \\x71\x8f\x36\x52\x77\x3e\x69\x50\xe8\x8b\x3e\xa0\x58\x1e\x53\x14\ - \\x4e\x33\xc4\x26\x15\x8e\x83\x64\xe2\x2e\x4e\xc8\xee\xe5\x67\x19\ - \\x22\x40\x75\x70\x9a\x71\xa4\xfd\x9a\xba\x61\x7a\x6a\xdf\xc1\x1f\ - \\x15\x48\x49\x86\x00\xc7\x86\xde\xa0\x14\x7d\x8c\xa2\x2b\xd9\x13\ - \\x1a\x9a\xdb\xa7\xc0\x78\x28\x16\xc9\x59\x9c\x2f\x8b\x76\xcf\x18\ - \\xa1\x80\xd2\xd1\xf0\x96\xb2\x5b\x3b\x70\x83\xfb\x2d\x54\x03\x1f\ - \\x64\x90\x23\x83\x56\x9e\x4f\x19\x25\x26\x32\xbd\x9c\x14\x62\x13\ - \\x7e\x74\xec\x23\xec\x85\xa3\x5f\xae\xaf\x7e\xec\xc3\x99\x3a\x18\ - \\x9d\x91\xe7\x2c\x67\x67\x8c\xf7\x99\x5b\x9e\xe7\x34\x40\x49\x1e\ - \\x02\xbb\x10\x7c\xa0\xc0\xb7\x3a\x40\xf9\xc2\x10\x21\xc8\xed\x12\ - \\xc3\xe9\x14\x9b\xc8\xb0\x65\x49\x90\xb7\xf3\x54\x29\x3a\xa9\x17\ - \\x33\x24\xda\xc1\xfa\x1c\xbf\x5b\x74\xa5\x30\xaa\xb3\x88\x93\x1d\ - \\xa0\x56\x28\xb9\x1c\x72\x57\xb9\x68\x67\x5e\x4a\x70\x35\x7c\x12\ - \\x48\x6c\x72\xe7\xa3\x4e\xad\xe7\x42\x01\xf6\x5c\xcc\x42\x1b\x17\ - \\x5a\x07\x4f\xe1\x4c\xa2\x98\xa1\x93\x81\x33\x74\x7f\x13\xe2\x1c\ - \\x98\x64\xd1\x0c\x70\x65\xff\x44\xfc\x30\xa0\xa8\x2f\x4c\x0d\x12\ - \\xbe\xbd\x05\x10\xcc\x3e\x3f\x56\x3b\x3d\xc8\x92\x3b\x9f\x90\x16\ - \\x2e\x2d\x07\x14\x7f\x0e\xcf\x2b\x8a\x4c\x7a\x77\x0a\xc7\x34\x1c\ - \\x3d\x7c\x84\x6c\x0f\x69\x61\x5b\xd6\x6f\xac\x8a\x66\xfc\xa0\x11\ - \\x4c\x9b\xa5\x47\x53\xc3\x39\xf2\xcb\x8b\x57\x2d\x80\x3b\x09\x16\ - \\x1f\x02\x8f\x19\x28\x34\xc8\xee\xbe\x6e\xad\x38\x60\x8a\x8b\x1b\ - \\x53\x61\xf9\x0f\x99\x20\x3d\x55\x37\x65\x6c\x23\x7c\x36\x37\x11\ - \\xa8\xb9\xf7\x53\xbf\x68\x8c\x2a\x85\x7e\x47\x2c\x1b\x04\x85\x15\ - \\x12\xa8\xf5\x28\xef\x82\x2f\x75\x26\x5e\x59\xf7\x21\x45\xe6\x1a\ - \\x0b\x89\x99\x79\xd5\xb1\x3d\x09\xd8\xda\x97\x3a\x35\xeb\xcf\x10\ - \\x4e\xeb\xff\xd7\x4a\x1e\x8d\x0b\x8e\xd1\x3d\x89\x02\xe6\x03\x15\ - \\x22\xe6\xff\x8d\xdd\x65\x70\x8e\xf1\x45\x8d\x2b\x83\xdf\x44\x1a\ - \\xd5\xef\xbf\x78\xaa\x3f\x06\xf9\xb6\x4b\x38\xfb\xb1\x0b\x6b\x10\ - \\xca\xeb\xef\x16\x95\xcf\x47\xb7\xa4\x5e\x06\x7a\x9e\xce\x85\x14\ - \\xbd\xe6\xab\x5c\x7a\xc3\x19\xe5\x4d\xf6\x87\x18\x46\x42\xa7\x19\ - \\x36\x70\xeb\x79\x2c\x1a\x30\xaf\xf0\xf9\x54\xcf\x6b\x89\x08\x10\ - \\x43\x4c\x66\x98\xb7\x20\xfc\xda\x6c\x38\x2a\xc3\xc6\xab\x0a\x14\ - \\x54\xdf\x7f\x7e\xe5\x28\xbb\x11\x88\xc6\xf4\x73\xb8\x56\x0d\x19\ - \\x2a\xd7\x1f\xde\x1e\xf3\x29\x16\x2a\xf8\xf1\x90\x66\xac\x50\x1f\ - \\x7a\xe6\xd3\x4a\xf3\x37\xda\x4d\x1a\x3b\x97\x1a\xc0\x6b\x92\x13\ - \\x19\xe0\x88\x1d\xf0\xc5\x50\xe1\xe0\x09\x3d\x21\xb0\x06\x77\x18\ - \\x1f\x18\xeb\x24\x6c\xf7\xa4\x19\x59\x4c\x8c\x29\x5c\xc8\x94\x1e\ - \\x13\xef\x12\x97\xa3\x1a\x07\xb0\xb7\xaf\xf7\x99\x39\xfd\x1c\x13\ - \\xd8\xaa\xd7\x7c\x4c\xe1\x08\x9c\xa5\x9b\x75\x00\x88\x3c\xe4\x17\ - \\x8e\x95\x0d\x9c\x9f\x19\x0b\x03\x8f\x02\x93\x00\xaa\x4b\xdd\x1d\ - \\x79\x7d\x88\xc1\x03\xf0\xe6\x61\x99\xe1\x5b\x40\x4a\x4f\xaa\x12\ - \\xd7\x9c\xea\xb1\x04\xac\x60\xba\xff\xd9\x72\xd0\x1c\xe3\x54\x17\ - \\x0d\x44\x65\xde\x05\xd7\xf8\xa8\x7f\x90\x8f\x04\xe4\x1b\x2a\x1d\ - \\x88\x4a\xff\xaa\x63\x86\x9b\xc9\x4f\xba\xd9\x82\x6e\x51\x3a\x12\ - \\x2a\x1d\xbf\x95\xfc\x67\x02\xbc\xe3\x28\x90\x23\xca\xe5\xc8\x16\ - \\x74\xe4\x2e\xbb\xfb\x01\x03\xab\x1c\x33\x74\xac\x3c\x1f\x7b\x1c\ - \\xc9\x4e\xfd\x54\x3d\xe1\xe1\xea\xf1\x9f\xc8\xeb\x85\xf3\xcc\x11\ - \\x7b\xa2\x3c\xaa\x8c\x59\x9a\x65\xee\xc7\xba\x66\x67\x30\x40\x16\ - \\x1a\xcb\xcb\xd4\xef\xef\x00\xff\xe9\x79\x69\x40\x81\x3c\xd0\x1b\ - \\xf0\x5e\xff\xe4\xf5\x95\x60\x3f\x32\xec\x41\xc8\xd0\x25\x62\x11\ - \\xac\x36\x3f\x5e\x73\xbb\x38\xcf\x3e\x67\x52\xfa\x44\xaf\xba\x15\ - \\x57\x04\xcf\x35\x50\xea\x06\x83\x0e\x01\xe7\x38\x16\x5b\x29\x1b\ - \\xb6\x62\xa1\x21\x72\x52\xe4\x11\xa9\x60\x90\xe3\xed\xd8\xf9\x10\ - \\x64\xbb\x09\xaa\x0e\x67\x5d\x56\xd3\x78\x74\x5c\x29\x4f\x38\x15\ - \\x3d\x2a\x8c\x54\xd2\xc0\xf4\x2b\x08\x97\x91\xb3\xf3\x62\x86\x1a\ - \\x66\x9a\xd7\x74\x83\xf8\x78\x1b\x65\xfe\x3a\x50\xd8\xfd\x93\x10\ - \\x00\x81\x0d\x52\xa4\x36\x57\x62\xfe\xbd\x49\x64\x4e\xfd\xb8\x14\ - \\x40\xe1\x90\x66\x4d\x04\xed\xfa\x7d\x2d\x5c\xfd\xa1\x3c\xe7\x19\ - \\xc8\x8c\x1a\x60\xb0\x22\xd4\xbc\x6e\x9c\x59\x3e\xe5\x85\x30\x10\ - \\xfa\x2f\x21\x78\x5c\x2b\x09\x6c\x8a\x03\xf0\x8d\x5e\xa7\x3c\x14\ - \\xf8\x7b\x29\x96\x33\x76\x0b\x07\x6d\x04\x6c\x31\x36\xd1\x4b\x19\ - \\xf6\xda\xb3\x7b\xc0\x53\xce\x48\x88\x05\xc7\xbd\x83\xc5\x9e\x1f\ - \\xda\x68\x50\x4d\x58\xf4\x80\x2d\x75\x63\x9c\x56\x72\x3b\xc3\x13\ - \\x10\x83\xa4\x60\x6e\x31\xe1\x78\x52\x7c\x43\xec\x4e\x0a\xb4\x18"# +-- +-- > splitWord128s $ fmap (fnorm double_pow5_bitcount) [0..double_max_split] +foreign import ccall "&hs_bytestring_double_pow5_split" + double_pow5_split :: Ptr Word64 -- | Number of mantissa bits of a 64-bit float. The number of significant bits -- (floatDigits (undefined :: Double)) is 53 since we have a leading 1 for @@ -720,15 +104,11 @@ mulShift64 m (factorHi, factorLo) shift = -- | Index into the 128-bit word lookup table double_pow5_inv_split get_double_pow5_inv_split :: Int -> (Word64, Word64) -get_double_pow5_inv_split = - let !(Addr arr) = double_pow5_inv_split - in getWord128At arr +get_double_pow5_inv_split = getWord128At double_pow5_inv_split -- | Index into the 128-bit word lookup table double_pow5_split get_double_pow5_split :: Int -> (Word64, Word64) -get_double_pow5_split = - let !(Addr arr) = double_pow5_split - in getWord128At arr +get_double_pow5_split = getWord128At double_pow5_split -- | Take the high bits of m * 5^-e2-q / 2^k / 2^q-k mulPow5DivPow2 :: Word64 -> Int -> Int -> Word64 diff --git a/Data/ByteString/Builder/RealFloat/F2S.hs b/Data/ByteString/Builder/RealFloat/F2S.hs index 4d0961458..1e64e83ff 100644 --- a/Data/ByteString/Builder/RealFloat/F2S.hs +++ b/Data/ByteString/Builder/RealFloat/F2S.hs @@ -20,66 +20,23 @@ import Data.ByteString.Builder.Internal (Builder) import Data.ByteString.Builder.Prim (primBounded) import Data.ByteString.Builder.RealFloat.Internal import GHC.Int (Int32(..)) +import GHC.Ptr (Ptr(..)) import GHC.Word (Word32(..), Word64(..)) -- See Data.ByteString.Builder.RealFloat.TableGenerator for a high-level -- explanation of the ryu algorithm -- | Table of 2^k / 5^q + 1 --- Byte-swapped version of --- > fmap (finv float_pow5_inv_bitcount) [0..float_max_inv_split] -- --- Displayed here as 2 Word64 table values per line -float_pow5_inv_split :: Addr -float_pow5_inv_split = Addr - "\x01\x00\x00\x00\x00\x00\x00\x08\x67\x66\x66\x66\x66\x66\x66\x06\ - \\xb9\x1e\x85\xeb\x51\xb8\x1e\x05\xfa\x7e\x6a\xbc\x74\x93\x18\x04\ - \\x2a\xcb\x10\xc7\xba\xb8\x8d\x06\x22\x3c\xda\x38\x62\x2d\x3e\x05\ - \\x4e\x63\x7b\x2d\xe8\xbd\x31\x04\x16\xd2\x2b\xaf\xa6\xfc\xb5\x06\ - \\x78\x0e\x23\x8c\xb8\x63\x5e\x05\x2d\xa5\xb5\x09\xfa\x82\x4b\x04\ - \\xae\x6e\xef\x75\xf6\x37\xdf\x06\x58\x25\x59\x5e\xf8\x5f\x7f\x05\ - \\x47\x84\x7a\x4b\x60\xe6\x65\x04\x71\xa0\x5d\x12\x9a\x70\x09\x07\ - \\xc1\xe6\x4a\xa8\xe1\x26\xa1\x05\x67\x85\xd5\xb9\xe7\xeb\x80\x04\ - \\x0b\x6f\x22\xf6\xa5\xac\x34\x07\xa3\x25\xb5\x91\x51\xbd\xc3\x05\ - \\xe9\xea\x90\x74\x74\x97\x9c\x04\x0e\xab\xb4\xed\x53\xf2\x60\x07\ - \\xd8\x88\x90\x24\x43\x28\xe7\x05\xe0\xd3\xa6\x83\x02\xed\xb8\x04\ - \\x66\xb9\xd7\x05\x04\x48\x8e\x07\x52\x94\xac\x04\xd0\x6c\x0b\x06\ - \\xdb\xa9\x23\x6a\xa6\xf0\xd5\x04\x2b\x76\x9f\x76\x3d\xb4\xbc\x07\ - \\xef\xc4\xb2\x2b\x31\x90\x30\x06\xf3\x03\x8f\xbc\x8d\xa6\xf3\x04\ - \\x51\x06\x18\x94\xaf\x3d\xec\x07\xda\xd1\xac\xa9\xbf\x97\x56\x06\ - \\xe2\xa7\xf0\xba\xff\x12\x12\x05"# +-- > fmap (finv float_pow5_inv_bitcount) [0..float_max_inv_split] +foreign import ccall "&hs_bytestring_float_pow5_inv_split" + float_pow5_inv_split :: Ptr Word64 -- | Table of 5^(-e2-q) / 2^k + 1 --- Byte-swapped version of --- > fmap (fnorm float_pow5_bitcount) [0..float_max_split] -- --- Displayed here as 2 Word64 table values per line -float_pow5_split :: Addr -float_pow5_split = Addr - "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x14\ - \\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x40\x1f\ - \\x00\x00\x00\x00\x00\x00\x88\x13\x00\x00\x00\x00\x00\x00\x6a\x18\ - \\x00\x00\x00\x00\x00\x80\x84\x1e\x00\x00\x00\x00\x00\xd0\x12\x13\ - \\x00\x00\x00\x00\x00\x84\xd7\x17\x00\x00\x00\x00\x00\x65\xcd\x1d\ - \\x00\x00\x00\x00\x20\x5f\xa0\x12\x00\x00\x00\x00\xe8\x76\x48\x17\ - \\x00\x00\x00\x00\xa2\x94\x1a\x1d\x00\x00\x00\x40\xe5\x9c\x30\x12\ - \\x00\x00\x00\x90\x1e\xc4\xbc\x16\x00\x00\x00\x34\x26\xf5\x6b\x1c\ - \\x00\x00\x80\xe0\x37\x79\xc3\x11\x00\x00\xa0\xd8\x85\x57\x34\x16\ - \\x00\x00\xc8\x4e\x67\x6d\xc1\x1b\x00\x00\x3d\x91\x60\xe4\x58\x11\ - \\x00\x40\x8c\xb5\x78\x1d\xaf\x15\x00\x50\xef\xe2\xd6\xe4\x1a\x1b\ - \\x00\x92\xd5\x4d\x06\xcf\xf0\x10\x80\xf6\x4a\xe1\xc7\x02\x2d\x15\ - \\x20\xb4\x9d\xd9\x79\x43\x78\x1a\x94\x90\x02\x28\x2c\x2a\x8b\x10\ - \\xb9\x34\x03\x32\xb7\xf4\xad\x14\xe7\x01\x84\xfe\xe4\x71\xd9\x19\ - \\x30\x81\x12\x1f\x2f\xe7\x27\x10\x7c\x21\xd7\xe6\xfa\xe0\x31\x14\ - \\xdb\xe9\x8c\xa0\x39\x59\x3e\x19\x52\x24\xb0\x08\x88\xef\x8d\x1f\ - \\xb3\x16\x6e\x05\xb5\xb5\xb8\x13\x60\x9c\xc9\x46\x22\xe3\xa6\x18\ - \\x78\x03\x7c\xd8\xea\x9b\xd0\x1e\x2b\x82\x4d\xc7\x72\x61\x42\x13\ - \\xb6\xe2\x20\x79\xcf\xf9\x12\x18\x64\x1b\x69\x57\x43\xb8\x17\x1e\ - \\x1e\xb1\xa1\x16\x2a\xd3\xce\x12\x66\x1d\x4a\x9c\xf4\x87\x82\x17\ - \\xbf\xa4\x5c\xc3\xf1\x29\x63\x1d\xf7\xe6\x19\x1a\x37\xfa\x5d\x12\ - \\xb5\x60\xa0\xe0\xc4\x78\xf5\x16\xe3\x78\xc8\x18\xf6\xd6\xb2\x1c\ - \\x8d\x4b\x7d\xcf\x59\xc6\xef\x11\x71\x9e\x5c\x43\xf0\xb7\x6b\x16\ - \\x0d\xc6\x33\x54\xec\xa5\x06\x1c"# +-- > fmap (fnorm float_pow5_bitcount) [0..float_max_split] +foreign import ccall "&hs_bytestring_float_pow5_split" + float_pow5_split :: Ptr Word64 -- | Number of mantissa bits of a 32-bit float. The number of significant bits -- (floatDigits (undefined :: Float)) is 24 since we have a leading 1 for @@ -113,15 +70,11 @@ mulShift32 m factor shift = -- | Index into the 64-bit word lookup table float_pow5_inv_split get_float_pow5_inv_split :: Int -> Word64 -get_float_pow5_inv_split = - let !(Addr arr) = float_pow5_inv_split - in getWord64At arr +get_float_pow5_inv_split = getWord64At float_pow5_inv_split -- | Index into the 64-bit word lookup table float_pow5_split get_float_pow5_split :: Int -> Word64 -get_float_pow5_split = - let !(Addr arr) = float_pow5_split - in getWord64At arr +get_float_pow5_split = getWord64At float_pow5_split -- | Take the high bits of m * 2^k / 5^q / 2^-e2+q+k mulPow5InvDivPow2 :: Word32 -> Int -> Int -> Word32 diff --git a/Data/ByteString/Builder/RealFloat/Internal.hs b/Data/ByteString/Builder/RealFloat/Internal.hs index 9dac7825b..ccfdc5cc0 100644 --- a/Data/ByteString/Builder/RealFloat/Internal.hs +++ b/Data/ByteString/Builder/RealFloat/Internal.hs @@ -50,8 +50,6 @@ module Data.ByteString.Builder.RealFloat.Internal , dquot100 -- prim-op helpers , timesWord2 - , Addr(..) - , ByteArray(..) , castDoubleToWord64 , castFloatToWord32 , getWord64At @@ -74,13 +72,15 @@ import Data.Bits (Bits(..), FiniteBits(..)) import Data.ByteString.Internal (c2w) import Data.ByteString.Builder.Prim.Internal (BoundedPrim, boundedPrim) import Data.ByteString.Builder.RealFloat.TableGenerator +import Data.ByteString.Utils.UnalignedWrite import Data.Char (ord) +import Foreign.C.Types import GHC.Int (Int(..), Int32(..)) +import GHC.IO (IO(..), unIO) import GHC.Prim -import GHC.Ptr (Ptr(..), plusPtr) -import GHC.ST (ST(..), runST) +import GHC.Ptr (Ptr(..), plusPtr, castPtr) import GHC.Types (isTrue#) -import GHC.Word (Word8, Word32(..), Word64(..)) +import GHC.Word (Word8, Word16(..), Word32(..), Word64(..)) import qualified Foreign.Storable as S (poke) #include @@ -90,34 +90,8 @@ import qualified Foreign.Storable as S (poke) import GHC.IntWord64 #endif -#if __GLASGOW_HASKELL__ >= 804 -import GHC.Float (castFloatToWord32, castDoubleToWord64) -#else -import System.IO.Unsafe (unsafePerformIO) -import Foreign.Marshal.Utils (with) -import Foreign.Ptr (castPtr) -import Foreign.Storable (peek) - --- | Interpret a 'Float' as a 'Word32' as if through a bit-for-bit copy. --- (fallback if not available through GHC.Float) --- --- e.g --- --- > showHex (castFloatToWord32 1.0) [] = "3f800000" -{-# NOINLINE castFloatToWord32 #-} -castFloatToWord32 :: Float -> Word32 -castFloatToWord32 x = unsafePerformIO (with x (peek . castPtr)) - --- | Interpret a 'Double' as a 'Word64' as if through a bit-for-bit copy. --- (fallback if not available through GHC.Float) --- --- e.g --- --- > showHex (castDoubleToWord64 1.0) [] = "3ff0000000000000" -{-# NOINLINE castDoubleToWord64 #-} -castDoubleToWord64 :: Double -> Word64 -castDoubleToWord64 x = unsafePerformIO (with x (peek . castPtr)) -#endif +import Data.ByteString.Builder.Prim.Internal.Floating + (castFloatToWord32, castDoubleToWord64) -- | Build a full bit-mask of specified length. -- @@ -734,36 +708,22 @@ ascii_e = ord 'e' toAscii :: Word# -> Word# toAscii a = a `plusWord#` asciiRaw asciiZero -data Addr = Addr Addr# - -- | Index into the 64-bit word lookup table provided {-# INLINE getWord64At #-} -getWord64At :: Addr# -> Int -> Word64 -getWord64At arr (I# i) = -#if defined(WORDS_BIGENDIAN) - W64# (byteSwap64# (indexWord64OffAddr# arr i)) -#else - W64# (indexWord64OffAddr# arr i) -#endif +getWord64At :: Ptr Word64 -> Int -> Word64 +getWord64At (Ptr arr) (I# i) = W64# (indexWord64OffAddr# arr i) -- | Index into the 128-bit word lookup table provided -- Return (# high-64-bits , low-64-bits #) --- NB: really just swaps the bytes and doesn't reorder the words +-- +-- NB: The lookup tables we use store the low 64 bits in +-- host-byte-order then the high 64 bits in host-byte-order {-# INLINE getWord128At #-} -getWord128At :: Addr# -> Int -> (Word64, Word64) -getWord128At arr (I# i) = -#if defined(WORDS_BIGENDIAN) - ( W64# (byteSwap64# (indexWord64OffAddr# arr (i *# 2# +# 1#))) - , W64# (byteSwap64# (indexWord64OffAddr# arr (i *# 2#))) - ) -#else - ( W64# (indexWord64OffAddr# arr (i *# 2# +# 1#)) - , W64# (indexWord64OffAddr# arr (i *# 2#)) - ) -#endif - - -data ByteArray = ByteArray ByteArray# +getWord128At :: Ptr Word64 -> Int -> (Word64, Word64) +getWord128At (Ptr arr) (I# i) = let + !hi = W64# (indexWord64OffAddr# arr (i *# 2# +# 1#)) + !lo = W64# (indexWord64OffAddr# arr (i *# 2#)) + in (hi, lo) -- | Packs 2 bytes [lsb, msb] into 16-bit word packWord16 :: Word# -> Word# -> Word# @@ -784,39 +744,32 @@ unpackWord16 w = #endif --- | ByteArray of 2-digit pairs 00..99 for faster ascii rendering -digit_table :: ByteArray -digit_table = runST (ST $ \s1 -> - let !(# s2, marr #) = newByteArray# 200# s1 - go y r = \i s -> - let !(h, l) = fquotRem10 y - e' = packWord16 (toAscii (unsafeRaw l)) (toAscii (unsafeRaw h)) -#if __GLASGOW_HASKELL__ >= 902 - s' = writeWord16Array# marr i (wordToWord16# e') s -#else - s' = writeWord16Array# marr i e' s -#endif - in if isTrue# (i ==# 99#) then s' else r (i +# 1#) s' - !(# s3, bs #) = unsafeFreezeByteArray# marr (foldr go (\_ s -> s) [0..99] 0# s2) - in (# s3, ByteArray bs #)) +foreign import ccall "&hs_bytestring_digit_pairs_table" + c_digit_pairs_table :: Ptr CChar + +-- | Static array of 2-digit pairs 00..99 for faster ascii rendering +digit_table :: Ptr Word16 +digit_table = castPtr c_digit_pairs_table --- | Unsafe index a ByteArray for the 16-bit word at the index -unsafeAt :: ByteArray -> Int# -> Word# -unsafeAt (ByteArray bs) i = +-- | Unsafe index a static array for the 16-bit word at the index +unsafeAt :: Ptr Word16 -> Int# -> Word# +unsafeAt (Ptr a) i = #if __GLASGOW_HASKELL__ >= 902 - word16ToWord# (indexWord16Array# bs i) + word16ToWord# (indexWord16OffAddr# a i) #else - indexWord16Array# bs i + indexWord16OffAddr# a i #endif -- | Write a 16-bit word into the given address -copyWord16 :: Word# -> Addr# -> State# d -> State# d -copyWord16 w a s = +copyWord16 :: Word# -> Addr# -> State# RealWorld -> State# RealWorld +copyWord16 w a s = let #if __GLASGOW_HASKELL__ >= 902 - writeWord16OffAddr# a 0# (wordToWord16# w) s + w16 = wordToWord16# w #else - writeWord16OffAddr# a 0# w s + w16 = w #endif + in case unIO (unalignedWriteU16 (W16# w16) (Ptr a)) s of + (# s', _ #) -> s' -- | Write an 8-bit word into the given address poke :: Addr# -> Word# -> State# d -> State# d @@ -830,9 +783,9 @@ poke a w s = -- | Write the mantissa into the given address. This function attempts to -- optimize this by writing pairs of digits simultaneously when the mantissa is -- large enough -{-# SPECIALIZE writeMantissa :: Addr# -> Int# -> Word32 -> State# d -> (# Addr#, State# d #) #-} -{-# SPECIALIZE writeMantissa :: Addr# -> Int# -> Word64 -> State# d -> (# Addr#, State# d #) #-} -writeMantissa :: forall a d. (Mantissa a) => Addr# -> Int# -> a -> State# d -> (# Addr#, State# d #) +{-# SPECIALIZE writeMantissa :: Addr# -> Int# -> Word32 -> State# RealWorld -> (# Addr#, State# RealWorld #) #-} +{-# SPECIALIZE writeMantissa :: Addr# -> Int# -> Word64 -> State# RealWorld -> (# Addr#, State# RealWorld #) #-} +writeMantissa :: forall a. (Mantissa a) => Addr# -> Int# -> a -> State# RealWorld -> (# Addr#, State# RealWorld #) writeMantissa ptr olength = go (ptr `plusAddr#` olength) where go p mantissa s1 @@ -865,7 +818,7 @@ writeMantissa ptr olength = go (ptr `plusAddr#` olength) in (# ptr `plusAddr#` 3#, s4 #) -- | Write the exponent into the given address. -writeExponent :: Addr# -> Int32 -> State# d -> (# Addr#, State# d #) +writeExponent :: Addr# -> Int32 -> State# RealWorld -> (# Addr#, State# RealWorld #) writeExponent ptr !expo s1 | expo >= 100 = let !(e1, e0) = fquotRem10 (fromIntegral expo) -- TODO @@ -896,10 +849,10 @@ toCharsScientific :: (Mantissa a) => Bool -> a -> Int32 -> BoundedPrim () toCharsScientific !sign !mantissa !expo = boundedPrim maxEncodedLength $ \_ !(Ptr p0)-> do let !olength@(I# ol) = decimalLength mantissa !expo' = expo + intToInt32 olength - 1 - return $ runST (ST $ \s1 -> + IO $ \s1 -> let !(# p1, s2 #) = writeSign p0 sign s1 !(# p2, s3 #) = writeMantissa p1 ol mantissa s2 s4 = poke p2 (asciiRaw ascii_e) s3 !(# p3, s5 #) = writeSign (p2 `plusAddr#` 1#) (expo' < 0) s4 !(# p4, s6 #) = writeExponent p3 (abs expo') s5 - in (# s6, (Ptr p4) #)) + in (# s6, (Ptr p4) #) diff --git a/Data/ByteString/Builder/RealFloat/TableGenerator.hs b/Data/ByteString/Builder/RealFloat/TableGenerator.hs index 420a64fb1..81a4d1288 100644 --- a/Data/ByteString/Builder/RealFloat/TableGenerator.hs +++ b/Data/ByteString/Builder/RealFloat/TableGenerator.hs @@ -25,10 +25,17 @@ module Data.ByteString.Builder.RealFloat.TableGenerator , float_max_inv_split , double_max_split , double_max_inv_split + + , finv + , fnorm + , splitWord128s ) where import GHC.Float (int2Double) +import Data.Bits +import Data.Word + -- The basic floating point conversion algorithm is as such: -- @@ -127,39 +134,31 @@ double_pow5_inv_bitcount :: Int double_pow5_inv_bitcount = 125 -- NB: these tables are encoded directly into the source code in F2S and D2S --- --- -- | Number of bits in a positive integer --- blen :: Integer -> Int --- blen 0 = 0 --- blen 1 = 1 --- blen n = 1 + blen (n `quot` 2) - --- -- | Used for table generation of 2^k / 5^q + 1 --- finv :: Int -> Int -> Integer --- finv bitcount i = --- let p = 5^i --- in (1 `shiftL` (blen p - 1 + bitcount)) `div` p + 1 - --- -- | Used for table generation of 5^-e2-q / 2^k --- fnorm :: Int -> Int -> Integer --- fnorm bitcount i = --- let p = 5^i --- s = blen p - bitcount --- in if s < 0 then p `shiftL` (-s) else p `shiftR` s - --- -- | Generates a compile-time lookup table for floats as Word64 --- gen_table_f :: Int -> (Int -> Integer) -> Q Exp --- gen_table_f n f = return $ ListE (fmap (LitE . IntegerL . f) [0..n]) --- --- -- | Generates a compile-time lookup table for doubles as Word128 --- gen_table_d :: Int -> (Int -> Integer) -> Q Exp --- gen_table_d n f = return $ ListE (fmap ff [0..n]) --- where --- ff :: Int -> Exp --- ff c = let r = f c --- hi = r `shiftR` 64 --- lo = r .&. ((1 `shiftL` 64) - 1) --- in AppE (AppE (ConE 'Word128) (LitE . IntegerL $ hi)) (LitE . IntegerL $ lo) + +-- | Number of bits in a positive integer +blen :: Integer -> Int +blen 0 = 0 +blen 1 = 1 +blen n = 1 + blen (n `quot` 2) + +-- | Used for table generation of 2^k / 5^q + 1 +finv :: Int -> Int -> Integer +finv bitcount i = + let p = 5^i + in (1 `shiftL` (blen p - 1 + bitcount)) `div` p + 1 + +-- | Used for table generation of 5^-e2-q / 2^k +fnorm :: Int -> Int -> Integer +fnorm bitcount i = + let p = 5^i + s = blen p - bitcount + in if s < 0 then p `shiftL` (-s) else p `shiftR` s + +-- | Breaks each integer into two Word64s (lowBits, highBits) +splitWord128s :: [Integer] -> [Word64] +splitWord128s li + = [fromInteger w | x <- li, w <- [x .&. maxWord64, x `shiftR` 64]] + where maxWord64 = toInteger (maxBound :: Word64) -- Given a specific floating-point type, determine the range of q for the < 0 -- and >= 0 cases diff --git a/Data/ByteString/Utils/UnalignedWrite.hs b/Data/ByteString/Utils/UnalignedWrite.hs new file mode 100644 index 000000000..ff1c7393c --- /dev/null +++ b/Data/ByteString/Utils/UnalignedWrite.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE CPP #-} + +#include "bytestring-cpp-macros.h" + +module Data.ByteString.Utils.UnalignedWrite + ( unalignedWriteU16 + , unalignedWriteU32 + , unalignedWriteU64 + , unalignedWriteFloat + , unalignedWriteDouble + ) where + +import Foreign.Ptr +import Data.Word + +#if HS_UNALIGNED_POKES_OK +import Foreign.Storable + +unalignedWriteU16 :: Word16 -> Ptr Word8 -> IO () +unalignedWriteU16 x p = poke (castPtr p) x + +unalignedWriteU32 :: Word32 -> Ptr Word8 -> IO () +unalignedWriteU32 x p = poke (castPtr p) x + +unalignedWriteU64 :: Word64 -> Ptr Word8 -> IO () +unalignedWriteU64 x p = poke (castPtr p) x + +unalignedWriteFloat :: Float -> Ptr Word8 -> IO () +unalignedWriteFloat x p = poke (castPtr p) x + +unalignedWriteDouble :: Double -> Ptr Word8 -> IO () +unalignedWriteDouble x p = poke (castPtr p) x + +#else +foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u16" + unalignedWriteU16 :: Word16 -> Ptr Word8 -> IO () +foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u32" + unalignedWriteU32 :: Word32 -> Ptr Word8 -> IO () +foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u64" + unalignedWriteU64 :: Word64 -> Ptr Word8 -> IO () +foreign import ccall unsafe "static fpstring.h fps_unaligned_write_HsFloat" + unalignedWriteFloat :: Float -> Ptr Word8 -> IO () +foreign import ccall unsafe "static fpstring.h fps_unaligned_write_HsDouble" + unalignedWriteDouble :: Double -> Ptr Word8 -> IO () +#endif + diff --git a/bytestring.cabal b/bytestring.cabal index 2767a87d0..61b690a53 100644 --- a/bytestring.cabal +++ b/bytestring.cabal @@ -110,6 +110,7 @@ library Data.ByteString.Lazy.ReadNat Data.ByteString.ReadInt Data.ByteString.ReadNat + Data.ByteString.Utils.UnalignedWrite default-language: Haskell2010 other-extensions: CPP, @@ -133,6 +134,7 @@ library c-sources: cbits/fpstring.c cbits/itoa.c cbits/shortbytestring.c + cbits/aligned-static-hs-data.c if (arch(aarch64)) c-sources: cbits/aarch64/is-valid-utf8.c diff --git a/cbits/aligned-static-hs-data.c b/cbits/aligned-static-hs-data.c new file mode 100644 index 000000000..e71609746 --- /dev/null +++ b/cbits/aligned-static-hs-data.c @@ -0,0 +1,760 @@ +// This file contains various chunks of raw static data that we can't +// put into GHC-Haskell primitive string literals because we perform +// /aligned/ reads with them. + +#include "MachDeps.h" +#include + +#if ALIGNMENT_WORD16 == 0 +#error "yikes" +#endif + +extern const char hs_bytestring_lower_hex_table[513]; +const char hs_bytestring_lower_hex_table[513] + __attribute__(( aligned(ALIGNMENT_WORD16) )) + = "000102030405060708090a0b0c0d0e0f" + "101112131415161718191a1b1c1d1e1f" + "202122232425262728292a2b2c2d2e2f" + "303132333435363738393a3b3c3d3e3f" + "404142434445464748494a4b4c4d4e4f" + "505152535455565758595a5b5c5d5e5f" + "606162636465666768696a6b6c6d6e6f" + "707172737475767778797a7b7c7d7e7f" + "808182838485868788898a8b8c8d8e8f" + "909192939495969798999a9b9c9d9e9f" + "a0a1a2a3a4a5a6a7a8a9aaabacadaeaf" + "b0b1b2b3b4b5b6b7b8b9babbbcbdbebf" + "c0c1c2c3c4c5c6c7c8c9cacbcccdcecf" + "d0d1d2d3d4d5d6d7d8d9dadbdcdddedf" + "e0e1e2e3e4e5e6e7e8e9eaebecedeeef" + "f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"; + +extern const char hs_bytestring_digit_pairs_table[201]; +const char hs_bytestring_digit_pairs_table[201] + __attribute__(( aligned(ALIGNMENT_WORD16) )) + = "00010203040506070809" + "10111213141516171819" + "20212223242526272829" + "30313233343536373839" + "40414243444546474849" + "50515253545556575859" + "60616263646566676869" + "70717273747576777879" + "80818283848586878889" + "90919293949596979899"; + +extern const uint64_t hs_bytestring_float_pow5_inv_split[31]; +const uint64_t hs_bytestring_float_pow5_inv_split[31] = { +// map (finv float_pow5_inv_bitcount) [0..float_max_inv_split] + 0x800000000000001, + 0x666666666666667, + 0x51eb851eb851eb9, + 0x4189374bc6a7efa, + 0x68db8bac710cb2a, + 0x53e2d6238da3c22, + 0x431bde82d7b634e, + 0x6b5fca6af2bd216, + 0x55e63b88c230e78, + 0x44b82fa09b5a52d, + 0x6df37f675ef6eae, + 0x57f5ff85e592558, + 0x465e6604b7a8447, + 0x709709a125da071, + 0x5a126e1a84ae6c1, + 0x480ebe7b9d58567, + 0x734aca5f6226f0b, + 0x5c3bd5191b525a3, + 0x49c97747490eae9, + 0x760f253edb4ab0e, + 0x5e72843249088d8, + 0x4b8ed0283a6d3e0, + 0x78e480405d7b966, + 0x60b6cd004ac9452, + 0x4d5f0a66a23a9db, + 0x7bcb43d769f762b, + 0x63090312bb2c4ef, + 0x4f3a68dbc8f03f3, + 0x7ec3daf94180651, + 0x65697bfa9acd1da, + 0x51212ffbaf0a7e2 +}; + +extern const uint64_t hs_bytestring_float_pow5_split[47]; +const uint64_t hs_bytestring_float_pow5_split[47] = { +// map (fnorm float_pow5_bitcount) [0..float_max_split] + 0x1000000000000000, + 0x1400000000000000, + 0x1900000000000000, + 0x1f40000000000000, + 0x1388000000000000, + 0x186a000000000000, + 0x1e84800000000000, + 0x1312d00000000000, + 0x17d7840000000000, + 0x1dcd650000000000, + 0x12a05f2000000000, + 0x174876e800000000, + 0x1d1a94a200000000, + 0x12309ce540000000, + 0x16bcc41e90000000, + 0x1c6bf52634000000, + 0x11c37937e0800000, + 0x16345785d8a00000, + 0x1bc16d674ec80000, + 0x1158e460913d0000, + 0x15af1d78b58c4000, + 0x1b1ae4d6e2ef5000, + 0x10f0cf064dd59200, + 0x152d02c7e14af680, + 0x1a784379d99db420, + 0x108b2a2c28029094, + 0x14adf4b7320334b9, + 0x19d971e4fe8401e7, + 0x1027e72f1f128130, + 0x1431e0fae6d7217c, + 0x193e5939a08ce9db, + 0x1f8def8808b02452, + 0x13b8b5b5056e16b3, + 0x18a6e32246c99c60, + 0x1ed09bead87c0378, + 0x13426172c74d822b, + 0x1812f9cf7920e2b6, + 0x1e17b84357691b64, + 0x12ced32a16a1b11e, + 0x178287f49c4a1d66, + 0x1d6329f1c35ca4bf, + 0x125dfa371a19e6f7, + 0x16f578c4e0a060b5, + 0x1cb2d6f618c878e3, + 0x11efc659cf7d4b8d, + 0x166bb7f0435c9e71, + 0x1c06a5ec5433c60d +}; + +extern const uint64_t hs_bytestring_double_pow5_inv_split[584]; +const uint64_t hs_bytestring_double_pow5_inv_split[584] = { +// splitWord128s $ map (finv double_pow5_inv_bitcount) [0..double_max_inv_split] + 0x1,0x2000000000000000, + 0x999999999999999a,0x1999999999999999, + 0x47ae147ae147ae15,0x147ae147ae147ae1, + 0x6c8b4395810624de,0x10624dd2f1a9fbe7, + 0x7a786c226809d496,0x1a36e2eb1c432ca5, + 0x61f9f01b866e43ab,0x14f8b588e368f084, + 0xb4c7f34938583622,0x10c6f7a0b5ed8d36, + 0x87a6520ec08d236a,0x1ad7f29abcaf4857, + 0x9fb841a566d74f88,0x15798ee2308c39df, + 0xe62d01511f12a607,0x112e0be826d694b2, + 0xd6ae6881cb5109a4,0x1b7cdfd9d7bdbab7, + 0xdef1ed34a2a73aea,0x15fd7fe17964955f, + 0x7f27f0f6e885c8bb,0x119799812dea1119, + 0x650cb4be40d60df8,0x1c25c268497681c2, + 0xea70909833de7193,0x16849b86a12b9b01, + 0x21f3a6e0297ec143,0x1203af9ee756159b, + 0x6985d7cd0f313537,0x1cd2b297d889bc2b, + 0x2137dfd73f5a90f9,0x170ef54646d49689, + 0xe75fe645cc4873fa,0x12725dd1d243aba0, + 0xa5663d3c7a0d865d,0x1d83c94fb6d2ac34, + 0x511e976394d79eb1,0x179ca10c9242235d, + 0xda7edf82dd794bc1,0x12e3b40a0e9b4f7d, + 0x2a6498d1625bac68,0x1e392010175ee596, + 0xeeb6e0a781e2f053,0x182db34012b25144, + 0x58924d52ce4f26a9,0x1357c299a88ea76a, + 0x27507bb7b07ea441,0x1ef2d0f5da7dd8aa, + 0x52a6c95fc0655034,0x18c240c4aecb13bb, + 0xeebd44c99eaa690,0x13ce9a36f23c0fc9, + 0xb17953adc3110a80,0x1fb0f6be50601941, + 0xc12ddc8b02740867,0x195a5efea6b34767, + 0x3424b06f3529a052,0x14484bfeebc29f86, + 0x901d59f290ee19db,0x1039d66589687f9e, + 0x4cfbc31db4b0295f,0x19f623d5a8a73297, + 0x3d9635b15d59bab2,0x14c4e977ba1f5bac, + 0x97ab5e277de16228,0x109d8792fb4c4956, + 0xf2abc9d8c9689d0d,0x1a95a5b7f87a0ef0, + 0x5bbca17a3aba173e,0x154484932d2e725a, + 0xafca1ac82efb45cb,0x11039d428a8b8eae, + 0xb2dcf7a6b1920945,0x1b38fb9daa78e44a, + 0xf57d92ebc141a104,0x15c72fb1552d836e, + 0xc46475896767b403,0x116c262777579c58, + 0x6d6d88dbd8a5ecd2,0x1be03d0bf225c6f4, + 0x8abe071646eb23db,0x164cfda3281e38c3, + 0x6efe6c11d255b649,0x11d7314f534b609c, + 0xb197134fb6ef8a0e,0x1c8b821885456760, + 0x27ac0f72f8bfa1a5,0x16d601ad376ab91a, + 0xb95672c260994e1e,0x1244ce242c5560e1, + 0xf5571e03cdc21695,0x1d3ae36d13bbce35, + 0x2aac18030b01abab,0x17624f8a762fd82b, + 0xbbbce0026f348956,0x12b50c6ec4f31355, + 0x92c7ccd0b1eda889,0x1dee7a4ad4b81eef, + 0xdbd30a408e57ba07,0x17f1fb6f10934bf2, + 0x7ca8d50071dfc806,0x1327fc58da0f6ff5, + 0xfaa7bb33e9660cd6,0x1ea6608e29b24cbb, + 0x9552fc298784d711,0x18851a0b548ea3c9, + 0xaaa8c9bad2d0ac0e,0x139dae6f76d88307, + 0xdddadc5e1e1aace3,0x1f62b0b257c0d1a5, + 0x7e48b04b4b488a4f,0x191bc08eac9a4151, + 0xcb6d59d5d5d3a1d9,0x141633a556e1cdda, + 0x3c577b1177dc817b,0x1011c2eaabe7d7e2, + 0xc6f25e825960cf2a,0x19b604aaaca62636, + 0x6bf518684780a5bb,0x14919d5556eb51c5, + 0x232a79ed06008496,0x10747ddddf22a7d1, + 0xd1dd8fe1a3340756,0x1a53fc9631d10c81, + 0xa7e4731ae8f66c45,0x150ffd44f4a73d34, + 0x531d28e253f8569e,0x10d9976a5d52975d, + 0xeb61db03b98d5762,0x1af5bf109550f22e, + 0xbc4e48cfc7a445e8,0x159165a6ddda5b58, + 0x6371d3d96c836b20,0x11411e1f17e1e2ad, + 0x9f1c8628ad9f11cd,0x1b9b6364f3030448, + 0xe5b06b53be18db0b,0x1615e91d8f359d06, + 0xeaf3890fcb4715a2,0x11ab20e472914a6b, + 0x44b8db4c7871bc37,0x1c45016d841baa46, + 0x3c715d6c6c1635f,0x169d9abe03495505, + 0x3638de456bcde919,0x1217aefe69077737, + 0x56c163a2461641c1,0x1cf2b1970e725858, + 0xdf011c81d1ab67ce,0x17288e1271f51379, + 0x7f3416ce4155eca5,0x1286d80ec190dc61, + 0x6520247d3556476e,0x1da48ce468e7c702, + 0xea801d30f7783925,0x17b6d71d20b96c01, + 0xbb99b0f3f92cfa84,0x12f8ac174d612334, + 0x5f5c4e532847f739,0x1e5aacf215683854, + 0x7f7d0b75b9d32c2e,0x18488a5b44536043, + 0x9930d5f7c7dc2358,0x136d3b7c36a919cf, + 0x8eb4898c72f9d226,0x1f152bf9f10e8fb2, + 0x722a07a38f2e41b8,0x18ddbcc7f40ba628, + 0xc1bb394fa5be9afa,0x13e497065cd61e86, + 0x9c5ec2190930f7f6,0x1fd424d6faf030d7, + 0x49e56814075a5ff8,0x197683df2f268d79, + 0x6e51201005e1e660,0x145ecfe5bf520ac7, + 0xf1da800cd181851a,0x104bd984990e6f05, + 0x4fc400148268d4f5,0x1a12f5a0f4e3e4d6, + 0xd96999aa01ed772b,0x14dbf7b3f71cb711, + 0xadee1488018ac5bc,0x10aff95cc5b09274, + 0x497ceda668de092c,0x1ab328946f80ea54, + 0x3aca57b853e4d424,0x155c2076bf9a5510, + 0x623b7960431d7683,0x1116805effaeaa73, + 0x9d2bf566d1c8bd9e,0x1b5733cb32b110b8, + 0x7dbcc452416d647f,0x15df5ca28ef40d60, + 0xcafd69db678ab6cc,0x117f7d4ed8c33de6, + 0xab2f0fc572778adf,0x1bff2ee48e052fd7, + 0x88f273045b92d580,0x1665bf1d3e6a8cac, + 0xd3f528d049424466,0x11eaff4a98553d56, + 0xb988414d4203a0a3,0x1cab3210f3bb9557, + 0x6139cdd76802e6e9,0x16ef5b40c2fc7779, + 0xe761717920025254,0x125915cd68c9f92d, + 0xa568b58e999d5086,0x1d5b561574765b7c, + 0x5120913ee14aa6d2,0x177c44ddf6c515fd, + 0xa74d40ff1aa21f0e,0x12c9d0b1923744ca, + 0xbaece64f769cb4a,0x1e0fb44f50586e11, + 0x3c8bd850c5ee3c3b,0x180c903f7379f1a7, + 0xca0979da37f1c9c9,0x133d4032c2c7f485, + 0xa9a8c2f6bfe942db,0x1ec866b79e0cba6f, + 0x2153cf2bccba9be3,0x18a0522c7e709526, + 0x1aa9728970954982,0x13b374f06526ddb8, + 0xf775840f1a88759d,0x1f8587e7083e2f8c, + 0x5f9136727ba05e17,0x19379fec0698260a, + 0x1940f85b9619e4df,0x142c7ff0054684d5, + 0xe100c6afab47ea4c,0x1023998cd1053710, + 0xce67a44c453fdd47,0x19d28f47b4d524e7, + 0xd852e9d69dccb106,0x14a8729fc3ddb71f, + 0x79dbee454b0a2738,0x1086c219697e2c19, + 0x295fe3a211a9d859,0x1a71368f0f30468f, + 0xbab31c81a7bb137a,0x15275ed8d8f36ba5, + 0x6228e39aec95a92f,0x10ec4be0ad8f8951, + 0x9d0e38f7e0ef7517,0x1b13ac9aaf4c0ee8, + 0xb0d82d931a592a79,0x15a956e225d67253, + 0x8d79be0f4847552e,0x11544581b7dec1dc, + 0x158f967eda0bbb7c,0x1bba08cf8c979c94, + 0x77a611ff14d62f97,0x162e6d72d6dfb076, + 0xf951a7ff43de8c79,0x11bebdf578b2f391, + 0xc21c3ffed2fdad8e,0x1c6463225ab7ec1c, + 0x1b0333242648ad8,0x16b6b5b5155ff017, + 0x159c28e9b83a246,0x122bc490dde659ac, + 0xcef604175f3903a3,0x1d12d41afca3c2ac, + 0x725e69ac4c2d9c83,0x17424348ca1c9bbd, + 0xf5185489d68ae39c,0x129b69070816e2fd, + 0xee8d540fbdab05c6,0x1dc574d80cf16b2f, + 0xbed77672fe226b05,0x17d12a4670c1228c, + 0xff12c528cb4ebc04,0x130dbb6b8d674ed6, + 0xcb513b74787df9a0,0x1e7c5f127bd87e24, + 0x90dc929f9fe614d,0x18637f41fcad31b7, + 0xa0d7d42194cb810a,0x1382cc34ca2427c5, + 0x67bfb9cf5478ce77,0x1f37ad21436d0c6f, + 0x1fcc94a5dd2d71f9,0x18f9574dcf8a7059, + 0x7fd6dd517dbdf4c7,0x13faac3e3fa1f37a, + 0xffbe2ee8c92fee0b,0x1ff779fd329cb8c3, + 0x6631bf20a0f324d6,0x1992c7fdc216fa36, + 0xb827cc1a1a5c1d78,0x14756ccb01abfb5e, + 0x935309ae7b7ce460,0x105df0a267bcc918, + 0x1eeb42b0c594a099,0x1a2fe76a3f9474f4, + 0xe58902270476e6e1,0x14f31f8832dd2a5c, + 0xb7a0ce859d2bebe7,0x10c27fa028b0eeb0, + 0x59014a6f61dfdfd8,0x1ad0cc33744e4ab4, + 0xe0cdd525e7e64cad,0x1573d68f903ea229, + 0x4d7177518651d6f1,0x11297872d9cbb4ee, + 0x7be8bee8d6e957e8,0x1b758d848fac54b0, + 0xfcba3253df211320,0x15f7a46a0c89dd59, + 0x63c8284318e74280,0x1192e9ee706e4aae, + 0x60d0d3827d86a66,0x1c1e43171a4a1117, + 0x6b3da42cecad21eb,0x167e9c127b6e7412, + 0x88fe1cf0bd574e56,0x11fee341fc585cdb, + 0x419694b462254a23,0x1ccb0536608d615f, + 0x67abaa29e81dd4e9,0x1708d0f84d3de77f, + 0xb95621bb2017dd87,0x126d73f9d764b932, + 0xc223692b668c95a5,0x1d7becc2f23ac1ea, + 0xce82ba891ed6de1d,0x179657025b6234bb, + 0xa53562074bdf1818,0x12deac01e2b4f6fc, + 0x3b889cd87964f359,0x1e3113363787f194, + 0xfc6d4a46c783f5e1,0x18274291c6065adc, + 0x30576e9f06032b1a,0x13529ba7d19eaf17, + 0x1a257dcb3cd1de90,0x1eea92a61c311825, + 0x481dfe3c30a7e540,0x18bba884e35a79b7, + 0xd34b31c9c0865100,0x13c9539d82aec7c5, + 0x5211e942cda3b4cd,0x1fa885c8d117a609, + 0x74db21023e1c90a4,0x19539e3a40dfb807, + 0xf715b401cb4a0d50,0x1442e4fb67196005, + 0xf8de299b09080aa7,0x103583fc527ab337, + 0x8e304291a80cddd7,0x19ef3993b72ab859, + 0x3e8d020e200a4b13,0x14bf6142f8eef9e1, + 0x653d9b3e80083c0f,0x10991a9bfa58c7e7, + 0x6ec8f864000d2ce4,0x1a8e90f9908e0ca5, + 0x8bd3f9e999a423ea,0x153eda614071a3b7, + 0x3ca994bae1501cbb,0x10ff151a99f482f9, + 0xc775bac49bb3612b,0x1b31bb5dc320d18e, + 0xd2c4956a16291a89,0x15c162b168e70e0b, + 0xdbd0778811ba7ba1,0x11678227871f3e6f, + 0x2c80bf401c5d929b,0x1bd8d03f3e9863e6, + 0xbd33cc3349e47549,0x16470cff6546b651, + 0xca8fd68f6e505dd4,0x11d270cc51055ea7, + 0x4419574be3b3c953,0x1c83e7ad4e6efdd9, + 0x347790982f63aa9,0x16cfec8aa52597e1, + 0xcf6c60d468c4fbba,0x123ff06eea847980, + 0xe57a34870e07f92a,0x1d331a4b10d3f59a, + 0x512e906c0b399422,0x175c1508da432ae2, + 0xda8ba6bcd5c7a9b5,0x12b010d3e1cf5581, + 0x90df712e22d90f87,0x1de6815302e5559c, + 0xda4c5a8b4f140c6c,0x17eb9aa8cf1dde16, + 0xaea37ba2a5a9a38a,0x1322e220a5b17e78, + 0x7dd25f6aa2a905a9,0x1e9e369aa2b59727, + 0x97db7f888220d154,0x187e92154ef7ac1f, + 0x797c6606ce80a777,0x139874ddd8c6234c, + 0x8f2d700ae4010bf1,0x1f5a549627a36bad, + 0xc2459a25000d65a,0x191510781fb5efbe, + 0x701d1481d99a4515,0x1410d9f9b2f7f2fe, + 0xc017439b147b6a77,0x100d7b2e28c65bfe, + 0xccf205c4ed9243f2,0x19af2b7d0e0a2cca, + 0xa5b37d0be0e9cc2,0x148c22ca71a1bd6f, + 0x848f973cb3ee3ce,0x10701bd527b4978c, + 0xda0e5bec78649fb0,0x1a4cf9550c5425ac, + 0x7b3eaff060507fc0,0x150a6110d6a9b7bd, + 0x95cbbff380406633,0x10d51a73deee2c97, + 0xefac665266cd7052,0x1aee90b964b04758, + 0x2623850eb8a459db,0x158ba6fab6f36c47, + 0x1e82d0d893b6ae49,0x113c85955f29236c, + 0xfd9e1af41f8ab075,0x1b9408eefea838ac, + 0x97b1af29b2d559f7,0x16100725988693bd, + 0xac8e25baf5777b2c,0x11a66c1e139edc97, + 0x7a7d092b2258c513,0x1c3d79c9b8fe2dbf, + 0x61fda0ef4ead6a76,0x169794a160cb57cc, + 0xe7fe1a590bbdeec5,0x1212dd4de7091309, + 0xa6635d5b45fcb13a,0x1ceafbafd80e84dc, + 0x851c4aaf6b308dc8,0x172262f3133ed0b0, + 0xd0e36ef2bc26d7d4,0x1281e8c275cbda26, + 0xb49f17eac6a48c86,0x1d9ca79d894629d7, + 0x2a18dfef0550706b,0x17b08617a104ee46, + 0x54e0b3259dd9f389,0x12f39e794d9d8b6b, + 0x87cdeb6f62f65274,0x1e5297287c2f4578, + 0xd30b22bf825ea85d,0x18421286c9bf6ac6, + 0xf3c1bcc684bb9e4,0x13680ed23aff889f, + 0x18602c7a4079296d,0x1f0ce4839198da98, + 0x46b356c833942124,0x18d71d360e13e213, + 0x388f78a029434db6,0x13df4a91a4dcb4dc, + 0x5a7f2766a86baf8a,0x1fcbaa82a1612160, + 0x153285ebb9efbfa2,0x196fbb9bb44db44d, + 0xaa8ed189618c994e,0x145962e2f6a4903d, + 0xeed8a7a11ad6e10c,0x1047824f2bb6d9ca, + 0x7e27729b5e249b45,0x1a0c03b1df8af611, + 0xfe85f549181d4904,0x14d6695b193bf80d, + 0xcb9e5dd4134aa0d0,0x10ab877c142ff9a4, + 0xdf63c9535211014d,0x1aac0bf9b9e65c3a, + 0x191ca10f74da6771,0x15566ffafb1eb02f, + 0xadb080d92a4852c1,0x1111f32f2f4bc025, + 0x15e7348eaa0d5134,0x1b4feb7eb212cd09, + 0xab1f5d3eee710dc4,0x15d98932280f0a6d, + 0xbc1917658b8da49d,0x117ad428200c0857, + 0x2cf4f23c127c3a94,0x1bf7b9d9cce00d59, + 0xf0c3f4fcdb969543,0x165fc7e170b33de0, + 0x5a365d9716121103,0x11e6398126f5cb1a, + 0x9056fc24f01ce804,0x1ca38f350b22de90, + 0xd9df301d8ce3ecd0,0x16e93f5da2824ba6, + 0xe17f59b13d8323da,0x125432b14ecea2eb, + 0x68cbc2b52f38395c,0x1d53844ee47dd179, + 0x53d6355dbf602de3,0x177603725064a794, + 0xa9782ab165e68b1c,0x12c4cf8ea6b6ec76, + 0xf26aab56fd744fa,0x1e07b27dd78b13f1, + 0x3f52222abfdf6a62,0x18062864ac6f4327, + 0x65db4e88997f884e,0x1338205089f29c1f, + 0x6fc54a7428cc0d4a,0x1ec033b40fea9365, + 0x596aa1f68709a43b,0x1899c2f673220f84, + 0xadeee7f86c07b696,0x13ae3591f5b4d936, + 0x497e3ff3e00c5756,0x1f7d228322baf524, + 0xd464fff64cd6ac45,0x1930e868e89590e9, + 0x4383fff83d7889d1,0x14272053ed4473ee, + 0xcf9cccc69793a174,0x101f4d0ff1038ff1, + 0x7f6147a425b90252,0x19cbae7fe805b31c, + 0xcc4dd2e9b7c7350f,0x14a2f1ffecd15c16, + 0x3d0b0f215fd290d9,0x10825b3323dab012, + 0x61ab4b689950e7c1,0x1a6a2b85062ab350, + 0x4e22a2ba1440b967,0x1521bc6a6b555c40, + 0xb4ee894dd009453,0x10e7c9eebc4449cd, + 0x1217da87c800ed51,0x1b0c764ac6d3a948, + 0xdb46486ca000bdda,0x15a391d56bdc876c, + 0x490506bd4ccd64af,0x114fa7ddefe39f8a, + 0xa8080ac87ae23ab1,0x1bb2a62fe638ff43, + 0x5339a239fbe82ef4,0x162884f31e93ff69, + 0x75c7b4fb2fecf25d,0x11ba03f5b20fff87, + 0x22d92191e647ea2e,0x1c5cd322b67fff3f, + 0xb57a8141850654f2,0x16b0a8e891ffff65, + 0xc4620101373843f5,0x1226ed86db3332b7, + 0x3a366801f1f39fee,0x1d0b15a491eb8459, + 0xfb5eb99b27f6198b,0x173c115074bc69e0, + 0x2f7efae2865e7ad6,0x129674405d6387e7, + 0xe597f7d0d6fd9156,0x1dbd86cd6238d971, + 0x8479930d78cadaab,0x17cad23de82d7ac1, + 0xd06142712d6f1556,0x1308a831868ac89a, + 0x4d686a4eaf182222,0x1e74404f3daada91, + 0xa453883ef279b4e8,0x185d003f6488aeda, + 0xe9dc6cff28615d87,0x137d99cc506d58ae, + 0xa960ae650d6895a4,0x1f2f5c7a1a488de4, + 0xbab3beb73ded4483,0x18f2b061aea07183, + 0x2ef6322c318a9d36,0x13f559e7bee6c136 +}; + +extern const uint64_t hs_bytestring_double_pow5_split[652]; +const uint64_t hs_bytestring_double_pow5_split[652] = { +// splitWord128s $ map (fnorm double_pow5_bitcount) [0..double_max_split] + 0x0,0x1000000000000000, + 0x0,0x1400000000000000, + 0x0,0x1900000000000000, + 0x0,0x1f40000000000000, + 0x0,0x1388000000000000, + 0x0,0x186a000000000000, + 0x0,0x1e84800000000000, + 0x0,0x1312d00000000000, + 0x0,0x17d7840000000000, + 0x0,0x1dcd650000000000, + 0x0,0x12a05f2000000000, + 0x0,0x174876e800000000, + 0x0,0x1d1a94a200000000, + 0x0,0x12309ce540000000, + 0x0,0x16bcc41e90000000, + 0x0,0x1c6bf52634000000, + 0x0,0x11c37937e0800000, + 0x0,0x16345785d8a00000, + 0x0,0x1bc16d674ec80000, + 0x0,0x1158e460913d0000, + 0x0,0x15af1d78b58c4000, + 0x0,0x1b1ae4d6e2ef5000, + 0x0,0x10f0cf064dd59200, + 0x0,0x152d02c7e14af680, + 0x0,0x1a784379d99db420, + 0x0,0x108b2a2c28029094, + 0x0,0x14adf4b7320334b9, + 0x4000000000000000,0x19d971e4fe8401e7, + 0x8800000000000000,0x1027e72f1f128130, + 0xaa00000000000000,0x1431e0fae6d7217c, + 0xd480000000000000,0x193e5939a08ce9db, + 0xc9a0000000000000,0x1f8def8808b02452, + 0xbe04000000000000,0x13b8b5b5056e16b3, + 0xad85000000000000,0x18a6e32246c99c60, + 0xd8e6400000000000,0x1ed09bead87c0378, + 0x878fe80000000000,0x13426172c74d822b, + 0x6973e20000000000,0x1812f9cf7920e2b6, + 0x3d0da8000000000,0x1e17b84357691b64, + 0x8262889000000000,0x12ced32a16a1b11e, + 0x22fb2ab400000000,0x178287f49c4a1d66, + 0xabb9f56100000000,0x1d6329f1c35ca4bf, + 0xcb54395ca0000000,0x125dfa371a19e6f7, + 0xbe2947b3c8000000,0x16f578c4e0a060b5, + 0x2db399a0ba000000,0x1cb2d6f618c878e3, + 0xfc90400474400000,0x11efc659cf7d4b8d, + 0x7bb4500591500000,0x166bb7f0435c9e71, + 0xdaa16406f5a40000,0x1c06a5ec5433c60d, + 0xa8a4de8459868000,0x118427b3b4a05bc8, + 0xd2ce16256fe82000,0x15e531a0a1c872ba, + 0x87819baecbe22800,0x1b5e7e08ca3a8f69, + 0xf4b1014d3f6d5900,0x111b0ec57e6499a1, + 0x71dd41a08f48af40,0x1561d276ddfdc00a, + 0xe549208b31adb10,0x1aba4714957d300d, + 0x28f4db456ff0c8ea,0x10b46c6cdd6e3e08, + 0x33321216cbecfb24,0x14e1878814c9cd8a, + 0xbffe969c7ee839ed,0x1a19e96a19fc40ec, + 0xf7ff1e21cf512434,0x105031e2503da893, + 0xf5fee5aa43256d41,0x14643e5ae44d12b8, + 0x337e9f14d3eec892,0x197d4df19d605767, + 0x5e46da08ea7ab6,0x1fdca16e04b86d41, + 0xa03aec4845928cb2,0x13e9e4e4c2f34448, + 0xc849a75a56f72fde,0x18e45e1df3b0155a, + 0x7a5c1130ecb4fbd6,0x1f1d75a5709c1ab1, + 0xec798abe93f11d65,0x13726987666190ae, + 0xa797ed6e38ed64bf,0x184f03e93ff9f4da, + 0x517de8c9c728bdef,0x1e62c4e38ff87211, + 0xd2eeb17e1c7976b5,0x12fdbb0e39fb474a, + 0x87aa5ddda397d462,0x17bd29d1c87a191d, + 0xe994f5550c7dc97b,0x1dac74463a989f64, + 0x11fd195527ce9ded,0x128bc8abe49f639f, + 0xd67c5faa71c24568,0x172ebad6ddc73c86, + 0x8c1b77950e32d6c2,0x1cfa698c95390ba8, + 0x57912abd28dfc639,0x121c81f7dd43a749, + 0xad75756c7317b7c8,0x16a3a275d494911b, + 0x98d2d2c78fdda5ba,0x1c4c8b1349b9b562, + 0x9f83c3bcb9ea8794,0x11afd6ec0e14115d, + 0x764b4abe8652979,0x161bcca7119915b5, + 0x493de1d6e27e73d7,0x1ba2bfd0d5ff5b22, + 0x6dc6ad264d8f0866,0x1145b7e285bf98f5, + 0xc938586fe0f2ca80,0x159725db272f7f32, + 0x7b866e8bd92f7d20,0x1afcef51f0fb5eff, + 0xad34051767bdae34,0x10de1593369d1b5f, + 0x9881065d41ad19c1,0x15159af804446237, + 0x7ea147f492186032,0x1a5b01b605557ac5, + 0x6f24ccf8db4f3c1f,0x1078e111c3556cbb, + 0x4aee003712230b27,0x14971956342ac7ea, + 0xdda98044d6abcdf0,0x19bcdfabc13579e4, + 0xa89f02b062b60b6,0x10160bcb58c16c2f, + 0xcd2c6c35c7b638e4,0x141b8ebe2ef1c73a, + 0x8077874339a3c71d,0x1922726dbaae3909, + 0xe0956914080cb8e4,0x1f6b0f092959c74b, + 0x6c5d61ac8507f38e,0x13a2e965b9d81c8f, + 0x4774ba17a649f072,0x188ba3bf284e23b3, + 0x1951e89d8fdc6c8f,0x1eae8caef261aca0, + 0xfd3316279e9c3d9,0x132d17ed577d0be4, + 0x13c7fdbb186434cf,0x17f85de8ad5c4edd, + 0x58b9fd29de7d4203,0x1df67562d8b36294, + 0xb7743e3a2b0e4942,0x12ba095dc7701d9c, + 0xe5514dc8b5d1db92,0x17688bb5394c2503, + 0xdea5a13ae3465277,0x1d42aea2879f2e44, + 0xb2784c4ce0bf38a,0x1249ad2594c37ceb, + 0xcdf165f6018ef06d,0x16dc186ef9f45c25, + 0x416dbf7381f2ac88,0x1c931e8ab871732f, + 0x88e497a83137abd5,0x11dbf316b346e7fd, + 0xeb1dbd923d8596ca,0x1652efdc6018a1fc, + 0x25e52cf6cce6fc7d,0x1be7abd3781eca7c, + 0x97af3c1a40105dce,0x1170cb642b133e8d, + 0xfd9b0b20d0147542,0x15ccfe3d35d80e30, + 0x3d01cde904199292,0x1b403dcc834e11bd, + 0x462120b1a28ffb9b,0x1108269fd210cb16, + 0xd7a968de0b33fa82,0x154a3047c694fddb, + 0xcd93c3158e00f923,0x1a9cbc59b83a3d52, + 0xc07c59ed78c09bb6,0x10a1f5b813246653, + 0xb09b7068d6f0c2a3,0x14ca732617ed7fe8, + 0xdcc24c830cacf34c,0x19fd0fef9de8dfe2, + 0xc9f96fd1e7ec180f,0x103e29f5c2b18bed, + 0x3c77cbc661e71e13,0x144db473335deee9, + 0x8b95beb7fa60e598,0x1961219000356aa3, + 0x6e7b2e65f8f91efe,0x1fb969f40042c54c, + 0xc50cfcffbb9bb35f,0x13d3e2388029bb4f, + 0xb6503c3faa82a037,0x18c8dac6a0342a23, + 0xa3e44b4f95234844,0x1efb1178484134ac, + 0xe66eaf11bd360d2b,0x135ceaeb2d28c0eb, + 0xe00a5ad62c839075,0x183425a5f872f126, + 0x980cf18bb7a47493,0x1e412f0f768fad70, + 0x5f0816f752c6c8dc,0x12e8bd69aa19cc66, + 0xf6ca1cb527787b13,0x17a2ecc414a03f7f, + 0xf47ca3e2715699d7,0x1d8ba7f519c84f5f, + 0xf8cde66d86d62026,0x127748f9301d319b, + 0xf7016008e88ba830,0x17151b377c247e02, + 0xb4c1b80b22ae923c,0x1cda62055b2d9d83, + 0x50f91306f5ad1b65,0x12087d4358fc8272, + 0xe53757c8b318623f,0x168a9c942f3ba30e, + 0x9e852dbadfde7acf,0x1c2d43b93b0a8bd2, + 0xa3133c94cbeb0cc1,0x119c4a53c4e69763, + 0x8bd80bb9fee5cff1,0x16035ce8b6203d3c, + 0xaece0ea87e9f43ee,0x1b843422e3a84c8b, + 0x4d40c9294f238a75,0x1132a095ce492fd7, + 0x2090fb73a2ec6d12,0x157f48bb41db7bcd, + 0x68b53a508ba78856,0x1adf1aea12525ac0, + 0x417144725748b536,0x10cb70d24b7378b8, + 0x51cd958eed1ae283,0x14fe4d06de5056e6, + 0xe640faf2a8619b24,0x1a3de04895e46c9f, + 0xefe89cd7a93d00f7,0x1066ac2d5daec3e3, + 0xebe2c40d938c4134,0x14805738b51a74dc, + 0x26db7510f86f5181,0x19a06d06e2611214, + 0x9849292a9b4592f1,0x100444244d7cab4c, + 0xbe5b73754216f7ad,0x1405552d60dbd61f, + 0xadf25052929cb598,0x1906aa78b912cba7, + 0x996ee4673743e2ff,0x1f485516e7577e91, + 0xffe54ec0828a6ddf,0x138d352e5096af1a, + 0xbfdea270a32d0957,0x18708279e4bc5ae1, + 0x2fd64b0ccbf84bad,0x1e8ca3185deb719a, + 0x5de5eee7ff7b2f4c,0x1317e5ef3ab32700, + 0x755f6aa1ff59fb1f,0x17dddf6b095ff0c0, + 0x92b7454a7f3079e7,0x1dd55745cbb7ecf0, + 0x5bb28b4e8f7e4c30,0x12a5568b9f52f416, + 0xf29f2e22335ddf3c,0x174eac2e8727b11b, + 0xef46f9aac035570b,0x1d22573a28f19d62, + 0xd58c5c0ab8215667,0x123576845997025d, + 0x4aef730d6629ac01,0x16c2d4256ffcc2f5, + 0x9dab4fd0bfb41701,0x1c73892ecbfbf3b2, + 0xa28b11e277d08e60,0x11c835bd3f7d784f, + 0x8b2dd65b15c4b1f9,0x163a432c8f5cd663, + 0x6df94bf1db35de77,0x1bc8d3f7b3340bfc, + 0xc4bbcf772901ab0a,0x115d847ad000877d, + 0x35eac354f34215cd,0x15b4e5998400a95d, + 0x8365742a30129b40,0x1b221effe500d3b4, + 0xd21f689a5e0ba108,0x10f5535fef208450, + 0x6a742c0f58e894a,0x1532a837eae8a565, + 0x4851137132f22b9d,0x1a7f5245e5a2cebe, + 0xed32ac26bfd75b42,0x108f936baf85c136, + 0xa87f57306fcd3212,0x14b378469b673184, + 0xd29f2cfc8bc07e97,0x19e056584240fde5, + 0xa3a37c1dd7584f1e,0x102c35f729689eaf, + 0x8c8c5b254d2e62e6,0x14374374f3c2c65b, + 0x6faf71eea079fb9f,0x1945145230b377f2, + 0xb9b4e6a48987a87,0x1f965966bce055ef, + 0x674111026d5f4c94,0x13bdf7e0360c35b5, + 0xc111554308b71fba,0x18ad75d8438f4322, + 0x7155aa93cae4e7a8,0x1ed8d34e547313eb, + 0x26d58a9c5ecf10c9,0x13478410f4c7ec73, + 0xf08aed437682d4fb,0x1819651531f9e78f, + 0xecada89454238a3a,0x1e1fbe5a7e786173, + 0x73ec895cb4963664,0x12d3d6f88f0b3ce8, + 0x90e7abb3e1bbc3fd,0x1788ccb6b2ce0c22, + 0x352196a0da2ab4fd,0x1d6affe45f818f2b, + 0x134fe24885ab11e,0x1262dfeebbb0f97b, + 0xc1823dadaa715d65,0x16fb97ea6a9d37d9, + 0x31e2cd19150db4bf,0x1cba7de5054485d0, + 0x1f2dc02fad2890f7,0x11f48eaf234ad3a2, + 0xa6f9303b9872b535,0x1671b25aec1d888a, + 0x50b77c4a7e8f6282,0x1c0e1ef1a724eaad, + 0x5272adae8f199d91,0x1188d357087712ac, + 0x670f591a32e004f6,0x15eb082cca94d757, + 0x40d32f60bf980633,0x1b65ca37fd3a0d2d, + 0x4883fd9c77bf03e0,0x111f9e62fe44483c, + 0x5aa4fd0395aec4d8,0x156785fbbdd55a4b, + 0x314e3c447b1a760e,0x1ac1677aad4ab0de, + 0xded0e5aaccf089c9,0x10b8e0acac4eae8a, + 0x96851f15802cac3b,0x14e718d7d7625a2d, + 0xfc2666dae037d74a,0x1a20df0dcd3af0b8, + 0x9d980048cc22e68e,0x10548b68a044d673, + 0x84fe005aff2ba032,0x1469ae42c8560c10, + 0xa63d8071bef6883e,0x198419d37a6b8f14, + 0xcfcce08e2eb42a4e,0x1fe52048590672d9, + 0x21e00c58dd309a70,0x13ef342d37a407c8, + 0x2a580f6f147cc10d,0x18eb0138858d09ba, + 0xb4ee134ad99bf150,0x1f25c186a6f04c28, + 0x7114cc0ec80176d2,0x137798f428562f99, + 0xcd59ff127a01d486,0x18557f31326bbb7f, + 0xc0b07ed7188249a8,0x1e6adefd7f06aa5f, + 0xd86e4f466f516e09,0x1302cb5e6f642a7b, + 0xce89e3180b25c98b,0x17c37e360b3d351a, + 0x822c5bde0def3bee,0x1db45dc38e0c8261, + 0xf15bb96ac8b58575,0x1290ba9a38c7d17c, + 0x2db2a7c57ae2e6d2,0x1734e940c6f9c5dc, + 0x391f51b6d99ba086,0x1d022390f8b83753, + 0x3b3931248014454,0x1221563a9b732294, + 0x4a077d6da019569,0x16a9abc9424feb39, + 0x45c895cc9081fac3,0x1c5416bb92e3e607, + 0x8b9d5d9fda513cba,0x11b48e353bce6fc4, + 0xae84b507d0e58be8,0x1621b1c28ac20bb5, + 0x1a25e249c51eeee3,0x1baa1e332d728ea3, + 0xf057ad6e1b33554d,0x114a52dffc679925, + 0x6c6d98c9a2002aa1,0x159ce797fb817f6f, + 0x4788fefc0a803549,0x1b04217dfa61df4b, + 0xcb59f5d8690214e,0x10e294eebc7d2b8f, + 0xcfe30734e83429a1,0x151b3a2a6b9c7672, + 0x83dbc9022241340a,0x1a6208b50683940f, + 0xb2695da15568c086,0x107d457124123c89, + 0x1f03b509aac2f0a7,0x149c96cd6d16cbac, + 0x26c4a24c1573acd1,0x19c3bc80c85c7e97, + 0x783ae56f8d684c03,0x101a55d07d39cf1e, + 0x16499ecb70c25f03,0x1420eb449c8842e6, + 0x9bdc067e4cf2f6c4,0x19292615c3aa539f, + 0x82d3081de02fb476,0x1f736f9b3494e887, + 0xb1c3e512ac1dd0c9,0x13a825c100dd1154, + 0xde34de57572544fc,0x18922f31411455a9, + 0x55c215ed2cee963b,0x1eb6bafd91596b14, + 0xb5994db43c151de5,0x133234de7ad7e2ec, + 0xe2ffa1214b1a655e,0x17fec216198ddba7, + 0xdbbf89699de0feb6,0x1dfe729b9ff15291, + 0x2957b5e202ac9f31,0x12bf07a143f6d39b, + 0xf3ada35a8357c6fe,0x176ec98994f48881, + 0x70990c31242db8bd,0x1d4a7bebfa31aaa2, + 0x865fa79eb69c9376,0x124e8d737c5f0aa5, + 0xe7f791866443b854,0x16e230d05b76cd4e, + 0xa1f575e7fd54a669,0x1c9abd04725480a2, + 0xa53969b0fe54e801,0x11e0b622c774d065, + 0xe87c41d3dea2202,0x1658e3ab7952047f, + 0xd229b5248d64aa82,0x1bef1c9657a6859e, + 0x435a1136d85eea91,0x117571ddf6c81383, + 0x143095848e76a536,0x15d2ce55747a1864, + 0x193cbae5b2144e83,0x1b4781ead1989e7d, + 0x2fc5f4cf8f4cb112,0x110cb132c2ff630e, + 0xbbb77203731fdd56,0x154fdd7f73bf3bd1, + 0x2aa54e844fe7d4ac,0x1aa3d4df50af0ac6, + 0xdaa75112b1f0e4eb,0x10a6650b926d66bb, + 0xd15125575e6d1e26,0x14cffe4e7708c06a, + 0x85a56ead360865b0,0x1a03fde214caf085, + 0x7387652c41c53f8e,0x10427ead4cfed653, + 0x50693e7752368f71,0x14531e58a03e8be8, + 0x64838e1526c4334e,0x1967e5eec84e2ee2, + 0xfda4719a70754022,0x1fc1df6a7a61ba9a, + 0xde86c70086494815,0x13d92ba28c7d14a0, + 0x162878c0a7db9a1a,0x18cf768b2f9c59c9, + 0x5bb296f0d1d280a1,0x1f03542dfb83703b, + 0x194f9e5683239064,0x1362149cbd322625, + 0x5fa385ec23ec747e,0x183a99c3ec7eafae, + 0xf78c67672ce7919d,0x1e494034e79e5b99, + 0x3ab7c0a07c10bb02,0x12edc82110c2f940, + 0x4965b0c89b14e9c3,0x17a93a2954f3b790, + 0x5bbf1cfac1da2433,0x1d9388b3aa30a574, + 0xb957721cb92856a0,0x127c35704a5e6768, + 0xe7ad4ea3e7726c48,0x171b42cc5cf60142, + 0xa198a24ce14f075a,0x1ce2137f74338193, + 0x44ff65700cd16498,0x120d4c2fa8a030fc, + 0x563f3ecc1005bdbe,0x16909f3b92c83d3b, + 0x2bcf0e7f14072d2e,0x1c34c70a777a4c8a, + 0x5b61690f6c847c3d,0x11a0fc668aac6fd6, + 0xf239c35347a59b4c,0x16093b802d578bcb, + 0xeec83428198f021f,0x1b8b8a6038ad6ebe, + 0x553d20990ff96153,0x1137367c236c6537, + 0x2a8c68bf53f7b9a8,0x1585041b2c477e85, + 0x752f82ef28f5a812,0x1ae64521f7595e26, + 0x93db1d57999890b,0x10cfeb353a97dad8, + 0xb8d1e4ad7ffeb4e,0x1503e602893dd18e, + 0x8e7065dd8dffe622,0x1a44df832b8d45f1, + 0xf9063faa78bfefd5,0x106b0bb1fb384bb6, + 0xb747cf9516efebca,0x1485ce9e7a065ea4, + 0xe519c37a5cabe6bd,0x19a742461887f64d, + 0xaf301a2c79eb7036,0x1008896bcf54f9f0, + 0xdafc20b798664c43,0x140aabc6c32a386c, + 0x11bb28e57e7fdf54,0x190d56b873f4c688, + 0x1629f31ede1fd72a,0x1f50ac6690f1f82a, + 0x4dda37f34ad3e67a,0x13926bc01a973b1a, + 0xe150c5f01d88e019,0x187706b0213d09e0, + 0x19a4f76c24eb181f,0x1e94c85c298c4c59, + 0xb0071aa39712ef13,0x131cfd3999f7afb7, + 0x9c08e14c7cd7aad8,0x17e43c8800759ba5, + 0x30b199f9c0d958e,0x1ddd4baa0093028f, + 0x61e6f003c1887d79,0x12aa4f4a405be199, + 0xba60ac04b1ea9cd7,0x1754e31cd072d9ff, + 0xa8f8d705de65440d,0x1d2a1be4048f907f, + 0xc99b8663aaff4a88,0x123a516e82d9ba4f, + 0xbc0267fc95bf1d2a,0x16c8e5ca239028e3, + 0xab0301fbbb2ee474,0x1c7b1f3cac74331c, + 0xeae1e13d54fd4ec9,0x11ccf385ebc89ff1, + 0x659a598caa3ca27b,0x1640306766bac7ee, + 0xff00efefd4cbcb1a,0x1bd03c81406979e9, + 0x3f6095f5e4ff5ef0,0x116225d0c841ec32, + 0xcf38bb735e3f36ac,0x15baaf44fa52673e, + 0x8306ea5035cf0457,0x1b295b1638e7010e, + 0x11e4527221a162b6,0x10f9d8ede39060a9, + 0x565d670eaa09bb64,0x15384f295c7478d3, + 0x2bf4c0d2548c2a3d,0x1a8662f3b3919708, + 0x1b78f88374d79a66,0x1093fdd8503afe65, + 0x625736a4520d8100,0x14b8fd4e6449bdfe, + 0xfaed044d6690e140,0x19e73ca1fd5c2d7d, + 0xbcd422b0601a8cc8,0x103085e53e599c6e, + 0x6c092b5c78212ffa,0x143ca75e8df0038a, + 0x70b763396297bf8,0x194bd136316c046d, + 0x48ce53c07bb3daf6,0x1f9ec583bdc70588, + 0x2d80f4584d5068da,0x13c33b72569c6375, + 0x78e1316e60a48310,0x18b40a4eec437c52 +}; diff --git a/cbits/fpstring.c b/cbits/fpstring.c index 310aa2baf..1c363e992 100644 --- a/cbits/fpstring.c +++ b/cbits/fpstring.c @@ -29,6 +29,9 @@ * SUCH DAMAGE. */ +#include "HsFFI.h" +#include "MachDeps.h" + #include "fpstring.h" #if defined(__x86_64__) #include @@ -123,6 +126,14 @@ void fps_unaligned_write_u64(uint64_t x, uint8_t *p) { return; } +void fps_unaligned_write_HsFloat(HsFloat x, uint8_t *p) { + memcpy(p, &x, SIZEOF_HSFLOAT); +} + +void fps_unaligned_write_HsDouble(HsDouble x, uint8_t *p) { + memcpy(p, &x, SIZEOF_HSDOUBLE); +} + /* count the number of occurrences of a char in a string */ size_t fps_count_naive(unsigned char *str, size_t len, unsigned char w) { size_t c; From 22f86df0c4a8fe39613cb2df11e511bc520f27c7 Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Fri, 15 Sep 2023 17:19:58 -0400 Subject: [PATCH 15/17] Update comment about locaiton of RealFloat tables --- Data/ByteString/Builder/RealFloat/TableGenerator.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Data/ByteString/Builder/RealFloat/TableGenerator.hs b/Data/ByteString/Builder/RealFloat/TableGenerator.hs index 81a4d1288..c31dbc74c 100644 --- a/Data/ByteString/Builder/RealFloat/TableGenerator.hs +++ b/Data/ByteString/Builder/RealFloat/TableGenerator.hs @@ -133,7 +133,8 @@ double_pow5_bitcount = 125 double_pow5_inv_bitcount :: Int double_pow5_inv_bitcount = 125 --- NB: these tables are encoded directly into the source code in F2S and D2S +-- NB: these tables are encoded directly into the +-- in cbits/aligned-static-hs-data.c -- | Number of bits in a positive integer blen :: Integer -> Int From e957fb9a49f3b14f5e0c8ec90ef8be81bf4b5ba1 Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Fri, 15 Sep 2023 17:20:53 -0400 Subject: [PATCH 16/17] Remove useless temporary CPP guard --- cbits/aligned-static-hs-data.c | 4 ---- 1 file changed, 4 deletions(-) diff --git a/cbits/aligned-static-hs-data.c b/cbits/aligned-static-hs-data.c index e71609746..213b3a8f2 100644 --- a/cbits/aligned-static-hs-data.c +++ b/cbits/aligned-static-hs-data.c @@ -5,10 +5,6 @@ #include "MachDeps.h" #include -#if ALIGNMENT_WORD16 == 0 -#error "yikes" -#endif - extern const char hs_bytestring_lower_hex_table[513]; const char hs_bytestring_lower_hex_table[513] __attribute__(( aligned(ALIGNMENT_WORD16) )) From bfae183e098a59071c2916d82d34349faeb35c9e Mon Sep 17 00:00:00 2001 From: Matthew Craven Date: Fri, 15 Sep 2023 19:32:11 -0400 Subject: [PATCH 17/17] Re-add words "source code" in comment --- Data/ByteString/Builder/RealFloat/TableGenerator.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Data/ByteString/Builder/RealFloat/TableGenerator.hs b/Data/ByteString/Builder/RealFloat/TableGenerator.hs index c31dbc74c..9c6d14b44 100644 --- a/Data/ByteString/Builder/RealFloat/TableGenerator.hs +++ b/Data/ByteString/Builder/RealFloat/TableGenerator.hs @@ -134,7 +134,7 @@ double_pow5_inv_bitcount :: Int double_pow5_inv_bitcount = 125 -- NB: these tables are encoded directly into the --- in cbits/aligned-static-hs-data.c +-- source code in cbits/aligned-static-hs-data.c -- | Number of bits in a positive integer blen :: Integer -> Int