checksums.superfast: make checksum on byte-arrays much faster.
parent
055895da3b
commit
34853bf550
|
@ -1,4 +1,5 @@
|
|||
USING: checksums fry kernel math sequences tools.test ;
|
||||
USING: byte-arrays checksums fry kernel math sequences
|
||||
tools.test ;
|
||||
IN: checksums.superfast
|
||||
|
||||
{
|
||||
|
@ -19,3 +20,11 @@ IN: checksums.superfast
|
|||
"1234567890" [ length 1 + ] keep 0 <superfast>
|
||||
'[ _ swap head _ checksum-bytes ] { } map-integers
|
||||
] unit-test
|
||||
|
||||
|
||||
{ t } [
|
||||
"1234567890" dup >byte-array [
|
||||
[ length 1 + ] keep 0 <superfast>
|
||||
'[ _ swap head _ checksum-bytes ] { } map-integers
|
||||
] bi@ =
|
||||
] unit-test
|
||||
|
|
|
@ -1,8 +1,10 @@
|
|||
! Copyright (C) 2013 John Benediktsson.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: accessors checksums combinators fry grouping io.binary
|
||||
kernel math math.bitwise sequences sequences.private ;
|
||||
USING: accessors alien alien.data byte-arrays checksums
|
||||
combinators fry grouping io.binary kernel math math.bitwise
|
||||
math.ranges sequences sequences.private ;
|
||||
QUALIFIED-WITH: alien.c-types c
|
||||
|
||||
IN: checksums.superfast
|
||||
|
||||
|
@ -13,16 +15,28 @@ C: <superfast> superfast
|
|||
|
||||
: 32-bit ( n -- n' ) 32 on-bits mask ; inline
|
||||
|
||||
: main-loop ( seq seed -- hash )
|
||||
[ 4 <groups> ] dip [
|
||||
2 cut-slice
|
||||
[ le> + ] [ le> 11 shift dupd bitxor ] bi*
|
||||
[ 16 shift ] [ bitxor ] bi* 32-bit
|
||||
[ -11 shift ] [ + ] bi
|
||||
] reduce ; inline
|
||||
: main-loop ( seq hash -- seq hash' )
|
||||
over byte-array? little-endian? and [
|
||||
[ 0 over length 4 - 4 <range> ] dip
|
||||
[
|
||||
pick
|
||||
[ <displaced-alien> c:short deref ]
|
||||
[ [ 2 + ] dip <displaced-alien> c:short deref ] 2bi
|
||||
[ + ] [ 11 shift dupd bitxor ] bi*
|
||||
[ 16 shift ] [ bitxor ] bi* 32-bit
|
||||
[ -11 shift ] [ + ] bi
|
||||
] reduce
|
||||
] [
|
||||
[ dup length 4 mod dupd head-slice* 4 <groups> ] dip [
|
||||
2 cut-slice
|
||||
[ le> + ] [ le> 11 shift dupd bitxor ] bi*
|
||||
[ 16 shift ] [ bitxor ] bi* 32-bit
|
||||
[ -11 shift ] [ + ] bi
|
||||
] reduce
|
||||
] if ; inline
|
||||
|
||||
: end-case ( hash seq -- hash' )
|
||||
dup length {
|
||||
: end-case ( seq hash -- hash' )
|
||||
swap dup length 4 mod [ tail-slice* ] keep {
|
||||
[ drop ]
|
||||
[
|
||||
first + [ 10 shift ] [ bitxor ] bi 32-bit
|
||||
|
@ -51,5 +65,4 @@ C: <superfast> superfast
|
|||
PRIVATE>
|
||||
|
||||
M: superfast checksum-bytes
|
||||
[ dup length 4 mod cut* ] [ seed>> 32-bit ] bi*
|
||||
'[ _ main-loop ] [ end-case ] bi* avalanche ;
|
||||
seed>> 32-bit main-loop end-case avalanche ;
|
||||
|
|
Loading…
Reference in New Issue