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

simplify bitroll

db4
erg 2008-04-03 13:27:10 -05:00
parent 5c2b2b024e
commit 0b90458cca
6 changed files with 64 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/crypto/common/common.factor
View File

@ -2,7 +2,7 @@ USING: arrays kernel io io.binary sbufs splitting strings sequences
namespaces math math.parser parser hints math.bitfields.lib ;
IN: crypto.common
: w+ ( int int -- int ) + 32-bit ; inline
: w+ ( int int -- int ) + 32 bits ; inline
: (nth-int) ( string n -- int )
2 shift dup 4 + rot <slice> ; inline

2
extra/crypto/sha1/sha1.factor
View File

@ -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 bits ; inline
: set-vars ( temp -- )
! E = D; D = C; C = S^30(B); B = A; A = TEMP;

3
extra/crypto/sha2/sha2.factor
View File

@ -4,7 +4,7 @@ IN: crypto.sha2
<PRIVATE
SYMBOLS: vars M K H S0 S1 process-M word-size block-size >word ;
SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
: a 0 ; inline
: b 1 ; inline
@ -124,7 +124,6 @@ PRIVATE>
initial-H-256 H set
4 word-size set
64 block-size set
\ 32-bit >word set
byte-array>sha2
] with-scope ;

16
extra/math/bitfields/lib/lib-docs.factor Normal file
View File

@ -0,0 +1,16 @@
USING: help.markup help.syntax kernel math sequences ;
IN: math.bitfields.lib
HELP: bits
{ $values { "m" integer } { "n" integer } { "m'" integer } }
{ $description "Keep only n bits from the integer m." }
{ $example "USING: math.bitfields.lib prettyprint ;" "HEX: 123abcdef 16 bits .h" "cdef" } ;
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: math.bitfields.lib prettyprint ;" "1 -1 32 bitroll .b" "10000000000000000000000000000000" }
{ $example "USING: math.bitfields.lib prettyprint ;" "HEX: ffff0000 8 32 bitroll .h" "ff0000ff" }
} ;

14
extra/math/bitfields/lib/lib-tests.factor Normal file
View File

@ -0,0 +1,14 @@
USING: math.bitfields.lib tools.test ;
IN: math.bitfields.lib.test
[ 0 ] [ 1 0 0 bitroll ] unit-test
[ 1 ] [ 1 0 1 bitroll ] unit-test
[ 1 ] [ 1 1 1 bitroll ] unit-test
[ 1 ] [ 1 0 2 bitroll ] unit-test
[ 1 ] [ 1 0 1 bitroll ] unit-test
[ 1 ] [ 1 20 2 bitroll ] unit-test
[ 1 ] [ 1 8 8 bitroll ] unit-test
[ 1 ] [ 1 -8 8 bitroll ] unit-test
[ 1 ] [ 1 -32 8 bitroll ] unit-test
[ 128 ] [ 1 -1 8 bitroll ] unit-test
[ 8 ] [ 1 3 32 bitroll ] unit-test

31
extra/math/bitfields/lib/lib.factor Normal file
View File

@ -0,0 +1,31 @@
USING: hints kernel math ;
IN: math.bitfields.lib
: 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
: wrap ( m n -- m' ) 1- bitand ; foldable
: bits ( m n -- m' ) 2^ wrap ; inline
: mask-bit ( m n -- m' ) 1- 2^ mask ; inline
: shift-mod ( n s w -- n )
>r shift r> 2^ wrap ; inline
: bitroll ( x s w -- y )
[ wrap ] keep
[ 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 ;