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

checksums.md5: more types and inline, lots faster.

db4
John Benediktsson 2014-02-17 18:26:57 -08:00
parent c3f79c1482
commit 6fd68ecb64
1 changed files with 22 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
basis/checksums/md5/md5.factor
View File

@ -14,7 +14,9 @@ SINGLETON: md5
INSTANCE: md5 stream-checksum INSTANCE: md5 stream-checksum
TUPLE: md5-state < checksum-state state old-state ; TUPLE: md5-state < checksum-state
{ state uint-array }
{ old-state uint-array } ;
: <md5-state> ( -- md5 ) : <md5-state> ( -- md5 )
md5-state new-checksum-state md5-state new-checksum-state
@ -26,16 +28,13 @@ M: md5 initialize-checksum-state drop <md5-state> ;
<PRIVATE <PRIVATE
: v-w+ ( v1 v2 -- v3 ) [ w+ ] 2map ;
: update-md5 ( md5 -- ) : update-md5 ( md5 -- )
[ state>> ] [ old-state>> v-w+ dup clone ] [ ] tri [ state>> ] [ old-state>> [ w+ ] 2map dup clone ] [ ] tri
[ old-state<< ] [ state<< ] bi ; [ old-state<< ] [ state<< ] bi ; inline
CONSTANT: T CONSTANT: T $[
$[ 80 iota [ sin abs 32 2^ * >integer ] uint-array{ } map-as
80 iota [ sin abs 32 2^ * >integer ] uint-array{ } map-as ]
]
:: F ( X Y Z -- FXYZ ) :: F ( X Y Z -- FXYZ )
#! F(X,Y,Z) = XY v not(X) Z #! F(X,Y,Z) = XY v not(X) Z
@ -108,7 +107,7 @@ MACRO: with-md5-round ( ops quot -- )
[ d a b c 13 S12 14 ] [ d a b c 13 S12 14 ]
[ c d a b 14 S13 15 ] [ c d a b 14 S13 15 ]
[ b c d a 15 S14 16 ] [ b c d a 15 S14 16 ]
} [ F ] with-md5-round ; } [ F ] with-md5-round ; inline
: (process-md5-block-G) ( block state -- ) : (process-md5-block-G) ( block state -- )
{ {
@ -128,7 +127,7 @@ MACRO: with-md5-round ( ops quot -- )
[ d a b c 2 S22 30 ] [ d a b c 2 S22 30 ]
[ c d a b 7 S23 31 ] [ c d a b 7 S23 31 ]
[ b c d a 12 S24 32 ] [ b c d a 12 S24 32 ]
} [ G ] with-md5-round ; } [ G ] with-md5-round ; inline
: (process-md5-block-H) ( block state -- ) : (process-md5-block-H) ( block state -- )
{ {
@ -148,7 +147,7 @@ MACRO: with-md5-round ( ops quot -- )
[ d a b c 12 S32 46 ] [ d a b c 12 S32 46 ]
[ c d a b 15 S33 47 ] [ c d a b 15 S33 47 ]
[ b c d a 2 S34 48 ] [ b c d a 2 S34 48 ]
} [ H ] with-md5-round ; } [ H ] with-md5-round ; inline
: (process-md5-block-I) ( block state -- ) : (process-md5-block-I) ( block state -- )
{ {
@ -168,12 +167,7 @@ MACRO: with-md5-round ( ops quot -- )
[ d a b c 11 S42 62 ] [ d a b c 11 S42 62 ]
[ c d a b 2 S43 63 ] [ c d a b 2 S43 63 ]
[ b c d a 9 S44 64 ] [ b c d a 9 S44 64 ]
} [ I ] with-md5-round ; } [ I ] with-md5-round ; inline
HINTS: (process-md5-block-F) { uint-array md5-state } ;
HINTS: (process-md5-block-G) { uint-array md5-state } ;
HINTS: (process-md5-block-H) { uint-array md5-state } ;
HINTS: (process-md5-block-I) { uint-array md5-state } ;
: byte-array>le ( byte-array -- byte-array ) : byte-array>le ( byte-array -- byte-array )
little-endian? [ little-endian? [
@ -183,19 +177,11 @@ HINTS: (process-md5-block-I) { uint-array md5-state } ;
] each ] each
] unless ; ] unless ;
: uint-array-cast-le ( byte-array -- uint-array ) HINTS: byte-array>le byte-array ;
byte-array>le uint cast-array ;
HINTS: uint-array-cast-le byte-array ; M: md5-state checksum-block
: uint-array>byte-array-le ( uint-array -- byte-array )
underlying>> byte-array>le ;
HINTS: uint-array>byte-array-le uint-array ;
M: md5-state checksum-block ( block state -- )
[ [
[ uint-array-cast-le ] [ state>> ] bi* { [ byte-array>le uint cast-array ] [ state>> ] bi* {
[ (process-md5-block-F) ] [ (process-md5-block-F) ]
[ (process-md5-block-G) ] [ (process-md5-block-G) ]
[ (process-md5-block-H) ] [ (process-md5-block-H) ]
@ -205,18 +191,20 @@ M: md5-state checksum-block ( block state -- )
nip update-md5 nip update-md5
] 2bi ; ] 2bi ;
: md5>checksum ( md5 -- bytes ) state>> uint-array>byte-array-le ; : md5>checksum ( md5 -- bytes )
state>> underlying>> byte-array>le ;
M: md5-state clone ( md5 -- new-md5 ) M: md5-state clone
call-next-method call-next-method
[ clone ] change-state [ clone ] change-state
[ clone ] change-old-state ; [ clone ] change-old-state ;
M: md5-state get-checksum ( md5 -- bytes ) M: md5-state get-checksum
clone [ bytes>> f ] [ bytes-read>> pad-last-block ] [ ] tri clone
[ bytes>> f ] [ bytes-read>> pad-last-block ] [ ] tri
[ [ checksum-block ] curry each ] [ md5>checksum ] bi ; [ [ checksum-block ] curry each ] [ md5>checksum ] bi ;
M: md5 checksum-stream ( stream checksum -- byte-array ) M: md5 checksum-stream
drop drop
[ <md5-state> ] dip add-checksum-stream get-checksum ; [ <md5-state> ] dip add-checksum-stream get-checksum ;