diff options
author | Joe Crayne <joe@jerkface.net> | 2019-07-03 04:42:43 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-07-03 04:42:43 -0400 |
commit | eba3661ee3007c5e9e5444020b38333ef60fb88b (patch) | |
tree | c3ab6893eeac6cb811b4b18334b303d919fa8230 /Data | |
parent | a35b7f7517b6d4c351d95acba3b87aa786c90f05 (diff) |
Big-num optimization.
Diffstat (limited to 'Data')
-rw-r--r-- | Data/OpenPGP.hs | 13 | ||||
-rw-r--r-- | Data/OpenPGP/Internal.hs | 48 |
2 files changed, 29 insertions, 32 deletions
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs index 6667f1a..8fef50a 100644 --- a/Data/OpenPGP.hs +++ b/Data/OpenPGP.hs | |||
@@ -1005,19 +1005,10 @@ instance BINARY_CLASS MPI where | |||
1005 | put (MPI i) | 1005 | put (MPI i) |
1006 | | i >= 0 = do | 1006 | | i >= 0 = do |
1007 | put (bitl :: Word16) | 1007 | put (bitl :: Word16) |
1008 | putSomeByteString bytes | 1008 | putSomeByteString $ B.fromStrict bytes |
1009 | | otherwise = fail $ "MPI is less than 0: " ++ show i | 1009 | | otherwise = fail $ "MPI is less than 0: " ++ show i |
1010 | where | 1010 | where |
1011 | (bytes, bitl) | 1011 | (bitl, bytes) = putBigNum i |
1012 | | B.null bytes' = (B.singleton 0, 1) | ||
1013 | | otherwise = | ||
1014 | (bytes', (fromIntegral (B.length bytes') - 1) * 8 + sigBit) | ||
1015 | |||
1016 | sigBit = fromIntegral $ 8 - countLeadingZeros (B.index bytes 0) | ||
1017 | bytes' = B.reverse $ B.unfoldr (\x -> | ||
1018 | if x == 0 then Nothing else | ||
1019 | Just (fromIntegral x, x `shiftR` 8) | ||
1020 | ) i | ||
1021 | get = do | 1012 | get = do |
1022 | length <- fmap fromIntegral (get :: Get Word16) | 1013 | length <- fmap fromIntegral (get :: Get Word16) |
1023 | bytes <- getSomeByteString =<< assertProp (>0) ((length + 7) `div` 8) | 1014 | bytes <- getSomeByteString =<< assertProp (>0) ((length + 7) `div` 8) |
diff --git a/Data/OpenPGP/Internal.hs b/Data/OpenPGP/Internal.hs index 24330f1..175a62e 100644 --- a/Data/OpenPGP/Internal.hs +++ b/Data/OpenPGP/Internal.hs | |||
@@ -1,17 +1,20 @@ | |||
1 | {-# LANGUAGE BangPatterns #-} | 1 | {-# LANGUAGE BangPatterns, MagicHash #-} |
2 | module Data.OpenPGP.Internal where | 2 | module Data.OpenPGP.Internal where |
3 | 3 | ||
4 | import Data.Bits | 4 | import Data.Bits |
5 | import qualified Data.ByteString as BS | 5 | import qualified Data.ByteString as BS |
6 | import qualified Data.ByteString.Internal as BS | 6 | import qualified Data.ByteString.Internal as BS |
7 | import Data.Word | 7 | import Data.Word |
8 | import Foreign.ForeignPtr | 8 | import Foreign.ForeignPtr |
9 | import Foreign.Ptr | 9 | import Foreign.Ptr |
10 | import Foreign.Storable | 10 | import Foreign.Storable |
11 | import GHC.Exts | ||
12 | import GHC.Integer.GMP.Internals | ||
11 | import System.Endian | 13 | import System.Endian |
12 | import System.IO.Unsafe | 14 | import System.IO.Unsafe |
13 | 15 | ||
14 | 16 | ||
17 | |||
15 | decode_s2k_count :: Word8 -> Word32 | 18 | decode_s2k_count :: Word8 -> Word32 |
16 | decode_s2k_count c = (16 + (fromIntegral c .&. 15)) `shiftL` | 19 | decode_s2k_count c = (16 + (fromIntegral c .&. 15)) `shiftL` |
17 | ((fromIntegral c `shiftR` 4) + 6) | 20 | ((fromIntegral c `shiftR` 4) + 6) |
@@ -28,6 +31,7 @@ encode_s2k_count iterations | |||
28 | | count < 32 = (count, c) | 31 | | count < 32 = (count, c) |
29 | | otherwise = encode_s2k_count' (count `shiftR` 1) (c+1) | 32 | | otherwise = encode_s2k_count' (count `shiftR` 1) (c+1) |
30 | 33 | ||
34 | {- | ||
31 | getBigNum :: BS.ByteString -> Integer | 35 | getBigNum :: BS.ByteString -> Integer |
32 | getBigNum bytes = unsafeDupablePerformIO $ | 36 | getBigNum bytes = unsafeDupablePerformIO $ |
33 | let (fptr,offset,len) = BS.toForeignPtr bytes | 37 | let (fptr,offset,len) = BS.toForeignPtr bytes |
@@ -49,23 +53,25 @@ getBigNum bytes = unsafeDupablePerformIO $ | |||
49 | go2 (p `plusPtr` 1) a' | 53 | go2 (p `plusPtr` 1) a' |
50 | a <- go p 0 | 54 | a <- go p 0 |
51 | go2 (castPtr e :: Ptr Word8) a | 55 | go2 (castPtr e :: Ptr Word8) a |
56 | -} | ||
57 | getBigNum :: BS.ByteString -> Integer | ||
58 | getBigNum bytes = unsafeDupablePerformIO $ | ||
59 | let (fptr,offset,len) = BS.toForeignPtr bytes | ||
60 | in withForeignPtr fptr $ \ptr -> do | ||
61 | let Ptr addr = ptr `plusPtr` offset :: Ptr Word64 | ||
62 | I# n = len | ||
63 | importIntegerFromAddr addr (int2Word# n) 1# | ||
52 | 64 | ||
53 | {- | 65 | putBigNum :: Integer -> (Word16, BS.ByteString) |
54 | unchunk :: L.ByteString -> BS.ByteString | 66 | putBigNum 0 = (1,BS.singleton 0) |
55 | unchunk b = L.toStrict $ foldr reappend L.empty $ L.toChunks b | 67 | putBigNum i = ( (fromIntegral (BS.length bytes) - 1) * 8 + sigBit |
56 | 68 | , bytes ) | |
57 | reappend :: BS.ByteString -> BS.ByteString -> Maybe BS.ByteString | 69 | where |
58 | reappend a b = | 70 | sigBit = fromIntegral $ 8 - countLeadingZeros (BS.index bytes 0) |
59 | let (ap,ao,al) = BS.toForeignPtr a | 71 | bytes = integerToBS i |
60 | (bp,bo,bl) = BS.toForeignPtr b | ||
61 | in if ap == bp && ao+al == bo | ||
62 | then Just $ BS.PS ap ao (al+bl) | ||
63 | else Nothing | ||
64 | 72 | ||
65 | reconsChunk :: S.ByteString -> L.ByteString -> L.ByteString | 73 | integerToBS :: Integer -> BS.ByteString |
66 | reconsChunk b bs = case L.toChunks bs of | 74 | integerToBS i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \ptr -> do |
67 | (c:cs) -> case reappend b c of | 75 | let Ptr addr = ptr |
68 | Just x -> L.fromChunks (x:cs) | 76 | cnt <- exportIntegerToAddr i addr 1# |
69 | Nothing -> L.fromChunks (b:c:cs) | 77 | return () |
70 | _ -> L.fromChunks [b] | ||
71 | -} | ||