parent
499cc29c1c
commit
d642347f34
|
@ -2,23 +2,6 @@ USING: help.markup help.syntax kernel math sequences quotations
|
||||||
math.private ;
|
math.private ;
|
||||||
IN: crypto.common
|
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
|
HELP: hex-string
|
||||||
{ $values { "seq" "a sequence" } { "str" "a 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." }
|
{ $description "Converts a sequence of values from 0-255 to a string of hex numbers from 0-ff." }
|
||||||
|
|
|
@ -1,11 +1,8 @@
|
||||||
USING: arrays kernel io io.binary sbufs splitting strings sequences
|
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
|
IN: crypto.common
|
||||||
|
|
||||||
: >32-bit ( x -- y ) HEX: ffffffff bitand ; inline
|
: w+ ( int int -- int ) + 32-bit ; inline
|
||||||
: >64-bit ( x -- y ) HEX: ffffffffffffffff bitand ; inline
|
|
||||||
|
|
||||||
: w+ ( int int -- int ) + >32-bit ; inline
|
|
||||||
|
|
||||||
: (nth-int) ( string n -- int )
|
: (nth-int) ( string n -- int )
|
||||||
2 shift dup 4 + rot <slice> ; inline
|
2 shift dup 4 + rot <slice> ; inline
|
||||||
|
@ -39,26 +36,9 @@ SYMBOL: big-endian?
|
||||||
3 shift 8 rot [ >be ] [ >le ] if %
|
3 shift 8 rot [ >be ] [ >le ] if %
|
||||||
] "" make 64 group ;
|
] "" make 64 group ;
|
||||||
|
|
||||||
: shift-mod ( n s w -- n )
|
|
||||||
>r shift r> 2^ 1- bitand ; inline
|
|
||||||
|
|
||||||
: update-old-new ( old new -- )
|
: update-old-new ( old new -- )
|
||||||
[ get >r get r> ] 2keep >r >r w+ dup r> set r> set ; inline
|
[ 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-string ( seq -- str )
|
||||||
[ [ >hex 2 48 pad-left % ] each ] "" make ;
|
[ [ >hex 2 48 pad-left % ] each ] "" make ;
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
USING: arrays combinators crypto.common kernel io
|
USING: arrays combinators crypto.common kernel io
|
||||||
io.encodings.binary io.files io.streams.byte-array math.vectors
|
io.encodings.binary io.files io.streams.byte-array math.vectors
|
||||||
strings sequences namespaces math parser sequences vectors
|
strings sequences namespaces math parser sequences vectors
|
||||||
io.binary hashtables symbols ;
|
io.binary hashtables symbols math.bitfields.lib ;
|
||||||
IN: crypto.sha1
|
IN: crypto.sha1
|
||||||
|
|
||||||
! Implemented according to RFC 3174.
|
! 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 ,
|
K get nth ,
|
||||||
A get 5 bitroll-32 ,
|
A get 5 bitroll-32 ,
|
||||||
E get ,
|
E get ,
|
||||||
] { } make sum >32-bit ; inline
|
] { } make sum 32-bit ; inline
|
||||||
|
|
||||||
: set-vars ( temp -- )
|
: set-vars ( temp -- )
|
||||||
! E = D; D = C; C = S^30(B); B = A; A = TEMP;
|
! E = D; D = C; C = S^30(B); B = A; A = TEMP;
|
||||||
|
|
|
@ -1,19 +1,19 @@
|
||||||
USING: crypto.common kernel splitting math sequences namespaces
|
USING: crypto.common kernel splitting math sequences namespaces
|
||||||
io.binary symbols ;
|
io.binary symbols math.bitfields.lib ;
|
||||||
IN: crypto.sha2
|
IN: crypto.sha2
|
||||||
|
|
||||||
<PRIVATE
|
<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 >word ;
|
||||||
|
|
||||||
: a 0 ;
|
: a 0 ; inline
|
||||||
: b 1 ;
|
: b 1 ; inline
|
||||||
: c 2 ;
|
: c 2 ; inline
|
||||||
: d 3 ;
|
: d 3 ; inline
|
||||||
: e 4 ;
|
: e 4 ; inline
|
||||||
: f 5 ;
|
: f 5 ; inline
|
||||||
: g 6 ;
|
: g 6 ; inline
|
||||||
: h 7 ;
|
: h 7 ; inline
|
||||||
|
|
||||||
: initial-H-256 ( -- seq )
|
: initial-H-256 ( -- seq )
|
||||||
{
|
{
|
||||||
|
@ -124,7 +124,7 @@ PRIVATE>
|
||||||
initial-H-256 H set
|
initial-H-256 H set
|
||||||
4 word-size set
|
4 word-size set
|
||||||
64 block-size set
|
64 block-size set
|
||||||
\ >32-bit >word set
|
\ 32-bit >word set
|
||||||
byte-array>sha2
|
byte-array>sha2
|
||||||
] with-scope ;
|
] with-scope ;
|
||||||
|
|
||||||
|
|
|
@ -30,15 +30,6 @@ M: real sqrt
|
||||||
2dup >r >r >r odd? r> call r> 2/ r> each-bit
|
2dup >r >r >r odd? r> call r> 2/ r> each-bit
|
||||||
] if ; inline
|
] 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
|
GENERIC: (^) ( x y -- z ) foldable
|
||||||
|
|
||||||
: ^n ( z w -- z^w )
|
: ^n ( z w -- z^w )
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
|
! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
|
||||||
|
|
||||||
USING: arrays kernel math namespaces sequences system init
|
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
|
IN: random.mersenne-twister
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
@ -33,21 +33,18 @@ TUPLE: mersenne-twister seq i ;
|
||||||
[ >r mt-n r> seq>> [ [ (mt-generate) ] keep set-generated ] curry each ]
|
[ >r mt-n r> seq>> [ [ (mt-generate) ] keep set-generated ] curry each ]
|
||||||
[ 0 >>i drop ] bi ;
|
[ 0 >>i drop ] bi ;
|
||||||
|
|
||||||
: init-mt-first ( seed -- seq )
|
|
||||||
>r mt-n 0 <array> <circular> r>
|
|
||||||
HEX: ffffffff bitand 0 pick set-nth ;
|
|
||||||
|
|
||||||
: init-mt-formula ( seq i -- f(seq[i]) )
|
: init-mt-formula ( seq i -- f(seq[i]) )
|
||||||
tuck swap nth dup -30 shift bitxor 1812433253 * +
|
tuck swap nth dup -30 shift bitxor 1812433253 * +
|
||||||
1+ HEX: ffffffff bitand ;
|
1+ 32-bit ;
|
||||||
|
|
||||||
: init-mt-rest ( seq -- )
|
: init-mt-rest ( seq -- )
|
||||||
mt-n 1- [0,b) [
|
mt-n 1- [
|
||||||
dupd [ init-mt-formula ] keep 1+ rot set-nth
|
dupd [ init-mt-formula ] keep 1+ rot set-nth
|
||||||
] with each ;
|
] with each ;
|
||||||
|
|
||||||
: init-mt-seq ( seed -- seq )
|
: init-mt-seq ( seed -- seq )
|
||||||
init-mt-first dup init-mt-rest ;
|
32-bit mt-n 0 <array> <circular>
|
||||||
|
[ set-first ] [ init-mt-rest ] [ ] tri ;
|
||||||
|
|
||||||
: mt-temper ( y -- yt )
|
: mt-temper ( y -- yt )
|
||||||
dup -11 shift bitxor
|
dup -11 shift bitxor
|
||||||
|
|
Loading…
Reference in New Issue