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