- (if (eq kind :default)
- default
- (let* ((index (gensym))
- (value index))
- `(locally (declare #.*optimize-speed*)
- (let ((,index (svref ,pv ,pv-offset)))
- (setq ,value (typecase ,index
- ;; FIXME: the line marked by KLUDGE below
- ;; (and the analogous spot in
- ;; INSTANCE-WRITE-INTERNAL) is there purely
- ;; to suppress a type mismatch warning that
- ;; propagates through to user code.
- ;; Presumably SLOTS at this point can never
- ;; actually be NIL, but the compiler seems
- ;; to think it could, so we put this here
- ;; to shut it up. (see also mail Rudi
- ;; Schlatte sbcl-devel 2003-09-21) -- CSR,
- ;; 2003-11-30
- ,@(when (or (null kind) (eq kind :instance))
- `((fixnum
- (and ,slots ; KLUDGE
- (clos-slots-ref ,slots ,index)))))
- ,@(when (or (null kind) (eq kind :class))
- `((cons (cdr ,index))))
- (t +slot-unbound+)))
- (if (eq ,value +slot-unbound+)
- ,default
- ,value))))))
+ (let* ((index (gensym))
+ (value index))
+ `(locally (declare #.*optimize-speed*)
+ (let ((,index (svref ,pv ,pv-offset)))
+ (setq ,value (typecase ,index
+ ;; FIXME: the line marked by KLUDGE below (and
+ ;; the analogous spot in
+ ;; INSTANCE-WRITE-INTERNAL) is there purely to
+ ;; suppress a type mismatch warning that
+ ;; propagates through to user code.
+ ;; Presumably SLOTS at this point can never
+ ;; actually be NIL, but the compiler seems to
+ ;; think it could, so we put this here to shut
+ ;; it up. (see also mail Rudi Schlatte
+ ;; sbcl-devel 2003-09-21) -- CSR, 2003-11-30
+ ,@(when (or (null kind) (eq kind :instance))
+ `((fixnum
+ (and ,slots ; KLUDGE
+ (clos-slots-ref ,slots ,index)))))
+ ,@(when (or (null kind) (eq kind :class))
+ `((cons (cdr ,index))))
+ (t +slot-unbound+)))
+ (if (eq ,value +slot-unbound+)
+ ,default
+ ,value)))))