diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Revision history for base64 +## 0.4.1 -- 2020-02-04 + +* Optimize loops for 32-bit and 64-bit architectures +* Restructure project to be more amenable to swapping head/tail/loops +* Fix module header alignment + ## 0.4.0 -- 2020-01-26 * With this major version release, we remove the redundant `encodeBase64Unpadded` and `decodeBase64Unpadded` functions from `Base64.hs`. This is for two reasons: diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -20,7 +20,7 @@ There are no dependencies aside from those bundled with GHC: -![base64 dependencies](https://i.imgur.com/qynI5HM.png) +![base64 dependencies](https://i.imgur.com/OWW7c5s.png) ### Motivation diff --git a/base64.cabal b/base64.cabal --- a/base64.cabal +++ b/base64.cabal @@ -1,10 +1,11 @@ cabal-version: 2.0 name: base64 -version: 0.4.0 -synopsis: RFC 4648-compliant padded and unpadded base64 and base64url encodings +version: 0.4.1 +synopsis: Fast RFC 4648-compliant Base64 encoding description: - RFC 4648-compliant padded and unpadded base64 and base64url encoding and decoding. + RFC 4648-compliant padded and unpadded base64 and base64url encoding and decoding. This library provides + performant encoding and decoding primitives, as well as support for textual values. homepage: https://github.com/emilypi/base64 bug-reports: https://github.com/emilypi/base64/issues license: BSD3 @@ -32,6 +33,11 @@ , Data.Text.Encoding.Base64.URL other-modules: Data.ByteString.Base64.Internal + Data.ByteString.Base64.Internal.Tail + Data.ByteString.Base64.Internal.Utils + Data.ByteString.Base64.Internal.W32.Loop + Data.ByteString.Base64.Internal.W64.Loop + Data.ByteString.Base64.Internal.W8.Loop build-depends: base >=4.10 && <5 , bytestring ^>=0.10 diff --git a/benchmarks/Base64Bench.hs b/benchmarks/Base64Bench.hs --- a/benchmarks/Base64Bench.hs +++ b/benchmarks/Base64Bench.hs @@ -29,7 +29,7 @@ main :: IO () main = defaultMain - [ env bs $ \ ~(bs25,bs100,bs1k,bs10k,bs100k) -> + [ env bs $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) -> bgroup "encode" [ bgroup "memory" [ bench "25" $ whnf ctob bs25 @@ -45,6 +45,7 @@ , bench "1000" $ whnf Bos.encode bs1k , bench "10000" $ whnf Bos.encode bs10k , bench "100000" $ whnf Bos.encode bs100k + , bench "1000000" $ whnf Bos.encode bs1mm ] , bgroup "base64" [ bench "25" $ whnf B64.encodeBase64' bs25 @@ -52,6 +53,7 @@ , bench "1000" $ whnf B64.encodeBase64' bs1k , bench "10000" $ whnf B64.encodeBase64' bs10k , bench "100000" $ whnf B64.encodeBase64' bs100k + , bench "1000000" $ whnf B64.encodeBase64' bs1mm ] ] ] @@ -65,4 +67,5 @@ c <- random 1000 d <- random 10000 e <- random 100000 - return (a,b,c,d,e) + f <- random 1000000 + return (a,b,c,d,e,f) diff --git a/src/Data/ByteString/Base64.hs b/src/Data/ByteString/Base64.hs --- a/src/Data/ByteString/Base64.hs +++ b/src/Data/ByteString/Base64.hs @@ -2,12 +2,12 @@ {-# LANGUAGE OverloadedStrings #-} -- | -- Module : Data.ByteString.Base64 --- Copyright : (c) 2019 Emily Pillmore --- License : BSD-style +-- Copyright : (c) 2019 Emily Pillmore +-- License : BSD-style -- --- Maintainer : Emily Pillmore --- Stability : Experimental --- Portability : portable +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : portable -- -- This module contains the combinators implementing the -- RFC 4648 specification for the Base64 encoding including diff --git a/src/Data/ByteString/Base64/Internal.hs b/src/Data/ByteString/Base64/Internal.hs --- a/src/Data/ByteString/Base64/Internal.hs +++ b/src/Data/ByteString/Base64/Internal.hs @@ -1,16 +1,17 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -- | -- Module : Data.ByteString.Base64.Internal --- Copyright : (c) 2019 Emily Pillmore --- License : BSD-style +-- Copyright : (c) 2019 Emily Pillmore +-- License : BSD-style -- --- Maintainer : Emily Pillmore --- Stability : Experimental --- Portability : portable +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : portable -- -- Internal module defining the encoding and decoding -- processes and tables. @@ -43,8 +44,20 @@ ) where +#include "MachDeps.h" + import Data.Bits import qualified Data.ByteString as BS +import Data.ByteString.Base64.Internal.Tail +import Data.ByteString.Base64.Internal.Utils +#if WORD_SIZE_IN_BITS == 32 +import Data.ByteString.Base64.Internal.W32.Loop +#elif WORD_SIZE_IN_BITS == 64 +import Data.ByteString.Base64.Internal.W64.Loop +#else +import Data.ByteString.Base64.Internal.W8.Loop +#endif + import Data.ByteString.Internal import Data.Text (Text) import qualified Data.Text as T @@ -78,23 +91,8 @@ -- ^ Do we not pad out the bytestring? deriving Eq --- | Allocate and fill @n@ bytes with some data +-- | Pack an 'Addr#' into an encoding table of 'Word16's -- -writeNPlainForeignPtrBytes - :: ( Storable a - , Storable b - ) - => Int - -> [a] - -> ForeignPtr b -writeNPlainForeignPtrBytes !n as = unsafeDupablePerformIO $ do - fp <- mallocPlainForeignPtrBytes n - withForeignPtr fp $ \p -> go p as - return (castForeignPtr fp) - where - go !_ [] = return () - go !p (x:xs) = poke p x >> go (plusPtr p 1) xs - packTable :: Addr# -> EncodingTable packTable alphabet = etable where @@ -108,18 +106,23 @@ ] in EncodingTable (Ptr alphabet) (writeNPlainForeignPtrBytes 8192 bs) +-- | Base64url encoding table +-- base64UrlTable :: EncodingTable base64UrlTable = packTable "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"# {-# NOINLINE base64UrlTable #-} +-- | Base64 std encoding table +-- base64Table :: EncodingTable base64Table = packTable "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"# {-# NOINLINE base64Table #-} - -- -------------------------------------------------------------------------- -- -- Validating Base64 +-- | Given a bytestring, check to see that it conforms to a given alphabet +-- validateBase64 :: ByteString -> ByteString -> Bool validateBase64 !alphabet (PS fp off l) = accursedUnutterablePerformIO $ withForeignPtr fp $ \p -> @@ -142,178 +145,37 @@ -- -------------------------------------------------------------------------- -- -- Encode Base64 --- | Read 'Word8' index off alphabet addr --- -aix :: Word8 -> Addr# -> Word8 -aix (W8# i) alpha = W8# (indexWord8OffAddr# alpha (word2Int# i)) -{-# INLINE aix #-} - -w32 :: Word8 -> Word32 -w32 = fromIntegral -{-# INLINE w32 #-} - --- | Encoding inner loop. Packs 3 bytes from src pointer into --- the first 6 bytes of 4 'Word8''s (using the encoding table, --- as 2 'Word12''s ), writing these to the dst pointer. --- -innerLoop - :: Ptr Word16 - -> Ptr Word8 - -> Ptr Word16 - -> Ptr Word8 - -> (Ptr Word8 -> Ptr Word8 -> IO ()) - -> IO () -innerLoop etable sptr dptr end finalize = go sptr dptr - where - go !src !dst - | plusPtr src 2 >= end = finalize src (castPtr dst) - | otherwise = do - - !i <- w32 <$> peek src - !j <- w32 <$> peek (plusPtr src 1) - !k <- w32 <$> peek (plusPtr src 2) - - let !w = (shiftL i 16) .|. (shiftL j 8) .|. k - - !x <- peekElemOff etable (fromIntegral (shiftR w 12)) - !y <- peekElemOff etable (fromIntegral (w .&. 0xfff)) - - poke dst x - poke (plusPtr dst 2) y - - go (plusPtr src 3) (plusPtr dst 4) - --- | Unpadded encoding loop, finalized as a bytestring using the --- resultant length count. --- -innerLoopNopad - :: Ptr Word16 - -> Ptr Word8 - -> Ptr Word16 - -> Ptr Word8 - -> (Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString) - -> IO ByteString -innerLoopNopad etable sptr dptr end finalize = go sptr dptr 0 - where - go !src !dst !n - | plusPtr src 2 >= end = finalize src (castPtr dst) n - | otherwise = do - !i <- w32 <$> peek src - !j <- w32 <$> peek (plusPtr src 1) - !k <- w32 <$> peek (plusPtr src 2) - - let !w = (shiftL i 16) .|. (shiftL j 8) .|. k - !x <- peekElemOff etable (fromIntegral (shiftR w 12)) - !y <- peekElemOff etable (fromIntegral (w .&. 0xfff)) - - poke dst x - poke (plusPtr dst 2) y - - go (plusPtr src 3) (plusPtr dst 4) (n + 4) - encodeBase64_ :: EncodingTable -> ByteString -> ByteString encodeBase64_ (EncodingTable !aptr !efp) (PS !sfp !soff !slen) = unsafeCreate dlen $ \dptr -> withForeignPtr sfp $ \sptr -> - withForeignPtr efp $ \eptr -> - encodeBase64_' - aptr + withForeignPtr efp $ \eptr -> do + let !end = plusPtr sptr (soff + slen) + innerLoop eptr (plusPtr sptr soff) (castPtr dptr) - (plusPtr sptr (soff + slen)) + end + (loopTail aptr end) where !dlen = 4 * ((slen + 2) `div` 3) -encodeBase64_' - :: Ptr Word8 - -> Ptr Word16 - -> Ptr Word8 - -> Ptr Word16 - -> Ptr Word8 - -> IO () -encodeBase64_' (Ptr !alpha) !etable !sptr !dptr !end = - innerLoop etable sptr dptr end finalize - where - finalize !src !dst - | src == end = return () - | otherwise = do - !k <- peekByteOff src 0 - - let !a = shiftR (k .&. 0xfc) 2 - !b = shiftL (k .&. 0x03) 4 - - pokeByteOff dst 0 (aix a alpha) - - if plusPtr src 2 /= end - then do - pokeByteOff dst 1 (aix b alpha) - pokeByteOff @Word8 dst 2 0x3d - pokeByteOff @Word8 dst 3 0x3d - else do - !k' <- peekByteOff src 1 - - let !b' = shiftR (k' .&. 0xf0) 4 .|. b - !c' = shiftL (k' .&. 0x0f) 2 - - pokeByteOff dst 1 (aix b' alpha) - pokeByteOff dst 2 (aix c' alpha) - pokeByteOff @Word8 dst 3 0x3d - - encodeBase64Nopad_ :: EncodingTable -> ByteString -> ByteString encodeBase64Nopad_ (EncodingTable !aptr !efp) (PS !sfp !soff !slen) = unsafeDupablePerformIO $ do dfp <- mallocPlainForeignPtrBytes dlen withForeignPtr dfp $ \dptr -> withForeignPtr efp $ \etable -> - withForeignPtr sfp $ \sptr -> - encodeBase64Nopad_' - aptr + withForeignPtr sfp $ \sptr -> do + let !end = plusPtr sptr (soff + slen) + innerLoopNopad etable (plusPtr sptr soff) (castPtr dptr) - (plusPtr sptr (soff + slen)) - dfp + end + (loopTailNoPad dfp aptr end) where !dlen = 4 * ((slen + 2) `div` 3) - -encodeBase64Nopad_' - :: Ptr Word8 - -> Ptr Word16 - -> Ptr Word8 - -> Ptr Word16 - -> Ptr Word8 - -> ForeignPtr Word8 - -> IO ByteString -encodeBase64Nopad_' (Ptr !alpha) !etable !sptr !dptr !end !dfp = - innerLoopNopad etable sptr dptr end finalize - where - finalize !src !dst !n - | src == end = return (PS dfp 0 n) - | otherwise = do - !k <- peekByteOff src 0 - - let !a = shiftR (k .&. 0xfc) 2 - !b = shiftL (k .&. 0x03) 4 - - pokeByteOff dst 0 (aix a alpha) - - if plusPtr src 2 /= end - then do - pokeByteOff dst 1 (aix b alpha) - return (PS dfp 0 (n + 2)) - else do - !k' <- peekByteOff src 1 - - let !b' = shiftR (k' .&. 0xf0) 4 .|. b - !c' = shiftL (k' .&. 0x0f) 2 - - -- ideally, we'd want to pack these is in a single write - -- - pokeByteOff dst 1 (aix b' alpha) - pokeByteOff dst 2 (aix c' alpha) - return (PS dfp 0 (n + 3)) -- -------------------------------------------------------------------------- -- diff --git a/src/Data/ByteString/Base64/Internal/Tail.hs b/src/Data/ByteString/Base64/Internal/Tail.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Base64/Internal/Tail.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TypeApplications #-} +-- | +-- Module : Data.ByteString.Base64.Internal.W32.Loop +-- Copyright : (c) 2019 Emily Pillmore +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : portable +-- +-- Finalizers for the encoding loop +-- +module Data.ByteString.Base64.Internal.Tail +( loopTail +, loopTailNoPad +) where + +import Data.Bits +import Data.ByteString.Internal +import Data.ByteString.Base64.Internal.Utils + +import Foreign.ForeignPtr +import Foreign.Ptr +import Foreign.Storable + +import GHC.Exts +import GHC.Word + +-- | Finalize an encoded bytestring by filling in the remaining +-- bytes and any padding +-- +loopTail :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO () +loopTail (Ptr !alpha) !end !src !dst + | src == end = return () + | otherwise = do + !k <- peekByteOff src 0 + + let !a = shiftR (k .&. 0xfc) 2 + !b = shiftL (k .&. 0x03) 4 + + pokeByteOff dst 0 (aix a alpha) + + if plusPtr src 2 /= end + then do + pokeByteOff dst 1 (aix b alpha) + pokeByteOff @Word8 dst 2 0x3d + pokeByteOff @Word8 dst 3 0x3d + else do + !k' <- peekByteOff src 1 + + let !b' = shiftR (k' .&. 0xf0) 4 .|. b + !c' = shiftL (k' .&. 0x0f) 2 + + pokeByteOff dst 1 (aix b' alpha) + pokeByteOff dst 2 (aix c' alpha) + pokeByteOff @Word8 dst 3 0x3d +{-# INLINE loopTail #-} + + +-- | Finalize a bytestring by filling out the remaining bits +-- without padding. +-- +loopTailNoPad + :: ForeignPtr Word8 + -> Ptr Word8 + -> Ptr Word8 + -> Ptr Word8 + -> Ptr Word8 + -> Int + -> IO ByteString +loopTailNoPad !dfp (Ptr !alpha) !end !src !dst !n + | src == end = return (PS dfp 0 n) + | otherwise = do + !k <- peekByteOff src 0 + + let !a = shiftR (k .&. 0xfc) 2 + !b = shiftL (k .&. 0x03) 4 + + pokeByteOff dst 0 (aix a alpha) + + if plusPtr src 2 /= end + then do + pokeByteOff dst 1 (aix b alpha) + return (PS dfp 0 (n + 2)) + else do + !k' <- peekByteOff src 1 + + let !b' = shiftR (k' .&. 0xf0) 4 .|. b + !c' = shiftL (k' .&. 0x0f) 2 + + pokeByteOff dst 1 (aix b' alpha) + pokeByteOff dst 2 (aix c' alpha) + return (PS dfp 0 (n + 3)) +{-# INLINE loopTailNoPad #-} diff --git a/src/Data/ByteString/Base64/Internal/Utils.hs b/src/Data/ByteString/Base64/Internal/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Base64/Internal/Utils.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +-- | +-- Module : Data.ByteString.Base64.Internal +-- Copyright : (c) 2019 Emily Pillmore +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : portable +-- +-- Shared internal utils +-- +module Data.ByteString.Base64.Internal.Utils +( aix +, w32 +, writeNPlainForeignPtrBytes +) where + + +import System.IO.Unsafe + +import Foreign.ForeignPtr +import Foreign.Ptr +import Foreign.Storable + +import GHC.Exts +import GHC.ForeignPtr +import GHC.Word + +-- | Read 'Word8' index off alphabet addr +-- +aix :: Word8 -> Addr# -> Word8 +aix (W8# i) alpha = W8# (indexWord8OffAddr# alpha (word2Int# i)) +{-# INLINE aix #-} + +-- | Convert 'Word8''s into 'Word32''s +-- +w32 :: Word8 -> Word32 +w32 = fromIntegral +{-# INLINE w32 #-} + +-- | Allocate and fill @n@ bytes with some data +-- +writeNPlainForeignPtrBytes + :: ( Storable a + , Storable b + ) + => Int + -> [a] + -> ForeignPtr b +writeNPlainForeignPtrBytes !n as = unsafeDupablePerformIO $ do + fp <- mallocPlainForeignPtrBytes n + withForeignPtr fp $ \p -> go p as + return (castForeignPtr fp) + where + go !_ [] = return () + go !p (x:xs) = poke p x >> go (plusPtr p 1) xs diff --git a/src/Data/ByteString/Base64/Internal/W32/Loop.hs b/src/Data/ByteString/Base64/Internal/W32/Loop.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Base64/Internal/W32/Loop.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeApplications #-} +-- | +-- Module : Data.ByteString.Base64.Internal.W32.Loop +-- Copyright : (c) 2019-2020 Emily Pillmore +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : portable +-- +-- 'Word32'-optimized inner loop +-- +module Data.ByteString.Base64.Internal.W32.Loop +( innerLoop +, innerLoopNopad +) where + + +import Data.Bits +import Data.ByteString.Internal + +import Foreign.Ptr +import Foreign.Storable + +import GHC.Word + + +-- | Encoding inner loop. Packs 3 bytes from src pointer into +-- the first 6 bytes of 4 'Word8''s (using the encoding table, +-- as 2 'Word12''s ), writing these to the dst pointer. +-- +innerLoop + :: Ptr Word16 + -> Ptr Word8 + -> Ptr Word16 + -> Ptr Word8 + -> (Ptr Word8 -> Ptr Word8 -> IO ()) + -> IO () +innerLoop !etable !sptr !dptr !end finish = go (castPtr sptr) dptr + where + go !src !dst + | plusPtr src 2 >= end = finish (castPtr src) (castPtr dst) + | otherwise = do +#ifdef WORDS_BIGENDIAN + !w <- peek @Word32 src +#else + !w <- byteSwap32 <$> peek @Word32 src +#endif + let !a = (unsafeShiftR w 20) .&. 0xfff + !b = (unsafeShiftR w 8) .&. 0xfff + + !x <- peekElemOff etable (fromIntegral a) + !y <- peekElemOff etable (fromIntegral b) + + poke dst x + poke (plusPtr dst 2) y + + go (plusPtr src 3) (plusPtr dst 4) +{-# INLINE innerLoop #-} + +-- | Unpadded encoding loop, finalized as a bytestring using the +-- resultant length count. +-- +innerLoopNopad + :: Ptr Word16 + -> Ptr Word8 + -> Ptr Word16 + -> Ptr Word8 + -> (Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString) + -> IO ByteString +innerLoopNopad !etable !sptr !dptr !end finish = go (castPtr sptr) dptr 0 + where + go !src !dst !n + | plusPtr src 2 >= end = finish (castPtr src) (castPtr dst) n + | otherwise = do +#ifdef WORDS_BIGENDIAN + w <- peek @Word32 src +#else + w <- byteSwap32 <$> peek @Word32 src +#endif + let !a = (unsafeShiftR w 20) .&. 0xfff + !b = (unsafeShiftR w 8) .&. 0xfff + + !x <- peekElemOff etable (fromIntegral a) + !y <- peekElemOff etable (fromIntegral b) + + poke dst x + poke (plusPtr dst 2) y + + go (plusPtr src 3) (plusPtr dst 4) (n + 4) +{-# INLINE innerLoopNopad #-} diff --git a/src/Data/ByteString/Base64/Internal/W64/Loop.hs b/src/Data/ByteString/Base64/Internal/W64/Loop.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Base64/Internal/W64/Loop.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeApplications #-} +-- | +-- Module : Data.ByteString.Base64.Internal.W64.Loop +-- Copyright : (c) 2019-2020 Emily Pillmore +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : portable +-- +-- 'Word64'-optimized inner loops +-- +module Data.ByteString.Base64.Internal.W64.Loop +( innerLoop +, innerLoopNopad +) where + + +import Data.Bits +import Data.ByteString.Internal + +import Foreign.Ptr +import Foreign.Storable + +import GHC.Word + + +-- | Encoding inner loop. Packs 6 bytes from src pointer into +-- the first 6 bits of 4 'Word12''s (using the encoding table, +-- as 2 'Word12''s ), writing these to the dst pointer. +-- +innerLoop + :: Ptr Word16 + -> Ptr Word8 + -> Ptr Word16 + -> Ptr Word8 + -> (Ptr Word8 -> Ptr Word8 -> IO ()) + -> IO () +innerLoop !etable !sptr !dptr !end finish = go (castPtr sptr) dptr + where + tailRound !src !dst + | plusPtr src 2 >= end = finish src (castPtr dst) + | otherwise = do +#ifdef WORDS_BIGENDIAN + !w <- peek @Word32 (castPtr src) +#else + !w <- byteSwap32 <$> peek @Word32 (castPtr src) +#endif + let !a = (unsafeShiftR w 20) .&. 0xfff + !b = (unsafeShiftR w 8) .&. 0xfff + + !x <- peekElemOff etable (fromIntegral a) + !y <- peekElemOff etable (fromIntegral b) + + poke dst x + poke (plusPtr dst 2) y + + finish (plusPtr src 3) (castPtr (plusPtr dst 4)) + + go !src !dst + | plusPtr src 5 >= end = tailRound (castPtr src) dst + | otherwise = do +#ifdef WORDS_BIGENDIAN + !t <- peek @Word64 src +#else + !t <- byteSwap64 <$> peek @Word64 src +#endif + let !a = (unsafeShiftR t 52) .&. 0xfff + !b = (unsafeShiftR t 40) .&. 0xfff + !c = (unsafeShiftR t 28) .&. 0xfff + !d = (unsafeShiftR t 16) .&. 0xfff + + w <- peekElemOff etable (fromIntegral a) + x <- peekElemOff etable (fromIntegral b) + y <- peekElemOff etable (fromIntegral c) + z <- peekElemOff etable (fromIntegral d) + + poke dst w + poke (plusPtr dst 2) x + poke (plusPtr dst 4) y + poke (plusPtr dst 6) z + + go (plusPtr src 6) (plusPtr dst 8) +{-# INLINE innerLoop #-} + +-- | Unpadded encoding loop, finalized as a bytestring using the +-- resultant length count. +-- +innerLoopNopad + :: Ptr Word16 + -> Ptr Word8 + -> Ptr Word16 + -> Ptr Word8 + -> (Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString) + -> IO ByteString +innerLoopNopad !etable !sptr !dptr !end finish = go (castPtr sptr) dptr 0 + where + tailRound !src !dst !n + | plusPtr src 2 >= end = finish src (castPtr dst) n + | otherwise = do +#ifdef WORDS_BIGENDIAN + !w <- peek @Word32 (castPtr src) +#else + !w <- byteSwap32 <$> peek @Word32 (castPtr src) +#endif + let !a = (unsafeShiftR w 20) .&. 0xfff + !b = (unsafeShiftR w 8) .&. 0xfff + + !x <- peekElemOff etable (fromIntegral a) + !y <- peekElemOff etable (fromIntegral b) + + poke dst x + poke (plusPtr dst 2) y + + finish (plusPtr src 3) (castPtr (plusPtr dst 4)) (n + 4) + + go !src !dst !n + | plusPtr src 5 >= end = tailRound (castPtr src) dst n + | otherwise = do +#ifdef WORDS_BIGENDIAN + !t <- peek @Word64 src +#else + !t <- byteSwap64 <$> peek @Word64 src +#endif + let !a = (unsafeShiftR t 52) .&. 0xfff + !b = (unsafeShiftR t 40) .&. 0xfff + !c = (unsafeShiftR t 28) .&. 0xfff + !d = (unsafeShiftR t 16) .&. 0xfff + + w <- peekElemOff etable (fromIntegral a) + x <- peekElemOff etable (fromIntegral b) + y <- peekElemOff etable (fromIntegral c) + z <- peekElemOff etable (fromIntegral d) + + poke dst w + poke (plusPtr dst 2) x + poke (plusPtr dst 4) y + poke (plusPtr dst 6) z + + go (plusPtr src 6) (plusPtr dst 8) (n + 8) +{-# INLINE innerLoopNopad #-} diff --git a/src/Data/ByteString/Base64/Internal/W8/Loop.hs b/src/Data/ByteString/Base64/Internal/W8/Loop.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Base64/Internal/W8/Loop.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeApplications #-} +-- | +-- Module : Data.ByteString.Base64.Internal.W32.Loop +-- Copyright : (c) 2019-2020 Emily Pillmore +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : portable +-- +-- 'Word8' fallback loop +-- +module Data.ByteString.Base64.Internal.W8.Loop +( innerLoop +, innerLoopNopad +) where + + +import Data.Bits +import Data.ByteString.Internal +import Data.ByteString.Base64.Internal.Utils + +import Foreign.Ptr +import Foreign.Storable + +import GHC.Word + + +-- | Encoding inner loop. Packs 3 bytes from src pointer into +-- the first 6 bytes of 4 'Word8''s (using the encoding table, +-- as 2 'Word12''s ), writing these to the dst pointer. +-- +innerLoop + :: Ptr Word16 + -> Ptr Word8 + -> Ptr Word16 + -> Ptr Word8 + -> (Ptr Word8 -> Ptr Word8 -> IO ()) + -> IO () +innerLoop etable sptr dptr end finish = go sptr dptr + where + go !src !dst + | plusPtr src 2 >= end = finish src (castPtr dst) + | otherwise = do + + !i <- w32 <$> peek src + !j <- w32 <$> peek (plusPtr src 1) + !k <- w32 <$> peek (plusPtr src 2) + + let !w = (shiftL i 16) .|. (shiftL j 8) .|. k + + !x <- peekElemOff etable (fromIntegral (shiftR w 12)) + !y <- peekElemOff etable (fromIntegral (w .&. 0xfff)) + + poke dst x + poke (plusPtr dst 2) y + + go (plusPtr src 3) (plusPtr dst 4) + +-- | Unpadded encoding loop, finalized as a bytestring using the +-- resultant length count. +-- +innerLoopNopad + :: Ptr Word16 + -> Ptr Word8 + -> Ptr Word16 + -> Ptr Word8 + -> (Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString) + -> IO ByteString +innerLoopNopad etable sptr dptr end finish = go sptr dptr 0 + where + go !src !dst !n + | plusPtr src 2 >= end = finish src (castPtr dst) n + | otherwise = do + !i <- w32 <$> peek src + !j <- w32 <$> peek (plusPtr src 1) + !k <- w32 <$> peek (plusPtr src 2) + + let !w = (shiftL i 16) .|. (shiftL j 8) .|. k + !x <- peekElemOff etable (fromIntegral (shiftR w 12)) + !y <- peekElemOff etable (fromIntegral (w .&. 0xfff)) + + poke dst x + poke (plusPtr dst 2) y + + go (plusPtr src 3) (plusPtr dst 4) (n + 4) diff --git a/src/Data/ByteString/Base64/URL.hs b/src/Data/ByteString/Base64/URL.hs --- a/src/Data/ByteString/Base64/URL.hs +++ b/src/Data/ByteString/Base64/URL.hs @@ -2,12 +2,12 @@ {-# LANGUAGE OverloadedStrings #-} -- | -- Module : Data.ByteString.Base64.URL --- Copyright : (c) 2019 Emily Pillmore --- License : BSD-style +-- Copyright : (c) 2019 Emily Pillmore +-- License : BSD-style -- --- Maintainer : Emily Pillmore --- Stability : Experimental --- Portability : portable +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : portable -- -- This module contains the combinators implementing the -- RFC 4648 specification for the Base64-URL encoding including