-;;;; slot accessors for raw slots
-
-;;; Return info about how to read/write a slot in the value stored in
-;;; OBJECT. This is also used by constructors (since we can't safely
-;;; use the accessor function, since some slots are read-only). If
-;;; supplied, DATA is a variable holding the raw-data vector.
-;;;
-;;; returned values:
-;;; 1. accessor function name (SETFable)
-;;; 2. index to pass to accessor.
-;;; 3. object form to pass to accessor
-(defun slot-accessor-form (defstruct slot object &optional data)
- (let ((rtype (dsd-raw-type slot)))
- (values
- (ecase rtype
- (single-float '%raw-ref-single)
- (double-float '%raw-ref-double)
- #!+long-float
- (long-float '%raw-ref-long)
- (complex-single-float '%raw-ref-complex-single)
- (complex-double-float '%raw-ref-complex-double)
- #!+long-float
- (complex-long-float '%raw-ref-complex-long)
- (unsigned-byte 'aref)
- ((t) '%instance-ref))
- (case rtype
- #!+long-float
- (complex-long-float
- (truncate (dsd-index slot) #!+x86 6 #!+sparc 8))
- #!+long-float
- (long-float
- (truncate (dsd-index slot) #!+x86 3 #!+sparc 4))
- (double-float
- (ash (dsd-index slot) -1))
- (complex-double-float
- (ash (dsd-index slot) -2))
- (complex-single-float
- (ash (dsd-index slot) -1))
- (t
- (dsd-index slot)))
- (cond
- ((eq rtype t) object)
- (data)
- (t
- `(truly-the (simple-array (unsigned-byte 32) (*))
- (%instance-ref ,object ,(dd-raw-index defstruct))))))))
-\f