diff --git a/extra/crypto/common/common-docs.factor b/extra/crypto/common/common-docs.factor index b53ecaac3c..559c7934d0 100644 --- a/extra/crypto/common/common-docs.factor +++ b/extra/crypto/common/common-docs.factor @@ -2,23 +2,6 @@ USING: help.markup help.syntax kernel math sequences quotations math.private ; IN: crypto.common -HELP: >32-bit -{ $values { "x" integer } { "y" integer } } -{ $description "Used to implement 32-bit integer overflow." } ; - -HELP: >64-bit -{ $values { "x" integer } { "y" integer } } -{ $description "Used to implement 64-bit integer overflow." } ; - -HELP: bitroll -{ $values { "x" "an integer (input)" } { "s" "an integer (shift)" } { "w" "an integer (wrap)" } { "y" integer } } -{ $description "Roll n by s bits to the left, wrapping around after w bits." } -{ $examples - { $example "USING: crypto.common prettyprint ;" "1 -1 32 bitroll .b" "10000000000000000000000000000000" } - { $example "USING: crypto.common prettyprint ;" "HEX: ffff0000 8 32 bitroll .h" "ff0000ff" } -} ; - - HELP: hex-string { $values { "seq" "a sequence" } { "str" "a string" } } { $description "Converts a sequence of values from 0-255 to a string of hex numbers from 0-ff." } diff --git a/extra/crypto/common/common.factor b/extra/crypto/common/common.factor index 3ac551d114..f0129772b0 100644 --- a/extra/crypto/common/common.factor +++ b/extra/crypto/common/common.factor @@ -1,11 +1,8 @@ USING: arrays kernel io io.binary sbufs splitting strings sequences -namespaces math math.parser parser hints ; +namespaces math math.parser parser hints math.bitfields.lib ; IN: crypto.common -: >32-bit ( x -- y ) HEX: ffffffff bitand ; inline -: >64-bit ( x -- y ) HEX: ffffffffffffffff bitand ; inline - -: w+ ( int int -- int ) + >32-bit ; inline +: w+ ( int int -- int ) + 32-bit ; inline : (nth-int) ( string n -- int ) 2 shift dup 4 + rot ; inline @@ -39,26 +36,9 @@ SYMBOL: big-endian? 3 shift 8 rot [ >be ] [ >le ] if % ] "" make 64 group ; -: shift-mod ( n s w -- n ) - >r shift r> 2^ 1- bitand ; inline - : update-old-new ( old new -- ) [ get >r get r> ] 2keep >r >r w+ dup r> set r> set ; inline -: bitroll ( x s w -- y ) - [ 1 - bitand ] keep - over 0 < [ [ + ] keep ] when - [ shift-mod ] 3keep - [ - ] keep shift-mod bitor ; inline - -: bitroll-32 ( n s -- n' ) 32 bitroll ; - -HINTS: bitroll-32 bignum fixnum ; - -: bitroll-64 ( n s -- n' ) 64 bitroll ; - -HINTS: bitroll-64 bignum fixnum ; - : hex-string ( seq -- str ) [ [ >hex 2 48 pad-left % ] each ] "" make ; diff --git a/extra/crypto/sha1/sha1.factor b/extra/crypto/sha1/sha1.factor index 8f3d3e6ecc..7e8677a117 100755 --- a/extra/crypto/sha1/sha1.factor +++ b/extra/crypto/sha1/sha1.factor @@ -1,7 +1,7 @@ USING: arrays combinators crypto.common kernel io io.encodings.binary io.files io.streams.byte-array math.vectors strings sequences namespaces math parser sequences vectors -io.binary hashtables symbols ; +io.binary hashtables symbols math.bitfields.lib ; IN: crypto.sha1 ! Implemented according to RFC 3174. @@ -66,7 +66,7 @@ SYMBOLS: h0 h1 h2 h3 h4 A B C D E w K ; K get nth , A get 5 bitroll-32 , E get , - ] { } make sum >32-bit ; inline + ] { } make sum 32-bit ; inline : set-vars ( temp -- ) ! E = D; D = C; C = S^30(B); B = A; A = TEMP; diff --git a/extra/crypto/sha2/sha2.factor b/extra/crypto/sha2/sha2.factor index daba6d29ff..f555de8b08 100755 --- a/extra/crypto/sha2/sha2.factor +++ b/extra/crypto/sha2/sha2.factor @@ -1,19 +1,19 @@ USING: crypto.common kernel splitting math sequences namespaces -io.binary symbols ; +io.binary symbols math.bitfields.lib ; IN: crypto.sha2 word ; -: a 0 ; -: b 1 ; -: c 2 ; -: d 3 ; -: e 4 ; -: f 5 ; -: g 6 ; -: h 7 ; +: a 0 ; inline +: b 1 ; inline +: c 2 ; inline +: d 3 ; inline +: e 4 ; inline +: f 5 ; inline +: g 6 ; inline +: h 7 ; inline : initial-H-256 ( -- seq ) { @@ -124,7 +124,7 @@ PRIVATE> initial-H-256 H set 4 word-size set 64 block-size set - \ >32-bit >word set + \ 32-bit >word set byte-array>sha2 ] with-scope ; diff --git a/extra/math/functions/functions.factor b/extra/math/functions/functions.factor index dcbccb4316..77c7d9247d 100755 --- a/extra/math/functions/functions.factor +++ b/extra/math/functions/functions.factor @@ -30,15 +30,6 @@ M: real sqrt 2dup >r >r >r odd? r> call r> 2/ r> each-bit ] if ; inline -: clear-bit ( x n -- y ) 2^ bitnot bitand ; foldable -: set-bit ( x n -- y ) 2^ bitor ; foldable -: bit-clear? ( x n -- ? ) 2^ bitand zero? ; foldable -: bit-set? ( x n -- ? ) bit-clear? not ; foldable -: unmask ( x n -- ? ) bitnot bitand ; foldable -: unmask? ( x n -- ? ) unmask 0 > ; foldable -: mask ( x n -- ? ) bitand ; foldable -: mask? ( x n -- ? ) mask 0 > ; foldable - GENERIC: (^) ( x y -- z ) foldable : ^n ( z w -- z^w ) diff --git a/extra/random/mersenne-twister/mersenne-twister.factor b/extra/random/mersenne-twister/mersenne-twister.factor index 77054ea377..2aa6f45897 100755 --- a/extra/random/mersenne-twister/mersenne-twister.factor +++ b/extra/random/mersenne-twister/mersenne-twister.factor @@ -4,7 +4,7 @@ ! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c USING: arrays kernel math namespaces sequences system init -accessors math.ranges random circular ; +accessors math.ranges random circular math.bitfields.lib ; IN: random.mersenne-twister r mt-n r> seq>> [ [ (mt-generate) ] keep set-generated ] curry each ] [ 0 >>i drop ] bi ; -: init-mt-first ( seed -- seq ) - >r mt-n 0 r> - HEX: ffffffff bitand 0 pick set-nth ; - : init-mt-formula ( seq i -- f(seq[i]) ) tuck swap nth dup -30 shift bitxor 1812433253 * + - 1+ HEX: ffffffff bitand ; + 1+ 32-bit ; : init-mt-rest ( seq -- ) - mt-n 1- [0,b) [ + mt-n 1- [ dupd [ init-mt-formula ] keep 1+ rot set-nth ] with each ; : init-mt-seq ( seed -- seq ) - init-mt-first dup init-mt-rest ; + 32-bit mt-n 0 + [ set-first ] [ init-mt-rest ] [ ] tri ; : mt-temper ( y -- yt ) dup -11 shift bitxor