- (let (;; the operator that we'll use to access one value in
- ;; the raw data vector
- (rawref (ecase raw-type
- ;; The compiler thinks that the raw data
- ;; vector is a vector of unsigned bytes, so if
- ;; the slot we want to access actually *is* an
- ;; unsigned byte, it'll access the slot for
- ;; us even if we don't lie to it at all.
- (unsigned-byte 'aref)
- ;; "A lie can travel halfway round the world while
- ;; the truth is putting on its shoes." -- Mark Twain
- (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))))
- `(,rawref (,ref ,instance-name ,(dd-raw-index dd))
- ,(dsd-index dsd))))))
-
-;;; Return inline expansion designators (i.e. values suitable for
-;;; (INFO :FUNCTION :INLINE-EXPANSSION-DESIGNATOR ..)) for the reader
-;;; and writer functions of the slot described by DSD.
-(defun accessor-inline-expansion-designators (dd dsd)
- (values (lambda ()
- `(lambda (instance)
- (declare (type ,(dd-name dd) instance))
- (truly-the ,(dsd-type dsd)
- ,(%accessor-place-form dd dsd 'instance))))
- (lambda ()
- `(lambda (new-value instance)
- (declare (type ,(dsd-type dsd) new-value))
- (declare (type ,(dd-name dd) structure-object))
- (setf ,(%accessor-place-form dd dsd 'instance) new-value)))))
+ (let* ((raw-slot-data (find raw-type *raw-slot-data-list*
+ :key #'raw-slot-data-raw-type
+ :test #'equal))
+ (raw-slot-accessor (raw-slot-data-accessor-name raw-slot-data))
+ (raw-n-words (raw-slot-data-n-words raw-slot-data)))
+ (multiple-value-bind (scaled-dsd-index misalignment)
+ (floor (dsd-index dsd) raw-n-words)
+ (aver (zerop misalignment))
+ (let* ((raw-vector-bare-form
+ `(,ref ,instance-name ,(dd-raw-index dd)))
+ (raw-vector-form
+ (if (eq raw-type 'unsigned-byte)
+ (progn
+ (aver (= raw-n-words 1))
+ (aver (eq raw-slot-accessor 'aref))
+ ;; FIXME: when the 64-bit world rolls
+ ;; around, this will need to be reviewed,
+ ;; along with the whole RAW-SLOT thing.
+ `(truly-the (simple-array (unsigned-byte 32) (*))
+ ,raw-vector-bare-form))
+ raw-vector-bare-form)))
+ `(,raw-slot-accessor ,raw-vector-form ,scaled-dsd-index)))))))
+
+;;; Return source transforms for the reader and writer functions of
+;;; the slot described by DSD. They should be inline expanded, but
+;;; source transforms work faster.
+(defun slot-accessor-transforms (dd dsd)
+ (let ((accessor-place-form (%accessor-place-form dd dsd
+ `(the ,(dd-name dd) instance)))
+ (dsd-type (dsd-type dsd))
+ (value-the (if (dsd-safe-p dsd) 'truly-the 'the)))
+ (values (sb!c:source-transform-lambda (instance)
+ `(,value-the ,dsd-type ,(subst instance 'instance
+ accessor-place-form)))
+ (sb!c:source-transform-lambda (new-value instance)
+ (destructuring-bind (accessor-name &rest accessor-args)
+ accessor-place-form
+ `(,(info :setf :inverse accessor-name)
+ ,@(subst instance 'instance accessor-args)
+ (the ,dsd-type ,new-value)))))))
+
+;;; Return a LAMBDA form which can be used to set a slot.
+(defun slot-setter-lambda-form (dd dsd)
+ `(lambda (new-value instance)
+ ,(funcall (nth-value 1 (slot-accessor-transforms dd dsd))
+ '(dummy new-value instance))))