[Fencommits] fenserve: optimizations for SHA1.hs
Benja Fallenstein
benja.fallenstein at gmail.com
Sat Mar 31 23:53:58 EEST 2007
Sat Mar 31 23:53:35 EEST 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* optimizations for SHA1.hs
diff -rN -u old-fenserve/SHA1.hs new-fenserve/SHA1.hs
--- old-fenserve/SHA1.hs 2007-03-31 23:53:58.000000000 +0300
+++ new-fenserve/SHA1.hs 2007-03-31 23:53:58.000000000 +0300
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fglasgow-exts -O2 #-}
{-
=============================================================================
COPYING
@@ -67,8 +68,7 @@
import Data.Char
import Data.Word
-type ABCDE = (Word32, Word32, Word32, Word32, Word32)
-type XYZ = (Word32, Word32, Word32)
+data ABCDE = ABCDE !Word32 !Word32 !Word32 !Word32 !Word32
type Rotation = Int
type Arr s = STUArray s Int Word32
@@ -80,15 +80,6 @@
abcde' = sha1_step_4_main abcde s1_2
s5 = sha1_step_5_display abcde'
-{-
-sha1_size :: (Integral a) => a -> [Word8] -> String
-sha1_size l s = s5
- where s1_2 = s ++ sha1_step_1_2_work (fromIntegral ((toInteger l) `mod` (2^64))) []
- abcde = sha1_step_3_init
- abcde' = sha1_step_4_main abcde s1_2
- s5 = sha1_step_5_display abcde'
--}
-
sha1_step_1_2_pad_length :: ByteString -> ByteString
sha1_step_1_2_pad_length bytes = B.append bytes (B.pack (padding ++ lenBytes)) where
padding = 128:replicate' (shiftR (fromIntegral $ (440-len) `mod` 512) 3) 0
@@ -105,41 +96,43 @@
where (n', d) = divMod n 256
sha1_step_3_init :: ABCDE
-sha1_step_3_init = (0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476, 0xc3d2e1f0)
+sha1_step_3_init =
+ ABCDE 0x67452301 0xefcdab89 0x98badcfe 0x10325476 0xc3d2e1f0
sha1_step_4_main :: ABCDE -> ByteString -> ABCDE
sha1_step_4_main abcde s = runST st where
st = newArray (0,79) 0 >>= sha1_step_4_work abcde s 0
-abcseq :: ABCDE -> a -> a
-abcseq (a,b,c,d,e) x = a `seq` b `seq` c `seq` d `seq` e `seq` x
-
sha1_step_4_work :: ABCDE -> ByteString -> Int -> Arr s -> ST s ABCDE
sha1_step_4_work abcde s offs arr | offs >= B.length s = return abcde
-sha1_step_4_work abcde0 s offs arr = abcde0 `abcseq` do
+sha1_step_4_work abcde0 s offs arr = do
sha1_ws 0 s offs arr
sha1_add_ws 16 arr
- let f1 (x, y, z) = (x .&. y) .|. ((complement x) .&. z)
- f2 (x, y, z) = x `xor` y `xor` z
- f3 (x, y, z) = (x .&. y) .|. (x .&. z) .|. (y .&. z)
- abcde1 <- fold_arr (doit f1 0x5a827999) abcde0 arr (0,19)
- abcde2 <- fold_arr (doit f2 0x6ed9eba1) abcde1 arr (20,39)
- abcde3 <- fold_arr (doit f3 0x8f1bbcdc) abcde2 arr (40,59)
- abcde4 <- fold_arr (doit f2 0xca62c1d6) abcde3 arr (60,79)
- let (a, b, c, d, e ) = abcde0
- (a', b', c', d', e') = abcde4
- abcde5 = (a + a', b + b', c + c', d + d', e + e')
- sha1_step_4_work abcde5 s (offs+64) arr
-
-doit :: (XYZ -> Word32) -> Word32 -> ABCDE -> Word32 -> ABCDE
-doit f k (a, b, c, d, e) w = (a', a, rotL b 30, c, d)
- where a' = rotL a 5 + f(b, c, d) + e + w + k
+ let f1 x y z = (x .&. y) .|. ((complement x) .&. z)
+ f2 x y z = x `xor` y `xor` z
+ f3 x y z = (x .&. y) .|. (x .&. z) .|. (y .&. z)
+ abcde1 <- fold_arr (doit f1 0x5a827999) abcde0 arr 0 19
+ abcde2 <- fold_arr (doit f2 0x6ed9eba1) abcde1 arr 20 39
+ abcde3 <- fold_arr (doit f3 0x8f1bbcdc) abcde2 arr 40 59
+ abcde4 <- fold_arr (doit f2 0xca62c1d6) abcde3 arr 60 79
+ let ABCDE a b c d e = abcde0
+ ABCDE a' b' c' d' e' = abcde4
+ abcde5 = ABCDE (a + a') (b + b') (c + c') (d + d') (e + e')
+ abcde5 `seq` sha1_step_4_work abcde5 s (offs+64) arr
+
+doit :: (Word32 -> Word32 -> Word32 -> Word32)
+ -> Word32 -> ABCDE -> Word32 -> ABCDE
+doit f k (ABCDE a b c d e) w = (ABCDE a' a (rotL b 30) c d)
+ where a' = rotL a 5 + f b c d + e + w + k
sha1_ws :: Int -> ByteString -> Int -> Arr s -> ST s ByteString
sha1_ws 16 s offs arr = return s
sha1_ws n s offs arr = do
- let bs = map (\i -> B.index s (n+offs+i)) [0..3]
- w = sum $ zipWith shiftL (map fromIntegral bs) [24, 16, 8, 0]
+ let b1 = fromIntegral $ B.index s (n+offs)
+ b2 = fromIntegral $ B.index s (n+offs+1)
+ b3 = fromIntegral $ B.index s (n+offs+2)
+ b4 = fromIntegral $ B.index s (n+offs+3)
+ w = shiftL b1 24 + shiftL b2 16 + shiftL b3 8 + b4
writeArray arr n w; sha1_ws (n+1) s offs arr
sha1_add_ws :: Int -> Arr s -> ST s ()
@@ -150,14 +143,14 @@
writeArray arr n $ rotL (w1 `xor` w2 `xor` w3 `xor` w4) 1
sha1_add_ws (n+1) arr
-fold_arr :: (ABCDE -> Word32 -> ABCDE) -> ABCDE -> Arr s -> (Int,Int) ->
+fold_arr :: (ABCDE -> Word32 -> ABCDE) -> ABCDE -> Arr s -> Int -> Int ->
ST s ABCDE
-fold_arr f x arr (i,j) | i > j = return x
- | otherwise = do
- val <- readArray arr i; x `abcseq` fold_arr f (f x val) arr (i+1,j)
+fold_arr f x arr i j | i > j = return x
+ | otherwise = do
+ val <- readArray arr i; x `seq` fold_arr f (f x val) arr (i+1) j
sha1_step_5_display :: ABCDE -> String
-sha1_step_5_display (a, b, c, d, e)
+sha1_step_5_display (ABCDE a b c d e)
= foldr (\x y -> display_32bits_as_hex x ++ y) "" [a, b, c, d, e]
display_32bits_as_hex :: Word32 -> String
@@ -171,5 +164,6 @@
(y8, y7) = divMod x6 16
getc n = (['0'..'9'] ++ ['a'..'f']) !! (fromIntegral n)
+{-# INLINE rotL #-}
rotL :: Word32 -> Rotation -> Word32
rotL a s = shiftL a s .|. shiftL a (s-32)
diff -rN -u old-fenserve/TestSHA1.hs new-fenserve/TestSHA1.hs
--- old-fenserve/TestSHA1.hs 2007-03-31 23:53:58.000000000 +0300
+++ new-fenserve/TestSHA1.hs 2007-03-31 23:53:58.000000000 +0300
@@ -20,4 +20,5 @@
import qualified Data.ByteString as B
import SHA1
-main = putStrLn $ sha1 (B.replicate 300000 0)
+-- c613004d5d6608a3f188fb902611eabb6259f952
+main = putStrLn $ sha1 (B.replicate 3000000 0)
More information about the Fencommits
mailing list