basis/checksums/common/common.factor

   1 ! Copyright (C) 2006, 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors byte-arrays byte-vectors checksums grouping
   4 io.binary kernel locals make math sequences ;
   5 IN: checksums.common
   6
   7 : calculate-pad-length ( length -- length' )
   8     [ 56 < 55 119 ? ] keep - ;
   9
  10 : pad-last-block ( bytes big-endian? length -- blocks )
  11     [
  12         [ % ] 2dip 0x80 ,
  13         [ 0x3f bitand calculate-pad-length <byte-array> % ]
  14         [ 3 shift 8 rot [ >be ] [ >le ] if % ] bi
  15     ] B{ } make 64 group ;
  16
  17 MIXIN: block-checksum
  18
  19 INSTANCE: block-checksum checksum
  20
  21 TUPLE: block-checksum-state < checksum-state
  22     { bytes-read integer }
  23     { block-size integer } ;
  24
  25 GENERIC: checksum-block ( bytes checksum-state -- )
  26
  27 ! Update the bytes-read before calculating checksum in case
  28 ! checksum uses this in the calculation.
  29 M:: block-checksum-state add-checksum-bytes ( state data -- state )
  30     state block-size>> :> block-size
  31     state bytes>> length :> initial-len
  32     initial-len data length + block-size /mod :> ( n extra )
  33     data state bytes>> [ push-all ] keep :> all-bytes
  34     all-bytes block-size <groups>
  35     extra zero? [ f ] [ unclip-last-slice ] if :> ( blocks remain )
  36
  37     state [ initial-len - ] change-bytes-read drop
  38
  39     blocks [
  40         state [ block-size + ] change-bytes-read
  41         checksum-block
  42     ] each
  43
  44     state [ extra + ] change-bytes-read
  45     remain [ >byte-vector ] [ BV{ } clone ] if* >>bytes ;
  46
  47 M: block-checksum checksum-bytes
  48     [ swap add-checksum-bytes get-checksum ] with-checksum-state ;
  49
  50 M: block-checksum checksum-stream
  51     [ swap add-checksum-stream get-checksum ] with-checksum-state ;