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

remove >r r> from checksums

db4
Doug Coleman 2008-11-29 13:00:50 -06:00
parent e0329d7cf8
commit 3f9f6b3624
3 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/checksums/openssl/openssl.factor
View File

@ -28,7 +28,7 @@ M: evp-md-context dispose
handle>> EVP_MD_CTX_cleanup drop ; handle>> EVP_MD_CTX_cleanup drop ;
: with-evp-md-context ( quot -- ) : with-evp-md-context ( quot -- )
maybe-init-ssl >r <evp-md-context> r> with-disposal ; inline maybe-init-ssl [ <evp-md-context> ] dip with-disposal ; inline
: digest-named ( name -- md ) : digest-named ( name -- md )
dup EVP_get_digestbyname dup EVP_get_digestbyname

4
basis/checksums/sha1/sha1.factor
View File

@ -41,9 +41,9 @@ SYMBOLS: h0 h1 h2 h3 h4 A B C D E w K ;
: sha1-f ( B C D t -- f_tbcd ) : sha1-f ( B C D t -- f_tbcd )
20 /i 20 /i
{ {
{ 0 [ >r over bitnot r> bitand >r bitand r> bitor ] } { 0 [ [ over bitnot ] dip bitand [ bitand ] dip bitor ] }
{ 1 [ bitxor bitxor ] } { 1 [ bitxor bitxor ] }
{ 2 [ 2dup bitand >r pick bitand >r bitand r> r> bitor bitor ] } { 2 [ 2dup bitand [ pick bitand [ bitand ] dip ] dip bitor bitor ] }
{ 3 [ bitxor bitxor ] } { 3 [ bitxor bitxor ] }
} case ; } case ;

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

@ -59,7 +59,7 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
[ 15 - swap nth s0-256 ] 2keep [ 15 - swap nth s0-256 ] 2keep
[ 7 - swap nth ] 2keep [ 7 - swap nth ] 2keep
[ 2 - swap nth s1-256 ] 2keep [ 2 - swap nth s1-256 ] 2keep
>r >r + + w+ r> r> swap set-nth ; inline [ + + w+ ] 2dip swap set-nth ; inline
: prepare-message-schedule ( seq -- w-seq ) : prepare-message-schedule ( seq -- w-seq )
word-size get group [ be> ] map block-size get 0 pad-right word-size get group [ be> ] map block-size get 0 pad-right
@ -71,7 +71,7 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
[ bitxor bitand ] keep bitxor ; [ bitxor bitand ] keep bitxor ;
: maj ( x y z -- x' ) : maj ( x y z -- x' )
>r [ bitand ] 2keep bitor r> bitand bitor ; [ [ bitand ] 2keep bitor ] dip bitand bitor ;
: S0-256 ( x -- x' ) : S0-256 ( x -- x' )
[ -2 bitroll-32 ] keep [ -2 bitroll-32 ] keep
@ -83,7 +83,7 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
[ -11 bitroll-32 ] keep [ -11 bitroll-32 ] keep
-25 bitroll-32 bitxor bitxor ; inline -25 bitroll-32 bitxor bitxor ; inline
: slice3 ( n seq -- a b c ) >r dup 3 + r> <slice> first3 ; inline : slice3 ( n seq -- a b c ) [ dup 3 + ] dip <slice> first3 ; inline
: T1 ( W n -- T1 ) : T1 ( W n -- T1 )
[ swap nth ] keep [ swap nth ] keep
@ -105,7 +105,7 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
d c pick exchange d c pick exchange
c b pick exchange c b pick exchange
b a pick exchange b a pick exchange
>r w+ a r> set-nth ; [ w+ a ] dip set-nth ;
: process-chunk ( M -- ) : process-chunk ( M -- )
H get clone vars set H get clone vars set
@ -118,7 +118,7 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
: preprocess-plaintext ( string big-endian? -- padded-string ) : preprocess-plaintext ( string big-endian? -- padded-string )
#! pad 0x80 then 00 til 8 bytes left, then 64bit length in bits #! pad 0x80 then 00 til 8 bytes left, then 64bit length in bits
>r >sbuf r> over [ [ >sbuf ] dip over [
HEX: 80 , HEX: 80 ,
dup length HEX: 3f bitand dup length HEX: 3f bitand
calculate-pad-length 0 <string> % calculate-pad-length 0 <string> %