adler32.lisp

;; Unrolling a loop (just for fun)

(defconstant mod-adler 65521)

(defun adler32 (data &optional (length nil))
	   (let ((l (or length (length data)))
		 (a 1)
		 (b 0))
	     (declare (type fixnum l a b)
		      (type (vector fixnum) data))
	     (declare (optimize (speed 3) (safety 0) (debug 0)))
	     (loop for i from 0 to (1- l) do
		  (setf a (mod (+ a (aref data i)) mod-adler))
		  (setf b (mod (+ b a) mod-adler)))
	     (logior (ash b 16) a)))

(define-compiler-macro adler32 (&whole form data &optional length)
  (if (null length)
      form
      (if (and (constantp length) (integerp length))
	  `(progn
	     (let ((a 1)
		   (b 0)
		   (data ,data))
	       (declare (type fixnum  a b)
			(type (vector fixnum) data))
	       (declare (optimize (speed 3) (safety 0) (debug 0)))
	       ,@(loop for i from 0 to (1- length) collect
		      `(progn
			 (setf a (mod (+ a (aref data ,i)) mod-adler))
			 (setf b (mod (+ b a) mod-adler))))
	       (logior (ash b 16) a)))
	  form)))  ;; If data is constant then we can also unroll a loop here
	       
	       
CL-USER> (time
	  (loop for i from 0 to 100000000
	       do (adler32 *ntest* 9)))
Evaluation took:
  1.227 seconds of real time
  1.253446 seconds of total run time (1.253446 user, 0.000000 system)
  102.12% CPU
  3,425,032,679 processor cycles
  0 bytes consed
  
NIL
CL-USER> (time
	  (loop for i from 0 to 100000000
	       do (adler32 *ntest*)))
Evaluation took:
  24.407 seconds of real time
  24.620813 seconds of total run time (24.620813 user, 0.000000 system)
  100.88% CPU
  68,137,662,974 processor cycles
  196,720 bytes consed
  
NIL
CL-USER> (adler32 *ntest*)
300286872
CL-USER> (adler32 *ntest* 9)
300286872
CL-USER> *ntest*
#(87 105 107 105 112 101 100 105 97)

Oops, just realised that adler32 needs a (unsigned-byte 8) vector and not a fixnum one!