[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

patch to 12/7/88



There is a nasty little bug in optimized slot access in 12/7/88 PCL.
This bug probably exists in AAAI PCL as well, I don't have a set of
sources to check.

This bug manifests itself when:
  - a method has more than one specialized argument
  - and slot-value is used on a slot of more than one
    of the specialized arguments
  - and either one of the accessed slots is unbound
        or one of the slots is a :class slot
        or one of the slots doesn't exist

In this case, you can get an error message from slot-value-using-class
with a totally random slot name.  Here is an example of a method that
could have the bug:

(defmethod foo ((p position) (r rectangle))
  (with-slots (top left width height) r
    (with-slots (x y) p
       (setq top y
             left x)
       (values top left width height))))

If for example, the X slot of p is unbound, this would signal an error
saying that p didn't have a height slot!

The following patch fixes this problem.  Take a running PCL, edit
vector.lisp to have this fix, and compile and load vector.  You don't
need to use compile-pcl, it would do extra work.

This will be installed on arisia shortly.

Xerox internal users:  I haven't installed this patch anywhere.

;from vector.lisp

(defun pv-access-trap (instance offset isl &optional (new-value nil nvp))
  (let* ((i 0)
	 (slot-name
	  (block lookup-slot-name
	    (dolist (per-class-slots (cdr isl))
	      (dolist (slot per-class-slots)
		(if (= i offset)
		    (return-from lookup-slot-name slot)
		    (incf i)))))))
    (when (null slot-name)
      (error "Internal Error:~@
              Unable to determine the name of the slot from the PV-OFFSET~@
              and the ISL.  This results from inconsistency between the~@
              PV-OFFSET this access was told to use and the ISL for the~@
              method."))
    (if nvp
	(setf (slot-value-using-class (class-of instance) instance slot-name)
	      new-value)
	(slot-value-using-class (class-of instance) instance slot-name))))
-------