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

checksums.sha: more types, faster.

db4
John Benediktsson 2014-02-17 18:26:17 -08:00
parent 59677102b6
commit c3f79c1482
1 changed files with 24 additions and 19 deletions
basis/checksums/sha

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

@ -1,10 +1,9 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
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.generalizations sequences.private splitting strings ;
USING: accessors arrays checksums checksums.common
checksums.stream combinators combinators.smart fry grouping
io.binary kernel literals locals math math.bitwise math.ranges
sequences sequences.generalizations sequences.private ;
IN: checksums.sha
SINGLETON: sha1
@ -16,10 +15,14 @@ SINGLETON: sha-256
INSTANCE: sha-224 stream-checksum
INSTANCE: sha-256 stream-checksum
TUPLE: sha1-state < checksum-state K H W word-size ;
TUPLE: sha1-state < checksum-state
{ K array }
{ H array }
{ W array }
{ word-size fixnum } ;
CONSTANT: initial-H-sha1
{
{
0x67452301
0xefcdab89
0x98badcfe
@ -36,7 +39,10 @@ CONSTANT: K-sha1
4 { } nappend-as
]
TUPLE: sha2-state < checksum-state K H word-size ;
TUPLE: sha2-state < checksum-state
{ K array }
{ H array }
{ word-size fixnum } ;
TUPLE: sha2-short < sha2-state ;
@ -308,21 +314,21 @@ M: sha2-short checksum-block
[ prepare-message-schedule ]
[ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi ;
: sequence>byte-array ( seq n -- string )
'[ _ >be ] map B{ } concat-as ;
: sequence>byte-array ( seq n -- bytes )
'[ _ >be ] map B{ } concat-as ; inline
: sha1>checksum ( sha2 -- bytes )
H>> 4 sequence>byte-array ;
H>> 4 sequence>byte-array ; inline
: sha-224>checksum ( sha2 -- bytes )
H>> 7 head 4 sequence>byte-array ;
H>> 7 head 4 sequence>byte-array ; inline
: sha-256>checksum ( sha2 -- bytes )
H>> 4 sequence>byte-array ;
H>> 4 sequence>byte-array ; inline
: pad-last-short-block ( state -- )
[ bytes>> t ] [ bytes-read>> pad-last-block ] [ ] tri
[ checksum-block ] curry each ;
[ checksum-block ] curry each ; inline
PRIVATE>
@ -349,7 +355,7 @@ M: sha-256 checksum-stream ( stream checksum -- byte-array )
[ [ 14 - ] dip nth-unsafe bitxor ]
[ [ 16 - ] dip nth-unsafe bitxor 1 bitroll-32 ]
[ ]
} 2cleave set-nth-unsafe ;
} 2cleave set-nth-unsafe ; inline
: prepare-sha1-message-schedule ( seq -- w-seq )
4 <groups> [ be> ] map
@ -374,16 +380,16 @@ M: sha-256 checksum-stream ( stream checksum -- byte-array )
[
A 5 bitroll-32
B C D n sha1-f
B C D n sha1-f
E
n K nth-unsafe
n W nth-unsafe
] sum-outputs 32 bits ;
] sum-outputs 32 bits ; inline
:: process-sha1-chunk ( bytes H W K state -- )
:: process-sha1-chunk ( H W K state -- )
80 [
H W K inner-loop
d H nth-unsafe e H set-nth-unsafe
@ -397,7 +403,6 @@ M: sha-256 checksum-stream ( stream checksum -- byte-array )
M:: sha1-state checksum-block ( bytes state -- )
bytes prepare-sha1-message-schedule state W<<
bytes
state [ H>> clone ] [ W>> ] [ K>> ] tri state process-sha1-chunk ;
M: sha1-state get-checksum