steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

checksums.common: simplify add-checksum-bytes.

char-rename
John Benediktsson 2016-07-09 20:58:14 -07:00
parent 217b7f2b0c
commit 6b9d6c00c0
1 changed files with 19 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
basis/checksums/common/common.factor
View File

@ -41,29 +41,25 @@ GENERIC: get-checksum ( checksum-state -- value )
: next-level ( n size -- n' )
2dup mod [ + ] [ - + ] if-zero ; inline
! Update the bytes-read before calculating checksum in case checksum uses
! this in the calculation.
:: add-checksum-bytes ( state data -- state' )
state block-size>> :> block-size
state bytes>> length :> initial-len
data length :> data-len
initial-len data-len + :> total-len
total-len block-size /mod :> ( n extra )
data state bytes>> [ push-all ] keep :> all-bytes
n zero? [
state [ data-len + ] change-bytes-read drop
] [
all-bytes block-size <groups> [ length 64 = ] partition [
[ state [ block-size next-level ] change-bytes-read drop state checksum-block ] each
BV{ } clone state bytes<<
] [
[
first
[ length state [ + ] change-bytes-read drop ]
[ >byte-vector state bytes<< ] bi
] unless-empty
] bi*
] if state ;
! Update the bytes-read before calculating checksum in case
! checksum uses this in the calculation.
:: add-checksum-bytes ( checksum-state data -- checksum-state' )
checksum-state block-size>> :> block-size
checksum-state bytes>> length :> initial-len
initial-len data length + block-size /mod :> ( n extra )
data checksum-state bytes>> [ push-all ] keep :> all-bytes
all-bytes block-size <groups>
extra zero? [ f ] [ unclip-last-slice ] if :> ( blocks remain )
checksum-state [ initial-len - ] change-bytes-read drop
blocks [
checksum-state [ block-size + ] change-bytes-read
checksum-block
] each
checksum-state [ extra + ] change-bytes-read
remain [ >byte-vector ] [ BV{ } clone ] if* >>bytes ;
: add-checksum-stream ( checksum-state stream -- checksum-state )
[ [ add-checksum-bytes ] each-block ] with-input-stream ;