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

Changed to work with the new make word.

cvs
Doug Coleman 2005-08-29 05:44:32 +00:00
parent cd6c8d7ecd
commit 27c273a2cd
3 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
contrib/crypto/common.factor
View File

@ -47,14 +47,14 @@ unparser test parser lists ;
dup % "\u0080" % dup % "\u0080" %
dup length 64 mod zero-pad-length 0 fill % dup length 64 mod zero-pad-length 0 fill %
dup length 8 * 8 >le % dup length 8 * 8 >le %
] make-string nip ; ] "" make nip ;
: pad-string-sha1 ( string -- padded-string ) : pad-string-sha1 ( string -- padded-string )
[ [
dup % "\u0080" % dup % "\u0080" %
dup length 64 mod zero-pad-length 0 fill % dup length 64 mod zero-pad-length 0 fill %
dup length 8 * 8 >be % dup length 8 * 8 >be %
] make-string nip ; ] "" make nip ;
: num-blocks ( length -- num ) : num-blocks ( length -- num )
64 /i ; 64 /i ;
@ -67,5 +67,5 @@ unparser test parser lists ;
[ [
>hex 2 48 pad-left % >hex 2 48 pad-left %
] each ] each
] make-string ; ] "" make ;

2
contrib/crypto/md5.factor
View File

@ -148,7 +148,7 @@ SYMBOL: old-d
: get-md5 ( -- str ) : get-md5 ( -- str )
[ [
[ a b c d ] [ get 4 >le % ] each [ a b c d ] [ get 4 >le % ] each
] make-string hex-string ; ] "" make hex-string ;
: string>md5 ( string -- md5 ) : string>md5 ( string -- md5 )
[ [

6
contrib/crypto/sha1.factor
View File

@ -33,7 +33,7 @@ SYMBOL: K
20 [ HEX: 6ed9eba1 , ] times 20 [ HEX: 6ed9eba1 , ] times
20 [ HEX: 8f1bbcdc , ] times 20 [ HEX: 8f1bbcdc , ] times
20 [ HEX: ca62c1d6 , ] times 20 [ HEX: ca62c1d6 , ] times
] make-vector K set ; ] { } make K set ;
: update-hs ( -- ) : update-hs ( -- )
A h0 update-old-new A h0 update-old-new
@ -115,7 +115,7 @@ SYMBOL: K
: get-sha1 ( -- str ) : get-sha1 ( -- str )
[ [
[ h0 h1 h2 h3 h4 ] [ get 4 >be % ] each [ h0 h1 h2 h3 h4 ] [ get 4 >be % ] each
] make-string hex-string ; ] "" make hex-string ;
: string>sha1 ( string -- sha1 ) : string>sha1 ( string -- sha1 )
[ [
@ -139,5 +139,5 @@ SYMBOL: K
[ "a9993e364706816aba3e25717850c26c9cd0d89d" ] [ "abc" string>sha1 ] unit-test [ "a9993e364706816aba3e25717850c26c9cd0d89d" ] [ "abc" string>sha1 ] unit-test
[ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" ] [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" string>sha1 ] unit-test [ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" ] [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" string>sha1 ] unit-test
! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1 ] unit-test ! takes a long time... ! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1 ] unit-test ! takes a long time...
[ "dea356a2cddd90c7a7ecedc5ebb563934f460452" ] [ "0123456701234567012345670123456701234567012345670123456701234567" [ 10 [ dup % ] times ] make-string nip string>sha1 ] unit-test ; [ "dea356a2cddd90c7a7ecedc5ebb563934f460452" ] [ "0123456701234567012345670123456701234567012345670123456701234567" [ 10 [ dup % ] times ] "" make nip string>sha1 ] unit-test ;