wireform-core 0.2.0.1 → 0.3.0.0
raw patch · 26 files changed
+1453/−490 lines, 26 filesdep +hedgehogdep +sydtest-hedgehogdep ~basedep ~containersdep ~ghc-primPVP ok
version bump matches the API change (PVP)
Dependencies added: hedgehog, sydtest-hedgehog
Dependency ranges changed: base, containers, ghc-prim, template-haskell
API changes (from Hackage documentation)
- Wireform.Builder.FastBuilder: instance Data.String.IsString Wireform.Builder.FastBuilder.Builder
- Wireform.Builder.FastBuilder: instance GHC.Base.Applicative Wireform.Builder.FastBuilder.BuildM
- Wireform.Builder.FastBuilder: instance GHC.Base.Functor Wireform.Builder.FastBuilder.BuildM
- Wireform.Builder.FastBuilder: instance GHC.Base.Monad Wireform.Builder.FastBuilder.BuildM
- Wireform.Builder.FastBuilder: instance GHC.Base.Monoid Wireform.Builder.FastBuilder.Builder
- Wireform.Builder.FastBuilder: instance GHC.Base.Monoid Wireform.Builder.FastBuilder.Write
- Wireform.Builder.FastBuilder: instance GHC.Base.Semigroup Wireform.Builder.FastBuilder.Builder
- Wireform.Builder.FastBuilder: instance GHC.Base.Semigroup Wireform.Builder.FastBuilder.Write
- Wireform.Builder.FastBuilder: instance GHC.Exception.Type.Exception Wireform.Builder.FastBuilder.ChunkOverflowException
- Wireform.Builder.FastBuilder: instance GHC.Exception.Type.Exception Wireform.Builder.FastBuilder.SuspendBuilderException
- Wireform.Builder.FastBuilder: instance GHC.Show.Show Wireform.Builder.FastBuilder.ChunkOverflowException
- Wireform.Builder.FastBuilder: instance GHC.Show.Show Wireform.Builder.FastBuilder.Response
- Wireform.Builder.FastBuilder: instance GHC.Show.Show Wireform.Builder.FastBuilder.SuspendBuilderException
- Wireform.Hash: instance GHC.Show.Show Wireform.Hash.RoaringContainerKind
- Wireform.Parser.Adapter: instance GHC.Show.Show Wireform.Parser.Adapter.ChunkMode
- Wireform.Parser.Adapter: instance GHC.Show.Show Wireform.Parser.Adapter.ChunkParseError
- Wireform.Parser.Driver: instance GHC.Show.Show Wireform.Parser.Driver.LoopControl
- Wireform.Parser.Error: instance GHC.Base.Functor Wireform.Parser.Error.ParseError
- Wireform.Parser.Error: instance GHC.Exception.Type.Exception Wireform.Parser.Error.CleanEof
- Wireform.Parser.Error: instance GHC.Show.Show Wireform.Parser.Error.CleanEof
- Wireform.Parser.Error: instance GHC.Show.Show e => GHC.Show.Show (Wireform.Parser.Error.ParseError e)
- Wireform.Parser.Internal: instance Control.Monad.Fail.MonadFail (Wireform.Parser.Internal.Parser m e)
- Wireform.Parser.Internal: instance GHC.Base.Applicative (Wireform.Parser.Internal.Parser m e)
- Wireform.Parser.Internal: instance GHC.Base.Functor (Wireform.Parser.Internal.Parser m e)
- Wireform.Parser.Internal: instance GHC.Base.Monad (Wireform.Parser.Internal.Parser m e)
- Wireform.Parser.Internal: instance Wireform.Parser.Internal.ParserMode m => GHC.Base.Alternative (Wireform.Parser.Internal.Parser m e)
- Wireform.Parser.Internal: instance Wireform.Parser.Internal.ParserMode m => GHC.Base.MonadPlus (Wireform.Parser.Internal.Parser m e)
- Wireform.Parser.Mark: instance GHC.Show.Show Wireform.Parser.Mark.Mark
- Wireform.Parser.Position: instance GHC.Num.Num Wireform.Parser.Position.Pos
- Wireform.Parser.Position: instance GHC.Show.Show Wireform.Parser.Position.Pos
- Wireform.Parser.Position: instance GHC.Show.Show Wireform.Parser.Position.Span
- Wireform.Parser.Stateful: instance GHC.Base.Applicative (Wireform.Parser.Stateful.ParserS r s e)
- Wireform.Parser.Stateful: instance GHC.Base.Functor (Wireform.Parser.Stateful.ParserS r s e)
- Wireform.Parser.Stateful: instance GHC.Base.Monad (Wireform.Parser.Stateful.ParserS r s e)
- Wireform.Ring.Internal: instance Foreign.Storable.Storable Wireform.Ring.Internal.CRing
- Wireform.Ring.Internal: instance GHC.Exception.Type.Exception Wireform.Ring.Internal.MagicRingException
- Wireform.Ring.Internal: instance GHC.Show.Show Wireform.Ring.Internal.MagicRingException
- Wireform.Transport.Capabilities: instance GHC.Show.Show Wireform.Transport.Capabilities.CoreTopology
- Wireform.Transport.Capabilities: instance GHC.Show.Show Wireform.Transport.Capabilities.IOUringFeatures
- Wireform.Transport.Capabilities: instance GHC.Show.Show Wireform.Transport.Capabilities.NumaNodeInfo
- Wireform.Transport.Capabilities: instance GHC.Show.Show Wireform.Transport.Capabilities.Placement
- Wireform.Transport.Capabilities: instance GHC.Show.Show Wireform.Transport.Capabilities.SystemCapabilities
- Wireform.Transport.Config: instance GHC.Enum.Bounded Wireform.Transport.Config.CapabilityAction
- Wireform.Transport.Config: instance GHC.Enum.Bounded Wireform.Transport.Config.Profile
- Wireform.Transport.Config: instance GHC.Enum.Enum Wireform.Transport.Config.CapabilityAction
- Wireform.Transport.Config: instance GHC.Enum.Enum Wireform.Transport.Config.Profile
- Wireform.Transport.Config: instance GHC.Read.Read Wireform.Transport.Config.CapabilityAction
- Wireform.Transport.Config: instance GHC.Read.Read Wireform.Transport.Config.Profile
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.CapabilityAction
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.CompletionWaitMode
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.IOUringConfig
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.NumaPolicy
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.PagePolicy
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.PinningPolicy
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.Profile
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.SQPollPolicy
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.SpinBudget
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.TransportConfig
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.WaitPolicy
- Wireform.Transport.Receive: instance GHC.Show.Show Wireform.Transport.Receive.ReceiveWait
- Wireform.Transport.Send: instance GHC.Exception.Type.Exception Wireform.Transport.Send.SendReservationTooLarge
- Wireform.Transport.Send: instance GHC.Exception.Type.Exception Wireform.Transport.Send.SendRingFull
- Wireform.Transport.Send: instance GHC.Show.Show Wireform.Transport.Send.SendReservationTooLarge
- Wireform.Transport.Send: instance GHC.Show.Show Wireform.Transport.Send.SendRingFull
- Wireform.Transport.Send: instance GHC.Show.Show Wireform.Transport.Send.SendWait
+ Wireform.Builder.FastBuilder: FixedBufferOverflow :: !Int -> !Int -> FixedBufferOverflow
+ Wireform.Builder.FastBuilder: NoSpill :: RingSpill
+ Wireform.Builder.FastBuilder: SpillActive :: {-# UNPACK #-} !SpillBuf -> RingSpill
+ Wireform.Builder.FastBuilder: SpillBuf :: !ForeignPtr Word8 -> {-# UNPACK #-} !Int -> SpillBuf
+ Wireform.Builder.FastBuilder: SpillIdle :: {-# UNPACK #-} !SpillBuf -> RingSpill
+ Wireform.Builder.FastBuilder: [fixedBufferAvailable] :: FixedBufferOverflow -> !Int
+ Wireform.Builder.FastBuilder: [fixedBufferRequested] :: FixedBufferOverflow -> !Int
+ Wireform.Builder.FastBuilder: [rsSpill] :: RingSinkState -> !RingSpill
+ Wireform.Builder.FastBuilder: data FixedBufferOverflow
+ Wireform.Builder.FastBuilder: data RingSpill
+ Wireform.Builder.FastBuilder: data SpillBuf
+ Wireform.Builder.FastBuilder: instance GHC.Classes.Eq Wireform.Builder.FastBuilder.FixedBufferOverflow
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Base.Applicative Wireform.Builder.FastBuilder.BuildM
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Base.Functor Wireform.Builder.FastBuilder.BuildM
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Base.Monad Wireform.Builder.FastBuilder.BuildM
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Base.Monoid Wireform.Builder.FastBuilder.Builder
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Base.Monoid Wireform.Builder.FastBuilder.Write
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Base.Semigroup Wireform.Builder.FastBuilder.Builder
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Base.Semigroup Wireform.Builder.FastBuilder.Write
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Data.String.IsString Wireform.Builder.FastBuilder.Builder
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Exception.Type.Exception Wireform.Builder.FastBuilder.ChunkOverflowException
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Exception.Type.Exception Wireform.Builder.FastBuilder.FixedBufferOverflow
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Exception.Type.Exception Wireform.Builder.FastBuilder.SuspendBuilderException
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Show.Show Wireform.Builder.FastBuilder.ChunkOverflowException
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Show.Show Wireform.Builder.FastBuilder.FixedBufferOverflow
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Show.Show Wireform.Builder.FastBuilder.Response
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Show.Show Wireform.Builder.FastBuilder.SuspendBuilderException
+ Wireform.Hash: instance GHC.Internal.Show.Show Wireform.Hash.RoaringContainerKind
+ Wireform.Hash: xxh64IO :: Word64 -> ByteString -> IO Word64
+ Wireform.Parser.Adapter: instance GHC.Internal.Show.Show Wireform.Parser.Adapter.ChunkMode
+ Wireform.Parser.Adapter: instance GHC.Internal.Show.Show Wireform.Parser.Adapter.ChunkParseError
+ Wireform.Parser.Driver: instance GHC.Internal.Show.Show Wireform.Parser.Driver.LoopControl
+ Wireform.Parser.Error: instance GHC.Internal.Base.Functor Wireform.Parser.Error.ParseError
+ Wireform.Parser.Error: instance GHC.Internal.Exception.Type.Exception Wireform.Parser.Error.CleanEof
+ Wireform.Parser.Error: instance GHC.Internal.Show.Show Wireform.Parser.Error.CleanEof
+ Wireform.Parser.Error: instance GHC.Internal.Show.Show e => GHC.Internal.Show.Show (Wireform.Parser.Error.ParseError e)
+ Wireform.Parser.Internal: instance GHC.Internal.Base.Applicative (Wireform.Parser.Internal.Parser m e)
+ Wireform.Parser.Internal: instance GHC.Internal.Base.Functor (Wireform.Parser.Internal.Parser m e)
+ Wireform.Parser.Internal: instance GHC.Internal.Base.Monad (Wireform.Parser.Internal.Parser m e)
+ Wireform.Parser.Internal: instance GHC.Internal.Control.Monad.Fail.MonadFail (Wireform.Parser.Internal.Parser m e)
+ Wireform.Parser.Internal: instance Wireform.Parser.Internal.ParserMode m => GHC.Internal.Base.Alternative (Wireform.Parser.Internal.Parser m e)
+ Wireform.Parser.Internal: instance Wireform.Parser.Internal.ParserMode m => GHC.Internal.Base.MonadPlus (Wireform.Parser.Internal.Parser m e)
+ Wireform.Parser.Mark: instance GHC.Internal.Show.Show Wireform.Parser.Mark.Mark
+ Wireform.Parser.Position: instance GHC.Internal.Num.Num Wireform.Parser.Position.Pos
+ Wireform.Parser.Position: instance GHC.Internal.Show.Show Wireform.Parser.Position.Pos
+ Wireform.Parser.Position: instance GHC.Internal.Show.Show Wireform.Parser.Position.Span
+ Wireform.Parser.Stateful: instance GHC.Internal.Base.Applicative (Wireform.Parser.Stateful.ParserS r s e)
+ Wireform.Parser.Stateful: instance GHC.Internal.Base.Functor (Wireform.Parser.Stateful.ParserS r s e)
+ Wireform.Parser.Stateful: instance GHC.Internal.Base.Monad (Wireform.Parser.Stateful.ParserS r s e)
+ Wireform.Ring.Internal: instance GHC.Internal.Exception.Type.Exception Wireform.Ring.Internal.MagicRingException
+ Wireform.Ring.Internal: instance GHC.Internal.Foreign.Storable.Storable Wireform.Ring.Internal.CRing
+ Wireform.Ring.Internal: instance GHC.Internal.Show.Show Wireform.Ring.Internal.MagicRingException
+ Wireform.Transport.Capabilities: instance GHC.Internal.Show.Show Wireform.Transport.Capabilities.CoreTopology
+ Wireform.Transport.Capabilities: instance GHC.Internal.Show.Show Wireform.Transport.Capabilities.IOUringFeatures
+ Wireform.Transport.Capabilities: instance GHC.Internal.Show.Show Wireform.Transport.Capabilities.NumaNodeInfo
+ Wireform.Transport.Capabilities: instance GHC.Internal.Show.Show Wireform.Transport.Capabilities.Placement
+ Wireform.Transport.Capabilities: instance GHC.Internal.Show.Show Wireform.Transport.Capabilities.SystemCapabilities
+ Wireform.Transport.Config: instance GHC.Internal.Enum.Bounded Wireform.Transport.Config.CapabilityAction
+ Wireform.Transport.Config: instance GHC.Internal.Enum.Bounded Wireform.Transport.Config.Profile
+ Wireform.Transport.Config: instance GHC.Internal.Enum.Enum Wireform.Transport.Config.CapabilityAction
+ Wireform.Transport.Config: instance GHC.Internal.Enum.Enum Wireform.Transport.Config.Profile
+ Wireform.Transport.Config: instance GHC.Internal.Read.Read Wireform.Transport.Config.CapabilityAction
+ Wireform.Transport.Config: instance GHC.Internal.Read.Read Wireform.Transport.Config.Profile
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.CapabilityAction
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.CompletionWaitMode
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.IOUringConfig
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.NumaPolicy
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.PagePolicy
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.PinningPolicy
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.Profile
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.SQPollPolicy
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.SpinBudget
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.TransportConfig
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.WaitPolicy
+ Wireform.Transport.Receive: instance GHC.Internal.Show.Show Wireform.Transport.Receive.ReceiveWait
+ Wireform.Transport.Send: instance GHC.Internal.Exception.Type.Exception Wireform.Transport.Send.SendReservationTooLarge
+ Wireform.Transport.Send: instance GHC.Internal.Exception.Type.Exception Wireform.Transport.Send.SendRingFull
+ Wireform.Transport.Send: instance GHC.Internal.Show.Show Wireform.Transport.Send.SendReservationTooLarge
+ Wireform.Transport.Send: instance GHC.Internal.Show.Show Wireform.Transport.Send.SendRingFull
+ Wireform.Transport.Send: instance GHC.Internal.Show.Show Wireform.Transport.Send.SendWait
- Wireform.Builder.FastBuilder: RingSinkState :: {-# UNPACK #-} !Word64 -> {-# UNPACK #-} !Word64 -> {-# UNPACK #-} !Ptr Word8 -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> !Word64 -> IO () -> !Word64 -> IO () -> !IO Word64 -> RingSinkState
+ Wireform.Builder.FastBuilder: RingSinkState :: {-# UNPACK #-} !Word64 -> {-# UNPACK #-} !Word64 -> {-# UNPACK #-} !Ptr Word8 -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> !Word64 -> IO () -> !Word64 -> IO () -> !IO Word64 -> !RingSpill -> RingSinkState
Files
- CHANGELOG.md +18/−0
- README.md +12/−0
- cbits/base64.c +47/−36
- cbits/fast_decode.c +229/−123
- cbits/fast_rng.c +85/−15
- cbits/fast_scan.c +30/−13
- cbits/magic_ring_linux.c +48/−19
- cbits/magic_ring_posix.c +76/−24
- cbits/magic_ring_windows.c +43/−29
- cbits/wireform_hash_simd.c +85/−41
- include/magic_ring.h +26/−3
- src/Wireform/Base64.hs +47/−9
- src/Wireform/Builder/FastBuilder.hs +226/−107
- src/Wireform/Encode/Direct.hs +15/−4
- src/Wireform/FFI.hs +103/−30
- src/Wireform/Hash.hs +87/−18
- src/Wireform/Parser.hs +7/−2
- src/Wireform/Parser/Switch.hs +0/−6
- src/Wireform/Ring/Internal.hs +7/−2
- src/Wireform/Transport/Config.hs +3/−1
- src/Wireform/Transport/Send.hs +2/−0
- test/Spec.hs +4/−0
- test/Wireform/FFI/Test.hs +69/−0
- test/Wireform/Transport/SendBoundaryTest.hs +138/−0
- test/Wireform/Transport/SendTest.hs +35/−1
- wireform-core.cabal +11/−7
CHANGELOG.md view
@@ -1,6 +1,24 @@ # Changelog for wireform-core +## 0.3.0.0 -- unreleased++* Add `Wireform.Hash.xxh64IO` for callers that thread hashes through an IO+ loop without allocating a separate pure thunk per value.++* Breaking change: the exported `RingSinkState` record gains `rsSpill`.+ Custom ring sinks must initialise it with `NoSpill`. Requests larger+ than the ring now use reusable spill storage instead of failing.+* Export `RingSpill`, `SpillBuf` and `FixedBufferOverflow`. Exact-size+ builders reject writes that exceed the remaining buffer.+* Correct direct varint encoding for values at or above `2^21` and+ remove a per-copy continuation allocation from `dBytes`.+* Preserve full-width lengths and offsets at C FFI boundaries and include+ the accumulated buffer-boundary, base64, hashing, parser, ring and+ transport fixes required by the new format packages.+* Support GHC 9.10 and newer.++ ## 0.2.0.1 -- 2026-07-16 * Make `Wireform.Transport.Send` ring-capacity tests portable across
README.md view
@@ -41,6 +41,18 @@ duplicating the `__attribute__((target(...)))` / `simde-features.h` plumbing. +## C kernels++Every kernel in `cbits/` is tested directly by+[`c-harness/`](../c-harness/README.md) — unit, boundary and differential+tests plus libFuzzer targets, under ASan+UBSan (and MSan, valgrind,+guard-page `-O3` builds and the clang static analyzer in `ci`) — not+just through the FFI wrappers. Measured by `make -C c-harness coverage`:+every kernel here sits at 100% line coverage, and every branch except+`fast_rng.c`'s kernel_random-failure arm — unreachable on Darwin, where+`arc4random_buf` cannot fail, and covered by the Linux+getrandom-failure tests in CI.+ ## License BSD-3-Clause. Vendored `simde` headers carry their own MIT license
cbits/base64.c view
@@ -27,12 +27,14 @@ * for big payloads via the proto3 JSON mapping -- stays SSSE3. */ +#include <limits.h> #include <stdint.h> #include <string.h> #include <simde/x86/sse2.h> #include <simde/x86/ssse3.h> -static const char b64_alphabet[64] =+/* 64 symbols plus the literal's terminating NUL (never indexed). */+static const char b64_alphabet[65] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyz" "0123456789+/";@@ -82,11 +84,20 @@ * trailing '=' chars subtract one byte each. The exact decoded * length is reported by hs_base64_decode itself; this helper just * sizes the output buffer.+ *+ * Both take and return int (the FFI uses CInt). The largest input+ * whose padded encoding still fits in an int is 3 * (INT_MAX / 4);+ * for anything longer the encoded length is not representable, so+ * hs_base64_encoded_length returns -1 and hs_base64_encode refuses+ * to run (instead of overflowing its output index). * ------------------------------------------------------------------ */ +#define B64_MAX_ENCODE_INPUT (3 * (INT_MAX / 4))+ int hs_base64_encoded_length(int in_len) { if (in_len < 0) return 0;+ if (in_len > B64_MAX_ENCODE_INPUT) return -1; return ((in_len + 2) / 3) * 4; } @@ -99,8 +110,10 @@ /* ------------------------------------------------------------------ * Encode *- * Returns the number of bytes written to @out. Always equals- * hs_base64_encoded_length(in_len) (padded form).+ * Returns the number of bytes written to @out, which must hold+ * hs_base64_encoded_length(in_len) bytes; always equals that length+ * (padded form). in_len <= 0 writes nothing and returns 0;+ * in_len > 3 * (INT_MAX / 4) writes nothing and returns -1. * ------------------------------------------------------------------ */ static inline simde__m128i enc_reshuffle(simde__m128i in)@@ -138,6 +151,8 @@ { int i = 0, j = 0; + if (in_len > B64_MAX_ENCODE_INPUT) return -1;+ /* SIMD: 12 in -> 16 out per iter. Need 16 readable input bytes * (we load 16 then mask out the upper 4) so guard accordingly. */ while (in_len - i >= 16) {@@ -255,39 +270,35 @@ } /* Tail quartet: may contain '=' padding. */- {- uint8_t a = b64_dec_table[in[i+0]];- uint8_t b = b64_dec_table[in[i+1]];- if (a >= 64 || b >= 64) return -1;- if (in[i+2] == (uint8_t)'=') {- if (in[i+3] != (uint8_t)'=') return -1;- uint32_t v = ((uint32_t)a << 18) | ((uint32_t)b << 12);- out[j+0] = (uint8_t)(v >> 16);- j += 1;- } else if (in[i+3] == (uint8_t)'=') {- uint8_t c = b64_dec_table[in[i+2]];- if (c >= 64) return -1;- uint32_t v = ((uint32_t)a << 18)- | ((uint32_t)b << 12)- | ((uint32_t)c << 6);- out[j+0] = (uint8_t)(v >> 16);- out[j+1] = (uint8_t)(v >> 8);- j += 2;- } else {- uint8_t c = b64_dec_table[in[i+2]];- uint8_t d = b64_dec_table[in[i+3]];- if (c >= 64 || d >= 64) return -1;- uint32_t v = ((uint32_t)a << 18)- | ((uint32_t)b << 12)- | ((uint32_t)c << 6)- | (uint32_t)d;- out[j+0] = (uint8_t)(v >> 16);- out[j+1] = (uint8_t)(v >> 8);- out[j+2] = (uint8_t) v;- j += 3;- }- i += 4;+ uint8_t a = b64_dec_table[in[i+0]];+ uint8_t b = b64_dec_table[in[i+1]];+ if (a >= 64 || b >= 64) return -1;+ if (in[i+2] == (uint8_t)'=') {+ if (in[i+3] != (uint8_t)'=') return -1;+ uint32_t v = ((uint32_t)a << 18) | ((uint32_t)b << 12);+ out[j+0] = (uint8_t)(v >> 16);+ j += 1;+ } else if (in[i+3] == (uint8_t)'=') {+ uint8_t c = b64_dec_table[in[i+2]];+ if (c >= 64) return -1;+ uint32_t v = ((uint32_t)a << 18)+ | ((uint32_t)b << 12)+ | ((uint32_t)c << 6);+ out[j+0] = (uint8_t)(v >> 16);+ out[j+1] = (uint8_t)(v >> 8);+ j += 2;+ } else {+ uint8_t c = b64_dec_table[in[i+2]];+ uint8_t d = b64_dec_table[in[i+3]];+ if (c >= 64 || d >= 64) return -1;+ uint32_t v = ((uint32_t)a << 18)+ | ((uint32_t)b << 12)+ | ((uint32_t)c << 6)+ | (uint32_t)d;+ out[j+0] = (uint8_t)(v >> 16);+ out[j+1] = (uint8_t)(v >> 8);+ out[j+2] = (uint8_t) v;+ j += 3; }- (void)i; return j; }
cbits/fast_decode.c view
@@ -6,8 +6,18 @@ * - Branchless byte-level parallelism for common varint sizes * - Prefetch hints for sequential buffer access * - Unrolled loops for fixed-width fields+ *+ * Widths, applied per value (see the module docs in Wireform.FFI):+ * positions into a buffer (and every scanner result, which can return a+ * miss or an end index) are ptrdiff_t; pure byte counts, capacities and+ * the counts these kernels report are size_t. Nothing a Haskell caller+ * passes narrows to CInt, so a ByteString over 2 GiB is not truncated.+ * The functions below that still take int are the ones with no Haskell+ * caller (the scalar varint / fixed-width helpers); they are reached+ * only from C with buffer-sized indices. */ +#include <stddef.h> #include <stdint.h> #include <string.h> #include <simde/x86/sse2.h>@@ -28,6 +38,9 @@ int offset, uint64_t *out) {+ /* Requires 0 <= offset. Bounds are tested as len - offset, which+ * cannot overflow once offset < len (offset + k could for len near+ * INT_MAX). */ if (offset >= len) return 0; /* Fast path: single byte (extremely common for tags and small values) */@@ -37,14 +50,14 @@ return 1; } - if (offset + 1 >= len) return 0;+ if (len - offset <= 1) return 0; uint8_t b1 = buf[offset + 1]; if (b1 < 0x80) { *out = (uint64_t)(b0 & 0x7F) | ((uint64_t)b1 << 7); return 2; } - if (offset + 2 >= len) return 0;+ if (len - offset <= 2) return 0; uint8_t b2 = buf[offset + 2]; if (b2 < 0x80) { *out = (uint64_t)(b0 & 0x7F)@@ -57,7 +70,7 @@ * SWAR technique for 4+ byte varints: * Load remaining bytes and process with parallel bit extraction. */- if (offset + 3 >= len) return 0;+ if (len - offset <= 3) return 0; uint8_t b3 = buf[offset + 3]; if (b3 < 0x80) { *out = (uint64_t)(b0 & 0x7F)@@ -67,7 +80,7 @@ return 4; } - if (offset + 4 >= len) return 0;+ if (len - offset <= 4) return 0; uint8_t b4 = buf[offset + 4]; if (b4 < 0x80) { *out = (uint64_t)(b0 & 0x7F)@@ -129,18 +142,24 @@ * bytes, and strips the remaining sign bits. * * REQUIRES: at least 8 readable bytes starting at buf+offset.- * The caller must ensure this (via page boundary relocation or bounds check).+ * The caller must ensure this (Proto.Dynamic checks off + 8 <= length). *- * Returns bytes consumed (1-10), or 0 on overflow (>10 byte varint).- * Result is written to *out.+ * `offset` is a position into `buf` (ptrdiff_t: a ByteString over 2 GiB+ * must not truncate it). Returns bytes consumed (1-8), a genuinely small+ * value, or 0 if none of the 8 bytes terminates the varint (9- and+ * 10-byte varints, or malformed input); the caller then falls back to+ * its byte-at-a-time decoder. Result is written to *out. */ int hs_proto_decode_varint_swar( const uint8_t *buf,- int offset,+ ptrdiff_t offset, uint64_t *out) { uint64_t word; memcpy(&word, buf + offset, 8);+#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__+ word = __builtin_bswap64(word); /* byte 0 must be the low byte */+#endif /* Fast path: single byte (most common for tags) */ if ((word & 0x80) == 0) {@@ -186,13 +205,13 @@ /* Now compact the 7-bit groups. Each byte has 7 useful bits in [6:0]. */ uint64_t result = (stripped & 0x7F)- | ((stripped >> 1) & (0x7FUL << 7))- | ((stripped >> 2) & (0x7FUL << 14))- | ((stripped >> 3) & (0x7FUL << 21))- | ((stripped >> 4) & (0x7FUL << 28))- | ((stripped >> 5) & (0x7FUL << 35))- | ((stripped >> 6) & (0x7FUL << 42))- | ((stripped >> 7) & (0x7FUL << 49));+ | ((stripped >> 1) & (0x7FULL << 7))+ | ((stripped >> 2) & (0x7FULL << 14))+ | ((stripped >> 3) & (0x7FULL << 21))+ | ((stripped >> 4) & (0x7FULL << 28))+ | ((stripped >> 5) & (0x7FULL << 35))+ | ((stripped >> 6) & (0x7FULL << 42))+ | ((stripped >> 7) & (0x7FULL << 49)); *out = result; return (int)(tag_bits / 8) + 1;@@ -206,14 +225,20 @@ * bytes of padding. The padding bytes are zero, which look like varint * terminators (byte < 0x80). *+ * `len` and `out_len` are byte counts, not positions: `len` bytes of the+ * original buffer are copied, and `out_len` is the capacity of the+ * destination, so both are size_t (a capacity can never be negative; a+ * ByteString over 2 GiB needs len + 7 to be representable).+ * * Returns 1 if a copy was made (caller should use out_buf), 0 if the- * original buffer is safe (no copy needed).+ * original buffer is safe (no copy needed) or len == 0, -1 if a copy is+ * needed but out_len < len + 7. */ int hs_proto_relocate_page_boundary( const uint8_t *buf,- int len,+ size_t len, uint8_t *out_buf,- int out_len)+ size_t out_len) { if (len == 0) return 0; @@ -224,7 +249,8 @@ if (page_end - end_addr < 8) { /* Too close to page boundary; need to copy. */- if (out_len < len + 7) return -1; /* buffer too small */+ /* buffer too small; written so that len + 7 cannot overflow */+ if (out_len < 7 || out_len - 7 < len) return -1; memcpy(out_buf, buf, len); memset(out_buf + len, 0, 7); /* Zero padding acts as varint terminators */ return 1;@@ -234,30 +260,19 @@ /* * Skip a varint without decoding its value.- * Returns bytes consumed, or 0 on error.- *- * Uses SWAR: load up to 8 bytes and find the first byte < 0x80- * using bit manipulation.+ * Returns bytes consumed (1-10), or 0 if it is unterminated within len+ * or longer than 10 bytes. Requires 0 <= offset. */ int hs_proto_skip_varint( const uint8_t *buf, int len, int offset) {- int pos = offset;- /* Unrolled: most varints are 1-3 bytes */- if (pos < len && buf[pos] < 0x80) return 1;- pos++;- if (pos < len && buf[pos] < 0x80) return 2;- pos++;- if (pos < len && buf[pos] < 0x80) return 3;- pos++;-- /* Slow path for longer varints */- while (pos < len) {- if (buf[pos] < 0x80) return pos - offset + 1;- pos++;- if (pos - offset > 10) return 0; /* varint too long */+ /* A varint is at most 10 bytes; the compiler unrolls this. */+ int avail = offset < len ? len - offset : 0;+ if (avail > 10) avail = 10;+ for (int k = 0; k < avail; k++) {+ if (buf[offset + k] < 0x80) return k + 1; } return 0; }@@ -290,33 +305,38 @@ * Count the number of varints in a packed buffer. * Uses SWAR to process 8 bytes at a time: each byte with its high bit * clear terminates a varint, so we popcount the inverted high-bit mask.+ *+ * `len` is a byte count and the result a varint count, both size_t: a+ * packed run can be larger than 2 GiB, and its count can exceed INT_MAX+ * (which the old int count would have reported wrapped). Uses len - i+ * for the trip counts, never i + N <= len, so the bound cannot wrap. */-int hs_proto_count_packed_varints(+size_t hs_proto_count_packed_varints( const uint8_t *buf,- int len)+ size_t len) {- int count = 0;- int i = 0;+ size_t count = 0;+ size_t i = 0; { simde__m128i high_bit = simde_mm_set1_epi8((char)0x80);- for (; i + 16 <= len; i += 16) {+ for (; len - i >= 16; i += 16) { simde__m128i chunk = simde_mm_loadu_si128( (const simde__m128i *)(buf + i)); simde__m128i has_high = simde_mm_and_si128(chunk, high_bit); simde__m128i is_term = simde_mm_cmpeq_epi8(has_high, simde_mm_setzero_si128()); int mask = simde_mm_movemask_epi8(is_term);- count += __builtin_popcount(mask);+ count += (size_t)__builtin_popcount(mask); } } #if defined(__x86_64__) || defined(__aarch64__)- for (; i + 8 <= len; i += 8) {+ for (; len - i >= 8; i += 8) { uint64_t word; memcpy(&word, buf + i, 8); uint64_t term_mask = ~word & 0x8080808080808080ULL;- count += __builtin_popcountll(term_mask >> 7);+ count += (size_t)__builtin_popcountll(term_mask >> 7); } #endif @@ -332,17 +352,18 @@ * just read the bytes directly as values without varint parsing. * * Uses SWAR: if no byte has its high bit set, the entire buffer is- * single-byte varints. Returns 1 if all single-byte, 0 otherwise.+ * single-byte varints. `len` is a byte count (size_t). Returns 1 if all+ * single-byte, 0 otherwise. */ int hs_proto_packed_all_single_byte( const uint8_t *buf,- int len)+ size_t len) {- int i = 0;+ size_t i = 0; { simde__m128i high_bit = simde_mm_set1_epi8((char)0x80);- for (; i + 16 <= len; i += 16) {+ for (; len - i >= 16; i += 16) { simde__m128i chunk = simde_mm_loadu_si128( (const simde__m128i *)(buf + i)); simde__m128i has_high = simde_mm_and_si128(chunk, high_bit);@@ -351,7 +372,7 @@ } #if defined(__x86_64__) || defined(__aarch64__)- for (; i + 8 <= len; i += 8) {+ for (; len - i >= 8; i += 8) { uint64_t word; memcpy(&word, buf + i, 8); if (word & 0x8080808080808080ULL) return 0;@@ -378,9 +399,12 @@ int i = 0; #if defined(__x86_64__) || defined(__aarch64__)- for (; i + 8 <= len; i += 8) {+ for (; len - i >= 8; i += 8) { uint64_t word; memcpy(&word, buf + i, 8);+#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__+ word = __builtin_bswap64(word); /* out[i] is the first byte */+#endif out[i] = (word) & 0xFF; out[i + 1] = (word >> 8) & 0xFF; out[i + 2] = (word >> 16) & 0xFF;@@ -409,16 +433,19 @@ * For the ASCII-only case (the vast majority of protobuf string fields: * URLs, identifiers, enum names, etc.) this is dramatically faster than * calling into a full UTF-8 state machine.+ *+ * `len` is a byte count (size_t), so a string field over 2 GiB is+ * validated over its whole length rather than a truncated prefix. */ int hs_proto_validate_utf8_fast( const uint8_t *buf,- int len)+ size_t len) {- int i = 0;+ size_t i = 0; { simde__m128i high_bit = simde_mm_set1_epi8((char)0x80);- for (; i + 16 <= len; i += 16) {+ for (; len - i >= 16; i += 16) { simde__m128i chunk = simde_mm_loadu_si128( (const simde__m128i *)(buf + i)); simde__m128i has_high = simde_mm_and_si128(chunk, high_bit);@@ -429,7 +456,7 @@ } #if defined(__x86_64__) || defined(__aarch64__)- for (; i + 8 <= len; i += 8) {+ for (; len - i >= 8; i += 8) { uint64_t word; memcpy(&word, buf + i, 8); if (word & 0x8080808080808080ULL) {@@ -469,7 +496,7 @@ return 0; } - if (i + count > len) return 0;+ if (len - i < (size_t)count) return 0; for (int j = 1; j < count; j++) { uint8_t cb = buf[i + j];@@ -494,10 +521,15 @@ /* * Encode a varint into buf at the given offset. * Returns the number of bytes written.+ *+ * `offset` is the write cursor into a direct-encode buffer (Encode.Direct+ * allocates one ByteString and fills it front to back), so it is a+ * non-negative index that can pass INT_MAX: size_t, like the count+ * written. The caller guarantees the space. */-int hs_proto_encode_varint(+size_t hs_proto_encode_varint( uint8_t *buf,- int offset,+ size_t offset, uint64_t value) { uint8_t *p = buf + offset;@@ -531,7 +563,7 @@ p[4] = (uint8_t)(value >> 28); return 5; }- int n = 0;+ size_t n = 0; while (value >= 0x80) { p[n++] = (uint8_t)((value & 0x7F) | 0x80); value >>= 7;@@ -543,28 +575,36 @@ /* * Encode a length-delimited field: tag_byte + varint(len) + memcpy(data, len). * Returns bytes written. This is a single C call for the entire field.+ *+ * `offset` is the write cursor (size_t, see hs_proto_encode_varint) and+ * `len` the byte count of `data`: a single field over 2 GiB is encoded+ * in one call, and the result (1 + varint + len) exceeds INT_MAX for+ * one, so both the length and the return are size_t. */-int hs_proto_encode_length_delimited(+size_t hs_proto_encode_length_delimited( uint8_t *buf,- int offset,+ size_t offset, uint8_t tag, const uint8_t *data,- int len)+ size_t len) {- uint8_t *p = buf + offset;- p[0] = tag;- int n = 1 + hs_proto_encode_varint(buf, offset + 1, (uint64_t)len);- memcpy(buf + offset + n, data, len);+ buf[offset] = tag;+ size_t n = 1 + hs_proto_encode_varint(buf, offset + 1, (uint64_t)len);+ /* An empty ByteString / Text arrives as (NULL, 0); memcpy from NULL+ * is undefined even for zero bytes. */+ if (len > 0) memcpy(buf + offset + n, data, len); return n + len; } /* * Encode a varint field: tag_byte + varint(value). * Returns bytes written.+ *+ * `offset` is the write cursor (size_t, like the other encoders). */-int hs_proto_encode_varint_field(+size_t hs_proto_encode_varint_field( uint8_t *buf,- int offset,+ size_t offset, uint8_t tag, uint64_t value) {@@ -575,10 +615,12 @@ /* * Encode a bool field: tag_byte + 0x01/0x00. * Returns 2 (always 2 bytes).+ *+ * `offset` is the write cursor (size_t, like the other encoders). */-int hs_proto_encode_bool_field(+size_t hs_proto_encode_bool_field( uint8_t *buf,- int offset,+ size_t offset, uint8_t tag, int value) {@@ -617,6 +659,7 @@ * Scan for the next field tag in a message buffer. * Skips the current field value based on wire type. * Returns the new offset after skipping, or -1 on error.+ * Requires 0 <= offset <= len. */ int hs_proto_skip_field( const uint8_t *buf,@@ -631,18 +674,19 @@ return offset + consumed; } case 1: /* 64-bit */- if (offset + 8 > len) return -1;+ if (len - offset < 8) return -1; return offset + 8; case 2: { /* length-delimited */ uint64_t field_len; int consumed = hs_proto_decode_varint_fast(buf, len, offset, &field_len); if (consumed == 0) return -1;- int new_offset = offset + consumed + (int)field_len;- if (new_offset > len) return -1;- return new_offset;+ /* Compare in 64 bits: the declared length is untrusted and may+ * exceed INT_MAX (narrowing it to int could go negative). */+ if (field_len > (uint64_t)(len - offset - consumed)) return -1;+ return offset + consumed + (int)field_len; } case 5: /* 32-bit */- if (offset + 4 > len) return -1;+ if (len - offset < 4) return -1; return offset + 4; default: return -1;@@ -701,13 +745,20 @@ /* Find the offset of the first NUL byte starting at buf+offset. Returns offset relative to buf, or -1 if not found within len bytes.- 16-byte SIMD fast path. */-int hs_proto_find_nul(const uint8_t *buf, int offset, int len)+ 16-byte SIMD fast path.++ `offset` is the start position and `len` the buffer's length (also the+ exclusive end of the scan): both are indices into `buf`, so ptrdiff_t,+ which keeps a ByteString over 2 GiB from truncating and keeps the -1+ miss representable. Requires 0 <= offset; offset >= len returns -1+ without reading. */+ptrdiff_t hs_proto_find_nul(const uint8_t *buf, ptrdiff_t offset, ptrdiff_t len) {- int i = offset;+ ptrdiff_t i = offset; simde__m128i zero = simde_mm_setzero_si128(); - for (; i + 16 <= len; i += 16) {+ /* len - i, not i + 16: i starts at the caller's offset */+ for (; len - i >= 16; i += 16) { simde__m128i chunk = simde_mm_loadu_si128((const simde__m128i *)(buf + i)); simde__m128i cmp = simde_mm_cmpeq_epi8(chunk, zero); int mask = simde_mm_movemask_epi8(cmp);@@ -722,14 +773,21 @@ } /* Check if len bytes starting at buf+offset are all ASCII (< 0x80).- Uses 16-byte SIMD. Returns 1 if all ASCII, 0 otherwise. */-int hs_proto_is_ascii(const uint8_t *buf, int offset, int len)+ Uses 16-byte SIMD. Returns 1 if all ASCII, 0 otherwise.++ `offset` is a position into `buf` and `len` a count of bytes from+ there (so the window is [offset, offset + len)): both ptrdiff_t, like+ the other scanners, so neither truncates for a ByteString over 2 GiB.+ len <= 0 returns 1 without touching memory. */+int hs_proto_is_ascii(const uint8_t *buf, ptrdiff_t offset, ptrdiff_t len) {- int i = 0;+ /* An empty ByteString arrives as (NULL, 0, 0): do not form NULL + 0. */+ if (len <= 0) return 1;+ ptrdiff_t i = 0; const uint8_t *p = buf + offset; simde__m128i highbit = simde_mm_set1_epi8((char)0x80); - for (; i + 16 <= len; i += 16) {+ for (; len - i >= 16; i += 16) { simde__m128i chunk = simde_mm_loadu_si128((const simde__m128i *)(p + i)); simde__m128i test = simde_mm_and_si128(chunk, highbit); if (simde_mm_movemask_epi8(test) != 0) return 0;@@ -794,15 +852,21 @@ * anything < 0x20, or '"', or '\\'. * Returns the offset of the first such byte, or offset+len if none found. * 16-byte SIMD fast path.+ *+ * `offset` is a position into `buf` and `len` a count of bytes from+ * there; the result is a position again, so all three are ptrdiff_t+ * (a miss of offset + len must be representable, and can pass INT_MAX). */-int hs_proto_find_json_escape(const uint8_t *buf, int offset, int len)+ptrdiff_t hs_proto_find_json_escape(const uint8_t *buf, ptrdiff_t offset, ptrdiff_t len) {- int i = 0;+ /* Do not form NULL + 0 for an empty input. */+ if (len <= 0) return offset + len;+ ptrdiff_t i = 0; const uint8_t *p = buf + offset; simde__m128i dquote = simde_mm_set1_epi8('"'); simde__m128i bslash = simde_mm_set1_epi8('\\'); - for (; i + 16 <= len; i += 16) {+ for (; len - i >= 16; i += 16) { simde__m128i chunk = simde_mm_loadu_si128((const simde__m128i *)(p + i)); int m1 = simde_mm_movemask_epi8(simde_mm_cmpeq_epi8(chunk, dquote)); int m2 = simde_mm_movemask_epi8(simde_mm_cmpeq_epi8(chunk, bslash));@@ -825,14 +889,19 @@ * Returns the offset of the first non-whitespace character. * EDN treats commas as whitespace. Also skips ; comments to end of line. * 16-byte SIMD fast path for the common whitespace chars.+ *+ * `offset` is the start position and `len` the buffer's length (the+ * exclusive end), and the result is a position, so all three are+ * ptrdiff_t like the other scanners. Requires 0 <= offset; offset >= len+ * returns offset unchanged without reading. */-int hs_proto_skip_ws(const uint8_t *buf, int offset, int len)+ptrdiff_t hs_proto_skip_ws(const uint8_t *buf, ptrdiff_t offset, ptrdiff_t len) {- int i = offset;+ ptrdiff_t i = offset; while (i < len) { /* SIMD fast path: skip blocks of 16 whitespace bytes */- while (i + 16 <= len) {+ while (len - i >= 16) { simde__m128i chunk = simde_mm_loadu_si128((const simde__m128i *)(buf + i)); /* Check each byte against whitespace chars */ simde__m128i eq_space = simde_mm_cmpeq_epi8(chunk, simde_mm_set1_epi8(' '));@@ -868,56 +937,70 @@ } /*- * Compare a search value against N serialized LE int32 bounds.- * Returns a bitmask where bit i is set if bounds[i] <= search_val.- * Processes 4 bounds at a time using SSE2.- * count must be <= 32.+ * Compare a search value against N serialized bounds.+ * Returns a bitmask where bit i (i < 32) is set if bounds[i] <= search:+ * for width 4 as little-endian signed int32 (4 at a time with SSE2),+ * otherwise by memcmp. Bounds past the 32nd are ignored. The mask is+ * built unsigned (bit 31 is a valid result bit) and returned as an int.+ *+ * `count` is the number of bounds and `width` their size in bytes: both+ * are counts, so size_t (a caller that passes a negative Int would be a+ * bug: the value becomes huge, not empty). width == 0 means empty bounds,+ * which compare equal without touching `bounds`. The result is a 32-bit+ * bitmask, not a length, so it stays an int. */ int hs_proto_compare_bounds(- const uint8_t *bounds, int count, int width,+ const uint8_t *bounds, size_t count, size_t width, const uint8_t *search) {+ size_t n = count < 32 ? count : 32;+ if (width != 4) { /* Scalar fallback for non-int32 widths */- int result = 0;- for (int i = 0; i < count && i < 32; i++) {- int cmp = memcmp(bounds + i * width, search, width);- if (cmp <= 0) result |= (1 << i);+ uint32_t result = 0;+ for (size_t i = 0; i < n; i++) {+ /* width 0: every (empty) bound equals the search value; do+ * not form bounds + 0 when an empty ByteString passed NULL */+ int cmp = width != 0+ ? memcmp(bounds + i * width, search, width)+ : 0;+ if (cmp <= 0) result |= 1u << i; }- return result;+ return (int)result; } /* Fast path for 4-byte LE int32 bounds */ int32_t search_val; memcpy(&search_val, search, 4); #if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__- search_val = __builtin_bswap32(search_val);+ search_val = (int32_t)__builtin_bswap32((uint32_t)search_val); #endif - int result = 0;- int i = 0;+ uint32_t result = 0;+ size_t i = 0; simde__m128i sv = simde_mm_set1_epi32(search_val); - for (; i + 4 <= count; i += 4) {+ /* n - i, not i + 4 <= n: the bound cannot wrap. */+ for (; n - i >= 4; i += 4) { simde__m128i bv = simde_mm_loadu_si128((const simde__m128i *)(bounds + i * 4)); /* bounds[j] <= search_val iff NOT (search_val < bounds[j]) */ simde__m128i lt = simde_mm_cmplt_epi32(sv, bv); /* lt has 0xFFFFFFFF where search < bound, 0 where search >= bound */ int mask = simde_mm_movemask_ps(simde_mm_castsi128_ps(lt)); /* Invert: we want bits set where search >= bound */- result |= ((~mask) & 0xF) << i;+ result |= (uint32_t)(~mask & 0xF) << i; } /* Scalar tail */- for (; i < count && i < 32; i++) {+ for (; i < n; i++) { int32_t bval; memcpy(&bval, bounds + i * 4, 4); #if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__- bval = __builtin_bswap32(bval);+ bval = (int32_t)__builtin_bswap32((uint32_t)bval); #endif- if (bval <= search_val) result |= (1 << i);+ if (bval <= search_val) result |= 1u << i; }- return result;+ return (int)result; } /*@@ -930,31 +1013,54 @@ * * For the non-overlap check, we do a simple O(n) scan since buffers in * Arrow IPC are typically in order. Returns 1 if valid, 0 if invalid.+ *+ * `count` is the number of (offset, length) pairs and `buf_pairs` holds+ * 2 * count int64s, so it is size_t (a negative Int would be a caller+ * bug: it becomes a huge count rather than an empty table).+ *+ * `body_length` is signed like the offsets it is compared against; a+ * negative one describes no body and is rejected outright, even with+ * zero buffers. */+#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__+/* The two int64 sign bits in a movemask_epi8 result over one 16-byte+ * pair: bit 7 of each lane's most-significant byte, which is lane byte+ * 0 on big-endian. */+#define WF_PAIR_SIGN_MASK 0x0101+#else+/* Lane byte 7 on little-endian (movemask bits 7 and 15). */+#define WF_PAIR_SIGN_MASK 0x8080+#endif+ int hs_proto_validate_arrow_buffers(- const int64_t *buf_pairs, int count, int64_t body_length)+ const int64_t *buf_pairs, size_t count, int64_t body_length) {+ if (body_length < 0) return 0; if (count == 0) return 1; int64_t prev_end = 0;- int i = 0;+ size_t i = 0; - /* SSE2 path: validate 2 buffers (4 int64s) at a time for non-negative */- for (; i + 1 < count; i += 2) {- simde__m128i pair0 = simde_mm_loadu_si128(- (const simde__m128i *)(buf_pairs + i * 2));- simde__m128i pair1 = simde_mm_loadu_si128(- (const simde__m128i *)(buf_pairs + i * 2 + 2));- /* Check all 4 values are non-negative (high bit clear) */+ /* SSE2 path: validate 2 buffers (4 int64s) at a time for non-negative.+ * count - i >= 2: no wrap for a count near SIZE_MAX. */+ for (; count - i >= 2; i += 2) {+ /* size_t index: i * 2 must not overflow */+ const int64_t *pp = buf_pairs + i * 2;+ simde__m128i pair0 = simde_mm_loadu_si128((const simde__m128i *)pp);+ simde__m128i pair1 = simde_mm_loadu_si128((const simde__m128i *)(pp + 2));+ /* Check all 4 values are non-negative: each int64's sign bit+ * is bit 7 of its most-significant byte (see WF_PAIR_SIGN_MASK,+ * which names the movemask bits that byte lands in for the+ * platform's byte order). */ simde__m128i combined = simde_mm_or_si128(pair0, pair1);- if (simde_mm_movemask_epi8(combined) & 0x8888) return 0;+ if (simde_mm_movemask_epi8(combined) & WF_PAIR_SIGN_MASK) return 0; /* Scalar bounds + overlap checks */ for (int j = 0; j < 2; j++) {- int idx = i + j;- int64_t off = buf_pairs[idx * 2];- int64_t len = buf_pairs[idx * 2 + 1];- if (off + len > body_length) return 0;+ int64_t off = pp[j * 2];+ int64_t len = pp[j * 2 + 1];+ /* off, len >= 0, so this cannot overflow (off + len could). */+ if (len > body_length || off > body_length - len) return 0; if (off < prev_end && len > 0) return 0; int64_t end = off + len; if (end > prev_end) prev_end = end;@@ -966,7 +1072,7 @@ int64_t off = buf_pairs[i * 2]; int64_t len = buf_pairs[i * 2 + 1]; if (off < 0 || len < 0) return 0;- if (off + len > body_length) return 0;+ if (len > body_length || off > body_length - len) return 0; if (off < prev_end && len > 0) return 0; int64_t end = off + len; if (end > prev_end) prev_end = end;
cbits/fast_rng.c view
@@ -8,8 +8,9 @@ * * One 256-bit state per pthread, stored in '__thread' storage so * concurrent generation across many Haskell capabilities never- * touches a shared cache line. Seeded on first use from- * @getrandom(2)@.+ * touches a shared cache line. Seeded on first use from the+ * platform CSPRNG and reseeded in a forked child (see+ * pthread_atfork below). * * Used by 'wireform-websocket' to roll per-frame masking keys * without going through the global 'splitmix' MVar. Exposed@@ -21,17 +22,53 @@ #include <stdint.h> #include <stddef.h> #include <string.h>-#include <unistd.h>+#include <time.h> -#if defined(__linux__)+#if defined(_WIN32) || defined(_WIN64)+#define WIN32_LEAN_AND_MEAN+#include <windows.h>+#include <bcrypt.h>+static int kernel_random(void *buf, size_t len)+{+ NTSTATUS status = BCryptGenRandom(+ NULL, (PUCHAR)buf, (ULONG)len, BCRYPT_USE_SYSTEM_PREFERRED_RNG);+ return BCRYPT_SUCCESS(status) ? 0 : -1;+}+#elif defined(__linux__)+#include <errno.h>+#include <unistd.h>+#include <pthread.h> #include <sys/syscall.h> #include <linux/random.h>+#if defined(__has_feature)+# if __has_feature(memory_sanitizer)+# include <sanitizer/msan_interface.h>+# define WF_RNG_MSAN 1+# endif+#endif+/* getrandom(2) through syscall(2), so libcs without the wrapper still+ * build. Before the kernel pool is initialised the call blocks and a+ * signal can interrupt it (EINTR); a short count is allowed by the+ * interface too. Retry both rather than dropping to the weak fallback+ * seed. MemorySanitizer cannot see writes made by a raw syscall, so+ * mark the bytes initialised in that build. */ static int kernel_random(void *buf, size_t len) {- long r = syscall(SYS_getrandom, buf, len, 0);- return r == (long)len ? 0 : -1;+ size_t off = 0;+ while (off < len) {+ long r = syscall(SYS_getrandom, (char *)buf + off, len - off, 0);+ if (r < 0 && errno == EINTR) continue;+ if (r <= 0 || (size_t)r > len - off) return -1;+ off += (size_t)r;+ }+#ifdef WF_RNG_MSAN+ __msan_unpoison(buf, len);+#endif+ return 0; } #elif defined(__APPLE__) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__)+#include <unistd.h>+#include <pthread.h> #include <stdlib.h> static int kernel_random(void *buf, size_t len) {@@ -40,6 +77,8 @@ } #else /* Fall back to /dev/urandom for portability. */+#include <unistd.h>+#include <pthread.h> #include <fcntl.h> static int kernel_random(void *buf, size_t len) {@@ -96,11 +135,8 @@ return (x << k) | (x >> (64 - k)); } -/* Recover from a degenerate all-zero seed (xoshiro256++ has a- * fixed point at 0). Vigna's reference splitmix64 is the- * recommended way to expand a single 64-bit input into a 256-bit- * xoshiro seed. We only invoke this when 'kernel_random'- * returns all-zero, which on a working kernel never happens. */+/* Vigna's splitmix64, the recommended way to expand one 64-bit value+ * into a 256-bit xoshiro seed. Used only by the fallback below. */ static inline uint64_t splitmix64_step(uint64_t *x) { *x += 0x9E3779B97F4A7C15ULL;@@ -110,14 +146,30 @@ return z ^ (z >> 31); } +/* Seed from the kernel. If that fails (no getrandom, seccomp denial)+ * or returns the all-zero state (xoshiro256++'s fixed point), fall+ * back to splitmix64 over the state's TLS address mixed with the pid+ * and a monotonic timestamp. The pid matters: after fork() the child+ * has the parent's TLS address, so an address-only seed would make a+ * reseeding child replay the parent's stream from its first draw.+ * Four consecutive splitmix64 outputs come from four distinct counter+ * values of a bijection, so at most one is zero and the fallback state+ * is never all-zero. */ static void xoshiro_seed(void) { if (kernel_random(xoshiro_state, sizeof(xoshiro_state)) != 0 || (xoshiro_state[0] | xoshiro_state[1] | xoshiro_state[2] | xoshiro_state[3]) == 0) {- /* Last-resort fallback: tid + nanotime through splitmix. */ uint64_t fallback = (uint64_t)(uintptr_t)&xoshiro_state;+#if !defined(_WIN32) && !defined(_WIN64)+ struct timespec ts;+ if (clock_gettime(CLOCK_MONOTONIC, &ts) == 0) {+ fallback ^= (uint64_t)ts.tv_sec * 1000000000ULL+ + (uint64_t)ts.tv_nsec;+ }+ fallback = splitmix64_step(&fallback) ^ ((uint64_t)getpid() << 32);+#endif for (int i = 0; i < 4; i++) { xoshiro_state[i] = splitmix64_step(&fallback); }@@ -145,10 +197,28 @@ return result; } -/* Force reseed. Useful after fork() and for tests that want- * deterministic state — they can call this then immediately- * overwrite the seed via hs_xoshiro256pp_reseed. */+/* Discard the calling thread's state: its next draw reseeds from the+ * kernel. Not imported by Haskell (fork safety goes through the+ * pthread_atfork handler below); kept for C callers and tests. */ void hs_xoshiro256pp_reseed(void) { xoshiro_seeded = 0; }++/* Fork safety. A forked child inherits the parent's TLS, so without+ * this the child would replay the parent's stream: two processes+ * emitting identical WebSocket masking keys. The child handler runs+ * in the forking thread of the child (the only thread it has) and+ * forces a fresh kernel seed on its next draw. */+#if !defined(_WIN32) && !defined(_WIN64)+static void xoshiro_atfork_child(void)+{+ xoshiro_seeded = 0;+}++__attribute__((constructor))+static void xoshiro_register_atfork(void)+{+ pthread_atfork(NULL, NULL, xoshiro_atfork_child);+}+#endif
cbits/fast_scan.c view
@@ -12,21 +12,33 @@ * * Uses SSE2 via simde for portable SIMD. Fallback to scalar * loops on architectures without simde support.+ *+ * Widths (the same split as wireform-html and wireform-http1):+ * positions into a buffer are ptrdiff_t, so a ByteString or scan+ * range over 2 GiB is not truncated and a miss can be reported as+ * len (never -1 here); pure byte counts are size_t. Neither type+ * narrows to CInt on the Haskell side. */ +#include <stddef.h> #include <stdint.h> #include <string.h> #include <simde/x86/sse2.h> /* * Scan buf[offset..len) for the first occurrence of target_byte.- * Returns the absolute position of the match, or len if no- * match was found. Used by CSV delimiter scanning, NDJSON- * newline scanning, XML structural scanning, etc.+ *+ * `offset` is the start position and `len` the buffer's length, which+ * doubles as the exclusive end of the scan, so both are indices into+ * `buf` and both must fit in ptrdiff_t (any real object does). Requires+ * 0 <= offset. Returns the absolute position of the match, or len if no+ * match was found (offset >= len is a miss that touches no memory).+ * Used by CSV delimiter scanning, NDJSON newline scanning, XML+ * structural scanning, etc. */-int hs_find_byte(const uint8_t *buf, int offset, int len, uint8_t target_byte)+ptrdiff_t hs_find_byte(const uint8_t *buf, ptrdiff_t offset, ptrdiff_t len, uint8_t target_byte) {- int i = offset;+ ptrdiff_t i = offset; simde__m128i target = simde_mm_set1_epi8((char)target_byte); /* Scalar prologue until 16-byte aligned. */@@ -35,8 +47,9 @@ i++; } - /* SIMD main loop: 16 bytes at a time. */- for (; i + 16 <= len; i += 16) {+ /* SIMD main loop: 16 bytes at a time. The bound is len - i (never+ * i + 16 <= len) so a len near PTRDIFF_MAX cannot wrap it. */+ for (; len - i >= 16; i += 16) { simde__m128i chunk = simde_mm_load_si128((const simde__m128i *)(buf + i)); int mask = simde_mm_movemask_epi8(simde_mm_cmpeq_epi8(chunk, target)); if (mask != 0) return i + __builtin_ctz(mask);@@ -56,6 +69,9 @@ * (both directions: the parser un-masks an inbound payload; the * builder masks an outbound client payload). *+ * `len` is a pure byte count (size_t): the kernel touches every+ * byte it is given, so it has no 2 GiB ceiling.+ * * The mask repeats in 4-byte network-order chunks; for the SSE2 * inner loop we broadcast that 32-bit pattern into a 16-byte * vector once and XOR 16 bytes per iteration. Scalar prologue +@@ -65,7 +81,7 @@ * i.e. byte 0 of the mask in the high byte. The same byte * ordering the wire format uses. */-void hs_ws_mask(uint8_t *buf, int len, uint32_t mask)+void hs_ws_mask(uint8_t *buf, size_t len, uint32_t mask) { /* Build the byte ordering the loop needs: mask[0] at offset 0, * mask[1] at offset 1, … Easiest done by re-laying the bytes. */@@ -75,7 +91,7 @@ mb[2] = (uint8_t)(mask >> 8); mb[3] = (uint8_t) mask; - int i = 0;+ size_t i = 0; /* Align the scalar prologue so the main loop can use 'movdqa' * once we hit a 16-byte boundary. The mask byte at offset i@@ -88,14 +104,15 @@ /* SSE2 main loop: 16 bytes per iteration. The 4-byte mask * tiled into a 16-byte vector once. If i hit alignment at an * offset where i & 3 != 0, the tile rotates accordingly. */- if (i + 16 <= len) {- int phase = i & 3;+ if (len - i >= 16) {+ unsigned phase = (unsigned)(i & 3); uint8_t tile[16]; for (int k = 0; k < 16; k++) {- tile[k] = mb[(phase + k) & 3];+ tile[k] = mb[(phase + (unsigned)k) & 3]; } simde__m128i v = simde_mm_loadu_si128((const simde__m128i *)tile);- for (; i + 16 <= len; i += 16) {+ /* len - i (not i + 16 <= len): no wrap for a len near SIZE_MAX. */+ for (; len - i >= 16; i += 16) { simde__m128i chunk = simde_mm_load_si128((const simde__m128i *)(buf + i)); chunk = simde_mm_xor_si128(chunk, v); simde_mm_store_si128((simde__m128i *)(buf + i), chunk);
cbits/magic_ring_linux.c view
@@ -4,20 +4,25 @@ #include <unistd.h> #include <string.h> #include <errno.h>+#include <stdatomic.h> #include <stdint.h> #include <stdlib.h> #include "magic_ring.h" -static long cached_page_size = 0;+/* Filled lazily. Several capabilities can call in at once, so the cache is+ * an atomic: every racer stores the same value, relaxed order suffices. */+static _Atomic long cached_page_size = 0; long hs_page_size(void) {- if (cached_page_size == 0) {- cached_page_size = sysconf(_SC_PAGESIZE);+ long ps = atomic_load_explicit(&cached_page_size, memory_order_relaxed);+ if (ps == 0) {+ ps = sysconf(_SC_PAGESIZE);+ atomic_store_explicit(&cached_page_size, ps, memory_order_relaxed); }- return cached_page_size;+ return ps; } -/* Round up to the next power of two >= val, with val >= page_size. */+/* Round up to the next power of two >= val, for 1 <= val <= RING_MAX_SIZE. */ static size_t next_pow2(size_t val) { val--; val |= val >> 1;@@ -25,15 +30,35 @@ val |= val >> 4; val |= val >> 8; val |= val >> 16;+#if SIZE_MAX > 0xFFFFFFFFu val |= val >> 32;+#endif val++; return val; } +/* Largest ring. A ring is mapped twice, so 2N has to fit the address+ * space, off_t and the Haskell Int that receives the size; 4 GiB (1 GiB+ * on a 32-bit target) is already far beyond any use, since these are+ * network buffers of KiB to MiB. Capping well below SIZE_MAX / 2 means+ * an absurd request (including what a negative Haskell Int converts to)+ * fails with ENOMEM before any mapping, rather than relying on mmap to+ * reject a multi-exabyte reservation. */+#define RING_MAX_SIZE ((size_t)1 << (sizeof(size_t) >= 8 ? 32 : 30))++/* Close fd on an error path without clobbering the errno being reported. */+static int fail_close(int fd) {+ int saved_errno = errno;+ close(fd);+ errno = saved_errno;+ return -1;+}+ /* * Allocate a double-mapped ring of at least `requested` bytes.- * Returns 0 on success, -1 on failure (sets errno).- * On success, out->base and out->size are populated.+ * Returns 0 on success, -1 on failure (sets errno; ENOMEM for a request+ * above RING_MAX_SIZE). On success, out->base and out->size are populated;+ * on failure *out is left untouched. */ int hs_ring_create(size_t requested, struct hs_ring *out) { long ps = hs_page_size();@@ -41,6 +66,10 @@ int fd; void *base, *m1, *m2; + if (requested > RING_MAX_SIZE) {+ errno = ENOMEM;+ return -1;+ } if (requested < (size_t)ps) requested = (size_t)ps; @@ -52,34 +81,32 @@ if (fd < 0) return -1; - if (ftruncate(fd, (off_t)size) != 0) {- close(fd);- return -1;- }+ if (ftruncate(fd, (off_t)size) != 0)+ return fail_close(fd); /* Reserve 2N contiguous virtual addresses with no permissions */ base = mmap(NULL, size * 2, PROT_NONE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);- if (base == MAP_FAILED) {- close(fd);- return -1;- }+ if (base == MAP_FAILED)+ return fail_close(fd); /* Map the first copy */ m1 = mmap(base, size, PROT_READ | PROT_WRITE, MAP_SHARED | MAP_FIXED, fd, 0); if (m1 == MAP_FAILED) {+ int saved_errno = errno; munmap(base, size * 2);- close(fd);- return -1;+ errno = saved_errno;+ return fail_close(fd); } /* Map the second copy immediately after */ m2 = mmap((char *)base + size, size, PROT_READ | PROT_WRITE, MAP_SHARED | MAP_FIXED, fd, 0); if (m2 == MAP_FAILED) {+ int saved_errno = errno; munmap(base, size * 2);- close(fd);- return -1;+ errno = saved_errno;+ return fail_close(fd); } close(fd); /* mappings keep the memfd alive */@@ -92,6 +119,8 @@ return 0; } +/* Idempotent for one struct: clears base/size, so a second call on the+ * same struct is a no-op. A copy of the struct is NOT protected. */ void hs_ring_destroy(struct hs_ring *ring) { if (ring && ring->base) { munmap(ring->base, ring->size * 2);
cbits/magic_ring_posix.c view
@@ -9,15 +9,20 @@ #include <stdatomic.h> #include "magic_ring.h" -static long cached_page_size = 0;+/* Filled lazily. Several capabilities can call in at once, so the cache is+ * an atomic: every racer stores the same value, relaxed order suffices. */+static _Atomic long cached_page_size = 0; long hs_page_size(void) {- if (cached_page_size == 0) {- cached_page_size = sysconf(_SC_PAGESIZE);+ long ps = atomic_load_explicit(&cached_page_size, memory_order_relaxed);+ if (ps == 0) {+ ps = sysconf(_SC_PAGESIZE);+ atomic_store_explicit(&cached_page_size, ps, memory_order_relaxed); }- return cached_page_size;+ return ps; } +/* Round up to the next power of two >= val, for 1 <= val <= RING_MAX_SIZE. */ static size_t next_pow2(size_t val) { val--; val |= val >> 1;@@ -25,13 +30,53 @@ val |= val >> 4; val |= val >> 8; val |= val >> 16;+#if SIZE_MAX > 0xFFFFFFFFu val |= val >> 32;+#endif val++; return val; } +/* Largest ring. A ring is mapped twice, so 2N has to fit the address+ * space, off_t and the Haskell Int that receives the size; 4 GiB (1 GiB+ * on a 32-bit target) is already far beyond any use, since these are+ * network buffers of KiB to MiB. Capping well below SIZE_MAX / 2 means+ * an absurd request (including what a negative Haskell Int converts to)+ * fails with ENOMEM before any mapping, rather than relying on mmap to+ * reject a multi-exabyte reservation. */+#if SIZE_MAX > 0xFFFFFFFFu+#define RING_MAX_SIZE ((size_t)1 << 32)+#else+#define RING_MAX_SIZE ((size_t)1 << 30)+#endif++/* Digits of v appended to p (at most 20); returns the count. */+static size_t wf_dec_u64(char *p, uint64_t v) {+ char tmp[20];+ size_t n = 0;+ do {+ tmp[n++] = (char)('0' + v % 10);+ v /= 10;+ } while (v);+ for (size_t k = 0; k < n; k++) p[k] = tmp[n - 1 - k];+ return n;+}++/* Close fd on an error path without clobbering the errno being reported. */+static int fail_close(int fd) {+ int saved_errno = errno;+ close(fd);+ errno = saved_errno;+ return -1;+}+ #if !defined(__FreeBSD__) || !defined(SHM_ANON) static _Atomic long shm_counter = 0;++/* A name left behind by a process that died between shm_open and+ * shm_unlink (and whose pid has been reused) makes O_EXCL fail with+ * EEXIST; move on to the next counter value rather than fail. */+#define SHM_OPEN_ATTEMPTS 16 #endif int hs_ring_create(size_t requested, struct hs_ring *out) {@@ -41,6 +86,10 @@ void *base, *m1, *m2; int saved_errno; + if (requested > RING_MAX_SIZE) {+ errno = ENOMEM;+ return -1;+ } if (requested < (size_t)ps) requested = (size_t)ps; @@ -50,42 +99,44 @@ #if defined(__FreeBSD__) && defined(SHM_ANON) fd = shm_open(SHM_ANON, O_RDWR, 0600); #else- {+ for (int attempt = 0;; attempt++) {+ /* "/wfring.<pid>.<counter>" built directly: the shape is fixed,+ * and snprintf's fortified size check folds to a constant branch+ * that coverage cannot account for. */ char name[64];- snprintf(name, sizeof(name), "/wfring.%d.%ld",- getpid(), atomic_fetch_add(&shm_counter, 1));+ size_t k = 8;+ memcpy(name, "/wfring.", 8);+ k += wf_dec_u64(name + k, (uint64_t)getpid());+ name[k++] = '.';+ k += wf_dec_u64(name + k, (uint64_t)atomic_fetch_add(&shm_counter, 1));+ name[k] = '\0'; fd = shm_open(name, O_RDWR | O_CREAT | O_EXCL, 0600);- if (fd >= 0)+ if (fd >= 0) { shm_unlink(name);+ break;+ }+ if (errno != EEXIST || attempt + 1 >= SHM_OPEN_ATTEMPTS)+ break; } #endif if (fd < 0) return -1; - if (ftruncate(fd, (off_t)size) != 0) {- saved_errno = errno;- close(fd);- errno = saved_errno;- return -1;- }+ if (ftruncate(fd, (off_t)size) != 0)+ return fail_close(fd); base = mmap(NULL, size * 2, PROT_NONE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);- if (base == MAP_FAILED) {- saved_errno = errno;- close(fd);- errno = saved_errno;- return -1;- }+ if (base == MAP_FAILED)+ return fail_close(fd); m1 = mmap(base, size, PROT_READ | PROT_WRITE, MAP_SHARED | MAP_FIXED, fd, 0); if (m1 == MAP_FAILED) { saved_errno = errno; munmap(base, size * 2);- close(fd); errno = saved_errno;- return -1;+ return fail_close(fd); } m2 = mmap((char *)base + size, size, PROT_READ | PROT_WRITE,@@ -93,9 +144,8 @@ if (m2 == MAP_FAILED) { saved_errno = errno; munmap(base, size * 2);- close(fd); errno = saved_errno;- return -1;+ return fail_close(fd); } close(fd);@@ -106,6 +156,8 @@ return 0; } +/* Idempotent for one struct: clears base/size, so a second call on the+ * same struct is a no-op. A copy of the struct is NOT protected. */ void hs_ring_destroy(struct hs_ring *ring) { if (ring && ring->base) { munmap(ring->base, ring->size * 2);
cbits/magic_ring_windows.c view
@@ -2,65 +2,75 @@ #include <windows.h> #include <memoryapi.h>+#include <errno.h> #include <stdint.h>+#include <string.h> #include "magic_ring.h" -static long cached_page_size = 0;+/* Filled lazily; every racer stores the same value. */+static volatile LONG cached_page_size = 0; long hs_page_size(void) {- if (cached_page_size == 0) {+ LONG ps = InterlockedCompareExchange(&cached_page_size, 0, 0);+ if (ps == 0) { SYSTEM_INFO si; GetSystemInfo(&si);- cached_page_size = (long)si.dwAllocationGranularity;+ ps = (LONG)si.dwAllocationGranularity;+ InterlockedExchange(&cached_page_size, ps); }- return cached_page_size;+ return (long)ps; } +/* Largest ring. A ring is mapped twice, so 2N has to fit the address+ * space; 4 GiB (1 GiB on a 32-bit target) is already far beyond any use,+ * since these are network buffers of KiB to MiB. Capping well below+ * SIZE_MAX / 2 means an absurd request fails with ENOMEM before any+ * mapping (and before the size arithmetic below could wrap). */+#define RING_MAX_SIZE ((size_t)1 << (sizeof(size_t) >= 8 ? 32 : 30))++/* Round up to the next power of two >= val, for 1 <= val <= RING_MAX_SIZE. */ static size_t next_pow2(size_t val) { val--;- val |= val >> 1;- val |= val >> 2;- val |= val >> 4;- val |= val >> 8;- val |= val >> 16;-#if defined(_WIN64)- val |= val >> 32;-#endif- val++;- return val;+ for (unsigned s = 1; s < sizeof(size_t) * 8; s <<= 1)+ val |= val >> s;+ return val + 1; } int hs_ring_create(size_t requested, struct hs_ring *out) {- long ps = hs_page_size();+ size_t ps = (size_t)hs_page_size(); size_t size; PVOID placeholder = NULL; HANDLE section = NULL; PVOID view1 = NULL, view2 = NULL; - if (requested < (size_t)ps)- requested = (size_t)ps;+ if (requested > RING_MAX_SIZE) {+ errno = ENOMEM;+ return -1;+ }+ if (requested < ps)+ requested = ps; - size = (requested + (size_t)ps - 1) & ~((size_t)ps - 1);+ size = (requested + ps - 1) & ~(ps - 1); size = next_pow2(size); placeholder = VirtualAlloc2(NULL, NULL, size * 2, MEM_RESERVE | MEM_RESERVE_PLACEHOLDER, PAGE_NOACCESS, NULL, 0);- if (!placeholder)+ if (!placeholder) {+ errno = ENOMEM; return -1;+ } /* Split the placeholder into two halves */ if (!VirtualFree(placeholder, size, MEM_RELEASE | MEM_PRESERVE_PLACEHOLDER)) { VirtualFree(placeholder, 0, MEM_RELEASE);+ errno = ENOMEM; return -1; } section = CreateFileMappingW(INVALID_HANDLE_VALUE, NULL, PAGE_READWRITE,- (DWORD)(size >> 32), (DWORD)(size & 0xFFFFFFFF), NULL);- if (!section) {- VirtualFree(placeholder, 0, MEM_RELEASE);- VirtualFree((char *)placeholder + size, 0, MEM_RELEASE);- return -1;- }+ (DWORD)((unsigned long long)size >> 32), (DWORD)(size & 0xFFFFFFFF), NULL);+ if (!section)+ goto fail; view1 = MapViewOfFile3(section, NULL, placeholder, 0, size, MEM_REPLACE_PLACEHOLDER, PAGE_READWRITE, NULL, 0);@@ -74,18 +84,24 @@ goto fail; } + /* The two views keep the section alive; the handle is no longer needed+ * (and struct hs_ring has no room for it: the Haskell side allocates+ * exactly base + size). */+ CloseHandle(section);+ /* Pre-fault */ memset(view1, 0, size); out->base = view1; out->size = size;- out->section = section; return 0; fail:- CloseHandle(section);+ if (section)+ CloseHandle(section); VirtualFree(placeholder, 0, MEM_RELEASE); VirtualFree((char *)placeholder + size, 0, MEM_RELEASE);+ errno = ENOMEM; return -1; } @@ -93,10 +109,8 @@ if (ring && ring->base) { UnmapViewOfFile(ring->base); UnmapViewOfFile((char *)ring->base + ring->size);- CloseHandle(ring->section); ring->base = NULL; ring->size = 0;- ring->section = NULL; } }
cbits/wireform_hash_simd.c view
@@ -7,7 +7,7 @@ * * Hot loops are written to use SIMDe (`simde/x86/sse2.h`, `simde/x86/sse4.1.h`) * so they compile to AVX2/SSE4 on x86, NEON on ARM, and scalar everywhere- * else. The Haskell side is in Iceberg.SIMD.{Murmur3,XXH64,Roaring}.+ * else. The Haskell side is Wireform.Hash (wireform-core). * * Style mirrors wireform-columnar/cbits/columnar_simd.c. */@@ -54,17 +54,28 @@ return (x << r) | (x >> ((32 - r) & 31)); } -int32_t hs_wf_murmur3_32(const uint8_t *buf, int32_t len)+/* Murmur3 x86_32, seed 0, of buf[0, len).+ *+ * len is a byte count (size_t), so a ByteString over 2 GiB is hashed in+ * full; it is never narrowed. buf may be NULL when len == 0 (an empty+ * ByteString). Reads exactly buf[0, len). i is a byte position with+ * 0 <= i <= len, and the bounds are written as len - i, which is exact+ * and cannot wrap for any size_t length. The length also enters the+ * finalizer as a uint32, as the reference algorithm specifies, so two+ * lengths that differ by a multiple of 2^32 produce the same digest. */+int32_t hs_wf_murmur3_32(const uint8_t *buf, size_t len) { const uint32_t c1 = MURMUR_C1; const uint32_t c2 = MURMUR_C2; uint32_t h = 0;- int32_t i = 0;+ size_t i = 0; /* Body: 4-byte blocks. We unroll 4 lanes at a time (16 bytes per iter) * because the kernel is dominated by integer multiplies and rotates,- * which run independently on the typical CPU pipeline. */- for (; i + 16 <= len; i += 16) {+ * which run independently on the typical CPU pipeline. The bounds are+ * written as len - i (0 <= i <= len) so they are exact at any length,+ * including the old INT32_MAX overflow point and above it. */+ for (; len - i >= 16; i += 16) { uint32_t k0 = hs_load_le32(buf + i); uint32_t k1 = hs_load_le32(buf + i + 4); uint32_t k2 = hs_load_le32(buf + i + 8);@@ -78,7 +89,7 @@ k3 = (hs_rotl32(k3 * c1, 15)) * c2; h = (hs_rotl32(h ^ k3, 13)) * 5 + 0xe6546b64u; }- for (; i + 4 <= len; i += 4) {+ for (; len - i >= 4; i += 4) { uint32_t k = hs_load_le32(buf + i); k = (hs_rotl32(k * c1, 15)) * c2; h = (hs_rotl32(h ^ k, 13)) * 5 + 0xe6546b64u;@@ -86,7 +97,7 @@ /* Tail */ uint32_t k1 = 0;- int32_t tail = len - i;+ size_t tail = len - i; if (tail == 3) { k1 = (uint32_t)buf[i] | ((uint32_t)buf[i + 1] << 8) |@@ -101,7 +112,8 @@ h ^= k1; } - /* Finalize */+ /* Finalize. The reference algorithm folds in the length as a uint32,+ * so this cast is the specification, not a truncation bug. */ h ^= (uint32_t)len; h ^= h >> 16; h *= 0x85ebca6bu;@@ -111,9 +123,16 @@ return (int32_t)h; } -/* Inline 8-byte (long) bucket: avoid a tiny memcpy + function call. */+/* Inline 8-byte (long) bucket: avoid a tiny memcpy + function call.+ *+ * `buckets` stays int32_t on purpose. It is Iceberg's bucket[N] count from+ * table metadata, a small transform parameter rather than a buffer size;+ * the Haskell wrapper narrows N to Int32 (documented there), so a count+ * >= 2^31 arrives here as 0 or negative and returns 0 rather than dividing+ * by zero. Widening it would buy nothing a real table can reach. */ int32_t hs_wf_bucket_long(int64_t value, int32_t buckets) {+ if (buckets <= 0) return 0; uint8_t buf[8]; uint64_t u = (uint64_t)value; buf[0] = (uint8_t)(u);@@ -160,25 +179,30 @@ return acc; } -uint64_t hs_wf_xxh64(const uint8_t *buf, int64_t len, uint64_t seed)+/* len is a byte count (size_t) and is neither narrowed nor sign-checked;+ * the caller passes a ByteString length, which cannot be negative. buf+ * may be NULL when len == 0 (an empty ByteString) and hashes the empty+ * input. Reads exactly buf[0, len). Offsets are tracked as indices so no+ * pointer is formed past buf + len (or from NULL). */+uint64_t hs_wf_xxh64(const uint8_t *buf, size_t len, uint64_t seed) {- const uint8_t *p = buf;- const uint8_t *end = buf + len;+ const size_t n = len;+ size_t i = 0; uint64_t h64; - if (len >= 32) {- const uint8_t *limit = end - 32;+ if (n >= 32) { uint64_t v1 = seed + XXH_PRIME64_1 + XXH_PRIME64_2; uint64_t v2 = seed + XXH_PRIME64_2; uint64_t v3 = seed + 0; uint64_t v4 = seed - XXH_PRIME64_1; do {- v1 = xxh_round(v1, hs_load_le64(p)); p += 8;- v2 = xxh_round(v2, hs_load_le64(p)); p += 8;- v3 = xxh_round(v3, hs_load_le64(p)); p += 8;- v4 = xxh_round(v4, hs_load_le64(p)); p += 8;- } while (p <= limit);+ v1 = xxh_round(v1, hs_load_le64(buf + i));+ v2 = xxh_round(v2, hs_load_le64(buf + i + 8));+ v3 = xxh_round(v3, hs_load_le64(buf + i + 16));+ v4 = xxh_round(v4, hs_load_le64(buf + i + 24));+ i += 32;+ } while (n - i >= 32); h64 = xxh_rotl64(v1, 1) + xxh_rotl64(v2, 7) + xxh_rotl64(v3, 12) + xxh_rotl64(v4, 18);@@ -190,23 +214,23 @@ h64 = seed + XXH_PRIME64_5; } - h64 += (uint64_t)len;+ h64 += (uint64_t)n; - while (p + 8 <= end) {- uint64_t k1 = xxh_round(0, hs_load_le64(p));+ while (n - i >= 8) {+ uint64_t k1 = xxh_round(0, hs_load_le64(buf + i)); h64 ^= k1; h64 = xxh_rotl64(h64, 27) * XXH_PRIME64_1 + XXH_PRIME64_4;- p += 8;+ i += 8; }- while (p + 4 <= end) {- h64 ^= (uint64_t)hs_load_le32(p) * XXH_PRIME64_1;+ if (n - i >= 4) {+ h64 ^= (uint64_t)hs_load_le32(buf + i) * XXH_PRIME64_1; h64 = xxh_rotl64(h64, 23) * XXH_PRIME64_2 + XXH_PRIME64_3;- p += 4;+ i += 4; }- while (p < end) {- h64 ^= (uint64_t)(*p) * XXH_PRIME64_5;+ while (i < n) {+ h64 ^= (uint64_t)buf[i] * XXH_PRIME64_5; h64 = xxh_rotl64(h64, 11) * XXH_PRIME64_1;- p++;+ i++; } h64 ^= h64 >> 33;@@ -232,22 +256,35 @@ * The Haskell side produces only ARRAY containers when packing deletion * vectors, so this kernel is fast-pathed for them. BITSET containers are * decoded with a SIMDe popcount-for-bit-extraction loop.+ *+ * Widths: the kernel below has no byte length parameters, only element+ * counts (`cardinality`). Those stay int32_t deliberately. A container is+ * bounded by the format (ARRAY holds at most 4096 distinct 16-bit lows,+ * BITSET at most 65536), so a count that needs more than 31 bits cannot+ * arise from a real container, and the Haskell wrappers additionally+ * clamp untrusted counts to the payload size. Widening them would change+ * the Haskell vector signatures without removing a reachable truncation. * ============================================================ */ /* Decode an ARRAY container of @cardinality@ uint16 values starting at * @src@ and write them, OR'd with @hi << 16@, into @dst[0..cardinality)@.- * Returns the number of bytes consumed (always cardinality * 2). */+ * Contract: src holds 2 * cardinality bytes, dst holds cardinality int32+ * (the Haskell wrapper clamps cardinality to the payload length).+ * cardinality <= 0 touches nothing. Returns the number of bytes consumed,+ * cardinality * 2 (computed modulo 2^32). */ int32_t hs_wf_roaring_decode_array( const uint8_t *src, int32_t cardinality, uint32_t hi, int32_t *dst) {- int32_t i = 0;+ const size_t n = cardinality > 0 ? (size_t)cardinality : 0;+ const uint32_t base = hi << 16;+ size_t i = 0; /* SIMDe path: load 8 uint16 lanes, expand to 8 uint32, OR with hi. * 16 bytes in -> 32 bytes out per iteration. */- simde__m128i hiv = simde_mm_set1_epi32((int32_t)hi);- for (; i + 8 <= cardinality; i += 8) {+ simde__m128i hiv = simde_mm_set1_epi32((int32_t)base);+ for (; n - i >= 8; i += 8) { simde__m128i lows = simde_mm_loadu_si128((const simde__m128i *)(src + i * 2)); /* Expand low half to 32-bit lanes */@@ -260,12 +297,12 @@ simde_mm_storeu_si128((simde__m128i *)(dst + i), out0); simde_mm_storeu_si128((simde__m128i *)(dst + i + 4), out1); }- for (; i < cardinality; i++) {+ for (; i < n; i++) { uint16_t lo; memcpy(&lo, src + i * 2, 2);- dst[i] = (int32_t)(((uint32_t)lo) | hi);+ dst[i] = (int32_t)(((uint32_t)lo) | base); }- return cardinality * 2;+ return (int32_t)(2u * (uint32_t)cardinality); } /* Decode a BITSET container (8192 bytes = 65536 bits) into the destination@@ -282,12 +319,13 @@ uint32_t hi, int32_t *dst) {+ const uint32_t base = hi << 16; int32_t out = 0; for (int word = 0; word < 1024; word++) { uint64_t w = hs_load_le64(src + word * 8); while (w) { int bit = __builtin_ctzll(w);- dst[out++] = (int32_t)((hi & 0xffff0000u) | ((uint32_t)(word * 64 + bit)));+ dst[out++] = (int32_t)(base | ((uint32_t)(word * 64 + bit))); w &= w - 1; } }@@ -298,8 +336,11 @@ * We accept a single container at a time so the Haskell caller decides which * bucket (high16) to look up first. *- * @kind = 0 -> ARRAY: src is a sorted vector of uint16 lows * @kind = 1 -> BITSET: src is exactly 8192 bytes+ * @kind = anything else -> ARRAY: src is a sorted vector of @cardinality@+ * uint16 lows (2 * cardinality bytes); cardinality <= 0 is empty.+ * Unsorted input can yield a false negative, never a false positive or+ * a read outside the 2 * cardinality bytes. * * @value16 is the 16-bit low half of the position to test. Returns 1 if * present, 0 otherwise. */@@ -341,7 +382,7 @@ while (lo <= hi_) { int32_t mid = lo + ((hi_ - lo) >> 1); uint16_t v;- memcpy(&v, src + mid * 2, 2);+ memcpy(&v, src + (size_t)mid * 2, 2); if (v == value16) return 1; if (v < value16) lo = mid + 1; else hi_ = mid - 1;@@ -351,15 +392,18 @@ /* Bulk encode a sorted uint16 vector into an ARRAY container. The caller * already determined cardinality; we just unpack into the buffer. SIMDe- * memcpy lanes give it a small boost over scalar. Returns bytes written. */+ * memcpy lanes give it a small boost over scalar. Returns bytes written.+ * cardinality <= 0 writes nothing (and keeps a NULL src/dst away from+ * memcpy, which an empty Storable vector may hand over). */ int32_t hs_wf_roaring_encode_array( const uint16_t *src, int32_t cardinality, uint8_t *dst) {+ if (cardinality <= 0) return 0; /* aligned uint16 -> bytes is just memcpy. */ memcpy(dst, src, (size_t)cardinality * 2);- return cardinality * 2;+ return (int32_t)(2u * (uint32_t)cardinality); } /* Encode a sorted uint16 vector into a BITSET container (8192 bytes). */
include/magic_ring.h view
@@ -3,16 +3,39 @@ #include <stddef.h> +/*+ * A "magic" ring: `size` bytes of memory mapped twice, back to back, at+ * base[0, size) and base[size, 2*size), so byte i and byte i + size are+ * the same byte and any window of up to `size` bytes starting inside the+ * first copy is contiguous.+ */ struct hs_ring { void *base; size_t size;-#ifdef _WIN32- void *section; /* HANDLE */-#endif }; +/* System page size (the allocation granularity on Windows). Thread-safe. */ long hs_page_size(void);++/*+ * Map a ring of at least `requested` bytes. The size is rounded up to a+ * page multiple and then to a power of two (minimum one page), so+ * `size - 1` is an index mask. A ring is mapped twice, so 2 * size must+ * fit the address space; a request above 4 GiB (1 GiB on a 32-bit+ * target), which includes the huge values a negative Haskell Int+ * converts to, fails with ENOMEM before anything is mapped. Returns 0+ * and fills *out on success; returns -1 with errno set and leaves *out+ * untouched on failure. The memory starts zeroed. Thread-safe; leaks no+ * descriptors.+ */ int hs_ring_create(size_t requested, struct hs_ring *out);++/*+ * Unmap both copies. NULL and a struct with base == NULL are no-ops; the+ * struct is cleared, so destroying the SAME struct twice is safe. Calling+ * it on a copy of an already destroyed struct unmaps whatever now lives at+ * that address: the caller must ensure each ring is destroyed once.+ */ void hs_ring_destroy(struct hs_ring *ring); #endif
src/Wireform/Base64.hs view
@@ -72,18 +72,31 @@ {- | Number of base64 characters produced for an input of @n@ bytes (including @=@ padding).++The C kernel takes a 'CInt' length, so an input longer than+'maxEncodeInput' raises the same error 'encodeBase64' does rather than+silently returning a wrong length; @n < 0@ asks the kernel, which+returns 0. -} encodeBase64Length :: Int -> Int-encodeBase64Length = fromIntegral . c_base64_encoded_length . fromIntegral+encodeBase64Length n+ | n > maxEncodeInput = errorWithoutStackTrace encodeTooLong+ | otherwise = fromIntegral (c_base64_encoded_length (fromIntegral n)) {-# INLINE encodeBase64Length #-} {- | Upper bound on the number of bytes produced when decoding @n@ input characters. The actual decoded length is shorter by the number of trailing @=@ characters.++Inputs longer than @maxBound :: CInt@ raise an error, like+'encodeBase64Length' does above 'maxEncodeInput'; 'decodeBase64'+returns 'Nothing' for such inputs instead. -} decodeBase64MaxLength :: Int -> Int-decodeBase64MaxLength = fromIntegral . c_base64_decoded_max_length . fromIntegral+decodeBase64MaxLength n+ | n > fromIntegral (maxBound :: CInt) = errorWithoutStackTrace decodeTooLong+ | otherwise = fromIntegral (c_base64_decoded_max_length (fromIntegral n)) {-# INLINE decodeBase64MaxLength #-} @@ -94,18 +107,39 @@ {- | Encode a 'ByteString' to RFC 4648 \u00a74 base64 (with @=@ padding). One allocation of the exact output length, one SIMD pass.++The C kernel works in 'CInt' lengths, so the input may be at most+@3 * (maxBound :: CInt) \`quot\` 4@ bytes (about 1.5 GiB); larger+inputs raise an error instead of being silently truncated. -} encodeBase64 :: ByteString -> ByteString-encodeBase64 bs = unsafePerformIO $ do- let !inLen = BS.length bs- !outLen = encodeBase64Length inLen- BSI.create outLen $ \outPtr ->- BSU.unsafeUseAsCStringLen bs $ \(inPtr, _) -> do- _ <- c_base64_encode (castPtr inPtr) (fromIntegral inLen) outPtr- pure ()+encodeBase64 bs+ | BS.length bs > maxEncodeInput = errorWithoutStackTrace encodeTooLong+ | otherwise = unsafePerformIO $ do+ let !inLen = BS.length bs+ !outLen = encodeBase64Length inLen+ BSI.create outLen $ \outPtr ->+ BSU.unsafeUseAsCStringLen bs $ \(inPtr, _) -> do+ _ <- c_base64_encode (castPtr inPtr) (fromIntegral inLen) outPtr+ pure () {-# NOINLINE encodeBase64 #-} +-- | Largest input whose padded encoding length fits in a 'CInt'.+maxEncodeInput :: Int+maxEncodeInput = 3 * (fromIntegral (maxBound :: CInt) `quot` 4)+++encodeTooLong :: String+encodeTooLong =+ "Wireform.Base64: input longer than 3 * (2^31 - 1) / 4 bytes"+++decodeTooLong :: String+decodeTooLong =+ "Wireform.Base64: input longer than 2^31 - 1 bytes"++ ------------------------------------------------------------------------ -- Decode ------------------------------------------------------------------------@@ -117,11 +151,15 @@ Whitespace is /not/ tolerated; strip it before calling if your input is line-wrapped (PEM, MIME, etc.).++Inputs longer than @maxBound :: CInt@ characters (the C kernel's+length type) yield 'Nothing' rather than being silently truncated. -} decodeBase64 :: ByteString -> Maybe ByteString decodeBase64 bs | BS.null bs = Just BS.empty | (BS.length bs .&. 3) /= 0 = Nothing+ | BS.length bs > fromIntegral (maxBound :: CInt) = Nothing | otherwise = unsafePerformIO $ do let !inLen = BS.length bs !maxOut = decodeBase64MaxLength inLen
src/Wireform/Builder/FastBuilder.hs view
@@ -48,8 +48,13 @@ -- * Ring-direct sink (zero-copy builder → send ring) RingSinkState (..),+ RingSpill (..),+ SpillBuf (..), finalizeRingSink, + -- * Exceptions+ FixedBufferOverflow (..),+ -- * Basic builders primBounded, primFixed,@@ -176,8 +181,8 @@ HandleSink !IO.Handle !Int {-next buffer size-} !(IORef Queue) | {- | The buffer has a known-exact size. No 'IORef', no growth. Used by 'toStrictByteStringExact' when the output size is- known in advance. If the builder overflows, behaviour is- undefined (but in practice 'getBytes_' will 'error').+ known in advance. A request that does not fit in what is left+ throws 'FixedBufferOverflow'. -} FixedBuffer | {- | Bytes are accumulated in a buffer, then fed to a streaming@@ -189,7 +194,9 @@ When the builder overflows, the already-written bytes are published to the ring consumer and the builder continues writing into newly-available ring space — no intermediate- 'S.ByteString' allocation or memcpy.+ 'S.ByteString' allocation or memcpy. A single request larger+ than the ring is served from a scratch buffer instead (see+ 'RingSpill'). -} RingSink !(IORef RingSinkState) @@ -271,9 +278,36 @@ {- ^ Read the consumer's current tail position. Used to check whether the ring has room without publishing first. -}+ , rsSpill :: !RingSpill+ {- ^ Scratch buffer for requests larger than the ring. While+ 'SpillActive', the builder's region is the scratch buffer, not+ the ring, and 'rsHead' is the ring position its bytes go to.+ -} } +{- | A pinned scratch buffer and its capacity. Kept across spills+within one builder run so repeated oversized requests reuse it.+-}+data SpillBuf = SpillBuf !(ForeignPtr Word8) {-# UNPACK #-} !Int+++{- | Spill state of a 'RingSink'.++A request for more contiguous bytes than the ring holds cannot be+served from the ring, so 'getBytes_' hands the builder a scratch+buffer instead and marks it active. The next overflow, insert or+'finalizeRingSink' copies the scratch bytes into the ring in+ring-sized chunks and resumes writing into the ring.+-}+data RingSpill+ = NoSpill+ | -- | A scratch buffer from an earlier spill, free for reuse.+ SpillIdle {-# UNPACK #-} !SpillBuf+ | -- | The builder is currently writing into this buffer.+ SpillActive {-# UNPACK #-} !SpillBuf++ {- | Publish the final bytes written by a builder into the ring. After 'runBuilder' returns a final cursor, call this to publish@@ -282,17 +316,104 @@ finalizeRingSink :: IORef RingSinkState -> Ptr Word8 -> IO Word64 finalizeRingSink rsRef finalCur = do rs <- readIORef rsRef- let !off = fromIntegral (rsHead rs) .&. rsMask rs- !startPtr = rsBase rs `plusPtr` off- !written = finalCur `minusPtr` startPtr- !finalHead = rsHead rs + fromIntegral written- -- Publish everything from the last-published position to- -- the builder's final cursor in a single call.- when (finalHead > rsPublished rs) $- rsPublishHead rs finalHead- pure finalHead+ case rsSpill rs of+ SpillActive _ -> do+ -- 'ringCopyIn' publishes as it goes, so nothing is left over.+ rs' <- settleRingSink rs finalCur+ writeIORef rsRef rs'+ pure (rsHead rs')+ _ -> do+ let !off = fromIntegral (rsHead rs) .&. rsMask rs+ !startPtr = rsBase rs `plusPtr` off+ !written = finalCur `minusPtr` startPtr+ !finalHead = rsHead rs + fromIntegral written+ -- Publish everything from the last-published position to+ -- the builder's final cursor in a single call.+ when (finalHead > rsPublished rs) $+ rsPublishHead rs finalHead+ pure finalHead +{- | Fold the builder's cursor back into the ring state. Afterwards+'rsHead' is the ring position just past everything the builder has+written, and no spill is active. An active spill is copied into+the ring (publishing as it goes); otherwise this is pure cursor+arithmetic.+-}+settleRingSink :: RingSinkState -> Ptr Word8 -> IO RingSinkState+settleRingSink rs cur = case rsSpill rs of+ SpillActive buf@(SpillBuf fp _) -> do+ let !base = unsafeForeignPtrToPtr fp+ rs' <- ringCopyIn rs base (cur `minusPtr` base)+ touchForeignPtr fp+ pure rs' {rsSpill = SpillIdle buf}+ _ -> do+ let !off = fromIntegral (rsHead rs) .&. rsMask rs+ !written = cur `minusPtr` (rsBase rs `plusPtr` off)+ pure rs {rsHead = rsHead rs + fromIntegral written}+{-# INLINE settleRingSink #-}+++{- | Copy @len@ bytes from @src@ into the ring at 'rsHead' (which must+be settled). Pending bytes are published first, then each+ring-sized chunk as it lands, so the consumer drains between chunks.+-}+ringCopyIn :: RingSinkState -> Ptr Word8 -> Int -> IO RingSinkState+ringCopyIn rs src len+ | len <= 0 = pure rs+ | otherwise = do+ when (rsHead rs > rsPublished rs) $+ rsPublishHead rs (rsHead rs)+ let !ringSz = rsRingSize rs+ loop !srcOff !hd+ | srcOff >= len = pure hd+ | otherwise = do+ let !chunk = min (len - srcOff) ringSz+ !wh = hd + fromIntegral chunk+ rsEnsureRoom rs wh+ let !dst = rsBase rs `plusPtr` (fromIntegral hd .&. rsMask rs)+ copyBytes dst (src `plusPtr` srcOff) chunk+ rsPublishHead rs wh+ loop (srcOff + chunk) wh+ hd' <- loop 0 (rsHead rs)+ pure rs {rsHead = hd', rsPublished = hd'}+{-# NOINLINE ringCopyIn #-}+++{- | Make @sz@ contiguous bytes at the (settled) 'rsHead' available+to the builder. Publishes pending bytes and waits only when the+consumer's tail says the ring lacks room. Requires+@sz <= rsRingSize@.+-}+openRingRegion :: RingSinkState -> Int -> IO RingSinkState+openRingRegion rs sz = do+ let !wantHead = rsHead rs + fromIntegral sz+ tl <- rsLoadTail rs+ if wantHead - tl <= fromIntegral (rsRingSize rs)+ then pure rs+ else do+ when (rsHead rs > rsPublished rs) $+ rsPublishHead rs (rsHead rs)+ rsEnsureRoom rs wantHead+ pure rs {rsPublished = rsHead rs}+++-- | Ring address of the (settled) 'rsHead'.+ringHeadPtr :: RingSinkState -> Ptr Word8+ringHeadPtr rs = rsBase rs `plusPtr` (fromIntegral (rsHead rs) .&. rsMask rs)+{-# INLINE ringHeadPtr #-}+++{- | A scratch buffer of at least @n@ bytes, reusing the idle one+when it is large enough.+-}+acquireSpill :: RingSpill -> Int -> IO SpillBuf+acquireSpill (SpillIdle buf@(SpillBuf _ cap)) n | cap >= n = pure buf+acquireSpill _ n = do+ fp <- S.mallocByteString n+ pure (SpillBuf fp n)++ {- | A streaming byte transform — middleware that processes chunks as a 'Builder' produces them. Used for compression, encryption, checksumming, or any incremental byte transform.@@ -419,6 +540,22 @@ instance E.Exception SuspendBuilderException +{- | A builder running into a fixed, exact-size buffer (see+'toStrictByteStringExact') asked for more room than was left,+i.e. the caller's size estimate was too small.+-}+data FixedBufferOverflow = FixedBufferOverflow+ { fixedBufferRequested :: !Int+ -- ^ Bytes the builder asked for.+ , fixedBufferAvailable :: !Int+ -- ^ Bytes left in the buffer at that point.+ }+ deriving stock (Show, Eq)+++instance E.Exception FixedBufferOverflow++ ---------------------------------------------------------------- -- Builder building blocks @@ -743,7 +880,8 @@ __Precondition:__ the builder must produce exactly @cap@ bytes. If it produces fewer, the trailing bytes are uninitialised.-If it produces more, behaviour is undefined.+If it asks for more room than is left, it throws+'FixedBufferOverflow'. -} toStrictByteStringExact :: Int -> Builder -> S.ByteString toStrictByteStringExact !sz builder = unsafePerformIO $ do@@ -976,11 +1114,36 @@ to the buffer, regardless of the size. -} byteStringCopy :: S.ByteString -> Builder-byteStringCopy !bstr =- -- TODO: this is suboptimal; should keep using the same buffer size.- ensureBytes (S.length bstr) <> byteStringCopyNoCheck bstr+byteStringCopy !bstr = mkBuilder $ do+ r <- remainingBytes+ if r >= S.length bstr+ then useBuilder $ byteStringCopyNoCheck bstr+ else useBuilder $ byteStringCopySlow_ bstr+{-# INLINE byteStringCopy #-} +{- | Out-of-line overflow path for 'byteStringCopy'.++A 'RingSink' can offer at most @ringSize@ contiguous bytes, so a+copy larger than the ring goes through the insert path, which+copies straight into the ring in chunks. 'getBytes' would also+cope (via its spill buffer) but would copy the bytes twice.+-}+byteStringCopySlow_ :: S.ByteString -> Builder+byteStringCopySlow_ bstr = mkBuilder $ do+ sink <- getSink+ case sink of+ RingSink rsRef -> do+ rs <- io $ readIORef rsRef+ if S.length bstr > rsRingSize rs+ then useBuilder $ byteStringInsert_ bstr+ else useBuilder $ getBytes (S.length bstr) <> byteStringCopyNoCheck bstr+ _ ->+ -- TODO: this is suboptimal; should keep using the same buffer size.+ useBuilder $ getBytes (S.length bstr) <> byteStringCopyNoCheck bstr+{-# NOINLINE byteStringCopySlow_ #-}++ -- | Like 'byteStringCopy', but assumes that the current buffer is large enough. byteStringCopyNoCheck :: S.ByteString -> Builder byteStringCopyNoCheck !bstr = mkBuilder $ do@@ -1024,9 +1187,15 @@ when (r < S.length bstr) $ growBuffer bufRef (S.length bstr) useBuilder $ byteStringCopyNoCheck bstr- FixedBuffer ->- -- FixedBuffer: buffer is exact-sized, so this large insert- -- must still fit. Just copy it in.+ FixedBuffer -> do+ r <- remainingBytes+ when (r < S.length bstr) $+ io $+ E.throwIO+ FixedBufferOverflow+ { fixedBufferRequested = S.length bstr+ , fixedBufferAvailable = r+ } useBuilder $ byteStringCopyNoCheck bstr HandleSink h _nextCap queueRef -> do cur <- getCur@@ -1047,46 +1216,18 @@ setCur (sqBase sq) RingSink rsRef -> do cur <- getCur- rs <- io $ readIORef rsRef- let !off = fromIntegral (rsHead rs) .&. rsMask rs- !startPtr = rsBase rs `plusPtr` off- !written = cur `minusPtr` startPtr- !newHead = rsHead rs + fromIntegral written- !bsLen = S.length bstr- !ringSz = rsRingSize rs- -- Publish accumulated builder bytes before the BS copy.- when (written > 0) $ io $ do- when (newHead > rsPublished rs) $- rsPublishHead rs newHead- -- Copy the BS into the ring, chunking at ringSize if- -- the BS is larger than the ring can hold contiguously.- io $ S.unsafeUseAsCString bstr $ \src -> do- let loop !srcOff !hd !remaining- | remaining <= 0 = pure hd- | otherwise = do- let !chunk = min remaining ringSz- !wh = hd + fromIntegral chunk- rsEnsureRoom rs wh- let !dstOff = fromIntegral hd .&. rsMask rs- !dst = rsBase rs `plusPtr` dstOff- copyBytes dst (castPtr src `plusPtr` srcOff) chunk- rsPublishHead rs wh- loop (srcOff + chunk) wh (remaining - chunk)- afterBs <- loop 0 newHead bsLen- let !pub = afterBs- writeIORef- rsRef- rs- { rsHead = afterBs- , rsPublished = pub- }- -- Set up a fresh region for subsequent builder writes.- rs' <- io $ readIORef rsRef- let !contChunk = min ringSz (rsChunkSize rs')- !contWant = rsHead rs' + fromIntegral contChunk- io $ rsEnsureRoom rs' contWant- let !contOff = fromIntegral (rsHead rs') .&. rsMask rs'- !contPtr = rsBase rs' `plusPtr` contOff+ -- Settle the builder's bytes (flushing any active spill),+ -- copy the BS in ring-sized chunks, then open a fresh+ -- region for subsequent builder writes.+ rs0 <- io $ readIORef rsRef+ let !contChunk = min (rsRingSize rs0) (rsChunkSize rs0)+ contPtr <- io $ do+ rs1 <- settleRingSink rs0 cur+ rs2 <- S.unsafeUseAsCString bstr $ \src ->+ ringCopyIn rs1 (castPtr src) (S.length bstr)+ rs3 <- openRingRegion rs2 contChunk+ writeIORef rsRef rs3+ pure (ringHeadPtr rs3) setCur contPtr setEnd (contPtr `plusPtr` contChunk) {-# NOINLINE byteStringInsert_ #-}@@ -1148,7 +1289,14 @@ BoundedGrowingBuffer fptr bound -> growBufferBounded dRef fptr bound (I# n) GrowingBuffer bufRef -> growBuffer bufRef (I# n)- FixedBuffer -> error "Wireform.Builder: FixedBuffer overflow (size estimate too small)"+ FixedBuffer -> do+ r <- remainingBytes+ io $+ E.throwIO+ FixedBufferOverflow+ { fixedBufferRequested = I# n+ , fixedBufferAvailable = r+ } HandleSink h nextCap queueRef -> do cur <- getCur io $ flushQueue h queueRef cur@@ -1184,53 +1332,24 @@ setEnd (newBase `plusPtr` I# n) RingSink rsRef -> do cur <- getCur- rs <- io $ readIORef rsRef- -- The ring provides at most ringSize contiguous bytes.- -- ensureBytes requests larger than that are a programming- -- error — use byteStringInsert (triggered automatically- -- by byteString / byteStringThreshold) for large payloads.- when (I# n > rsRingSize rs) $- io $- error $- "Wireform.Builder: RingSink getBytes request ("- ++ show (I# n)- ++ ") exceeds ring size ("- ++ show (rsRingSize rs)- ++ "); use byteString/byteStringInsert for large payloads"- let !off = fromIntegral (rsHead rs) .&. rsMask rs- !startPtr = rsBase rs `plusPtr` off- !written = cur `minusPtr` startPtr- !newHead = rsHead rs + fromIntegral written- -- Try to extend without publishing: the ring may already- -- have room beyond what we initially reserved.- let !chunkSz =- min- (rsRingSize rs)- (max (I# n) (rsChunkSize rs))- !wantHead = newHead + fromIntegral chunkSz- tl <- io $ rsLoadTail rs- let !ringCap = fromIntegral (rsRingSize rs) :: Word64- published' <-- if wantHead - tl <= ringCap- then- io $ pure (rsPublished rs)- else do- io $ do- when (newHead > rsPublished rs) $- rsPublishHead rs newHead- rsEnsureRoom rs wantHead- io $ pure newHead- let !newOff = fromIntegral newHead .&. rsMask rs- !newPtr = rsBase rs `plusPtr` newOff- io $- writeIORef- rsRef- rs- { rsHead = newHead- , rsPublished = published'- }- setCur newPtr- setEnd (newPtr `plusPtr` chunkSz)+ rs <- io $ readIORef rsRef >>= \rs0 -> settleRingSink rs0 cur+ if I# n > rsRingSize rs+ then do+ -- No ring region can hold this contiguously: spill into a+ -- scratch buffer; the next settle copies it into the ring.+ buf@(SpillBuf fp cap) <- io $ acquireSpill (rsSpill rs) (I# n)+ io $ writeIORef rsRef rs {rsSpill = SpillActive buf}+ let !base = unsafeForeignPtrToPtr fp+ setCur base+ setEnd (base `plusPtr` cap)+ else do+ -- Offer a full chunk; publish only if the ring lacks room.+ let !chunkSz = min (rsRingSize rs) (max (I# n) (rsChunkSize rs))+ rs' <- io $ openRingRegion rs chunkSz+ io $ writeIORef rsRef rs'+ let !newPtr = ringHeadPtr rs'+ setCur newPtr+ setEnd (newPtr `plusPtr` chunkSz) {-# NOINLINE getBytes_ #-}
src/Wireform/Encode/Direct.hs view
@@ -117,16 +117,27 @@ pokeByteOff p (off + 1) (fromIntegral ((n `shiftR` 7) .&. 0x7F .|. 0x80) :: Word8) pokeByteOff p (off + 2) (fromIntegral (n `shiftR` 14) :: Word8) pure $! off + 3- | otherwise = do- n' <- encodeVarintFieldC p off 0 n- pure $! off + n'+ | otherwise = go off n+ where+ -- Values of 2^21 and up are rare (lengths of 2 MiB+), so a plain loop.+ -- Not encodeVarintFieldC: that writes a field tag byte first.+ go !o !v+ | v < 0x80 = do+ pokeByteOff p o (fromIntegral v :: Word8)+ pure $! o + 1+ | otherwise = do+ pokeByteOff p o (fromIntegral (v .&. 0x7F .|. 0x80) :: Word8)+ go (o + 1) (v `shiftR` 7) {-# INLINE dVarint #-} -- | Write raw bytes at offset (no length prefix). Returns new offset. dBytes :: Ptr Word8 -> Int -> ByteString -> IO Int dBytes !p !off (BSI.BS fp len) = do- withForeignPtr fp $ \src ->+ -- This continuation only performs a bounded copy: it cannot loop or+ -- throw a Haskell exception. The touch-based lifetime wrapper therefore+ -- suffices and avoids a keepAlive# continuation allocation per string.+ BSI.unsafeWithForeignPtr fp $ \src -> copyBytes (p `plusPtr` off) src len pure $! off + len {-# INLINE dBytes #-}
src/Wireform/FFI.hs view
@@ -20,6 +20,14 @@ * 'compareBounds' \/ 'compareBoundsBS' — Iceberg partition bounds comparison * 'validateArrowBuffers' — Arrow IPC buffer offset validation * @read\/writeBE\/LE@ — endianness conversion helpers++Widths: every length and offset crosses the FFI at its full width, so a+'ByteString' or encode buffer over 2 GiB is not silently truncated. Byte+counts, capacities and reported counts are 'CSize' (\'size_t\'); positions+into a buffer, write cursors and scanner results are 'CPtrdiff'+(\'ptrdiff_t\'), which also carries the @-1@ / @len@ miss conventions.+Only genuinely small values (booleans, byte counts like bytes consumed,+the 32-bit bounds bitmask) stay 'CInt'. -} module Wireform.FFI ( -- * Packed varint helpers@@ -105,7 +113,7 @@ import Data.Text (Text) import Data.Text.Encoding qualified as TE import Data.Word (Word16, Word32, Word64, Word8, byteSwap16, byteSwap32, byteSwap64)-import Foreign.C.Types (CInt (..))+import Foreign.C.Types (CInt (..), CPtrdiff (..), CSize (..)) import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Alloc qualified import Foreign.Marshal.Array qualified@@ -116,40 +124,52 @@ import Wireform.Builder qualified as B +-- (byte count, varint count): both can exceed INT_MAX. foreign import ccall unsafe "hs_proto_count_packed_varints"- c_count_packed_varints :: Ptr () -> CInt -> CInt+ c_count_packed_varints :: Ptr () -> CSize -> CSize +-- (byte count), boolean result. foreign import ccall unsafe "hs_proto_packed_all_single_byte"- c_packed_all_single_byte :: Ptr () -> CInt -> CInt+ c_packed_all_single_byte :: Ptr () -> CSize -> CInt +-- (byte count), boolean result. foreign import ccall unsafe "hs_proto_validate_utf8_fast"- c_validate_utf8_fast :: Ptr () -> CInt -> CInt+ c_validate_utf8_fast :: Ptr () -> CSize -> CInt +-- (position), bytes consumed (1..8, or 0 on overflow). foreign import ccall unsafe "hs_proto_decode_varint_swar"- c_decode_varint_swar :: Ptr () -> CInt -> Ptr Word64 -> CInt+ c_decode_varint_swar :: Ptr () -> CPtrdiff -> Ptr Word64 -> CInt +-- (byte count, destination capacity), 1/0/-1 decision. foreign import ccall unsafe "hs_proto_relocate_page_boundary"- c_relocate_page_boundary :: Ptr () -> CInt -> Ptr () -> CInt -> CInt+ c_relocate_page_boundary :: Ptr () -> CSize -> Ptr () -> CSize -> CInt +-- (write cursor, byte count), bytes written. foreign import ccall unsafe "hs_proto_encode_length_delimited"- c_encode_length_delimited :: Ptr () -> CInt -> Word8 -> Ptr () -> CInt -> CInt+ c_encode_length_delimited :: Ptr () -> CSize -> Word8 -> Ptr () -> CSize -> CSize +-- (write cursor), bytes written. foreign import ccall unsafe "hs_proto_encode_varint_field"- c_encode_varint_field :: Ptr () -> CInt -> Word8 -> Word64 -> CInt+ c_encode_varint_field :: Ptr () -> CSize -> Word8 -> Word64 -> CSize +-- (write cursor), bytes written. foreign import ccall unsafe "hs_proto_encode_bool_field"- c_encode_bool_field :: Ptr () -> CInt -> Word8 -> CInt -> CInt+ c_encode_bool_field :: Ptr () -> CSize -> Word8 -> CInt -> CSize {- | Count the number of varints in a packed buffer using SWAR. Each byte with its high bit clear terminates one varint.++Both the length and the count cross the FFI at full width ('CSize'), so a+packed run over 2 GiB is counted whole, even when its count passes+'Prelude.maxBound' @::@ 'CInt'. -} countPackedVarints :: ByteString -> Int countPackedVarints bs = unsafePerformIO $@@ -168,7 +188,12 @@ {-# INLINE packedAllSingleByte #-} --- | Encode a length-delimited field (tag + length varint + data) in one C call.+{- | Encode a length-delimited field (tag + length varint + data) in one C call.++@off@ is a non-negative write cursor and @dataLen@ a byte count; both are+passed as 'CSize' (the C @off@/return are \'size_t\'), so a direct-encode+buffer or a single field over 2 GiB is written whole.+-} encodeLengthDelimitedC :: Ptr Word8 -> Int -> Word8 -> Ptr Word8 -> Int -> IO Int encodeLengthDelimitedC buf off tag dataPtr dataLen = pure $!@@ -251,7 +276,11 @@ (castPtr outBuf) (fromIntegral outLen) if result == 1- then BS.packCStringLen (outBuf, len)+ then do+ -- packCStringLen copies; the scratch buffer is ours to free.+ copied <- BS.packCStringLen (outBuf, len)+ Foreign.Marshal.Alloc.free outBuf+ pure copied else do Foreign.Marshal.Alloc.free outBuf pure bs@@ -262,8 +291,9 @@ -- SIMD NUL scanner ------------------------------------------------------------------------ +-- (start position, buffer length): both indices, so CPtrdiff; -1 on a miss. foreign import ccall unsafe "hs_proto_find_nul"- c_find_nul :: Ptr () -> CInt -> CInt -> CInt+ c_find_nul :: Ptr () -> CPtrdiff -> CPtrdiff -> CPtrdiff {- | Find the first NUL byte starting at the given offset within a raw pointer.@@ -291,13 +321,17 @@ absolute offset (0-based from the start of @buf@) of the first match, or @len@ if no match was found. +Both @offset@ and @len@ are indices into @buf@ and cross the FFI as+'CPtrdiff', so a 'ByteString' or scan range over 2 GiB is scanned whole+and a miss reports the real @len@ instead of a wrapped value.+ Callers that prefer @Maybe Int@ semantics should wrap the result; the @len@-on-miss convention matches the existing CSV / NDJSON / XML call sites that reused the primitive before it was lifted here. -} foreign import ccall unsafe "hs_find_byte"- c_find_byte :: Ptr () -> CInt -> CInt -> Word8 -> CInt+ c_find_byte :: Ptr () -> CPtrdiff -> CPtrdiff -> Word8 -> CPtrdiff findByte :: Ptr Word8 -> Int -> Int -> Word8 -> Int@@ -324,8 +358,9 @@ -- 4-byte repeating-key XOR (WebSocket masking) ------------------------------------------------------------------------ +-- (byte count), in place. foreign import ccall unsafe "hs_ws_mask"- c_ws_mask :: Ptr Word8 -> CInt -> Word32 -> IO ()+ c_ws_mask :: Ptr Word8 -> CSize -> Word32 -> IO () {- | In-place XOR of the 4-byte repeating @key@ over @buf[0..len)@.@@ -369,8 +404,10 @@ OS thread's xoshiro256++ generator. State is per-OS-thread (@__thread@), seeded from @getrandom(2)@-(@arc4random_buf@ on BSDs, @\/dev\/urandom@ everywhere else) on-first use. Once seeded, each call is a handful of register-only+(@arc4random_buf@ on macOS and the BSDs, @BCryptGenRandom@ on+Windows, @\/dev\/urandom@ elsewhere) on first use, and reseeded in+the child after @fork@ so parent and child never share a stream.+Once seeded, each call is a handful of register-only arithmetic ops — typically ~1 ns including the FFI boundary, versus ~50 ns for the global @splitmix@ generator that takes an @MVar@ on every call.@@ -393,8 +430,9 @@ -- SIMD ASCII check ------------------------------------------------------------------------ +-- (position, byte count from there), boolean result. foreign import ccall unsafe "hs_proto_is_ascii"- c_is_ascii :: Ptr () -> CInt -> CInt -> CInt+ c_is_ascii :: Ptr () -> CPtrdiff -> CPtrdiff -> CInt -- | Check if @len@ bytes starting at @ptr+offset@ are all ASCII.@@ -429,8 +467,9 @@ -- SIMD JSON escape scanner ------------------------------------------------------------------------ +-- (position, byte count from there), position or offset+len: CPtrdiff. foreign import ccall unsafe "hs_proto_find_json_escape"- c_find_json_escape :: Ptr () -> CInt -> CInt -> CInt+ c_find_json_escape :: Ptr () -> CPtrdiff -> CPtrdiff -> CPtrdiff {- | Find the first byte that needs JSON escaping (control char < 0x20,@@ -506,8 +545,9 @@ -- SIMD EDN whitespace skipper ------------------------------------------------------------------------ +-- (start position, buffer length), position: CPtrdiff throughout. foreign import ccall unsafe "hs_proto_skip_ws"- c_skip_ws :: Ptr () -> CInt -> CInt -> CInt+ c_skip_ws :: Ptr () -> CPtrdiff -> CPtrdiff -> CPtrdiff {- | Skip EDN whitespace (space, tab, newline, CR, comma) and comments@@ -532,26 +572,44 @@ -- SIMD Iceberg bounds comparison ------------------------------------------------------------------------ +-- (count, width in bytes), 32-bit bitmask result. foreign import ccall unsafe "hs_proto_compare_bounds"- c_compare_bounds :: Ptr () -> CInt -> CInt -> Ptr () -> CInt+ c_compare_bounds :: Ptr () -> CSize -> CSize -> Ptr () -> CInt {- | Compare a search value against N serialized bounds (all same width). Returns a bitmask where bit i is set if @bounds[i] <= search@. For 4-byte LE int32 bounds, uses SSE2 to compare 4 at a time.++@count@ and @width@ are counts, not offsets, and must be non-negative:+they cross the FFI as 'CSize', so a negative value would become a huge+count; it is rejected here with an empty mask instead. @width == 0@+means empty bounds, which compare equal to the search value. -} compareBounds :: Ptr Word8 -> Int -> Int -> Ptr Word8 -> Int-compareBounds !boundsPtr !count !width !searchPtr =- fromIntegral (c_compare_bounds (castPtr boundsPtr) (fromIntegral count) (fromIntegral width) (castPtr searchPtr))+compareBounds !boundsPtr !count !width !searchPtr+ | count < 0 || width < 0 = 0+ | otherwise =+ fromIntegral (c_compare_bounds (castPtr boundsPtr) (fromIntegral count) (fromIntegral width) (castPtr searchPtr)) {-# INLINE compareBounds #-} --- | Compare bounds stored in a 'ByteString' against a search value 'ByteString'.+-- | Compare bounds stored in a 'ByteString' against a search value+-- 'ByteString'.+--+-- @count@ and @width@ are clamped to what the buffers actually hold, so a+-- caller that passes an inconsistent count cannot make the kernel read+-- past either buffer (the kernel trusts them: it compares @count*width@+-- bytes and reads @width@ from the search value). compareBoundsBS :: ByteString -> Int -> Int -> ByteString -> Int-compareBoundsBS boundsBs count width searchBs = unsafePerformIO $- BSU.unsafeUseAsCStringLen boundsBs $ \(bPtr, _) ->- BSU.unsafeUseAsCStringLen searchBs $ \(sPtr, _) ->- pure $! compareBounds (castPtr bPtr) count width (castPtr sPtr)+compareBoundsBS boundsBs count width searchBs =+ let !w = max 0 (min width (BS.length searchBs))+ !fits = if w == 0 then 0 else BS.length boundsBs `quot` w+ !n = max 0 (min count fits)+ in unsafePerformIO $+ BSU.unsafeUseAsCStringLen boundsBs $ \(bPtr, _) ->+ BSU.unsafeUseAsCStringLen searchBs $ \(sPtr, _) ->+ pure $! compareBounds (castPtr bPtr) n w (castPtr sPtr) {-# INLINE compareBoundsBS #-} @@ -560,17 +618,32 @@ ------------------------------------------------------------------------ foreign import ccall unsafe "hs_proto_validate_arrow_buffers"- c_validate_arrow_buffers :: Ptr () -> CInt -> Int64 -> CInt+ c_validate_arrow_buffers :: Ptr () -> CSize -> Int64 -> CInt +foreign import ccall safe "hs_proto_validate_arrow_buffers"+ c_validate_arrow_buffers_safe :: Ptr () -> CSize -> Int64 -> CInt + {- | Validate Arrow IPC buffer offset/length pairs. Buffers are pairs of @(offset :: Int64, length :: Int64)@ packed contiguously. Returns 'True' if all offsets/lengths are non-negative, within body_length, and non-overlapping.++The kernel is one linear pass over the pairs (16 bytes each). Like the+"Columnar.SIMD" kernels it uses an @unsafe@ call for at most 64 KiB of+input (4096 buffers, far more than a record batch normally has) and a+@safe@ call above that, so a hostile buffer table cannot hold up the RTS.++@count@ is the number of pairs and crosses the FFI as 'CSize'; a negative+@count@ or body length is a caller bug that would otherwise widen into a+huge count, so both are rejected as invalid here instead of reaching the+kernel. -} validateArrowBuffers :: Ptr Int64 -> Int -> Int64 -> Bool-validateArrowBuffers !ptr !count !bodyLength =- c_validate_arrow_buffers (castPtr ptr) (fromIntegral count) bodyLength /= 0+validateArrowBuffers !ptr !count !bodyLength+ | count < 0 || bodyLength < 0 = False+ | count <= 4096 = c_validate_arrow_buffers (castPtr ptr) (fromIntegral count) bodyLength /= 0+ | otherwise = c_validate_arrow_buffers_safe (castPtr ptr) (fromIntegral count) bodyLength /= 0 {-# INLINE validateArrowBuffers #-}
src/Wireform/Hash.hs view
@@ -17,6 +17,12 @@ The implementations live in @cbits/wireform_hash_simd.c@. All entry points are 'unsafePerformIO' / 'unsafeDupablePerformIO' wrapped so callers don't think about IO.++Byte counts ('murmur3_32', 'xxh64') cross the FFI as 'CSize' (@size_t@),+so a 'BS.ByteString' of any length on a 64-bit platform is hashed in+full rather than truncated at 2^31. The Roaring kernels take element+counts instead, which the container format bounds far below 2^31 (see+'arrayCard'), so those stay 'Int32'. -} module Wireform.Hash ( -- * Murmur3 32-bit (Iceberg @BucketUtil@)@@ -26,6 +32,7 @@ -- * XXH64 xxh64,+ xxh64IO, -- * Roaring 32-bit container roaringDecodeArray,@@ -44,8 +51,10 @@ import Data.Vector.Storable qualified as VS import Data.Vector.Storable.Mutable qualified as VSM import Data.Word (Word16, Word32, Word64, Word8)-import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Ptr (Ptr, castPtr)+import Foreign.C.Types (CSize (..))+import Foreign.ForeignPtr (touchForeignPtr, withForeignPtr)+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import Foreign.Ptr (Ptr, castPtr, plusPtr) import System.IO.Unsafe (unsafeDupablePerformIO, unsafePerformIO) @@ -53,8 +62,10 @@ -- C entry points -- ============================================================ +-- Byte counts cross the FFI as CSize (size_t): a ByteString over 2 GiB is+-- hashed in full, and the C kernels index with the same width. foreign import ccall unsafe "hs_wf_murmur3_32"- c_murmur3_32 :: Ptr Word8 -> Int32 -> Int32+ c_murmur3_32 :: Ptr Word8 -> CSize -> Int32 foreign import ccall unsafe "hs_wf_bucket_long"@@ -62,7 +73,7 @@ foreign import ccall unsafe "hs_wf_xxh64"- c_xxh64 :: Ptr Word8 -> Int64 -> Word64 -> Word64+ c_xxh64 :: Ptr Word8 -> CSize -> Word64 -> IO Word64 foreign import ccall unsafe "hs_wf_roaring_decode_array"@@ -89,7 +100,14 @@ -- Public wrappers -- ============================================================ --- | Murmur3 32-bit hash with seed 0, matching Iceberg's @BucketUtil.hash@.+{- | Murmur3 32-bit hash with seed 0, matching Iceberg's @BucketUtil.hash@.++The whole 'BS.ByteString' is hashed: its length is passed as 'CSize'+(@size_t@), so inputs above 2 GiB are not narrowed. Note that the+algorithm folds the length into the finalizer as a @uint32@, so two+lengths differing by a multiple of 2^32 hash alike; that is the+reference behaviour, not a truncation here.+-} murmur3_32 :: BS.ByteString -> Int32 murmur3_32 bs = unsafePerformIO $ unsafeUseAsCStringLen bs $ \(p, len) ->@@ -122,14 +140,30 @@ {-# INLINE bucketBytes #-} --- | XXH64 with caller-supplied seed.+{- | XXH64 with caller-supplied seed. The byte length is a 'CSize'+(@size_t@), so a 'BS.ByteString' over 2 GiB is hashed in full.+-} xxh64 :: Word64 -> BS.ByteString -> Word64-xxh64 seed bs = unsafePerformIO $- unsafeUseAsCStringLen bs $ \(p, len) ->- pure $! c_xxh64 (castPtr p) (fromIntegral len) seed+xxh64 seed bs = unsafePerformIO (xxh64IO seed bs) {-# INLINE xxh64 #-} +{- | The same XXH64 operation in IO. Streaming callers can thread its+result directly through their loop without allocating a pure thunk+and running a separate 'unsafePerformIO' boundary for each value.+-}+xxh64IO :: Word64 -> BS.ByteString -> IO Word64+xxh64IO seed bs = do+ let (fp, offset, len) = BSI.toForeignPtr bs+ hash <- c_xxh64 (unsafeForeignPtrToPtr fp `plusPtr` offset) (fromIntegral len) seed+ -- The stateful FFI call finishes before touchForeignPtr. Returning its+ -- result after this lifetime barrier lets callers keep it unboxed;+ -- withForeignPtr would return a boxed Word64 through keepAlive#.+ touchForeignPtr fp+ pure hash+{-# INLINE xxh64IO #-}++ -- ============================================================ -- Roaring containers -- ============================================================@@ -139,7 +173,10 @@ {- | Decode a Roaring ARRAY container payload into a vector of 32-bit-positions, OR'd with @hi << 16@.+positions, OR'd with @hi << 16@. Only the payload's whole little-endian+lows are read: a payload shorter than @cardinality * 2@ bytes (a+truncated blob) decodes to that many positions, and a negative+cardinality to none. -} roaringDecodeArray :: BS.ByteString@@ -150,17 +187,19 @@ -- ^ High 32 bits to OR onto each position. -> VS.Vector Int32 roaringDecodeArray bs card hi = unsafeDupablePerformIO $ do- mv <- VSM.unsafeNew card+ let !n = arrayCard bs card+ mv <- VSM.unsafeNew n VSM.unsafeWith mv $ \dst -> unsafeUseAsCStringLen bs $ \(src, _) -> do- _ <- pure $! c_roaring_decode_array (castPtr src) (fromIntegral card) hi dst+ _ <- pure $! c_roaring_decode_array (castPtr src) (fromIntegral n) hi dst pure () VS.unsafeFreeze mv {-# INLINE roaringDecodeArray #-} {- | Decode a Roaring BITSET container payload (exactly 8192 bytes) into-a vector of set positions, OR'd with @hi << 16@.+a vector of set positions, OR'd with @hi << 16@. A shorter payload reads+as if zero-padded to 8192 bytes. -} roaringDecodeBitset :: BS.ByteString@@ -171,14 +210,16 @@ roaringDecodeBitset bs hi = unsafeDupablePerformIO $ do mv <- VSM.unsafeNew 65536 written <- VSM.unsafeWith mv $ \dst ->- unsafeUseAsCStringLen bs $ \(src, _) ->+ unsafeUseAsCStringLen (bitsetPayload bs) $ \(src, _) -> pure $! c_roaring_decode_bitset (castPtr src) hi dst let n = fromIntegral written VS.unsafeFreeze (VSM.unsafeSlice 0 n mv) {-# INLINE roaringDecodeBitset #-} --- | Test whether a 16-bit low value is present in a Roaring container.+{- | Test whether a 16-bit low value is present in a Roaring container.+The payload is bounded as in 'roaringDecodeArray' / 'roaringDecodeBitset'.+-} roaringContains :: RoaringContainerKind -> BS.ByteString@@ -187,10 +228,38 @@ -> Word16 -> Bool roaringContains kind bs card v = unsafePerformIO $- unsafeUseAsCStringLen bs $ \(p, _) ->- let !k = case kind of ArrayContainer -> 0; BitsetContainer -> 1- in pure $! c_roaring_contains k (castPtr p) (fromIntegral card) v /= 0+ case kind of+ ArrayContainer ->+ unsafeUseAsCStringLen bs $ \(p, _) ->+ pure $! c_roaring_contains 0 (castPtr p) (fromIntegral (arrayCard bs card)) v /= 0+ BitsetContainer ->+ unsafeUseAsCStringLen (bitsetPayload bs) $ \(p, _) ->+ pure $! c_roaring_contains 1 (castPtr p) 0 v /= 0 {-# INLINE roaringContains #-}+++{- | The ARRAY cardinality the C kernels may read: the caller's count+clamped to the payload's whole uint16 lows and to the Int32 range. The C+side has no payload length, and Iceberg's @decodeDV@ passes a count taken+from untrusted blob bytes next to a payload that may be truncated.++The Int32 clamp is not a width compromise: a Roaring ARRAY container+holds at most 4096 distinct 16-bit lows (and a BITSET at most 65536), so+no valid container can ask for a count above 2^31. The clamp exists to+reject an untrusted count before any allocation.+-}+arrayCard :: BS.ByteString -> Int -> Int+arrayCard bs card =+ max 0 (min card (min (BS.length bs `quot` 2) (fromIntegral (maxBound :: Int32))))+{-# INLINE arrayCard #-}+++-- | A BITSET payload zero-padded to the 8192 bytes the C kernels read.+bitsetPayload :: BS.ByteString -> BS.ByteString+bitsetPayload bs+ | BS.length bs >= 8192 = bs+ | otherwise = bs <> BS.replicate (8192 - BS.length bs) 0+{-# INLINE bitsetPayload #-} {- | Encode a sorted vector of 16-bit positions as a Roaring ARRAY
src/Wireform/Parser.hs view
@@ -150,6 +150,7 @@ import Data.ByteString.Internal qualified as BSI import Data.Int import Data.Word+import Foreign.C.Types (CSize (..)) import Foreign.Marshal.Utils (copyBytes) import GHC.Exts import GHC.Float (castWord32ToFloat, castWord64ToDouble)@@ -361,13 +362,17 @@ memcmpAddr# :: Addr# -> Addr# -> Int# -> Int#-memcmpAddr# a b n = case unsafeDupablePerformIO (c_memcmp (Ptr a) (Ptr b) (I# n)) of+memcmpAddr# a b n = case unsafeDupablePerformIO (c_memcmp (Ptr a) (Ptr b) (fromIntegral (I# n))) of r -> if r == 0 then 0# else 1# {-# INLINE memcmpAddr# #-} +-- memcmp's third parameter is size_t. n is the length of a literal+-- ByteString, which byteString has already compared against the bytes+-- remaining (`len# <=# ...`), so it is non-negative here and Int -> CSize+-- cannot narrow. foreign import ccall unsafe "memcmp"- c_memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Int+ c_memcmp :: Ptr Word8 -> Ptr Word8 -> CSize -> IO Int ------------------------------------------------------------------------
src/Wireform/Parser/Switch.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE BlockArguments #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TemplateHaskell #-}@@ -166,13 +165,8 @@ -- TH code generation ------------------------------------------------------------------------ -#if MIN_VERSION_base(4,15,0) mkDoE :: [Stmt] -> Exp mkDoE = DoE Nothing-#else-mkDoE :: [Stmt] -> Exp-mkDoE = DoE-#endif switch :: Q Exp -> Q Exp
src/Wireform/Ring/Internal.hs view
@@ -48,7 +48,7 @@ import Data.ByteString.Internal qualified as BSI import Data.Typeable (Typeable) import Data.Word (Word64, Word8)-import Foreign.C.Types (CInt (..), CLong (..), CSize (..))+import Foreign.C.Types (CInt (..), CSize (..)) import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Utils (copyBytes) import Foreign.Ptr (Ptr, nullPtr, plusPtr)@@ -142,7 +142,12 @@ } --- | Release the ring's virtual mappings. Safe to call multiple times.+{- | Release the ring's virtual mappings. Call it exactly once per ring:+each call passes a fresh copy of the base pointer to C, so a second call+unmaps whatever has been mapped at that address since (callers that may+close twice need their own once-guard, as+"Wireform.Network.Transport.Duplex" does).+-} destroyMagicRing :: MagicRing s -> IO () destroyMagicRing mr = alloca $ \p -> do poke p (CRing (mrBase mr) (fromIntegral (mrSize mr)))
src/Wireform/Transport/Config.hs view
@@ -84,7 +84,9 @@ data TransportConfig = TransportConfig { ringSizeHint :: !Int {- ^ Requested ring size in bytes. Rounded up to page-size multiple- and power of two. Default: 1 MiB.+ and power of two. Default: 1 MiB. The ring is mapped twice, so the+ ceiling is 4 GiB (1 GiB on a 32-bit target); a larger request fails+ with @ENOMEM@ instead of being silently clamped. -} , waitPolicy :: !WaitPolicy , pinning :: !PinningPolicy
src/Wireform/Transport/Send.hs view
@@ -55,6 +55,7 @@ import Wireform.Builder.FastBuilder ( DataSink (RingSink), RingSinkState (..),+ RingSpill (NoSpill), finalizeRingSink, runBuilder, )@@ -343,6 +344,7 @@ , rsPublishHead = sendPublishHead t , rsEnsureRoom = ensureRoom t , rsLoadTail = sendLoadTail t+ , rsSpill = NoSpill } finalCur <- runBuilder b (RingSink rsRef) ptr (ptr `plusPtr` chunkSz) _ <- finalizeRingSink rsRef finalCur
test/Spec.hs view
@@ -2,8 +2,10 @@ import Test.Syd import Wireform.Base64.Test qualified as Base64+import Wireform.FFI.Test qualified as FFI import Wireform.Parser.Test qualified as Parser import Wireform.Ring.Test qualified as Ring+import Wireform.Transport.SendBoundaryTest qualified as SendBoundary import Wireform.Transport.SendTest qualified as Send @@ -12,4 +14,6 @@ Ring.spec Parser.spec Send.spec+ SendBoundary.spec Base64.spec+ FFI.spec
+ test/Wireform/FFI/Test.hs view
@@ -0,0 +1,69 @@+module Wireform.FFI.Test (spec) where++import Data.ByteString qualified as BS+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Marshal.Array (peekArray)+import Foreign.Marshal.Utils (fillBytes)+import Foreign.Ptr (nullPtr)+import Test.Syd+import Wireform.Encode.Direct qualified as Direct+import Wireform.FFI (compareBounds, validateArrowBuffers)+import Wireform.Hash qualified as Hash+++{- | Negative counts and lengths must be rejected at the wrapper, not+widened: they cross the FFI as 'Data.Word.CSize'/'Int64', so a negative+'Int' would become a huge count and make the kernel read past the+caller's buffers.+-}+spec :: Spec+spec = describe "Wireform.FFI and direct encoding boundaries" $ do+ it "rejects a negative buffer count" $ do+ validateArrowBuffers nullPtr (-1) 8 `shouldBe` False++ it "rejects a negative body length" $ do+ validateArrowBuffers nullPtr 0 (-1) `shouldBe` False+ validateArrowBuffers nullPtr 1 (-1) `shouldBe` False++ it "rejects a negative bounds count with an empty mask" $ do+ compareBounds nullPtr (-1) 4 nullPtr `shouldBe` 0++ it "rejects a negative bound width with an empty mask" $ do+ compareBounds nullPtr 1 (-1) nullPtr `shouldBe` 0++ it "still accepts empty input" $ do+ validateArrowBuffers nullPtr 0 0 `shouldBe` True+ compareBounds nullPtr 0 0 nullPtr `shouldBe` 0++ it "keeps IO XXH64 byte-identical for empty, sliced, and block-boundary inputs" $ do+ empty <- Hash.xxh64IO 0 BS.empty+ empty `shouldBe` 0xef46db3751d8e999+ abc <- Hash.xxh64IO 0 (BS.pack [97, 98, 99])+ abc `shouldBe` 0x44bc2cf5ad770999+ mapM_+ ( \size -> do+ let payload = BS.pack (take size (cycle [0 .. 255]))+ sliced = BS.take size (BS.drop 3 (BS.replicate 3 0xa5 <> payload <> BS.replicate 7 0x5a))+ mapM_+ (\seed -> Hash.xxh64IO seed sliced >>= (`shouldBe` Hash.xxh64 seed payload))+ [0, 1, 0x123456789abcdef0, maxBound]+ )+ [0, 1, 7, 8, 15, 16, 31, 32, 33, 63, 64, 65, 257]++ it "writes raw varints across the 21-bit boundary without a field tag" $ do+ -- The published fallback used the field encoder with tag zero. That+ -- inserted an extra byte for values >= 2^21 (including 2 MiB lengths).+ let check value expected = allocaBytes 16 $ \ptr -> do+ fillBytes ptr 0xa5 16+ end <- Direct.dVarint ptr 3 value+ bytes <- peekArray 16 ptr+ end `shouldBe` (3 + length expected)+ bytes `shouldBe` (replicate 3 0xa5 ++ expected ++ replicate (13 - length expected) 0xa5)+ mapM_+ (uncurry check)+ [ (0x1fffff, [255, 255, 127])+ , (0x200000, [128, 128, 128, 1])+ , (0xfffffff, [255, 255, 255, 127])+ , (0x10000000, [128, 128, 128, 128, 1])+ , (maxBound, replicate 9 255 ++ [1])+ ]
+ test/Wireform/Transport/SendBoundaryTest.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE BangPatterns #-}++{- | Boundary properties for the ring-direct builder sink.++Which code path a builder primitive takes depends on how its+request compares with three sizes: the ring (a page multiple, so+host dependent), 'byteString''s copy/insert threshold+(@maximalCopySize@, ~8 KiB) and the sink's default chunk (32 KiB).+These properties cluster payload lengths at each of those and run+them against rings of 1x, 2x and 4x the page size, so every+crossing reachable on the host is exercised, whatever the page size.+-}+module Wireform.Transport.SendBoundaryTest (spec) where++import Control.Exception (evaluate, try)+import Data.ByteString qualified as BS+import Data.ByteString.Builder.Extra qualified as X+import Data.ByteString.Unsafe qualified as BSU+import Data.Word (Word8)+import Hedgehog (Gen, annotateShow, evalIO, forAll, property, (===))+import Hedgehog.Gen qualified as Gen+import Hedgehog.Range qualified as Range+import Test.Syd+import Test.Syd.Hedgehog ()+import Wireform.Builder+import Wireform.Transport.Send+import Wireform.Transport.SendTest (readChunks, ringSizeAt, withTestTransport)+++-- | The builder primitives whose ring-sink paths differ.+data Prim+ = PByteString+ | PByteStringCopy+ | PByteStringInsert+ | PCStringLen+ | {- | @ensureBytes n@ then an unchecked write: the shape of+ every primitive that reserves its whole length up front (e.g.+ the proto string-field writer).+ -}+ PEnsureThenWrite+ deriving stock (Show, Eq, Enum, Bounded)+++-- | One primitive call, preceded by @itemLead@ single-byte writes.+data Item = Item+ { itemPrim :: !Prim+ , itemLead :: !Int+ , itemLen :: !Int+ }+ deriving stock (Show)+++spec :: Spec+spec = describe "SendTransport boundaries" $ do+ it "builder primitives round-trip at every ring/threshold/chunk boundary" $+ property $ do+ page <- evalIO (ringSizeAt 1)+ mult <- forAll (Gen.element [1, 2, 4])+ ringSz <- evalIO (ringSizeAt (mult * page))+ annotateShow ringSz+ items <- forAll (Gen.list (Range.linear 1 4) (genItem ringSz))+ corked <- forAll Gen.bool+ let payloads = zipWith itemPayload [0 ..] items+ expected =+ BS.concat+ (zipWith (\item p -> BS.replicate (itemLead item) leadByte <> p) items payloads)+ (bytes, _) <- evalIO $ withTestTransport ringSz $ \t ->+ withItems (zip items payloads) $ \b ->+ if corked+ then withSendCork t (`sendBuilderDirect` b)+ else sendBuilderDirect t b+ readChunks bytes === expected++ describe "FixedBuffer overflow" $ do+ it "getBytes past the end throws FixedBufferOverflow" $+ try (evaluate (toStrictByteStringExact 4 (word64BE 1)))+ `shouldReturn` Left (FixedBufferOverflow {fixedBufferRequested = 8, fixedBufferAvailable = 4})++ it "byteStringInsert past the end throws FixedBufferOverflow" $+ try (evaluate (toStrictByteStringExact 16 (byteStringInsert (BS.replicate 32 1))))+ `shouldReturn` Left (FixedBufferOverflow {fixedBufferRequested = 32, fixedBufferAvailable = 16})+++genItem :: Int -> Gen Item+genItem ringSz =+ Item+ <$> Gen.enumBounded+ <*> Gen.int (Range.linear 0 3)+ <*> Gen.frequency+ [ (3, Gen.element (boundaryLens ringSz))+ , (1, Gen.int (Range.linear 0 (4 * ringSz)))+ ]+++-- | Every interesting size, and one either side of it.+boundaryLens :: Int -> [Int]+boundaryLens ringSz =+ filter (>= 0) $+ concatMap+ (\b -> fmap (b +) [-1, 0, 1])+ [0, ringSz, 2 * ringSz, maximalCopySize, defaultDirectChunk]+ where+ -- 'byteString' copies below this and inserts at or above it.+ maximalCopySize = 2 * X.smallChunkSize+ -- 'sendBuilderDirect''s default region size.+ defaultDirectChunk = 32768+++-- | Distinct content per item so misordered chunks are caught.+itemPayload :: Int -> Item -> BS.ByteString+itemPayload i item = fst (BS.unfoldrN (itemLen item) step (i * 37))+ where+ step !k = Just (fromIntegral (k `rem` 251) :: Word8, k + 1)+++leadByte :: Word8+leadByte = 0xA5+++{- | Build all items into one 'Builder' and run the action with it.+'PCStringLen' borrows the payload's buffer, so the action runs+inside every 'BSU.unsafeUseAsCStringLen' scope.+-}+withItems :: [(Item, BS.ByteString)] -> (Builder -> IO a) -> IO a+withItems [] k = k mempty+withItems ((item, p) : rest) k =+ withPrim (itemPrim item) p $ \b ->+ withItems rest $ \bs ->+ k (mconcat (replicate (itemLead item) (word8 leadByte)) <> b <> bs)+++withPrim :: Prim -> BS.ByteString -> (Builder -> IO a) -> IO a+withPrim prim p k = case prim of+ PByteString -> k (byteString p)+ PByteStringCopy -> k (byteStringCopy p)+ PByteStringInsert -> k (byteStringInsert p)+ PCStringLen -> BSU.unsafeUseAsCStringLen p (k . unsafeCStringLen)+ PEnsureThenWrite -> k (ensureBytes (BS.length p) <> byteStringCopyNoCheck p)
test/Wireform/Transport/SendTest.hs view
@@ -1,8 +1,15 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} -module Wireform.Transport.SendTest (spec) where+module Wireform.Transport.SendTest (+ spec, + -- * Shared with "Wireform.Transport.SendBoundaryTest"+ withTestTransport,+ readChunks,+ ringSizeAt,+) where+ import Control.Exception (catch) import Data.Bits ((.&.)) import Data.ByteString qualified as BS@@ -344,6 +351,33 @@ sendBuilderDirect corked (byteString payload) readChunks bytes `shouldBe` payload readIORef pubs >>= (`shouldSatisfy` (> 1))++ -- 'byteString' copies below ~8 KiB and inserts above it, while+ -- the ring size tracks the page size; pin both paths explicitly+ -- so the suite exercises each regardless of host page size.+ it "byteStringCopy > ring inside cork" $ do+ sz <- ringSizeAt 4096+ let payload = patternBytes (sz + 1)+ (bytes, pubs) <- withTestTransport 4096 $ \t ->+ withSendCork t $ \corked ->+ sendBuilderDirect corked (word8 0x7F <> byteStringCopy payload <> word8 0x7E)+ readChunks bytes `shouldBe` BS.concat [BS.singleton 0x7F, payload, BS.singleton 0x7E]+ readIORef pubs >>= (`shouldSatisfy` (> 1))++ it "byteStringCopy > ring uncorked" $ do+ sz <- ringSizeAt 4096+ let payload = patternBytes (sz * 3 + 7)+ (bytes, _) <- withTestTransport 4096 $ \t ->+ sendBuilderDirect t (byteStringCopy payload)+ readChunks bytes `shouldBe` payload++ it "byteStringInsert > ring inside cork" $ do+ sz <- ringSizeAt 4096+ let payload = patternBytes (sz + 1)+ (bytes, _) <- withTestTransport 4096 $ \t ->+ withSendCork t $ \corked ->+ sendBuilderDirect corked (byteStringInsert payload)+ readChunks bytes `shouldBe` payload it "many small sends exceeding ring" $ do sz <- ringSizeAt 4096
wireform-core.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: wireform-core-version: 0.2.0.1+version: 0.3.0.0 synopsis: Shared FFI primitives for wireform format packages description: Cross-format SWAR / SIMD-accelerated primitives used by every@@ -28,7 +28,7 @@ copyright: 2026 Ian Duncan category: Data, Codec, FFI build-type: Simple-tested-with: GHC == 9.6.4, GHC == 9.8.4+tested-with: GHC == 9.10.3, GHC == 9.12.4, GHC == 9.14.1 extra-source-files: cbits/*.c include/**/*.h@@ -116,14 +116,14 @@ c-sources: cbits/magic_ring_posix.c if os(windows) c-sources: cbits/magic_ring_windows.c- extra-libraries: kernel32+ extra-libraries: kernel32 bcrypt build-depends:- base >= 4.18 && < 5,+ base >= 4.20 && < 5, bytestring >= 0.11 && < 0.13,- containers,- ghc-prim,- template-haskell,+ containers >= 0.6 && < 0.9,+ ghc-prim >= 0.12 && < 0.14,+ template-haskell >= 2.22 && < 2.25, text >= 2.0 && < 2.2, vector >= 0.13 && < 0.14 @@ -136,12 +136,16 @@ Wireform.Ring.Test Wireform.Parser.Test Wireform.Transport.SendTest+ Wireform.Transport.SendBoundaryTest Wireform.Base64.Test+ Wireform.FFI.Test build-depends: base, bytestring, wireform-core, sydtest,+ sydtest-hedgehog,+ hedgehog >= 1.0 && < 1.8, QuickCheck benchmark parser-bench