diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,10 @@ # Changelog +- 0.3.0 (2026-05-16) + * Features order-of-magnitude performance improvements in both + encoding and decoding, especially on ARM platforms where NEON + intrinsics are available. + - 0.2.1 (2025-12-28) * Adds an 'llvm' build flag and is now tested with GHC 9.10.3. diff --git a/cbits/base16_arm.c b/cbits/base16_arm.c new file mode 100644 --- /dev/null +++ b/cbits/base16_arm.c @@ -0,0 +1,143 @@ +#include +#include + +#if defined(__aarch64__) + +#include + +/* lowercase ASCII hex character for each nibble value 0..15 */ +static const uint8_t hex_lut[16] = { + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f' +}; + +/* + * Encode 'l' input bytes at 'src' into 2*l ASCII hex bytes at 'dst'. + * + * NEON kernel processes 16 input bytes per iteration: + * - vshrq_n_u8 / vandq_u8 split the high and low nibbles + * - vqtbl1q_u8 looks up each nibble in 'hex_lut' (the tbl instr) + * - vst2q_u8 stores the two char vectors interleaved, producing + * [h0 l0 h1 l1 ... h15 l15] which is exactly the hex output + * + * A scalar tail finishes the final (l mod 16) bytes. + */ +void base16_encode_arm(const uint8_t *src, uint8_t *dst, size_t l) { + uint8x16_t lut = vld1q_u8(hex_lut); + uint8x16_t mask_lo = vdupq_n_u8(0x0f); + size_t i = 0; + + for (; i + 16 <= l; i += 16) { + uint8x16_t in = vld1q_u8(src + i); + uint8x16_t hi = vshrq_n_u8(in, 4); + uint8x16_t lo = vandq_u8(in, mask_lo); + uint8x16x2_t pair = { { vqtbl1q_u8(lut, hi), + vqtbl1q_u8(lut, lo) } }; + vst2q_u8(dst + 2 * i, pair); + } + + for (; i < l; i++) { + uint8_t b = src[i]; + dst[2 * i] = hex_lut[b >> 4]; + dst[2 * i + 1] = hex_lut[b & 0x0f]; + } +} + +/* + * Convert 16 ASCII hex chars to nibble values (0..15) in 'nib'. + * Each lane of 'bad' is set to 0xff if the corresponding input is + * not a valid hex digit ('0'..'9', 'a'..'f', 'A'..'F'), 0x00 if it + * is. Case-insensitive. + */ +static inline void ascii_to_nibble(uint8x16_t c, + uint8x16_t *nib, + uint8x16_t *bad) { + uint8x16_t is_digit = vandq_u8(vcgeq_u8(c, vdupq_n_u8('0')), + vcleq_u8(c, vdupq_n_u8('9'))); + uint8x16_t is_lower = vandq_u8(vcgeq_u8(c, vdupq_n_u8('a')), + vcleq_u8(c, vdupq_n_u8('f'))); + uint8x16_t is_upper = vandq_u8(vcgeq_u8(c, vdupq_n_u8('A')), + vcleq_u8(c, vdupq_n_u8('F'))); + + /* offset to subtract from c: '0' (0x30), 'a'-10 (0x57), 'A'-10 + * (0x37); zero in lanes that aren't valid hex (the resulting + * nibble in those lanes is garbage but 'bad' flags them). */ + uint8x16_t off = vorrq_u8( + vandq_u8(is_digit, vdupq_n_u8(0x30)), + vorrq_u8( + vandq_u8(is_lower, vdupq_n_u8(0x57)), + vandq_u8(is_upper, vdupq_n_u8(0x37)))); + + *nib = vsubq_u8(c, off); + *bad = vmvnq_u8(vorrq_u8(is_digit, vorrq_u8(is_lower, is_upper))); +} + +static inline uint8_t scalar_nib(uint8_t c) { + if (c >= '0' && c <= '9') return (uint8_t)(c - '0'); + if (c >= 'a' && c <= 'f') return (uint8_t)(c - 'a' + 10); + if (c >= 'A' && c <= 'F') return (uint8_t)(c - 'A' + 10); + return 0x80; /* invalid sentinel */ +} + +/* + * Decode 2*outlen hex chars at 'src' into 'outlen' bytes at 'dst'. + * Returns 1 on success, 0 if any invalid hex char was seen (in which + * case the contents of 'dst' are unspecified). + * + * NEON kernel processes 32 input chars per iteration: + * - vld2q_u8 deinterleaves into a vector of high-nibble chars and a + * vector of low-nibble chars + * - ascii_to_nibble validates and converts each char to its nibble + * - vshlq_n_u8 + vorrq_u8 packs nibble pairs into output bytes + * - the per-iteration 'bad' masks are OR-accumulated; we reduce + * once at the end with vmaxvq_u8 + * + * A scalar tail finishes the final (outlen mod 16) output bytes. + */ +int base16_decode_arm(const uint8_t *src, uint8_t *dst, size_t outlen) { + uint8x16_t bad = vdupq_n_u8(0); + size_t i = 0; + + for (; i + 16 <= outlen; i += 16) { + uint8x16x2_t pair = vld2q_u8(src + 2 * i); + uint8x16_t nib_hi, nib_lo, bad_hi, bad_lo; + ascii_to_nibble(pair.val[0], &nib_hi, &bad_hi); + ascii_to_nibble(pair.val[1], &nib_lo, &bad_lo); + uint8x16_t byte = vorrq_u8(vshlq_n_u8(nib_hi, 4), nib_lo); + vst1q_u8(dst + i, byte); + bad = vorrq_u8(bad, vorrq_u8(bad_hi, bad_lo)); + } + + uint8_t tail_bad = 0; + for (; i < outlen; i++) { + uint8_t n0 = scalar_nib(src[2 * i]); + uint8_t n1 = scalar_nib(src[2 * i + 1]); + tail_bad |= (n0 | n1) & 0x80; + dst[i] = (uint8_t)((n0 << 4) | (n1 & 0x0f)); + } + + return (vmaxvq_u8(bad) == 0) && (tail_bad == 0); +} + +int base16_arm_available(void) { + return 1; +} + +#else + +/* stubs for non-aarch64 builds; never reached because dispatch is + * gated on 'base16_arm_available' returning 0 */ + +void base16_encode_arm(const uint8_t *src, uint8_t *dst, size_t l) { + (void)src; (void)dst; (void)l; +} + +int base16_decode_arm(const uint8_t *src, uint8_t *dst, size_t outlen) { + (void)src; (void)dst; (void)outlen; + return 0; +} + +int base16_arm_available(void) { + return 0; +} + +#endif diff --git a/lib/Data/ByteString/Base16.hs b/lib/Data/ByteString/Base16.hs --- a/lib/Data/ByteString/Base16.hs +++ b/lib/Data/ByteString/Base16.hs @@ -1,7 +1,5 @@ {-# OPTIONS_HADDOCK prune #-} -{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE OverloadedStrings #-} -- | @@ -20,285 +18,154 @@ import qualified Data.Bits as B import Data.Bits ((.&.), (.|.)) import qualified Data.ByteString as BS -import qualified Data.ByteString.Builder as BSB -import qualified Data.ByteString.Builder.Extra as BE +import qualified Data.ByteString.Base16.Arm as Arm import qualified Data.ByteString.Internal as BI -import qualified Data.ByteString.Unsafe as BU import Data.Word (Word8, Word16) - -to_strict :: BSB.Builder -> BS.ByteString -to_strict = BS.toStrict . BSB.toLazyByteString -{-# INLINE to_strict #-} - -to_strict_small :: BSB.Builder -> BS.ByteString -to_strict_small = BS.toStrict - . BE.toLazyByteStringWith (BE.safeStrategy 128 BE.smallChunkSize) mempty -{-# INLINE to_strict_small #-} +import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Ptr (Ptr, castPtr, plusPtr) +import Foreign.Storable (peekElemOff, pokeElemOff) +import System.IO.Unsafe (unsafeDupablePerformIO) fi :: (Num a, Integral b) => b -> a fi = fromIntegral {-# INLINE fi #-} -hex_charset :: BS.ByteString -hex_charset = "0123456789abcdef" +-- 512-byte table. Bytes [2k] and [2k+1] are the two lowercase ASCII +-- hex characters representing the value k. All-ASCII content means +-- the bytestring 'IsString' rule rewrites this to 'unsafePackAddress' +-- and the bytes live in static rodata. +enc_tab :: BS.ByteString +enc_tab = + "000102030405060708090a0b0c0d0e0f\ + \101112131415161718191a1b1c1d1e1f\ + \202122232425262728292a2b2c2d2e2f\ + \303132333435363738393a3b3c3d3e3f\ + \404142434445464748494a4b4c4d4e4f\ + \505152535455565758595a5b5c5d5e5f\ + \606162636465666768696a6b6c6d6e6f\ + \707172737475767778797a7b7c7d7e7f\ + \808182838485868788898a8b8c8d8e8f\ + \909192939495969798999a9b9c9d9e9f\ + \a0a1a2a3a4a5a6a7a8a9aaabacadaeaf\ + \b0b1b2b3b4b5b6b7b8b9babbbcbdbebf\ + \c0c1c2c3c4c5c6c7c8c9cacbcccdcecf\ + \d0d1d2d3d4d5d6d7d8d9dadbdcdddedf\ + \e0e1e2e3e4e5e6e7e8e9eaebecedeeef\ + \f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff" +{-# NOINLINE enc_tab #-} -expand_w8 :: Word8 -> Word16 -expand_w8 b = - let !hi = BU.unsafeIndex hex_charset (fi b `B.shiftR` 4) - !lo = BU.unsafeIndex hex_charset (fi b .&. 0b00001111) - in fi hi `B.shiftL` 8 - .|. fi lo -{-# INLINE expand_w8 #-} +-- 256-byte table. Index by an ASCII byte to obtain its nibble; valid +-- hex chars ('0'..'9', 'a'..'f', 'A'..'F') map to 0x10..0x1f, every +-- other byte maps to 0x20. +-- +-- The encoding is chosen so the literal is strictly ASCII and contains +-- no embedded NUL, which is what the bytestring 'IsString' rule needs +-- to rewrite it into 'unsafePackAddress' (cf. 'enc_tab') — the bytes +-- end up in static rodata, with no CAF allocation. +-- +-- The 0x20 sentinel is distinguished by bit 5; no value 0x10..0x1f +-- carries that bit, so 'decode' OR-folds every lookup into an +-- accumulator and tests 'acc .&. 0x20 == 0' once at the end. The +-- output byte is '(n0 `shiftL` 4) .|. (n1 .&. 0x0f)': in 'Word8' the +-- shift naturally drops bit 4, and the mask isolates the low nibble. +dec_tab :: BS.ByteString +dec_tab = + "\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ + \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ + \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ + \\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x20\x20\x20\x20\x20\x20\ + \\x20\x1a\x1b\x1c\x1d\x1e\x1f\x20\x20\x20\x20\x20\x20\x20\x20\x20\ + \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ + \\x20\x1a\x1b\x1c\x1d\x1e\x1f\x20\x20\x20\x20\x20\x20\x20\x20\x20\ + \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ + \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ + \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ + \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ + \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ + \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ + \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ + \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ + \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20" +{-# NOINLINE dec_tab #-} -- | Encode a base256 'ByteString' as base16. -- +-- Uses ARM NEON extensions when available, otherwise a pure +-- Haskell scalar loop. +-- -- >>> encode "hello world" -- "68656c6c6f20776f726c64" encode :: BS.ByteString -> BS.ByteString -encode bs@(BI.PS _ _ l) - | l < 64 = to_strict_small loop - | otherwise = to_strict loop - where - -- writing as few words as possible requires performing some length - -- checks up front - loop - | l `rem` 4 == 0 = - go64 bs - | (l - 3) `rem` 4 == 0 = case BS.splitAt (l - 3) bs of - (chunk, etc) -> - go64 chunk - <> go32 (BU.unsafeTake 2 etc) - <> go16 (BU.unsafeDrop 2 etc) - | (l - 2) `rem` 4 == 0 = case BS.splitAt (l - 2) bs of - (chunk, etc) -> - go64 chunk - <> go32 etc - | (l - 1) `rem` 4 == 0 = case BS.splitAt (l - 1) bs of - (chunk, etc) -> - go64 chunk - <> go16 etc - - | l `rem` 2 == 0 = - go32 bs - | (l - 1) `rem` 2 == 0 = case BS.splitAt (l - 1) bs of - (chunk, etc) -> - go32 chunk - <> go16 etc - - | otherwise = - go16 bs - - go64 b = case BS.splitAt 4 b of - (chunk, etc) - | BS.null chunk -> mempty - | otherwise -> - let !w16_0 = expand_w8 (BU.unsafeIndex chunk 0) - !w16_1 = expand_w8 (BU.unsafeIndex chunk 1) - !w16_2 = expand_w8 (BU.unsafeIndex chunk 2) - !w16_3 = expand_w8 (BU.unsafeIndex chunk 3) - - !w64 = fi w16_0 `B.shiftL` 48 - .|. fi w16_1 `B.shiftL` 32 - .|. fi w16_2 `B.shiftL` 16 - .|. fi w16_3 - - in BSB.word64BE w64 <> go64 etc - - go32 b = case BS.splitAt 2 b of - (chunk, etc) - | BS.null chunk -> mempty - | otherwise -> - let !w16_0 = expand_w8 (BU.unsafeIndex chunk 0) - !w16_1 = expand_w8 (BU.unsafeIndex chunk 1) - - !w32 = fi w16_0 `B.shiftL` 16 - .|. fi w16_1 - - in BSB.word32BE w32 <> go32 etc - - go16 b = case BS.uncons b of - Nothing -> mempty - Just (h, t) -> - let !w16 = expand_w8 h - in BSB.word16BE w16 <> go16 t - --- word8 hex character to word4 -word4 :: Word8 -> Maybe Word8 -word4 c - | c > 47 && c < 58 = pure $! c - 48 -- 0-9 - | c > 64 && c < 71 = pure $! c - 55 -- A-F - | c > 96 && c < 103 = pure $! c - 87 -- a-f - | otherwise = Nothing -{-# INLINE word4 #-} +encode bs + | Arm.base16_arm_available = Arm.encode bs + | otherwise = encode_scalar bs +{-# INLINABLE encode #-} -- | Decode a base16 'ByteString' to base256. -- --- Invalid inputs (including odd-length inputs) will produce --- 'Nothing'. +-- Uses ARM NEON extensions when available, otherwise a pure +-- Haskell scalar loop. Invalid inputs (including odd-length +-- inputs) will produce 'Nothing'. -- -- >>> decode "68656c6c6f20776f726c64" -- Just "hello world" -- >>> decode "068656c6c6f20776f726c64" -- odd-length -- Nothing decode :: BS.ByteString -> Maybe BS.ByteString -decode bs@(BI.PS _ _ l) - | B.testBit l 0 = Nothing - | l `quot` 2 < 128 = fmap to_strict_small loop - | otherwise = fmap to_strict loop - where - -- same story, but we need more checks - loop - | l `rem` 16 == 0 = - go64 mempty bs - | (l - 2) `rem` 16 == 0 = case BS.splitAt (l - 2) bs of - (chunk, etc) -> do - b0 <- go64 mempty chunk - go8 b0 etc - | (l - 4) `rem` 16 == 0 = case BS.splitAt (l - 4) bs of - (chunk, etc) -> do - b0 <- go64 mempty chunk - go16 b0 etc - | (l - 6) `rem` 16 == 0 = case BS.splitAt (l - 6) bs of - (chunk, etc) -> do - b0 <- go64 mempty chunk - b1 <- go16 b0 (BU.unsafeTake 4 etc) - go8 b1 (BU.unsafeDrop 4 etc) - | (l - 8) `rem` 16 == 0 = case BS.splitAt (l - 8) bs of - (chunk, etc) -> do - b0 <- go64 mempty chunk - go32 b0 etc - | (l - 10) `rem` 16 == 0 = case BS.splitAt (l - 10) bs of - (chunk, etc) -> do - b0 <- go64 mempty chunk - b1 <- go32 b0 (BU.unsafeTake 8 etc) - go8 b1 (BU.unsafeDrop 8 etc) - | (l - 12) `rem` 16 == 0 = case BS.splitAt (l - 12) bs of - (chunk, etc) -> do - b0 <- go64 mempty chunk - b1 <- go32 b0 (BU.unsafeTake 8 etc) - go16 b1 (BU.unsafeDrop 8 etc) - | (l - 14) `rem` 16 == 0 = case BS.splitAt (l - 14) bs of - (chunk, etc) -> do - b0 <- go64 mempty chunk - b1 <- go32 b0 (BU.unsafeTake 8 etc) - b2 <- go16 b1 (BU.unsafeTake 4 (BU.unsafeDrop 8 etc)) - go8 b2 (BU.unsafeDrop 12 etc) - - | l `rem` 8 == 0 = - go32 mempty bs - | (l - 2) `rem` 8 == 0 = case BS.splitAt (l - 2) bs of - (chunk, etc) -> do - b0 <- go32 mempty chunk - go8 b0 etc - | (l - 4) `rem` 8 == 0 = case BS.splitAt (l - 4) bs of - (chunk, etc) -> do - b0 <- go32 mempty chunk - go16 b0 etc - | (l - 6) `rem` 8 == 0 = case BS.splitAt (l - 6) bs of - (chunk, etc) -> do - b0 <- go32 mempty chunk - b1 <- go16 b0 (BU.unsafeTake 4 etc) - go8 b1 (BU.unsafeDrop 4 etc) - - | l `rem` 4 == 0 = - go16 mempty bs - | (l - 2) `rem` 4 == 0 = case BS.splitAt (l - 2) bs of - (chunk, etc) -> do - b0 <- go16 mempty chunk - go8 b0 etc - - | otherwise = - go8 mempty bs - - go64 acc b = case BS.splitAt 16 b of - (chunk, etc) - | BS.null chunk -> pure acc - | otherwise -> do - !w4_00 <- word4 (BU.unsafeIndex chunk 00) - !w4_01 <- word4 (BU.unsafeIndex chunk 01) - !w4_02 <- word4 (BU.unsafeIndex chunk 02) - !w4_03 <- word4 (BU.unsafeIndex chunk 03) - !w4_04 <- word4 (BU.unsafeIndex chunk 04) - !w4_05 <- word4 (BU.unsafeIndex chunk 05) - !w4_06 <- word4 (BU.unsafeIndex chunk 06) - !w4_07 <- word4 (BU.unsafeIndex chunk 07) - !w4_08 <- word4 (BU.unsafeIndex chunk 08) - !w4_09 <- word4 (BU.unsafeIndex chunk 09) - !w4_10 <- word4 (BU.unsafeIndex chunk 10) - !w4_11 <- word4 (BU.unsafeIndex chunk 11) - !w4_12 <- word4 (BU.unsafeIndex chunk 12) - !w4_13 <- word4 (BU.unsafeIndex chunk 13) - !w4_14 <- word4 (BU.unsafeIndex chunk 14) - !w4_15 <- word4 (BU.unsafeIndex chunk 15) - - let !w64 = fi w4_00 `B.shiftL` 60 - .|. fi w4_01 `B.shiftL` 56 - .|. fi w4_02 `B.shiftL` 52 - .|. fi w4_03 `B.shiftL` 48 - .|. fi w4_04 `B.shiftL` 44 - .|. fi w4_05 `B.shiftL` 40 - .|. fi w4_06 `B.shiftL` 36 - .|. fi w4_07 `B.shiftL` 32 - .|. fi w4_08 `B.shiftL` 28 - .|. fi w4_09 `B.shiftL` 24 - .|. fi w4_10 `B.shiftL` 20 - .|. fi w4_11 `B.shiftL` 16 - .|. fi w4_12 `B.shiftL` 12 - .|. fi w4_13 `B.shiftL` 08 - .|. fi w4_14 `B.shiftL` 04 - .|. fi w4_15 - - go64 (acc <> BSB.word64BE w64) etc - - go32 acc b = case BS.splitAt 8 b of - (chunk, etc) - | BS.null chunk -> pure acc - | otherwise -> do - !w4_00 <- word4 (BU.unsafeIndex chunk 00) - !w4_01 <- word4 (BU.unsafeIndex chunk 01) - !w4_02 <- word4 (BU.unsafeIndex chunk 02) - !w4_03 <- word4 (BU.unsafeIndex chunk 03) - !w4_04 <- word4 (BU.unsafeIndex chunk 04) - !w4_05 <- word4 (BU.unsafeIndex chunk 05) - !w4_06 <- word4 (BU.unsafeIndex chunk 06) - !w4_07 <- word4 (BU.unsafeIndex chunk 07) - - let !w32 = fi w4_00 `B.shiftL` 28 - .|. fi w4_01 `B.shiftL` 24 - .|. fi w4_02 `B.shiftL` 20 - .|. fi w4_03 `B.shiftL` 16 - .|. fi w4_04 `B.shiftL` 12 - .|. fi w4_05 `B.shiftL` 08 - .|. fi w4_06 `B.shiftL` 04 - .|. fi w4_07 - - go32 (acc <> BSB.word32BE w32) etc - - go16 acc b = case BS.splitAt 4 b of - (chunk, etc) - | BS.null chunk -> pure acc - | otherwise -> do - !w4_00 <- word4 (BU.unsafeIndex chunk 00) - !w4_01 <- word4 (BU.unsafeIndex chunk 01) - !w4_02 <- word4 (BU.unsafeIndex chunk 02) - !w4_03 <- word4 (BU.unsafeIndex chunk 03) - - let !w16 = fi w4_00 `B.shiftL` 12 - .|. fi w4_01 `B.shiftL` 08 - .|. fi w4_02 `B.shiftL` 04 - .|. fi w4_03 - - go16 (acc <> BSB.word16BE w16) etc - - go8 acc b = case BS.splitAt 2 b of - (chunk, etc) - | BS.null chunk -> pure acc - | otherwise -> do - !w4_00 <- word4 (BU.unsafeIndex chunk 00) - !w4_01 <- word4 (BU.unsafeIndex chunk 01) - - let !w8 = fi w4_00 `B.shiftL` 04 - .|. fi w4_01 +decode bs + | Arm.base16_arm_available = Arm.decode bs + | otherwise = decode_scalar bs +{-# INLINABLE decode #-} - go8 (acc <> BSB.word8 w8) etc +encode_scalar :: BS.ByteString -> BS.ByteString +encode_scalar (BI.PS sfp soff l) = + case enc_tab of + BI.PS tfp toff _ -> + BI.unsafeCreate (l `B.shiftL` 1) $ \dst -> + withForeignPtr sfp $ \sp0 -> + withForeignPtr tfp $ \tp0 -> do + -- read 'enc_tab' and write 'dst' as 'Word16' pairs. The + -- two-byte block at 'enc_tab[2*b]' and the two-byte block + -- at 'dst[2*i]' share the same byte layout in memory, so + -- this is endianness-safe: we never inspect the numerical + -- value of the 'Word16', we just shuffle 16 bits between + -- two locations. + let !sp = sp0 `plusPtr` soff :: Ptr Word8 + !tp = tp0 `plusPtr` toff :: Ptr Word16 + !dp = castPtr dst :: Ptr Word16 + loop !i + | i == l = pure () + | otherwise = do + b <- peekElemOff sp i + w <- peekElemOff tp (fi b) + pokeElemOff dp i (w :: Word16) + loop (i + 1) + loop 0 +decode_scalar :: BS.ByteString -> Maybe BS.ByteString +decode_scalar (BI.PS sfp soff l) + | B.testBit l 0 = Nothing + | otherwise = case dec_tab of + BI.PS tfp toff _ -> unsafeDupablePerformIO $ do + let !n = l `B.shiftR` 1 + fp <- BI.mallocByteString n + ok <- withForeignPtr fp $ \dst -> + withForeignPtr sfp $ \sp0 -> + withForeignPtr tfp $ \tp0 -> do + let !sp = sp0 `plusPtr` soff :: Ptr Word8 + !tp = tp0 `plusPtr` toff :: Ptr Word8 + loop !i !acc + | i == n = + pure $! acc .&. 0x20 == 0 + | otherwise = do + let !o = i `B.shiftL` 1 + c0 <- peekElemOff sp o + c1 <- peekElemOff sp (o + 1) + n0 <- peekElemOff tp (fi c0) + n1 <- peekElemOff tp (fi c1) + let !b = (n0 `B.shiftL` 4) + .|. (n1 .&. 0x0f) + pokeElemOff dst i b + loop (i + 1) (acc .|. n0 .|. n1) + loop 0 0 + pure $! if ok then Just (BI.PS fp 0 n) else Nothing diff --git a/lib/Data/ByteString/Base16/Arm.hs b/lib/Data/ByteString/Base16/Arm.hs new file mode 100644 --- /dev/null +++ b/lib/Data/ByteString/Base16/Arm.hs @@ -0,0 +1,70 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE BangPatterns #-} + +-- | +-- Module: Data.ByteString.Base16.Arm +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- ARM NEON support for base16 encoding and decoding. + +module Data.ByteString.Base16.Arm ( + base16_arm_available + , encode + , decode + ) where + +import qualified Data.Bits as B +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BI +import Data.Word (Word8) +import Foreign.C.Types (CInt(..), CSize(..)) +import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Ptr (Ptr, plusPtr) +import System.IO.Unsafe (unsafeDupablePerformIO) + +-- ffi ------------------------------------------------------------------------ + +foreign import ccall unsafe "base16_encode_arm" + c_base16_encode :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () + +foreign import ccall unsafe "base16_decode_arm" + c_base16_decode :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt + +foreign import ccall unsafe "base16_arm_available" + c_base16_arm_available :: IO CInt + +-- utilities ------------------------------------------------------------------ + +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral +{-# INLINE fi #-} + +-- api ------------------------------------------------------------------------ + +-- | Are ARM NEON extensions available? +base16_arm_available :: Bool +base16_arm_available = + unsafeDupablePerformIO c_base16_arm_available /= 0 +{-# NOINLINE base16_arm_available #-} + +-- | Encode a base256 'ByteString' as base16 using NEON. +encode :: BS.ByteString -> BS.ByteString +encode (BI.PS sfp soff l) = + BI.unsafeCreate (l `B.shiftL` 1) $ \dst -> + withForeignPtr sfp $ \sp0 -> + c_base16_encode (sp0 `plusPtr` soff) dst (fi l) + +-- | Decode a base16 'ByteString' to base256 using NEON. Returns +-- 'Nothing' on odd-length or otherwise invalid input. +decode :: BS.ByteString -> Maybe BS.ByteString +decode (BI.PS sfp soff l) + | B.testBit l 0 = Nothing + | otherwise = unsafeDupablePerformIO $ do + let !n = l `B.shiftR` 1 + fp <- BI.mallocByteString n + ok <- withForeignPtr fp $ \dst -> + withForeignPtr sfp $ \sp0 -> + c_base16_decode (sp0 `plusPtr` soff) dst (fi n) + pure $! if ok /= 0 then Just (BI.PS fp 0 n) else Nothing diff --git a/ppad-base16.cabal b/ppad-base16.cabal --- a/ppad-base16.cabal +++ b/ppad-base16.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-base16 -version: 0.2.1 +version: 0.3.0 synopsis: Pure base16 encoding and decoding on bytestrings. license: MIT license-file: LICENSE @@ -18,6 +18,11 @@ default: False manual: True +flag sanitize + description: Build with AddressSanitizer and UndefinedBehaviorSanitizer. + default: False + manual: True + source-repository head type: git location: git.ppad.tech/base16.git @@ -31,9 +36,17 @@ ghc-options: -fllvm -O2 exposed-modules: Data.ByteString.Base16 + Data.ByteString.Base16.Arm build-depends: base >= 4.9 && < 5 , bytestring >= 0.9 && < 0.13 + c-sources: + cbits/base16_arm.c + if arch(aarch64) + cc-options: -march=armv8-a + if flag(sanitize) + cc-options: -fsanitize=address,undefined -fno-omit-frame-pointer + ghc-options: -optl=-fsanitize=address,undefined test-suite base16-tests type: exitcode-stdio-1.0 @@ -43,6 +56,8 @@ ghc-options: -rtsopts -Wall -O2 + if flag(sanitize) + ghc-options: -optl=-fsanitize=address,undefined build-depends: base