1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
;;;; adler32.lisp - computing adler32 checksums (rfc1950) of a byte array
(in-package :crypto)
;;; smallest prime < 65536
(defconstant adler32-modulo 65521)
(defstruct (adler32-state
(:constructor make-adler32-state)
(:copier copy-adler32-state))
(s1 1 :type fixnum)
(s2 0 :type fixnum)
(length 0 :type fixnum))
(defun update-adler32-state (state sequence &key (start 0) (end (length sequence)))
(declare (type adler32-state state)
(type (simple-array (unsigned-byte 8) (*)) sequence)
(type index start end))
(let ((s1 (adler32-state-s1 state))
(s2 (adler32-state-s2 state))
(length (adler32-state-length state)))
(declare (type fixnum s1 s2 length))
;; This loop could be unrolled for better performance.
(do ((i start (1+ i)))
((= i end)
(setf (adler32-state-s1 state) (logand s1 #xffff)
(adler32-state-s2 state) (logand s2 #xffff)
(adler32-state-length state) length)
state)
(setf s1 (+ s1 (aref sequence i))
s2 (+ s2 s1))
(incf length)
(when (= length 5552)
(setf s1 (truncate s1 adler32-modulo)
s2 (truncate s2 adler32-modulo)
length 0)))))
(defun finalize-adler32-state (state)
(declare (type adler32-state state))
(let ((digest (make-array 4 :element-type '(unsigned-byte 8))))
(store-ub32-be digest 0 (logior (ash (adler32-state-s2 state) 16)
(adler32-state-s1 state)))
digest))
(defdigest adler32
(:digest-length 4)
(:state-type adler32-state)
(:creation-function make-adler32-state)
(:copy-function copy-adler32-state)
(:update-function update-adler32-state)
(:finalize-function finalize-adler32-state))
|
