md5 stores state in a tuple now

db4
Doug Coleman 2009-05-10 23:06:33 -05:00
parent 052a0931d3
commit 6dabec9ed8
1 changed files with 57 additions and 75 deletions

View File

@ -7,49 +7,40 @@ io.encodings.binary math.bitwise checksums accessors
checksums.common checksums.stream combinators combinators.smart ;
IN: checksums.md5
TUPLE: md5-state bytes-read a b c d old-a old-b old-c old-d ;
TUPLE: md5-state bytes-read state old-state ;
: <md5-state> ( -- md5-state )
md5-state new
0 >>bytes-read
HEX: 67452301 [ >>a ] [ >>old-a ] bi
HEX: efcdab89 [ >>b ] [ >>old-b ] bi
HEX: 98badcfe [ >>c ] [ >>old-c ] bi
HEX: 10325476 [ >>d ] [ >>old-d ] bi ;
{ HEX: 67452301 HEX: efcdab89 HEX: 98badcfe HEX: 10325476 }
[ clone >>state ] [ clone >>old-state ] bi ;
<PRIVATE
: update-md5-state ( md5-state -- md5-state )
{
[ [ a>> ] [ ] [ old-a>> ] tri [ w+ ] change-a (>>old-a) ]
[ [ b>> ] [ ] [ old-b>> ] tri [ w+ ] change-b (>>old-b) ]
[ [ c>> ] [ ] [ old-c>> ] tri [ w+ ] change-c (>>old-c) ]
[ [ d>> ] [ ] [ old-d>> ] tri [ w+ ] change-d (>>old-d) ]
[ ]
} cleave ;
: v-w+ ( v1 v2 -- v3 ) [ w+ ] 2map ;
: md5-state>bytes ( md5-state -- str )
[ { [ a>> ] [ b>> ] [ c>> ] [ d>> ] } cleave ] output>array
[ 4 >le ] map B{ } concat-as ;
: update-md5-state ( md5-state -- )
[ state>> ] [ old-state>> v-w+ dup clone ] [ ] tri
[ (>>old-state) ] [ (>>state) ] bi ;
: T ( N -- Y )
sin abs 32 2^ * >integer ; foldable
:: F ( X Y Z -- FXYZ )
#! F(X,Y,Z) = XY v not(X) Z
X Y bitand X bitnot Z bitand bitor ;
X Y bitand X bitnot Z bitand bitor ; inline
:: G ( X Y Z -- GXYZ )
#! G(X,Y,Z) = XZ v Y not(Z)
X Z bitand Y Z bitnot bitand bitor ;
X Z bitand Y Z bitnot bitand bitor ; inline
: H ( X Y Z -- HXYZ )
#! H(X,Y,Z) = X xor Y xor Z
bitxor bitxor ;
bitxor bitxor ; inline
:: I ( X Y Z -- IXYZ )
#! I(X,Y,Z) = Y xor (X v not(Z))
Z bitnot X bitor Y bitxor ;
Z bitnot X bitor Y bitxor ; inline
CONSTANT: S11 7
CONSTANT: S12 12
@ -68,39 +59,27 @@ CONSTANT: S42 10
CONSTANT: S43 15
CONSTANT: S44 21
CONSTANT: a 0
CONSTANT: b 1
CONSTANT: c 2
CONSTANT: d 3
SYMBOLS: a b c d old-a old-b old-c old-d ;
: initialize-md5 ( -- )
0 bytes-read set
HEX: 67452301 dup a set old-a set
HEX: efcdab89 dup b set old-b set
HEX: 98badcfe dup c set old-c set
HEX: 10325476 dup d set old-d set ;
: update-md ( -- )
old-a a update-old-new
old-b b update-old-new
old-c c update-old-new
old-d d update-old-new ;
:: (ABCD) ( x a b c d k s i func -- )
:: (ABCD) ( x V a b c d k s i quot -- )
#! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
a [
b get c get d get func call w+
a V [
b V nth-unsafe
c V nth-unsafe
d V nth-unsafe quot call w+
k x nth-unsafe w+
i T w+
s bitroll-32
b get w+
] change ; inline
b V nth-unsafe w+
] change-nth ; inline
MACRO: with-md5-round ( ops func -- )
'[ [ _ (ABCD) ] compose ] map '[ _ cleave ] ;
MACRO: with-md5-round ( ops quot -- )
'[ [ _ (ABCD) ] compose ] map '[ _ 2cleave ] ;
: (process-md5-block-F) ( block -- )
: (process-md5-block-F) ( block v -- )
{
[ a b c d 0 S11 1 ]
[ d a b c 1 S12 2 ]
@ -118,9 +97,9 @@ MACRO: with-md5-round ( ops func -- )
[ d a b c 13 S12 14 ]
[ c d a b 14 S13 15 ]
[ b c d a 15 S14 16 ]
} [ F ] with-md5-round ;
} [ F ] with-md5-round ; inline
: (process-md5-block-G) ( block -- )
: (process-md5-block-G) ( block v -- )
{
[ a b c d 1 S21 17 ]
[ d a b c 6 S22 18 ]
@ -138,9 +117,9 @@ MACRO: with-md5-round ( ops func -- )
[ d a b c 2 S22 30 ]
[ c d a b 7 S23 31 ]
[ b c d a 12 S24 32 ]
} [ G ] with-md5-round ;
} [ G ] with-md5-round ; inline
: (process-md5-block-H) ( block -- )
: (process-md5-block-H) ( block v -- )
{
[ a b c d 5 S31 33 ]
[ d a b c 8 S32 34 ]
@ -158,9 +137,9 @@ MACRO: with-md5-round ( ops func -- )
[ d a b c 12 S32 46 ]
[ c d a b 15 S33 47 ]
[ b c d a 2 S34 48 ]
} [ H ] with-md5-round ;
} [ H ] with-md5-round ; inline
: (process-md5-block-I) ( block -- )
: (process-md5-block-I) ( block v -- )
{
[ a b c d 0 S41 49 ]
[ d a b c 7 S42 50 ]
@ -178,33 +157,36 @@ MACRO: with-md5-round ( ops func -- )
[ d a b c 11 S42 62 ]
[ c d a b 2 S43 63 ]
[ b c d a 9 S44 64 ]
} [ I ] with-md5-round ;
} [ I ] with-md5-round ; inline
: (process-md5-block) ( block -- )
4 <groups> [ le> ] map {
[ (process-md5-block-F) ]
[ (process-md5-block-G) ]
[ (process-md5-block-H) ]
[ (process-md5-block-I) ]
} cleave
update-md ;
: process-md5-block ( str -- )
dup length [ bytes-read [ + ] change ] keep 64 = [
(process-md5-block)
: (process-md5-block) ( block state -- )
[
[ 4 <groups> [ le> ] map ] [ state>> ] bi* {
[ (process-md5-block-F) ]
[ (process-md5-block-G) ]
[ (process-md5-block-H) ]
[ (process-md5-block-I) ]
} 2cleave
] [
f bytes-read get pad-last-block
[ (process-md5-block) ] each
nip update-md5-state
] 2bi ;
:: process-md5-block ( block state -- )
block length
[ state [ + ] change-bytes-read drop ] [ 64 = ] bi [
block state (process-md5-block)
] [
block f state bytes-read>> pad-last-block
[ state (process-md5-block) ] each
] if ;
: stream>md5 ( stream -- )
64 over stream-read
[ process-md5-block ] [ length 64 = ] bi
[ stream>md5 ] [ drop ] if ;
:: stream>md5 ( stream state -- )
64 stream stream-read
[ state process-md5-block ] [ length 64 = ] bi
[ stream state stream>md5 ] when ;
: get-md5 ( -- str )
[ a b c d ] [ get 4 >le ] map concat >byte-array ;
: get-md5 ( md5-state -- bytes )
state>> [ 4 >le ] map B{ } concat-as ;
PRIVATE>
@ -213,4 +195,4 @@ SINGLETON: md5
INSTANCE: md5 stream-checksum
M: md5 checksum-stream
drop initialize-md5 stream>md5 get-md5 ;
drop <md5-state> [ stream>md5 ] [ get-md5 ] bi ;