bug in 7/20 PCL

[Gregor.pa@Xerox.COM]

There is a bug in the 7/20 version of PCL which can cause calls to aref
with a list as an argument.  This happens inside of methods which have
calls to slot-value in them.  Anyone who is using the 7/20 version of
PCL should make these changes.

1) Make these 4 changes to vector.lisp.
2) In a already loaded pcl, recompile vector.lisp.
3) Get a fresh lisp and reload PCL and your program.

You don't need to recompile your code.

;from vector.lisp
(defun lookup-pv-1 (isl w0 i0)
  (let* ((cache *pv-cache-1*)
	 (mask *pv-cache-1-mask*)
	 (offset (%logand mask
			  (%logxor (object-cache-no isl mask)
				   (validate-wrapper i0 w0)))))
    (without-interrupts
      (if (and (eq (%svref cache offset) isl)
	       (eq (%svref cache (%1+ offset)) w0))
	  (aref cache (%+ offset 2))
	  (let ((pv (with-interrupts (lookup-pv-miss isl w0))))
	    (setf (%svref cache offset) isl)
	    (setf (%svref cache (%1+ offset)) w0)
	    (setf (%svref cache (%+ offset 2)) pv))))))

(defun lookup-pv-2 (isl w0 i0 w1 i1)
  (let* ((cache *pv-cache-2*)
	 (mask *pv-cache-2-mask*)
	 (offset (%logand mask
			  (%logxor (object-cache-no isl mask)
				   (validate-wrapper i0 w0)
				   (validate-wrapper i1 w1)))))
    (without-interrupts
      (if (and (eq (%svref cache offset) isl)
	       (eq (%svref cache (%1+ offset)) w0)
	       (eq (%svref cache (%+ offset 2)) w1))
	  (aref cache (%+ offset 4))
	  (let ((pv (with-interrupts (lookup-pv-miss isl w0 w1))))
	    (setf (%svref cache offset) isl)
	    (setf (%svref cache (%1+ offset)) w0)
	    (setf (%svref cache (%+ offset 2)) w1)
	    (setf (%svref cache (%+ offset 3)) pv))))))

(defun lookup-pv-3 (isl w0 i0 w1 i1 w2 i2)
  (let* ((cache *pv-cache-3*)
	 (mask *pv-cache-3-mask*)
	 (offset (%logand mask
			  (%logxor (object-cache-no isl mask)
				   (validate-wrapper i0 w0)
				   (validate-wrapper i1 w1)
				   (validate-wrapper i2 w2)))))
    (without-interrupts
      (if (and (eq (%svref cache offset) isl)
	       (eq (%svref cache (%1+ offset)) w0)
	       (eq (%svref cache (%+ offset 2)) w1)
	       (eq (%svref cache (%+ offset 3)) w2))
	  (aref cache (%+ offset 4))
	  (let ((pv (with-interrupts (lookup-pv-miss isl w0 w1 w2))))
	    (setf (%svref cache offset) isl)
	    (setf (%svref cache (%1+ offset)) w0)
	    (setf (%svref cache (%+ offset 2)) w1)
	    (setf (%svref cache (%+ offset 3)) w2)
	    (setf (%svref cache (%+ offset 4)) pv))))))

(defun lookup-pv-n (isl &rest wrappers-and-instances)
  (let* ((cache *pv-cache-n*)
	 (mask *pv-cache-n-mask*)
	 (offset (object-cache-no isl mask)))
    (doplist (wrapper instance) 	;Slight abuse of this macro,
	     wrappers-and-instances     ;but what the hell.
      (setq offset (boole boole-xor
			  offset
			  (validate-wrapper instance wrapper))))
    (setq offset (%logand mask offset))
    (without-interrupts
      (if (and (eq (%svref cache offset) isl)
	       (let ((cached-wrappers (%svref cache (+ offset 1)))
		     (tail wrappers-and-instances))
		 (loop (cond ((neq (car cached-wrappers)
				   (car tail))
			      (return nil))
			     ((or (null cached-wrappers)
				  (null tail))
			      (return t))
			     (t
			      (setq cached-wrappers (cdr cached-wrappers)
				    tail (cddr tail)))))))
	  (%svref cache (+ offset 2))
	  (with-interrupts
	    (let* ((wrappers (gathering ((ws (collecting)))
			       (doplist (w i)
					wrappers-and-instances
				 (gather w ws))))
		   (pv (apply #'lookup-pv-miss isl wrappers)))
	      (without-interrupts
		(setf (%svref cache offset) isl
		      (%svref cache (+ offset 1)) wrappers
		      (%svref cache (+ offset 2)) pv))))))))
-------