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 checksums combinators fry grouping io.binary
   5 kernel math math.bitwise sequences sequences.private ;
   6
   7 IN: checksums.superfast
   8
   9 TUPLE: superfast seed ;
  10 C: <superfast> superfast
  11
  12 <PRIVATE
  13
  14 : 32-bit ( n -- n' ) 32 on-bits mask ; inline
  15
  16 : main-loop ( seq seed -- hash )
  17     [ 4 <groups> ] dip [
  18         2 cut-slice
  19         [ le> + ] [ le> 11 shift dupd bitxor ] bi*
  20         [ 16 shift ] [ bitxor ] bi* 32-bit
  21         [ -11 shift ] [ + ] bi
  22     ] reduce ; inline
  23
  24 : end-case ( hash seq -- hash' )
  25     dup length {
  26         [ drop ]
  27         [
  28             first + [ 10 shift ] [ bitxor ] bi 32-bit
  29             [ -1 shift ] [ + ] bi
  30         ]
  31         [
  32             le> + [ 11 shift ] [ bitxor ] bi 32-bit
  33             [ -17 shift ] [ + ] bi
  34         ]
  35         [
  36             unclip-last-slice
  37             [ le> + [ 16 shift ] [ bitxor ] bi ]
  38             [ 18 shift bitxor ] bi* 32-bit
  39             [ -11 shift ] [ + ] bi
  40         ]
  41     } dispatch ; inline
  42
  43 : avalanche ( hash -- hash' )
  44     [ 3 shift ] [ bitxor ] bi 32-bit
  45     [ -5 shift ] [ + ] bi
  46     [ 4 shift ] [ bitxor ] bi 32-bit
  47     [ -17 shift ] [ + ] bi
  48     [ 25 shift ] [ bitxor ] bi 32-bit
  49     [ -6 shift ] [ + ] bi ; inline
  50
  51 PRIVATE>
  52
  53 M: superfast checksum-bytes
  54     [ dup length 4 mod cut* ] [ seed>> 32-bit ] bi*
  55     '[ _ main-loop ] [ end-case ] bi* avalanche ;