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 combinators fry grouping io.binary kernel math
   6 math.bitwise math.ranges sequences sequences.private ;
   7
   8 IN: checksums.superfast
   9
  10 TUPLE: superfast seed ;
  11 C: <superfast> superfast
  12
  13 <PRIVATE
  14
  15 : 32-bit ( n -- n' ) 32 on-bits mask ; inline
  16
  17 : (main-loop) ( hash m n -- hash' )
  18     [ + ] [ 11 shift dupd bitxor ] bi*
  19     [ 16 shift ] [ bitxor ] bi* 32-bit
  20     [ -11 shift ] [ + ] bi ; inline
  21
  22 : main-loop ( seq hash -- seq hash' )
  23     over byte-array? little-endian? and [
  24         [ 0 over length 4 - 4 <range> ] dip [
  25             pick <displaced-alien> int deref
  26             [ 16 on-bits mask ] [ -16 shift ] bi
  27             (main-loop)
  28         ] reduce
  29     ] [
  30         [ dup length 4 mod dupd head-slice* 4 <groups> ] dip [
  31             2 cut-slice [ le> ] bi@ (main-loop)
  32         ] reduce
  33     ] if ; inline
  34
  35 : end-case ( seq hash -- hash' )
  36     swap dup length 4 mod [ tail-slice* ] keep {
  37         [ drop ]
  38         [
  39             first + [ 10 shift ] [ bitxor ] bi 32-bit
  40             [ -1 shift ] [ + ] bi
  41         ]
  42         [
  43             le> + [ 11 shift ] [ bitxor ] bi 32-bit
  44             [ -17 shift ] [ + ] bi
  45         ]
  46         [
  47             unclip-last-slice
  48             [ le> + [ 16 shift ] [ bitxor ] bi ]
  49             [ 18 shift bitxor ] bi* 32-bit
  50             [ -11 shift ] [ + ] bi
  51         ]
  52     } dispatch ; inline
  53
  54 : avalanche ( hash -- hash' )
  55     [ 3 shift ] [ bitxor ] bi 32-bit
  56     [ -5 shift ] [ + ] bi
  57     [ 4 shift ] [ bitxor ] bi 32-bit
  58     [ -17 shift ] [ + ] bi
  59     [ 25 shift ] [ bitxor ] bi 32-bit
  60     [ -6 shift ] [ + ] bi ; inline
  61
  62 PRIVATE>
  63
  64 M: superfast checksum-bytes
  65     seed>> 32-bit main-loop end-case avalanche ;