chains.lisp

   1 ;;;; $Id: chains.lisp,v 1.9 2007/12/19 20:57:27 xach Exp $
   2
   3 (in-package #:salza2)
   4
   5 (defun hash-value (input position)
   6   (+ (* #.+rmax+ (aref input position))
   7      (* #.+radix+ (aref input (logand #.+input-mask+ (+ position 1))))
   8      (aref input (logand #.+input-mask+ (+ position 2)))))
   9
  10 (declaim (inline mod8191))
  11 (defun mod8191 (z)
  12   (declare (type (integer 0 3057705) z))
  13   (let ((zz (+ (ash z -13) (logand #x1FFF z))))
  14     (if (< zz #x1FFF)
  15         zz
  16         (- zz #x1FFF))))
  17
  18 (defun update-chains (input hashes chains start count)
  19   (declare (type input-buffer input)
  20            (type hashes-buffer hashes)
  21            (type chains-buffer chains)
  22            (type input-index start)
  23            (type (integer 0 32768) count)
  24            (optimize speed))
  25   (when (< count 3)
  26     (return-from update-chains))
  27   (let* ((hash (hash-value input start))
  28          (p0 start)
  29          (p1 (logand (+ start 2) #xFFFF)))
  30     (declare (type (integer 0 3057705) hash))
  31     (loop
  32      (let ((hash-index (mod8191 hash)))
  33        ;; Stuff the old hash index into chains at p0
  34        (setf (aref chains p0) (aref hashes hash-index))
  35        ;; Stuff p0 into the hashes
  36        (setf (aref hashes hash-index) p0)
  37        ;; Tentatively advance; if we hit the end, don't do the rest of
  38        ;; the hash update
  39        (setf p1 (logand (1+ p1) #xFFFF))
  40        (decf count)
  41        (when (= count 2)
  42          (return))
  43        ;; We're not at the end, so lop off the high, shift left, and
  44        ;; add the low to form a new hash value
  45        (setf hash (- hash (* (aref input p0) 11881)))
  46        (setf hash (* hash 109))
  47        (setf p0 (logand (1+ p0) #xFFFF))
  48        (setf hash (+ hash (aref input p1)))))))