Updated version to 2.1.
[salza2.git] / chains.lisp
blobea428a64b7261e515f2fc131b36e723578f75206
1 ;;;
2 ;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
3 ;;;
4 ;;; Redistribution and use in source and binary forms, with or without
5 ;;; modification, are permitted provided that the following conditions
6 ;;; are met:
7 ;;;
8 ;;; * Redistributions of source code must retain the above copyright
9 ;;; notice, this list of conditions and the following disclaimer.
10 ;;;
11 ;;; * Redistributions in binary form must reproduce the above
12 ;;; copyright notice, this list of conditions and the following
13 ;;; disclaimer in the documentation and/or other materials
14 ;;; provided with the distribution.
15 ;;;
16 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
17 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
18 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
19 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
20 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
21 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
22 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
23 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
24 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
25 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
26 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 ;;;
29 (in-package #:salza2)
31 (defun hash-value (input position)
32 (+ (* #.+rmax+ (aref input position))
33 (* #.+radix+ (aref input (logand #.+input-mask+ (+ position 1))))
34 (aref input (logand #.+input-mask+ (+ position 2)))))
36 (declaim (inline mod8191))
37 (defun mod8191 (z)
38 (declare (type (integer 0 3057705) z))
39 (let ((zz (+ (ash z -13) (logand #x1FFF z))))
40 (if (< zz #x1FFF)
42 (- zz #x1FFF))))
44 (defun update-chains (input hashes chains start count)
45 (declare (type input-buffer input)
46 (type hashes-buffer hashes)
47 (type chains-buffer chains)
48 (type input-index start)
49 (type (integer 0 32768) count)
50 (optimize speed))
51 (when (< count 3)
52 (return-from update-chains))
53 (let* ((hash (hash-value input start))
54 (p0 start)
55 (p1 (logand (+ start 2) #xFFFF)))
56 (declare (type (integer 0 3057705) hash))
57 (loop
58 (let ((hash-index (mod8191 hash)))
59 ;; Stuff the old hash index into chains at p0
60 (setf (aref chains p0) (aref hashes hash-index))
61 ;; Stuff p0 into the hashes
62 (setf (aref hashes hash-index) p0)
63 ;; Tentatively advance; if we hit the end, don't do the rest of
64 ;; the hash update
65 (setf p1 (logand (1+ p1) #xFFFF))
66 (decf count)
67 (when (= count 2)
68 (return))
69 ;; We're not at the end, so lop off the high, shift left, and
70 ;; add the low to form a new hash value
71 (setf hash (- hash (* (aref input p0) 11881)))
72 (setf hash (* hash 109))
73 (setf p0 (logand (1+ p0) #xFFFF))
74 (setf hash (+ hash (aref input p1)))))))