1 ;;;; $Id: matches.lisp,v 1.10 2007/12/20 16:36:41 xach Exp $
5 (defconstant +maximum-match-length
+ 258
6 "The maximum match length allowed.")
8 (defconstant +maximum-match-distance
+ 32768
9 "The maximum distance for a match.")
11 (declaim (inline match-length
))
12 (defun match-length (p1 p2 input end
)
13 "Returns the length of the match between positions p1 and p2 in
14 INPUT; END is a sentinel position that ends the match length
16 (declare (type input-index p1 p2 end
)
17 (type input-buffer input
)
21 (when (or (/= (aref input p1
) (aref input p2
))
22 (= length
+maximum-match-length
+)
25 (setf p1
(logand (1+ p1
) #xFFFF
)
26 p2
(logand (1+ p2
) #xFFFF
)
27 length
(logand #xFFF
(1+ length
))))))
29 (defun longest-match (p1 input chains end max-tests
)
30 (declare (type input-index p1 end
)
31 (type input-buffer input
)
32 (type chains-buffer chains
)
33 (type (integer 0 32) max-tests
)
35 (let ((match-length 0)
39 (declare (type (integer 0 258) match-length
)
40 (type (integer 0 32) test-count
))
42 (when (or (= match-length
+maximum-match-length
+)
43 (= test-count max-tests
)
45 (= p2
(aref chains p2
)))
46 (return (values match-length distance
)))
47 (let ((step (logand (- p1 p2
) #xFFFF
)))
48 (when (< +maximum-match-distance
+ step
)
49 (return (values match-length distance
)))
50 (let ((possible-length (match-length p1 p2 input end
)))
51 (when (and (< 2 possible-length
)
52 (< match-length possible-length
))
54 match-length possible-length
))
55 (setf p2
(aref chains p2
)))