adler32.lisp

   1 ;;;; $Id: adler32.lisp,v 1.5 2007/12/19 20:57:08 xach Exp $
   2
   3 (in-package #:salza2)
   4
   5 (defconstant +adler32-base+ 65521)
   6
   7 (defun adler32-update (adler-high adler-low buf start count)
   8   (declare (type array-index start)
   9            (type (integer 0 65536) count)
  10            (type (unsigned-byte 16) adler-high adler-low)
  11            (type octet-vector buf)
  12            (optimize speed))
  13   (cond ((zerop count)
  14          (values adler-high adler-low))
  15         (t
  16          (let ((length count)
  17                (i 0)
  18                (k 0)
  19                (s1 adler-low)
  20                (s2 adler-high))
  21            (declare (type (integer 0 32658) length)
  22                     (type (integer 0 16) i k)
  23                     (type (integer 0 65536) s1 s2))
  24            (tagbody
  25             loop
  26               (setf k (min length 16))
  27               (decf length k)
  28             sum
  29               (setf s1 (+ (aref buf (logand #xFFFF (+ start i))) s1))
  30               (setf s2 (+ s1 s2))
  31               (decf k)
  32               (incf i)
  33               (unless (zerop k)
  34                 (go sum))
  35               (setf s1 (mod s1 +adler32-base+))
  36               (setf s2 (mod s2 +adler32-base+))
  37               (unless (zerop length)
  38                 (go loop)))
  39            (values s2 s1)))))
  40
  41 ;;; Class interface
  42
  43 (defclass adler32-checksum (checksum)
  44   ((high
  45     :initarg :high
  46     :accessor high)
  47    (low
  48     :initarg :low
  49     :accessor low))
  50   (:default-initargs
  51    :high 0
  52    :low 1))
  53
  54 (defmethod result ((checksum adler32-checksum))
  55   (+ (ash (high checksum) 16)
  56      (low checksum)))
  57
  58 (defmethod result-octets ((checksum adler32-checksum))
  59   (ub32-octets (result checksum)))
  60
  61 (defmethod update ((checksum adler32-checksum) buffer start count)
  62   (setf (values (high checksum)
  63                 (low checksum))
  64         (adler32-update (high checksum)
  65                         (low checksum)
  66                         buffer
  67                         start
  68                         count)))