steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

checksums.sha: benchmark.sha1 is 15% faster.

db4
John Benediktsson 2015-07-15 16:54:33 -07:00
parent 19bf287d67
commit 4cf54117ee
1 changed files with 39 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
basis/checksums/sha/sha.factor
View File

@ -1,19 +1,24 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays checksums checksums.common USING: accessors arrays checksums checksums.common combinators
checksums.stream combinators combinators.smart fry grouping combinators.smart fry grouping io.binary kernel kernel.private
io.binary kernel literals locals math math.bitwise math.ranges literals locals math math.bitwise math.ranges sequences
sequences sequences.generalizations sequences.private ; sequences.generalizations sequences.private ;
IN: checksums.sha IN: checksums.sha
MIXIN: sha
INSTANCE: sha checksum
SINGLETON: sha1 SINGLETON: sha1
INSTANCE: sha1 stream-checksum INSTANCE: sha1 sha
SINGLETON: sha-224 SINGLETON: sha-224
SINGLETON: sha-256 SINGLETON: sha-256
INSTANCE: sha-224 stream-checksum INSTANCE: sha-224 sha
INSTANCE: sha-256 stream-checksum INSTANCE: sha-256 sha
<PRIVATE
TUPLE: sha1-state < checksum-state TUPLE: sha1-state < checksum-state
{ K array } { K array }
@ -57,8 +62,6 @@ M: sha2-state clone
[ clone ] change-H [ clone ] change-H
[ clone ] change-K ; [ clone ] change-K ;
<PRIVATE
CONSTANT: a 0 CONSTANT: a 0
CONSTANT: b 1 CONSTANT: b 1
CONSTANT: c 2 CONSTANT: c 2
@ -235,6 +238,7 @@ M: sha-256 initialize-checksum-state drop <sha-256-state> ;
] [ bitxor ] reduce-outputs ; inline ] [ bitxor ] reduce-outputs ; inline
: prepare-M-256 ( n seq -- ) : prepare-M-256 ( n seq -- )
{ array } declare
{ {
[ [ 16 - ] dip nth-unsafe ] [ [ 16 - ] dip nth-unsafe ]
[ [ 15 - ] dip nth-unsafe s0-256 ] [ [ 15 - ] dip nth-unsafe s0-256 ]
@ -244,6 +248,7 @@ M: sha-256 initialize-checksum-state drop <sha-256-state> ;
} 2cleave set-nth-unsafe ; inline } 2cleave set-nth-unsafe ; inline
: prepare-M-512 ( n seq -- ) : prepare-M-512 ( n seq -- )
{ array } declare
{ {
[ [ 16 - ] dip nth-unsafe ] [ [ 16 - ] dip nth-unsafe ]
[ [ 15 - ] dip nth-unsafe s0-512 ] [ [ 15 - ] dip nth-unsafe s0-512 ]
@ -270,9 +275,9 @@ GENERIC: pad-initial-bytes ( string sha2 -- padded-string )
e H nth-unsafe S1-256 w+ e H nth-unsafe S1-256 w+
h H nth-unsafe w+ ; inline h H nth-unsafe w+ ; inline
: T2-256 ( H -- T2 ) :: T2-256 ( H -- T2 )
[ a swap nth-unsafe S0-256 ] a H nth-unsafe S0-256
[ a swap slice3 maj w+ ] bi ; inline a H slice3 maj w+ ; inline
:: T1-512 ( n M H sha2 -- T1 ) :: T1-512 ( n M H sha2 -- T1 )
n M nth-unsafe n M nth-unsafe
@ -281,19 +286,19 @@ GENERIC: pad-initial-bytes ( string sha2 -- padded-string )
e H nth-unsafe S1-512 w+ e H nth-unsafe S1-512 w+
h H nth-unsafe w+ ; inline h H nth-unsafe w+ ; inline
: T2-512 ( H -- T2 ) :: T2-512 ( H -- T2 )
[ a swap nth-unsafe S0-512 ] a H nth-unsafe S0-512
[ a swap slice3 maj w+ ] bi ; inline a H slice3 maj w+ ; inline
: update-H ( T1 T2 H -- ) :: update-H ( T1 T2 H -- )
h g pick exchange-unsafe h g H exchange-unsafe
g f pick exchange-unsafe g f H exchange-unsafe
f e pick exchange-unsafe f e H exchange-unsafe
pick d pick nth-unsafe w+ e pick set-nth-unsafe T1 d H nth-unsafe w+ e H set-nth-unsafe
d c pick exchange-unsafe d c H exchange-unsafe
c b pick exchange-unsafe c b H exchange-unsafe
b a pick exchange-unsafe b a H exchange-unsafe
[ w+ a ] dip set-nth-unsafe ; inline T1 T2 w+ a H set-nth-unsafe ; inline
: prepare-message-schedule ( seq sha2 -- w-seq ) : prepare-message-schedule ( seq sha2 -- w-seq )
[ word-size>> <groups> [ be> ] map ] [ word-size>> <groups> [ be> ] map ]
@ -330,8 +335,6 @@ M: sha2-short checksum-block
[ bytes>> t ] [ bytes-read>> pad-last-block ] [ ] tri [ bytes>> t ] [ bytes-read>> pad-last-block ] [ ] tri
[ checksum-block ] curry each ; inline [ checksum-block ] curry each ; inline
PRIVATE>
M: sha-224-state get-checksum M: sha-224-state get-checksum
clone clone
[ pad-last-short-block ] [ sha-224>checksum ] bi ; [ pad-last-short-block ] [ sha-224>checksum ] bi ;
@ -340,15 +343,8 @@ M: sha-256-state get-checksum
clone clone
[ pad-last-short-block ] [ sha-256>checksum ] bi ; [ pad-last-short-block ] [ sha-256>checksum ] bi ;
M: sha-224 checksum-stream ( stream checksum -- byte-array )
drop
[ <sha-224-state> ] dip add-checksum-stream get-checksum ;
M: sha-256 checksum-stream ( stream checksum -- byte-array )
drop
[ <sha-256-state> ] dip add-checksum-stream get-checksum ;
: sha1-W ( t seq -- ) : sha1-W ( t seq -- )
{ array } declare
{ {
[ [ 3 - ] dip nth-unsafe ] [ [ 3 - ] dip nth-unsafe ]
[ [ 8 - ] dip nth-unsafe bitxor ] [ [ 8 - ] dip nth-unsafe bitxor ]
@ -409,6 +405,12 @@ M: sha1-state get-checksum
clone clone
[ pad-last-short-block ] [ sha-256>checksum ] bi ; [ pad-last-short-block ] [ sha-256>checksum ] bi ;
M: sha1 checksum-stream ( stream checksum -- byte-array ) M: sha checksum-stream
drop initialize-checksum-state swap add-checksum-stream
[ <sha1-state> ] dip add-checksum-stream get-checksum ; get-checksum ;
M: sha checksum-bytes
initialize-checksum-state swap add-checksum-bytes
get-checksum ;
PRIVATE>