[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Bug in 8/27/87 Reader/Writer Dcode Generation
- To: commonloops.pa@Xerox.COM
- Subject: Bug in 8/27/87 Reader/Writer Dcode Generation
- From: kempf%hplabsz@hplabs.HP.COM
- Date: Sun, 22 Nov 87 13:57:23 MST
- Cc: gregor.pa@Xerox.COM, harris%hplms2@hplabs.HP.COM
- Redistributed: commonloops.pa
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.))))))))