diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-09-26 23:22:15 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-09-26 23:22:15 +0400 |
commit | a34bc4269a11165ec9c05a0f5e55ba2800764b0f (patch) | |
tree | 8c5761af282156a16b5f2b22492a8167fb07158a /src/Data | |
parent | 861f289b2500d2576fe3572b3441e2ac868edeea (diff) |
Move pack5 & unpack5 to separate module
Diffstat (limited to 'src/Data')
-rw-r--r-- | src/Data/ByteString/Base32.hs | 210 | ||||
-rw-r--r-- | src/Data/ByteString/Base32/Internal.hs | 230 |
2 files changed, 231 insertions, 209 deletions
diff --git a/src/Data/ByteString/Base32.hs b/src/Data/ByteString/Base32.hs index ca377e2..704aac6 100644 --- a/src/Data/ByteString/Base32.hs +++ b/src/Data/ByteString/Base32.hs | |||
@@ -19,127 +19,9 @@ module Data.ByteString.Base32 | |||
19 | , decodeLenient | 19 | , decodeLenient |
20 | ) where | 20 | ) where |
21 | 21 | ||
22 | import Data.Bits.Extras | ||
23 | import Data.ByteString as BS | 22 | import Data.ByteString as BS |
24 | import Data.ByteString.Internal as BS | 23 | import Data.ByteString.Internal as BS |
25 | import Data.Word | 24 | import Data.ByteString.Base32.Internal |
26 | import Foreign hiding (unsafePerformIO) | ||
27 | import System.IO.Unsafe (unsafePerformIO) | ||
28 | import System.Endian | ||
29 | |||
30 | |||
31 | {----------------------------------------------------------------------- | ||
32 | -- Utils | ||
33 | -----------------------------------------------------------------------} | ||
34 | |||
35 | type Word5 = Word8 | ||
36 | |||
37 | -- System.Endian.toBE32 is slower because toBE32 implemented using | ||
38 | -- cbits shuffle functions while toBE32' implemented used gcc | ||
39 | -- intrinsics | ||
40 | -- | ||
41 | toBE64' :: Word64 -> Word64 | ||
42 | toBE64' = if getSystemEndianness == BigEndian then id else byteSwap | ||
43 | {-# INLINE toBE64' #-} | ||
44 | |||
45 | toBE32' :: Word32 -> Word32 | ||
46 | toBE32' = if getSystemEndianness == BigEndian then id else byteSwap | ||
47 | {-# INLINE toBE32' #-} | ||
48 | |||
49 | fromBE32' :: Word32 -> Word32 | ||
50 | fromBE32' = toBE32' | ||
51 | {-# INLINE fromBE32' #-} | ||
52 | |||
53 | -- n = 2 ^ d | ||
54 | padCeilN :: Int -> Int -> Int | ||
55 | padCeilN !n !x | ||
56 | | remd == 0 = x | ||
57 | | otherwise = (x - remd) + n | ||
58 | where mask = n - 1 | ||
59 | remd = x .&. mask | ||
60 | |||
61 | {----------------------------------------------------------------------- | ||
62 | -- Encoding | ||
63 | -----------------------------------------------------------------------} | ||
64 | |||
65 | unpack5Ptr :: Ptr Word8 -> ByteString -> ByteString | ||
66 | unpack5Ptr !tbl bs @ (PS fptr off sz) = | ||
67 | unsafePerformIO $ do | ||
68 | let unpackedSize = dstSize $ BS.length bs | ||
69 | BS.create unpackedSize $ \ dst -> do | ||
70 | withForeignPtr fptr $ \ ptr -> do | ||
71 | dst_end <- bigStep dst (advancePtr ptr off) sz | ||
72 | _ <- fillPadding dst_end (unpackedSize - (dst_end `minusPtr` dst)) | ||
73 | return () | ||
74 | where | ||
75 | dstSize x = padCeilN 8 (d + if m == 0 then 0 else 1) | ||
76 | where (d, m) = (x * 8) `quotRem` 5 | ||
77 | |||
78 | fillPadding dst s = memset dst (c2w '=') (fromIntegral s) | ||
79 | |||
80 | bigStep !dst !src !s | ||
81 | | s >= 5 = do | ||
82 | unpack5_40 dst src | ||
83 | bigStep (dst `advancePtr` 8) (src `advancePtr` 5) (s - 5) | ||
84 | | otherwise = smallStep dst src s 0 0 | ||
85 | |||
86 | unpack5_40 !dst !src = do | ||
87 | w32he <- peek (castPtr src) :: IO Word32 | ||
88 | let w32 = toBE32' w32he | ||
89 | fill8_32 0 (w32 `unsafeShiftR` 27) | ||
90 | fill8_32 1 (w32 `unsafeShiftR` 22) | ||
91 | fill8_32 2 (w32 `unsafeShiftR` 17) | ||
92 | fill8_32 3 (w32 `unsafeShiftR` 12) | ||
93 | fill8_32 4 (w32 `unsafeShiftR` 7) | ||
94 | fill8_32 5 (w32 `unsafeShiftR` 2) | ||
95 | |||
96 | w8 <- peekElemOff src 4 | ||
97 | fill8_32 6 ( (w32 `unsafeShiftL` 3) | ||
98 | .|. fromIntegral (w8 `unsafeShiftR` 5)) | ||
99 | fill8_32 7 (fromIntegral w8) | ||
100 | where | ||
101 | fill8_32 :: Int -> Word32 -> IO () | ||
102 | fill8_32 !i !w32 = do | ||
103 | w8 <- peekByteOff tbl (fromIntegral w32 .&. 0x1f) | ||
104 | poke (dst `advancePtr` i) w8 | ||
105 | |||
106 | smallStep !dst !src !s !unused !un_cnt | ||
107 | | un_cnt >= 5 = do | ||
108 | let ix = unused `unsafeShiftR` 3 | ||
109 | peekByteOff tbl (fromIntegral ix) >>= poke dst | ||
110 | smallStep (advancePtr dst 1) | ||
111 | src s | ||
112 | (unused `unsafeShiftL` 5) | ||
113 | (un_cnt - 5) | ||
114 | |||
115 | | s == 0 = do | ||
116 | if un_cnt == 0 | ||
117 | then return dst | ||
118 | else do | ||
119 | let ix = unused `unsafeShiftR` 3 | ||
120 | peekByteOff tbl (fromIntegral ix) >>= poke dst | ||
121 | return (dst `advancePtr` 1) | ||
122 | |||
123 | | otherwise = do | ||
124 | w8 <- peek src | ||
125 | let usd_cnt = 5 - un_cnt | ||
126 | let bits = w8 .&. complement (bit (8 - usd_cnt) - 1) | ||
127 | let ix = (unused .|. bits `shiftR` un_cnt) `unsafeShiftR` 3 | ||
128 | peekByteOff tbl (fromIntegral ix) >>= poke dst | ||
129 | smallStep (advancePtr dst 1) | ||
130 | (advancePtr src 1) (pred s) | ||
131 | (w8 `shiftL` usd_cnt) (8 - usd_cnt) | ||
132 | |||
133 | type EncTable = ByteString | ||
134 | |||
135 | unpack5 :: EncTable -> ByteString -> ByteString | ||
136 | unpack5 (PS fptr off len) bs | ||
137 | | len /= 32 | ||
138 | = error $ "base32: unpack5: invalid lookup table size " ++ show len | ||
139 | | otherwise = | ||
140 | unsafePerformIO $ do | ||
141 | withForeignPtr fptr $ \ptr -> do | ||
142 | return $ unpack5Ptr (ptr `advancePtr` off) bs | ||
143 | 25 | ||
144 | encW5 :: Word5 -> Word8 | 26 | encW5 :: Word5 -> Word8 |
145 | encW5 !x | 27 | encW5 !x |
@@ -154,92 +36,6 @@ encTable = BS.pack $ fmap encW5 [0..31] | |||
154 | encode :: ByteString -> ByteString | 36 | encode :: ByteString -> ByteString |
155 | encode = unpack5 encTable | 37 | encode = unpack5 encTable |
156 | 38 | ||
157 | {----------------------------------------------------------------------- | ||
158 | -- Decoding | ||
159 | -----------------------------------------------------------------------} | ||
160 | |||
161 | invIx :: Word5 | ||
162 | invIx = 255 | ||
163 | |||
164 | pack5Ptr :: Ptr Word5 -> ByteString -> ByteString | ||
165 | pack5Ptr !tbl bs @ (PS fptr off sz) = | ||
166 | unsafePerformIO $ do | ||
167 | let packedSize = dstSize $ BS.length bs | ||
168 | BS.createAndTrim packedSize $ \ dst -> do | ||
169 | withForeignPtr fptr $ \ ptr -> do | ||
170 | dst_end <- bigStep dst (advancePtr ptr off) sz | ||
171 | return (dst_end `minusPtr` dst) | ||
172 | where | ||
173 | lookupTable :: Word8 -> Word5 | ||
174 | lookupTable ix | ||
175 | | x == invIx = error $ "base32: decode: invalid character" ++ show ix | ||
176 | | otherwise = x | ||
177 | where x = inlinePerformIO (peekByteOff tbl (fromIntegral ix)) | ||
178 | {-# INLINE lookupTable #-} | ||
179 | |||
180 | dstSize x = d + if m == 0 then 0 else 1 | ||
181 | where (d, m) = (x * 5) `quotRem` 8 | ||
182 | |||
183 | bigStep !dst !src !s | ||
184 | | s > 8 = do | ||
185 | pack5_40 dst src | ||
186 | bigStep (dst `advancePtr` 5) (src `advancePtr` 8) (s - 8) | ||
187 | | otherwise = smallStep dst src s (0 :: Word64) 0 | ||
188 | |||
189 | pack5_40 !dst !src = do | ||
190 | w64he <- peek (castPtr src) :: IO Word64 | ||
191 | let w64 = toBE64' w64he | ||
192 | let w40 = putAsW5 (w64 `unsafeShiftR` 00) $ | ||
193 | putAsW5 (w64 `unsafeShiftR` 08) $ | ||
194 | putAsW5 (w64 `unsafeShiftR` 16) $ | ||
195 | putAsW5 (w64 `unsafeShiftR` 24) $ | ||
196 | putAsW5 (w64 `unsafeShiftR` 32) $ | ||
197 | putAsW5 (w64 `unsafeShiftR` 40) $ | ||
198 | putAsW5 (w64 `unsafeShiftR` 48) $ | ||
199 | putAsW5 (w64 `unsafeShiftR` 56) 0 | ||
200 | pokeW40 w40 | ||
201 | where | ||
202 | putAsW5 :: Word64 -> Word64 -> Word64 | ||
203 | {-# INLINE putAsW5 #-} | ||
204 | putAsW5 !w8 !acc = (acc `unsafeShiftL` 5) | ||
205 | .|. fromIntegral (lookupTable (fromIntegral w8)) | ||
206 | |||
207 | pokeW40 :: Word64 -> IO () | ||
208 | {-# INLINE pokeW40 #-} | ||
209 | pokeW40 !w40 = do | ||
210 | poke dst (fromIntegral (w40 `unsafeShiftR` 32) :: Word8) | ||
211 | poke (castPtr (dst `advancePtr` 1)) | ||
212 | (fromBE32' (fromIntegral w40 :: Word32)) | ||
213 | |||
214 | smallStep !dst !src !s !unused !un_cnt | ||
215 | | un_cnt >= 8 = do | ||
216 | poke dst $ fromIntegral (unused `unsafeShiftR` (un_cnt - 8)) | ||
217 | smallStep (dst `advancePtr` 1) src s unused (un_cnt - 8) | ||
218 | |||
219 | | s == 0 = return dst | ||
220 | | otherwise = do | ||
221 | w8 <- peek src | ||
222 | if w2c w8 == '=' | ||
223 | then if (bit un_cnt - 1) .&. unused == 0 | ||
224 | then smallStep dst src 0 0 0 | ||
225 | else smallStep dst src 0 (unused `shiftL` (8 - un_cnt)) 8 | ||
226 | else smallStep dst | ||
227 | (src `advancePtr` 1) (pred s) | ||
228 | ((unused `unsafeShiftL` 5) | ||
229 | .|. fromIntegral (lookupTable (fromIntegral w8))) | ||
230 | (un_cnt + 5) | ||
231 | |||
232 | type DecTable = ByteString | ||
233 | |||
234 | pack5 :: DecTable -> ByteString -> ByteString | ||
235 | pack5 (PS fptr off len) bs | ||
236 | | len /= 256 | ||
237 | = error $ "base32: pack5: invalid lookup table size " ++ show len | ||
238 | | otherwise = | ||
239 | unsafePerformIO $ do | ||
240 | withForeignPtr fptr $ \ptr -> | ||
241 | return $ pack5Ptr (ptr `advancePtr` off) bs | ||
242 | |||
243 | decW5 :: Word8 -> Word5 | 39 | decW5 :: Word8 -> Word5 |
244 | decW5 !x | 40 | decW5 !x |
245 | | x < 50 {- c2w '2' -} = invIx | 41 | | x < 50 {- c2w '2' -} = invIx |
@@ -258,10 +54,6 @@ decTable = BS.pack $ fmap decW5 [minBound .. maxBound] | |||
258 | decode :: ByteString -> ByteString | 54 | decode :: ByteString -> ByteString |
259 | decode = pack5 decTable | 55 | decode = pack5 decTable |
260 | 56 | ||
261 | {----------------------------------------------------------------------- | ||
262 | -- Lenient Decoding | ||
263 | -----------------------------------------------------------------------} | ||
264 | |||
265 | decCharLenient :: Char -> Word5 | 57 | decCharLenient :: Char -> Word5 |
266 | decCharLenient x | 58 | decCharLenient x |
267 | | x < '2' = err | 59 | | x < '2' = err |
diff --git a/src/Data/ByteString/Base32/Internal.hs b/src/Data/ByteString/Base32/Internal.hs new file mode 100644 index 0000000..c34e80c --- /dev/null +++ b/src/Data/ByteString/Base32/Internal.hs | |||
@@ -0,0 +1,230 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam Truzjan 2013 | ||
3 | -- License : BSD3 | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : stable | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- (Word5 <-> Word8) and (Word8 -> Word5) bytestring packers using | ||
9 | -- lookup table. | ||
10 | -- | ||
11 | {-# LANGUAGE BangPatterns #-} | ||
12 | module Data.ByteString.Base32.Internal | ||
13 | ( Word5 | ||
14 | , Word8 | ||
15 | |||
16 | , EncTable | ||
17 | , unpack5 | ||
18 | |||
19 | , DecTable | ||
20 | , pack5 | ||
21 | , invIx | ||
22 | ) where | ||
23 | |||
24 | import Data.Bits.Extras | ||
25 | import Data.ByteString as BS | ||
26 | import Data.ByteString.Internal as BS | ||
27 | import Data.Word | ||
28 | import Foreign hiding (unsafePerformIO) | ||
29 | import System.IO.Unsafe (unsafePerformIO) | ||
30 | import System.Endian | ||
31 | |||
32 | |||
33 | {----------------------------------------------------------------------- | ||
34 | -- Utils | ||
35 | -----------------------------------------------------------------------} | ||
36 | |||
37 | type Word5 = Word8 | ||
38 | |||
39 | -- System.Endian.toBE32 is slower because toBE32 implemented using | ||
40 | -- cbits shuffle functions while toBE32' implemented used gcc | ||
41 | -- intrinsics | ||
42 | -- | ||
43 | toBE64' :: Word64 -> Word64 | ||
44 | toBE64' = if getSystemEndianness == BigEndian then id else byteSwap | ||
45 | {-# INLINE toBE64' #-} | ||
46 | |||
47 | toBE32' :: Word32 -> Word32 | ||
48 | toBE32' = if getSystemEndianness == BigEndian then id else byteSwap | ||
49 | {-# INLINE toBE32' #-} | ||
50 | |||
51 | fromBE32' :: Word32 -> Word32 | ||
52 | fromBE32' = toBE32' | ||
53 | {-# INLINE fromBE32' #-} | ||
54 | |||
55 | -- n = 2 ^ d | ||
56 | padCeilN :: Int -> Int -> Int | ||
57 | padCeilN !n !x | ||
58 | | remd == 0 = x | ||
59 | | otherwise = (x - remd) + n | ||
60 | where mask = n - 1 | ||
61 | remd = x .&. mask | ||
62 | |||
63 | {----------------------------------------------------------------------- | ||
64 | -- Encoding | ||
65 | -----------------------------------------------------------------------} | ||
66 | |||
67 | unpack5Ptr :: Ptr Word8 -> ByteString -> ByteString | ||
68 | unpack5Ptr !tbl bs @ (PS fptr off sz) = | ||
69 | unsafePerformIO $ do | ||
70 | let unpackedSize = dstSize $ BS.length bs | ||
71 | BS.create unpackedSize $ \ dst -> do | ||
72 | withForeignPtr fptr $ \ ptr -> do | ||
73 | dst_end <- bigStep dst (advancePtr ptr off) sz | ||
74 | _ <- fillPadding dst_end (unpackedSize - (dst_end `minusPtr` dst)) | ||
75 | return () | ||
76 | where | ||
77 | dstSize x = padCeilN 8 (d + if m == 0 then 0 else 1) | ||
78 | where (d, m) = (x * 8) `quotRem` 5 | ||
79 | |||
80 | fillPadding dst s = memset dst (c2w '=') (fromIntegral s) | ||
81 | |||
82 | bigStep !dst !src !s | ||
83 | | s >= 5 = do | ||
84 | unpack5_40 dst src | ||
85 | bigStep (dst `advancePtr` 8) (src `advancePtr` 5) (s - 5) | ||
86 | | otherwise = smallStep dst src s 0 0 | ||
87 | |||
88 | unpack5_40 !dst !src = do | ||
89 | w32he <- peek (castPtr src) :: IO Word32 | ||
90 | let w32 = toBE32' w32he | ||
91 | fill8_32 0 (w32 `unsafeShiftR` 27) | ||
92 | fill8_32 1 (w32 `unsafeShiftR` 22) | ||
93 | fill8_32 2 (w32 `unsafeShiftR` 17) | ||
94 | fill8_32 3 (w32 `unsafeShiftR` 12) | ||
95 | fill8_32 4 (w32 `unsafeShiftR` 7) | ||
96 | fill8_32 5 (w32 `unsafeShiftR` 2) | ||
97 | |||
98 | w8 <- peekElemOff src 4 | ||
99 | fill8_32 6 ( (w32 `unsafeShiftL` 3) | ||
100 | .|. fromIntegral (w8 `unsafeShiftR` 5)) | ||
101 | fill8_32 7 (fromIntegral w8) | ||
102 | where | ||
103 | fill8_32 :: Int -> Word32 -> IO () | ||
104 | fill8_32 !i !w32 = do | ||
105 | w8 <- peekByteOff tbl (fromIntegral w32 .&. 0x1f) | ||
106 | poke (dst `advancePtr` i) w8 | ||
107 | |||
108 | smallStep !dst !src !s !unused !un_cnt | ||
109 | | un_cnt >= 5 = do | ||
110 | let ix = unused `unsafeShiftR` 3 | ||
111 | peekByteOff tbl (fromIntegral ix) >>= poke dst | ||
112 | smallStep (advancePtr dst 1) | ||
113 | src s | ||
114 | (unused `unsafeShiftL` 5) | ||
115 | (un_cnt - 5) | ||
116 | |||
117 | | s == 0 = do | ||
118 | if un_cnt == 0 | ||
119 | then return dst | ||
120 | else do | ||
121 | let ix = unused `unsafeShiftR` 3 | ||
122 | peekByteOff tbl (fromIntegral ix) >>= poke dst | ||
123 | return (dst `advancePtr` 1) | ||
124 | |||
125 | | otherwise = do | ||
126 | w8 <- peek src | ||
127 | let usd_cnt = 5 - un_cnt | ||
128 | let bits = w8 .&. complement (bit (8 - usd_cnt) - 1) | ||
129 | let ix = (unused .|. bits `shiftR` un_cnt) `unsafeShiftR` 3 | ||
130 | peekByteOff tbl (fromIntegral ix) >>= poke dst | ||
131 | smallStep (advancePtr dst 1) | ||
132 | (advancePtr src 1) (pred s) | ||
133 | (w8 `shiftL` usd_cnt) (8 - usd_cnt) | ||
134 | |||
135 | type EncTable = ByteString | ||
136 | |||
137 | unpack5 :: EncTable -> ByteString -> ByteString | ||
138 | unpack5 (PS fptr off len) bs | ||
139 | | len /= 32 | ||
140 | = error $ "base32: unpack5: invalid lookup table size " ++ show len | ||
141 | | otherwise = | ||
142 | unsafePerformIO $ do | ||
143 | withForeignPtr fptr $ \ptr -> do | ||
144 | return $ unpack5Ptr (ptr `advancePtr` off) bs | ||
145 | |||
146 | {----------------------------------------------------------------------- | ||
147 | -- Decoding | ||
148 | -----------------------------------------------------------------------} | ||
149 | |||
150 | invIx :: Word5 | ||
151 | invIx = 255 | ||
152 | |||
153 | pack5Ptr :: Ptr Word5 -> ByteString -> ByteString | ||
154 | pack5Ptr !tbl bs @ (PS fptr off sz) = | ||
155 | unsafePerformIO $ do | ||
156 | let packedSize = dstSize $ BS.length bs | ||
157 | BS.createAndTrim packedSize $ \ dst -> do | ||
158 | withForeignPtr fptr $ \ ptr -> do | ||
159 | dst_end <- bigStep dst (advancePtr ptr off) sz | ||
160 | return (dst_end `minusPtr` dst) | ||
161 | where | ||
162 | lookupTable :: Word8 -> Word5 | ||
163 | lookupTable ix | ||
164 | | x == invIx = error $ "base32: decode: invalid character" ++ show ix | ||
165 | | otherwise = x | ||
166 | where x = inlinePerformIO (peekByteOff tbl (fromIntegral ix)) | ||
167 | {-# INLINE lookupTable #-} | ||
168 | |||
169 | dstSize x = d + if m == 0 then 0 else 1 | ||
170 | where (d, m) = (x * 5) `quotRem` 8 | ||
171 | |||
172 | bigStep !dst !src !s | ||
173 | | s > 8 = do | ||
174 | pack5_40 dst src | ||
175 | bigStep (dst `advancePtr` 5) (src `advancePtr` 8) (s - 8) | ||
176 | | otherwise = smallStep dst src s (0 :: Word64) 0 | ||
177 | |||
178 | pack5_40 !dst !src = do | ||
179 | w64he <- peek (castPtr src) :: IO Word64 | ||
180 | let w64 = toBE64' w64he | ||
181 | let w40 = putAsW5 (w64 `unsafeShiftR` 00) $ | ||
182 | putAsW5 (w64 `unsafeShiftR` 08) $ | ||
183 | putAsW5 (w64 `unsafeShiftR` 16) $ | ||
184 | putAsW5 (w64 `unsafeShiftR` 24) $ | ||
185 | putAsW5 (w64 `unsafeShiftR` 32) $ | ||
186 | putAsW5 (w64 `unsafeShiftR` 40) $ | ||
187 | putAsW5 (w64 `unsafeShiftR` 48) $ | ||
188 | putAsW5 (w64 `unsafeShiftR` 56) 0 | ||
189 | pokeW40 w40 | ||
190 | where | ||
191 | putAsW5 :: Word64 -> Word64 -> Word64 | ||
192 | {-# INLINE putAsW5 #-} | ||
193 | putAsW5 !w8 !acc = (acc `unsafeShiftL` 5) | ||
194 | .|. fromIntegral (lookupTable (fromIntegral w8)) | ||
195 | |||
196 | pokeW40 :: Word64 -> IO () | ||
197 | {-# INLINE pokeW40 #-} | ||
198 | pokeW40 !w40 = do | ||
199 | poke dst (fromIntegral (w40 `unsafeShiftR` 32) :: Word8) | ||
200 | poke (castPtr (dst `advancePtr` 1)) | ||
201 | (fromBE32' (fromIntegral w40 :: Word32)) | ||
202 | |||
203 | smallStep !dst !src !s !unused !un_cnt | ||
204 | | un_cnt >= 8 = do | ||
205 | poke dst $ fromIntegral (unused `unsafeShiftR` (un_cnt - 8)) | ||
206 | smallStep (dst `advancePtr` 1) src s unused (un_cnt - 8) | ||
207 | |||
208 | | s == 0 = return dst | ||
209 | | otherwise = do | ||
210 | w8 <- peek src | ||
211 | if w2c w8 == '=' | ||
212 | then if (bit un_cnt - 1) .&. unused == 0 | ||
213 | then smallStep dst src 0 0 0 | ||
214 | else smallStep dst src 0 (unused `shiftL` (8 - un_cnt)) 8 | ||
215 | else smallStep dst | ||
216 | (src `advancePtr` 1) (pred s) | ||
217 | ((unused `unsafeShiftL` 5) | ||
218 | .|. fromIntegral (lookupTable (fromIntegral w8))) | ||
219 | (un_cnt + 5) | ||
220 | |||
221 | type DecTable = ByteString | ||
222 | |||
223 | pack5 :: DecTable -> ByteString -> ByteString | ||
224 | pack5 (PS fptr off len) bs | ||
225 | | len /= 256 | ||
226 | = error $ "base32: pack5: invalid lookup table size " ++ show len | ||
227 | | otherwise = | ||
228 | unsafePerformIO $ do | ||
229 | withForeignPtr fptr $ \ptr -> | ||
230 | return $ pack5Ptr (ptr `advancePtr` off) bs | ||