basis/checksums/superfast/superfast.factor

   1 ! Copyright (C) 2013 John Benediktsson.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: accessors alien alien.c-types alien.data byte-arrays
   5 checksums endian grouping kernel math math.bitwise ranges
   6 sequences sequences.private ;
   7
   8 IN: checksums.superfast
   9
  10 TUPLE: superfast seed ;
  11 C: <superfast> superfast
  12
  13 <PRIVATE
  14
  15 : (main-loop) ( hash n -- hash' )
  16     [ 16 bits ] [ -16 shift ] bi
  17     [ + ] [ 11 shift dupd bitxor ] bi*
  18     [ 16 shift ] [ bitxor ] bi* 32 bits
  19     [ -11 shift ] [ + ] bi ; inline
  20
  21 : main-loop ( seq hash -- seq hash' )
  22     over byte-array? alien.data:little-endian? and [
  23         [ 0 over length 4 - 4 <range> ] dip
  24         [ pick <displaced-alien> int deref (main-loop) ] reduce
  25     ] [
  26         [ dup length 4 mod dupd head-slice* 4 <groups> ] dip
  27         [ le> (main-loop) ] reduce
  28     ] if ; inline
  29
  30 : end-case ( seq hash -- hash' )
  31     swap dup length 4 mod [ tail-slice* ] keep {
  32         [ drop ]
  33         [
  34             first + [ 10 shift ] [ bitxor ] bi 32 bits
  35             [ -1 shift ] [ + ] bi
  36         ]
  37         [
  38             le> + [ 11 shift ] [ bitxor ] bi 32 bits
  39             [ -17 shift ] [ + ] bi
  40         ]
  41         [
  42             unclip-last-slice
  43             [ le> + [ 16 shift ] [ bitxor ] bi ]
  44             [ 18 shift bitxor ] bi* 32 bits
  45             [ -11 shift ] [ + ] bi
  46         ]
  47     } dispatch ; inline
  48
  49 : avalanche ( hash -- hash' )
  50     [ 3 shift ] [ bitxor ] bi 32 bits [ -5 shift ] [ + ] bi
  51     [ 4 shift ] [ bitxor ] bi 32 bits [ -17 shift ] [ + ] bi
  52     [ 25 shift ] [ bitxor ] bi 32 bits [ -6 shift ] [ + ] bi ; inline
  53
  54 PRIVATE>
  55
  56 M: superfast checksum-bytes
  57     seed>> 32 bits main-loop end-case avalanche ;