Handling of "no applicable method"

[Gregor.pa@Xerox.COM]

    Date: 9 Mar 88 12:00 EST (Wednesday)
    From: fritzson@PRC.Unisys.COM (Richard Fritzson)

    When I mistakenly apply a slot accessor on an entirely inappropriate
    object (such as NIL), I would expect to see something like "No
    applicable method". Instead the method for "slot-value-using-class
    (standard-class)" is invoked on the object producing very bad
    results.

This bug will be fixed in the version of PCL I hope to release later
today.  In the meantime, you can fix it for yourself by replacing the
following two definitions from dcode.lisp.  You will then have to
recompile the file dcode.lisp and the file dcode-pre1.lisp.  You can
then load those two files into an exisiting PCL.  Note that you will
have to reload all of your code for this change to take effect though.

;from dcode.lisp
(define-function-template all-std-class-readers-dcode
			  ()
			  '(.GENERIC-FUNCTION. .CACHE.)
  (let ((mask (make-generic-function-cache-mask 1)))
    `(function
       (lambda (arg)
	 (locally
	   (declare (optimize (speed 3) (safety 0)))
	   (let* ((wrapper (and (iwmc-class-p arg)
				(iwmc-class-class-wrapper arg)))
		  (offset (wrapper-cache-no wrapper ,mask))
		  (method nil)			
		  
		  (class nil))
	     (cond ((null wrapper)
		    (no-matching-method .GENERIC-FUNCTION.))
		   ((eq (r/w-cache-key) wrapper)
		    (get-static-slot--class arg (r/w-cache-val)))
		   ((setq class (class-wrapper-class wrapper)
			  method (lookup-method-1 .GENERIC-FUNCTION. arg))
		    (let* ((slot-name (reader/writer-method-slot-name method))
			   (slot-pos
			     (slotd-position
			       slot-name
			       (class-instance-slots class))))
		      (cond ((not (null slot-pos))	;Got an instance slot!
			     (setq slot-pos
				   (%convert-slotd-position-to-slot-index
				     slot-pos))
			     (without-interrupts
			       (setf (r/w-cache-key) wrapper)
			       (setf (r/w-cache-val) slot-pos))
			     (get-static-slot--class arg slot-pos))
			    (t
			     (slot-value-using-class--class-internal
			       class arg slot-name nil nil)))))
		   (t
		    (no-matching-method .GENERIC-FUNCTION.)))))))))

(define-function-template all-std-class-writers-dcode
			  ()
			  '(.GENERIC-FUNCTION. .CACHE.)
  (let ((mask (make-generic-function-cache-mask 1)))
    `(function
       (lambda (arg new-value)
	 (locally
	   (declare (optimize (speed 3) (safety 0)))
	   (let* ((wrapper (and (iwmc-class-p arg)
				(iwmc-class-class-wrapper arg)))
		  (offset (wrapper-cache-no wrapper ,mask))
		  (method nil)
		  (class nil))
	     (cond ((null wrapper)
		    (no-matching-method .GENERIC-FUNCTION.))
		   ((eq (r/w-cache-key) wrapper)
		    (setf (get-static-slot--class arg (r/w-cache-val))
			  new-value))
		   ((setq class (class-wrapper-class wrapper)
			  method (lookup-method-1 .GENERIC-FUNCTION. arg))
		    (let* ((slot-name (reader/writer-method-slot-name method))
			   (slot-pos
			     (slotd-position
			       slot-name
			       (class-instance-slots class))))
		      (cond ((not (null slot-pos))	;Got an instance slot!
			     (setq slot-pos
				   (%convert-slotd-position-to-slot-index
				     slot-pos))
			     (without-interrupts
			       (setf (r/w-cache-key) wrapper)
			       (setf (r/w-cache-val) slot-pos))
			     (setf (get-static-slot--class arg slot-pos)
				   new-value))
			    (t
			     (put-slot-using-class--class-internal
			       class arg slot-name new-value nil)))))
		   (t
		    (no-matching-method .GENERIC-FUNCTION.)))))))))
-------