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

checksums.superfast: make checksum on byte-arrays much faster.

db4
John Benediktsson 2013-11-22 18:50:59 -08:00
parent 055895da3b
commit 34853bf550
2 changed files with 36 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
basis/checksums/superfast/superfast-tests.factor
View File

@ -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 IN: checksums.superfast
{ {
@ -19,3 +20,11 @@ IN: checksums.superfast
"1234567890" [ length 1 + ] keep 0 <superfast> "1234567890" [ length 1 + ] keep 0 <superfast>
'[ _ swap head _ checksum-bytes ] { } map-integers '[ _ swap head _ checksum-bytes ] { } map-integers
] unit-test ] unit-test
{ t } [
"1234567890" dup >byte-array [
[ length 1 + ] keep 0 <superfast>
'[ _ swap head _ checksum-bytes ] { } map-integers
] bi@ =
] unit-test

31
basis/checksums/superfast/superfast.factor
View File

@ -1,8 +1,10 @@
! Copyright (C) 2013 John Benediktsson. ! Copyright (C) 2013 John Benediktsson.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors checksums combinators fry grouping io.binary USING: accessors alien alien.data byte-arrays checksums
kernel math math.bitwise sequences sequences.private ; combinators fry grouping io.binary kernel math math.bitwise
math.ranges sequences sequences.private ;
QUALIFIED-WITH: alien.c-types c
IN: checksums.superfast IN: checksums.superfast
@ -13,16 +15,28 @@ C: <superfast> superfast
: 32-bit ( n -- n' ) 32 on-bits mask ; inline : 32-bit ( n -- n' ) 32 on-bits mask ; inline
: main-loop ( seq seed -- hash ) : main-loop ( seq hash -- seq hash' )
[ 4 <groups> ] dip [ 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 2 cut-slice
[ le> + ] [ le> 11 shift dupd bitxor ] bi* [ le> + ] [ le> 11 shift dupd bitxor ] bi*
[ 16 shift ] [ bitxor ] bi* 32-bit [ 16 shift ] [ bitxor ] bi* 32-bit
[ -11 shift ] [ + ] bi [ -11 shift ] [ + ] bi
] reduce ; inline ] reduce
] if ; inline
: end-case ( hash seq -- hash' ) : end-case ( seq hash -- hash' )
dup length { swap dup length 4 mod [ tail-slice* ] keep {
[ drop ] [ drop ]
[ [
first + [ 10 shift ] [ bitxor ] bi 32-bit first + [ 10 shift ] [ bitxor ] bi 32-bit
@ -51,5 +65,4 @@ C: <superfast> superfast
PRIVATE> PRIVATE>
M: superfast checksum-bytes M: superfast checksum-bytes
[ dup length 4 mod cut* ] [ seed>> 32-bit ] bi* seed>> 32-bit main-loop end-case avalanche ;
'[ _ main-loop ] [ end-case ] bi* avalanche ;