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 io
4 io.backend io.binary io.encodings.binary io.files kernel make
5 math sequences locals ;
8 : calculate-pad-length ( length -- length' )
9 [ 56 < 55 119 ? ] keep - ;
11 : pad-last-block ( bytes big-endian? length -- blocks )
14 [ 0x3f bitand calculate-pad-length <byte-array> % ]
15 [ 3 shift 8 rot [ >be ] [ >le ] if % ] bi
16 ] B{ } make 64 group ;
20 INSTANCE: block-checksum checksum
23 { bytes-read integer }
24 { block-size integer }
25 { bytes byte-vector } ;
27 : new-checksum-state ( class -- checksum-state )
29 BV{ } clone >>bytes ; inline
31 M: checksum-state clone
33 [ clone ] change-bytes ;
35 GENERIC: initialize-checksum-state ( checksum -- checksum-state )
37 GENERIC: checksum-block ( bytes checksum-state -- )
39 GENERIC: get-checksum ( checksum-state -- value )
41 ! Update the bytes-read before calculating checksum in case
42 ! checksum uses this in the calculation.
43 :: add-checksum-bytes ( checksum-state data -- checksum-state' )
44 checksum-state block-size>> :> block-size
45 checksum-state bytes>> length :> initial-len
46 initial-len data length + block-size /mod :> ( n extra )
47 data checksum-state bytes>> [ push-all ] keep :> all-bytes
48 all-bytes block-size <groups>
49 extra zero? [ f ] [ unclip-last-slice ] if :> ( blocks remain )
51 checksum-state [ initial-len - ] change-bytes-read drop
54 checksum-state [ block-size + ] change-bytes-read
58 checksum-state [ extra + ] change-bytes-read
59 remain [ >byte-vector ] [ BV{ } clone ] if* >>bytes ;
61 : add-checksum-stream ( checksum-state stream -- checksum-state )
62 [ [ add-checksum-bytes ] each-block ] with-input-stream ;
64 : add-checksum-file ( checksum-state path -- checksum-state )
65 binary <file-reader> add-checksum-stream ;
67 M: block-checksum checksum-bytes
68 initialize-checksum-state
69 swap add-checksum-bytes get-checksum ;
71 M: block-checksum checksum-stream
72 initialize-checksum-state
73 swap add-checksum-stream get-checksum ;