50% speedup using unsafe nth/set-nth/exchange in checksums.sha

db4
Doug Coleman 2009-06-21 00:58:36 -05:00
parent f2208728e2
commit 785c341c9b
1 changed files with 51 additions and 53 deletions

View File

@ -1,10 +1,10 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel splitting grouping math sequences namespaces make
io.binary math.bitwise checksums checksums.common
sbufs strings combinators.smart math.ranges fry combinators
accessors locals checksums.stream multiline literals
generalizations ;
USING: accessors checksums checksums.common checksums.stream
combinators combinators.smart fry generalizations grouping
io.binary kernel literals locals make math math.bitwise
math.ranges multiline namespaces sbufs sequences
sequences.private splitting strings ;
IN: checksums.sha
SINGLETON: sha1
@ -230,21 +230,21 @@ M: sha-256 initialize-checksum-state drop <sha-256-state> ;
: prepare-M-256 ( n seq -- )
{
[ [ 16 - ] dip nth ]
[ [ 15 - ] dip nth s0-256 ]
[ [ 7 - ] dip nth ]
[ [ 2 - ] dip nth s1-256 w+ w+ w+ ]
[ [ 16 - ] dip nth-unsafe ]
[ [ 15 - ] dip nth-unsafe s0-256 ]
[ [ 7 - ] dip nth-unsafe ]
[ [ 2 - ] dip nth-unsafe s1-256 w+ w+ w+ ]
[ ]
} 2cleave set-nth ; inline
} 2cleave set-nth-unsafe ; inline
: prepare-M-512 ( n seq -- )
{
[ [ 16 - ] dip nth ]
[ [ 15 - ] dip nth s0-512 ]
[ [ 7 - ] dip nth ]
[ [ 2 - ] dip nth s1-512 w+ w+ w+ ]
[ [ 16 - ] dip nth-unsafe ]
[ [ 15 - ] dip nth-unsafe s0-512 ]
[ [ 7 - ] dip nth-unsafe ]
[ [ 2 - ] dip nth-unsafe s1-512 w+ w+ w+ ]
[ ]
} 2cleave set-nth ; inline
} 2cleave set-nth-unsafe ; inline
: ch ( x y z -- x' )
[ bitxor bitand ] keep bitxor ; inline
@ -258,36 +258,36 @@ M: sha-256 initialize-checksum-state drop <sha-256-state> ;
GENERIC: pad-initial-bytes ( string sha2 -- padded-string )
:: T1-256 ( n M H sha2 -- T1 )
n M nth
n sha2 K>> nth +
n M nth-unsafe
n sha2 K>> nth-unsafe +
e H slice3 ch w+
e H nth S1-256 w+
h H nth w+ ; inline
e H nth-unsafe S1-256 w+
h H nth-unsafe w+ ; inline
: T2-256 ( H -- T2 )
[ a swap nth S0-256 ]
[ a swap nth-unsafe S0-256 ]
[ a swap slice3 maj w+ ] bi ; inline
:: T1-512 ( n M H sha2 -- T1 )
n M nth
n sha2 K>> nth +
n M nth-unsafe
n sha2 K>> nth-unsafe +
e H slice3 ch w+
e H nth S1-512 w+
h H nth w+ ; inline
e H nth-unsafe S1-512 w+
h H nth-unsafe w+ ; inline
: T2-512 ( H -- T2 )
[ a swap nth S0-512 ]
[ a swap nth-unsafe S0-512 ]
[ a swap slice3 maj w+ ] bi ; inline
: update-H ( T1 T2 H -- )
h g pick exchange
g f pick exchange
f e pick exchange
pick d pick nth w+ e pick set-nth
d c pick exchange
c b pick exchange
b a pick exchange
[ w+ a ] dip set-nth ; inline
h g pick exchange-unsafe
g f pick exchange-unsafe
f e pick exchange-unsafe
pick d pick nth-unsafe w+ e pick set-nth-unsafe
d c pick exchange-unsafe
c b pick exchange-unsafe
b a pick exchange-unsafe
[ w+ a ] dip set-nth-unsafe ; inline
: prepare-message-schedule ( seq sha2 -- w-seq )
[ word-size>> <sliced-groups> [ be> ] map ]
@ -309,7 +309,7 @@ M: sha2-short checksum-block
[ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi ;
: seq>byte-array ( seq n -- string )
'[ _ >be ] map B{ } join ;
'[ _ >be ] map B{ } concat-as ;
: sha1>checksum ( sha2 -- bytes )
H>> 4 seq>byte-array ;
@ -342,16 +342,14 @@ M: sha-256 checksum-stream ( stream checksum -- byte-array )
drop
[ <sha-256-state> ] dip add-checksum-stream get-checksum ;
: sha1-W ( t seq -- )
{
[ [ 3 - ] dip nth ]
[ [ 8 - ] dip nth bitxor ]
[ [ 14 - ] dip nth bitxor ]
[ [ 16 - ] dip nth bitxor 1 bitroll-32 ]
[ [ 3 - ] dip nth-unsafe ]
[ [ 8 - ] dip nth-unsafe bitxor ]
[ [ 14 - ] dip nth-unsafe bitxor ]
[ [ 16 - ] dip nth-unsafe bitxor 1 bitroll-32 ]
[ ]
} 2cleave set-nth ;
} 2cleave set-nth-unsafe ;
: prepare-sha1-message-schedule ( seq -- w-seq )
4 <sliced-groups> [ be> ] map
@ -368,11 +366,11 @@ M: sha-256 checksum-stream ( stream checksum -- byte-array )
} case ;
:: inner-loop ( n H W K -- temp )
a H nth :> A
b H nth :> B
c H nth :> C
d H nth :> D
e H nth :> E
a H nth-unsafe :> A
b H nth-unsafe :> B
c H nth-unsafe :> C
d H nth-unsafe :> D
e H nth-unsafe :> E
[
A 5 bitroll-32
@ -380,19 +378,19 @@ M: sha-256 checksum-stream ( stream checksum -- byte-array )
E
n K nth
n K nth-unsafe
n W nth
n W nth-unsafe
] sum-outputs 32 bits ;
:: process-sha1-chunk ( bytes H W K state -- )
80 [
H W K inner-loop
d H nth e H set-nth
c H nth d H set-nth
b H nth 30 bitroll-32 c H set-nth
a H nth b H set-nth
a H set-nth
d H nth-unsafe e H set-nth-unsafe
c H nth-unsafe d H set-nth-unsafe
b H nth-unsafe 30 bitroll-32 c H set-nth-unsafe
a H nth-unsafe b H set-nth-unsafe
a H set-nth-unsafe
] each
state [ H [ w+ ] 2map ] change-H drop ; inline