compress.lisp

   1 ;;;; $Id: compress.lisp,v 1.6 2007/12/19 20:55:16 xach Exp $
   2
   3 (in-package #:salza2)
   4
   5 (defun compress (input chains start end
   6                  literal-fun length-fun distance-fun)
   7   (declare (type input-buffer input)
   8            (type chains-buffer chains)
   9            (type input-index start end)
  10            (type function literal-fun length-fun distance-fun)
  11            (optimize speed))
  12   (let ((p start))
  13     (loop
  14      (when (= p end)
  15        (return))
  16      (multiple-value-bind (length distance)
  17          (longest-match p input chains end 4)
  18        (declare (type (integer 0 258) length)
  19                 (type (integer 0 32768) distance))
  20        (cond ((zerop length)
  21               (funcall literal-fun (aref input p))
  22               (setf p (logand (+ p 1) #xFFFF)))
  23              (t
  24               (funcall length-fun length)
  25               (funcall distance-fun distance)
  26               (setf p (logand (+ p length) #xFFFF))))))))