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

remove dynamic variables from sha2

db4
Doug Coleman 2009-05-08 17:39:11 -05:00
parent 3292ceaf46
commit 884fdc8ceb
1 changed files with 41 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
basis/checksums/sha2/sha2.factor
View File

@ -3,7 +3,7 @@
USING: kernel splitting grouping math sequences namespaces make USING: kernel splitting grouping math sequences namespaces make
io.binary math.bitwise checksums checksums.common io.binary math.bitwise checksums checksums.common
sbufs strings combinators.smart math.ranges fry combinators sbufs strings combinators.smart math.ranges fry combinators
accessors ; accessors locals ;
IN: checksums.sha2 IN: checksums.sha2
<PRIVATE <PRIVATE
@ -83,26 +83,31 @@ CONSTANT: K-256
} 2cleave set-nth ; inline } 2cleave set-nth ; inline
: ch ( x y z -- x' ) : ch ( x y z -- x' )
[ bitxor bitand ] keep bitxor ; [ bitxor bitand ] keep bitxor ; inline
: maj ( x y z -- x' ) : maj ( x y z -- x' )
[ [ bitand ] [ bitor ] 2bi ] dip bitand bitor ; [ [ bitand ] [ bitor ] 2bi ] dip bitand bitor ; inline
: prepare-message-schedule ( seq -- w-seq )
sha2 get word-size>> <sliced-groups> [ be> ] map sha2 get block-size>> 0 pad-tail
16 64 [a,b) over '[ _ process-M-256 ] each ;
: slice3 ( n seq -- a b c ) : slice3 ( n seq -- a b c )
[ dup 3 + ] dip <slice> first3 ; inline [ dup 3 + ] dip <slice> first3 ; inline
: T1 ( W n H -- T1 ) : pad-initial-bytes ( string -- padded-string )
[ dup [
[ swap nth ] keep HEX: 80 ,
sha2 get K>> nth + length
] dip [ HEX: 3f bitand calculate-pad-length 0 <string> % ]
[ e swap slice3 ch w+ ] [ 3 shift 8 >be % ] bi
[ e swap nth S1-256 w+ ] ] "" make append ;
[ h swap nth w+ ] tri ;
: seq>byte-array ( seq n -- string )
'[ _ >be ] map B{ } join ;
:: T1 ( n M H sha2 -- T1 )
n M nth
n sha2 K>> nth +
e H slice3 ch w+
e H nth S1-256 w+
h H nth w+ ;
: T2 ( H -- T2 ) : T2 ( H -- T2 )
[ a swap nth S0-256 ] [ a swap nth S0-256 ]
@ -116,37 +121,28 @@ CONSTANT: K-256
d c pick exchange d c pick exchange
c b pick exchange c b pick exchange
b a pick exchange b a pick exchange
[ w+ a ] dip set-nth ; [ w+ a ] dip set-nth ; inline
: process-chunk ( M block-size H-cloned -- ) : prepare-message-schedule ( seq sha2 -- w-seq )
[ [ word-size>> <sliced-groups> [ be> ] map ]
'[ [ block-size>> 0 pad-tail 16 64 [a,b) over '[ _ process-M-256 ] each ] bi ;
_
[ T1 ]
[ T2 ]
[ update-H ] tri
] with each
] keep sha2 get H>> [ w+ ] 2map sha2 get (>>H) ;
: pad-initial-bytes ( string -- padded-string ) :: process-chunk ( M block-size cloned-H sha2 -- )
dup [ block-size [
HEX: 80 , M cloned-H sha2 T1
length cloned-H T2
[ HEX: 3f bitand calculate-pad-length 0 <string> % ] cloned-H update-H
[ 3 shift 8 >be % ] bi
] "" make append ;
: seq>byte-array ( seq n -- string )
'[ _ >be ] map B{ } join ;
: byte-array>sha2 ( byte-array -- string )
pad-initial-bytes
sha2 get block-size>> <sliced-groups>
[
prepare-message-schedule
sha2 get [ block-size>> ] [ H>> clone ] bi process-chunk
] each ] each
sha2 get H>> 4 seq>byte-array ; cloned-H sha2 H>> [ w+ ] 2map sha2 (>>H) ;
:: byte-array>sha2 ( bytes state -- string )
bytes pad-initial-bytes
state block-size>> <sliced-groups>
[
state prepare-message-schedule
state [ block-size>> ] [ H>> clone ] bi state process-chunk
] each
state H>> 4 seq>byte-array ;
PRIVATE> PRIVATE>
@ -163,10 +159,7 @@ TUPLE: sha-256-state < sha2-state ;
K-256 >>K K-256 >>K
initial-H-256 >>H initial-H-256 >>H
4 >>word-size 4 >>word-size
64 >>block-size ; 64 >>block-size ;
M: sha-256 checksum-bytes M: sha-256 checksum-bytes
drop drop <sha-256-state> byte-array>sha2 ;
<sha-256-state> sha2 [
byte-array>sha2
] with-variable ;