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

Bug in 8/27/87 Reader/Writer Dcode Generation



The reader and writer dcode, generated in dcode.l by the calls to the
DEFINE-FUNCTION-TEMPATE macro, has the following bug.
If the argument is not an IWMC class, then the WRAPPER lexical variable
is NIL, but WRAPPER is used throughout the following code as if it had
a legitimate value. The fix is to check in the LET* whether the WRAPPER
is NIL, and to move the no matching method check up to the beginning.
There are probably faster ways to do this, but this one works. 
Anyway, the code is included below.

		Jim Kempf	kempf@hplabs.hp.com

-------------------------------------------------------------------------------

(define-function-template all-std-class-readers-dcode
			  ()
			  '(.GENERIC-FUNCTION. .CACHE.)
  (let ((mask (make-generic-function-cache-mask 1)))
    `(function
       (lambda (arg)
	 (let* ((wrapper (and (iwmc-class-p arg)
			      (iwmc-class-class-wrapper arg)))
;;;Added the AND. JAK
		(offset (and wrapper 
			     (generic-function-cache-offset ,mask wrapper)))
		(method nil)
		(class nil))
;;;Added check for NULL. JAK
	   (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 .GENERIC-FUNCTION. class))
		  (let* ((slot-name (reader/writer-method-slot-name method))
			 (slot-pos
			   (slotd-position
			     slot-name
			     (class-instance-slots class))))
		    (cond ((not (null slot-pos))    ;This is 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)
	 (let* ((wrapper (and (iwmc-class-p arg)
			      (iwmc-class-class-wrapper arg)))
;;Added AND. JAK.
		(offset (and wrapper 
			     (generic-function-cache-offset ,mask wrapper)))
		(method nil)
		(class nil))
;;Added check for NULL. JAK.
	   (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))
		 ((and wrapper (setq class (class-wrapper-class wrapper)
			method (lookup-method .GENERIC-FUNCTION. class)))
		  (let* ((slot-name (reader/writer-method-slot-name method))
			 (slot-pos
			   (slotd-position
			     slot-name
			     (class-instance-slots class))))
		    (cond ((not (null slot-pos))    ;This is 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.))))))))