- (let* ((class (class-of object))
- (slot-definition (find-slot-definition class slot-name)))
- (if (null slot-definition)
- (values (slot-missing class object slot-name 'slot-value))
- (slot-value-using-class class object slot-definition))))
-
-(define-compiler-macro slot-value (&whole form object slot-name)
- (if (and (constantp slot-name)
- (interned-symbol-p (constant-form-value slot-name)))
+ (let* ((wrapper (valid-wrapper-of object))
+ (cell (find-slot-cell wrapper slot-name))
+ (location (car cell))
+ (value
+ (cond ((fixnump location)
+ (if (std-instance-p object)
+ (standard-instance-access object location)
+ (funcallable-standard-instance-access object location)))
+ ((consp location)
+ (cdr location))
+ ((not cell)
+ (return-from slot-value
+ (values (slot-missing (wrapper-class* wrapper) object slot-name
+ 'slot-value))))
+ ((not location)
+ (return-from slot-value
+ (slot-value-using-class (wrapper-class* wrapper) object (cddr cell))))
+ (t
+ (bug "Bogus slot cell in SLOT-VALUE: ~S" cell)))))
+ (if (eq +slot-unbound+ value)
+ (slot-unbound (wrapper-class* wrapper) object slot-name)
+ value)))
+
+;;; This is used during the PCL build, but gets replaced by a deftransform
+;;; in fixup.lisp.
+(define-compiler-macro slot-value (&whole form object slot-name
+ &environment env)
+ (if (and (constantp slot-name env)
+ (interned-symbol-p (constant-form-value slot-name env)))