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

add nth-unsafe to sequences.private, making md5 faster

db4
Doug Coleman 2009-05-18 00:24:24 -05:00
parent 8714aa48c5
commit 4eab045deb
3 changed files with 33 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,7 +4,8 @@ USING: kernel io io.binary io.files io.streams.byte-array math
math.functions math.parser namespaces splitting grouping strings math.functions math.parser namespaces splitting grouping strings
sequences byte-arrays locals sequences.private macros fry sequences byte-arrays locals sequences.private macros fry
io.encodings.binary math.bitwise checksums accessors io.encodings.binary math.bitwise checksums accessors
checksums.common checksums.stream combinators combinators.smart ; checksums.common checksums.stream combinators combinators.smart
specialized-arrays.uint literals ;
IN: checksums.md5 IN: checksums.md5
SINGLETON: md5 SINGLETON: md5
@ -16,7 +17,7 @@ TUPLE: md5-state < checksum-state state old-state ;
: <md5-state> ( -- md5 ) : <md5-state> ( -- md5 )
md5-state new-checksum-state md5-state new-checksum-state
64 >>block-size 64 >>block-size
{ HEX: 67452301 HEX: efcdab89 HEX: 98badcfe HEX: 10325476 } uint-array{ HEX: 67452301 HEX: efcdab89 HEX: 98badcfe HEX: 10325476 }
[ clone >>state ] [ >>old-state ] bi ; [ clone >>state ] [ >>old-state ] bi ;
M: md5 initialize-checksum-state drop <md5-state> ; M: md5 initialize-checksum-state drop <md5-state> ;
@ -29,8 +30,10 @@ M: md5 initialize-checksum-state drop <md5-state> ;
[ state>> ] [ old-state>> v-w+ dup clone ] [ ] tri [ state>> ] [ old-state>> v-w+ dup clone ] [ ] tri
[ (>>old-state) ] [ (>>state) ] bi ; inline [ (>>old-state) ] [ (>>state) ] bi ; inline
: T ( N -- Y ) CONSTANT: T
sin abs 32 2^ * >integer ; inline $[
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
@ -70,22 +73,22 @@ CONSTANT: b 1
CONSTANT: c 2 CONSTANT: c 2
CONSTANT: d 3 CONSTANT: d 3
:: (ABCD) ( x V a b c d k s i quot -- ) :: (ABCD) ( x state a b c d k s i quot -- )
#! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s) #! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
a V [ a state [
b V nth b state nth-unsafe
c V nth c state nth-unsafe
d V nth quot call w+ d state nth-unsafe quot call w+
k x nth w+ k x nth-unsafe w+
i T w+ i T nth-unsafe w+
s bitroll-32 s bitroll-32
b V nth w+ b state nth-unsafe w+ 32 bits
] change-nth ; inline ] change-nth-unsafe ; inline
MACRO: with-md5-round ( ops quot -- ) MACRO: with-md5-round ( ops quot -- )
'[ [ _ (ABCD) ] compose ] map '[ _ 2cleave ] ; '[ [ _ (ABCD) ] compose ] map '[ _ 2cleave ] ;
: (process-md5-block-F) ( block v -- ) : (process-md5-block-F) ( block state -- )
{ {
[ a b c d 0 S11 1 ] [ a b c d 0 S11 1 ]
[ d a b c 1 S12 2 ] [ d a b c 1 S12 2 ]
@ -105,7 +108,7 @@ MACRO: with-md5-round ( ops quot -- )
[ b c d a 15 S14 16 ] [ b c d a 15 S14 16 ]
} [ F ] with-md5-round ; inline } [ F ] with-md5-round ; inline
: (process-md5-block-G) ( block v -- ) : (process-md5-block-G) ( block state -- )
{ {
[ a b c d 1 S21 17 ] [ a b c d 1 S21 17 ]
[ d a b c 6 S22 18 ] [ d a b c 6 S22 18 ]
@ -125,7 +128,7 @@ MACRO: with-md5-round ( ops quot -- )
[ b c d a 12 S24 32 ] [ b c d a 12 S24 32 ]
} [ G ] with-md5-round ; inline } [ G ] with-md5-round ; inline
: (process-md5-block-H) ( block v -- ) : (process-md5-block-H) ( block state -- )
{ {
[ a b c d 5 S31 33 ] [ a b c d 5 S31 33 ]
[ d a b c 8 S32 34 ] [ d a b c 8 S32 34 ]
@ -145,7 +148,7 @@ MACRO: with-md5-round ( ops quot -- )
[ b c d a 2 S34 48 ] [ b c d a 2 S34 48 ]
} [ H ] with-md5-round ; inline } [ H ] with-md5-round ; inline
: (process-md5-block-I) ( block v -- ) : (process-md5-block-I) ( block state -- )
{ {
[ a b c d 0 S41 49 ] [ a b c d 0 S41 49 ]
[ d a b c 7 S42 50 ] [ d a b c 7 S42 50 ]
@ -167,7 +170,7 @@ MACRO: with-md5-round ( ops quot -- )
M: md5-state checksum-block ( block state -- ) M: md5-state checksum-block ( block state -- )
[ [
[ 4 <groups> [ le> ] map ] [ state>> ] bi* { [ byte-array>uint-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) ]
@ -177,8 +180,7 @@ M: md5-state checksum-block ( block state -- )
nip update-md5 nip update-md5
] 2bi ; ] 2bi ;
: md5>checksum ( md5 -- bytes ) : md5>checksum ( md5 -- bytes ) state>> underlying>> ;
state>> [ 4 >le ] map B{ } concat-as ;
M: md5-state clone ( md5 -- new-md5 ) M: md5-state clone ( md5 -- new-md5 )
call-next-method call-next-method

14
core/checksums/checksums.factor
View File

@ -1,17 +1,17 @@
! Copyright (c) 2008 Slava Pestov ! Copyright (c) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors io io.backend io.files kernel math math.parser USING: accessors io io.backend io.files kernel math math.parser
sequences vectors quotations ; sequences byte-arrays byte-vectors quotations ;
IN: checksums IN: checksums
MIXIN: checksum MIXIN: checksum
TUPLE: checksum-state bytes-read block-size bytes ; TUPLE: checksum-state
{ bytes-read integer } { block-size integer } { bytes byte-vector } ;
: new-checksum-state ( class -- checksum-state ) : new-checksum-state ( class -- checksum-state )
new new
0 >>bytes-read BV{ } clone >>bytes ; inline
V{ } clone >>bytes ; inline
M: checksum-state clone M: checksum-state clone
call-next-method call-next-method
@ -27,11 +27,13 @@ GENERIC: get-checksum ( checksum -- value )
over bytes>> [ push-all ] keep over bytes>> [ push-all ] keep
[ dup length pick block-size>> >= ] [ dup length pick block-size>> >= ]
[ [
64 cut-slice [ 64 cut-slice [ >byte-array ] dip [
over [ checksum-block ] over [ checksum-block ]
[ [ 64 + ] change-bytes-read drop ] bi [ [ 64 + ] change-bytes-read drop ] bi
] dip ] dip
] while >vector [ >>bytes ] [ length [ + ] curry change-bytes-read ] bi ; ] while
>byte-vector
[ >>bytes ] [ length [ + ] curry change-bytes-read ] bi ;
: add-checksum-stream ( checksum-state stream -- checksum-state ) : add-checksum-stream ( checksum-state stream -- checksum-state )
[ [

3
core/sequences/sequences.factor
View File

@ -88,6 +88,9 @@ M: sequence set-nth bounds-check set-nth-unsafe ;
M: sequence nth-unsafe nth ; M: sequence nth-unsafe nth ;
M: sequence set-nth-unsafe set-nth ; M: sequence set-nth-unsafe set-nth ;
: change-nth-unsafe ( i seq quot -- )
[ [ nth-unsafe ] dip call ] 3keep drop set-nth-unsafe ; inline
! The f object supports the sequence protocol trivially ! The f object supports the sequence protocol trivially
M: f length drop 0 ; M: f length drop 0 ;
M: f nth-unsafe nip ; M: f nth-unsafe nip ;