2 ;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
4 ;;; Redistribution and use in source and binary forms, with or without
5 ;;; modification, are permitted provided that the following conditions
8 ;;; * Redistributions of source code must retain the above copyright
9 ;;; notice, this list of conditions and the following disclaimer.
11 ;;; * Redistributions in binary form must reproduce the above
12 ;;; copyright notice, this list of conditions and the following
13 ;;; disclaimer in the documentation and/or other materials
14 ;;; provided with the distribution.
16 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
17 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
18 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
19 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
20 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
21 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
22 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
23 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
24 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
25 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
26 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 (defconstant +adler32-base
+ 65521)
33 (defun adler32-update (adler-high adler-low buf start count
)
34 (declare (type array-index start count
)
35 (type (unsigned-byte 16) adler-high adler-low
)
36 (type octet-vector buf
)
39 (values adler-high adler-low
))
46 (declare (type (integer 0 16) k
)
48 (type (unsigned-byte 16) length
)
49 (type (unsigned-byte 32) s1 s2
))
52 (setf k
(min length
16))
55 (setf s1
(+ (aref buf
(logand #xFFFF
(+ start i
))) s1
))
61 (setf s1
(mod s1
+adler32-base
+))
62 (setf s2
(mod s2
+adler32-base
+))
63 (unless (zerop length
)
69 (defclass adler32-checksum
(checksum)
80 (defmethod result ((checksum adler32-checksum
))
81 (+ (ash (high checksum
) 16)
84 (defmethod result-octets ((checksum adler32-checksum
))
85 (ub32-octets (result checksum
)))
87 (defmethod update ((checksum adler32-checksum
) buffer start count
)
88 (setf (values (high checksum
)
90 (adler32-update (high checksum
)
96 (defmethod reset ((checksum adler32-checksum
))
97 (setf (high checksum
) 0