+\f
+;;;; raw instance slot accessors
+
+(defun make-ea-for-raw-slot (object instance-length
+ &key (index nil) (adjustment 0) (scale 1))
+ (if (integerp instance-length)
+ ;; For RAW-INSTANCE-INIT/* VOPs, which know the exact instance length
+ ;; at compile time.
+ (make-ea :qword
+ :base object
+ :disp (+ (* (- instance-length instance-slots-offset index)
+ n-word-bytes)
+ (- instance-pointer-lowtag)
+ adjustment))
+ (etypecase index
+ (null
+ (make-ea :qword :base object :index instance-length :scale scale
+ :disp (+ (* (1- instance-slots-offset) n-word-bytes)
+ (- instance-pointer-lowtag)
+ adjustment)))
+ (integer
+ (make-ea :qword :base object :index instance-length
+ :scale 8
+ :disp (+ (* (1- instance-slots-offset) n-word-bytes)
+ (- instance-pointer-lowtag)
+ adjustment
+ (* index (- n-word-bytes))))))))
+
+(define-vop (raw-instance-ref/word)
+ (:translate %raw-instance-ref/word)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg)) (index :scs (any-reg)))
+ (:arg-types * tagged-num)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst shl tmp n-fixnum-tag-bits)
+ (inst sub tmp index)
+ (inst mov value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
+
+(define-vop (raw-instance-ref-c/word)
+ (:translate %raw-instance-ref/word)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg)))
+ (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
+ #.instance-pointer-lowtag
+ #.instance-slots-offset)))
+ (:info index)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:generator 4
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst mov value (make-ea-for-raw-slot object tmp :index index))))
+
+(define-vop (raw-instance-set/word)
+ (:translate %raw-instance-set/word)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg))
+ (value :scs (unsigned-reg) :target result))
+ (:arg-types * tagged-num unsigned-num)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst shl tmp n-fixnum-tag-bits)
+ (inst sub tmp index)
+ (inst mov (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)
+ (move result value)))
+
+(define-vop (raw-instance-set-c/word)
+ (:translate %raw-instance-set/word)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (value :scs (unsigned-reg) :target result))
+ (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
+ #.instance-pointer-lowtag
+ #.instance-slots-offset))
+ unsigned-num)
+ (:info index)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:generator 4
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst mov (make-ea-for-raw-slot object tmp :index index) value)
+ (move result value)))
+
+(define-vop (raw-instance-init/word)
+ (:args (object :scs (descriptor-reg))
+ (value :scs (unsigned-reg)))
+ (:arg-types * unsigned-num)
+ (:info instance-length index)
+ (:generator 4
+ (inst mov (make-ea-for-raw-slot object instance-length :index index) value)))
+
+(define-vop (raw-instance-atomic-incf-c/word)
+ (:translate %raw-instance-atomic-incf/word)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (diff :scs (unsigned-reg) :target result))
+ (:arg-types * (:constant (load/store-index #.n-word-bytes
+ #.instance-pointer-lowtag
+ #.instance-slots-offset))
+ unsigned-num)
+ (:info index)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:generator 4
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst xadd (make-ea-for-raw-slot object tmp :index index) diff :lock)
+ (move result diff)))
+
+(define-vop (raw-instance-ref/single)
+ (:translate %raw-instance-ref/single)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg)))
+ (:arg-types * positive-fixnum)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (single-reg)))
+ (:result-types single-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst shl tmp n-fixnum-tag-bits)
+ (inst sub tmp index)
+ (inst movss value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
+
+(define-vop (raw-instance-ref-c/single)
+ (:translate %raw-instance-ref/single)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg)))
+ (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
+ #.instance-pointer-lowtag
+ #.instance-slots-offset)))
+ (:info index)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (single-reg)))
+ (:result-types single-float)
+ (:generator 4
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst movss value (make-ea-for-raw-slot object tmp :index index))))
+
+(define-vop (raw-instance-set/single)
+ (:translate %raw-instance-set/single)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg))
+ (value :scs (single-reg) :target result))
+ (:arg-types * positive-fixnum single-float)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (single-reg)))
+ (:result-types single-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst shl tmp n-fixnum-tag-bits)
+ (inst sub tmp index)
+ (inst movss (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)
+ (move result value)))
+
+(define-vop (raw-instance-set-c/single)
+ (:translate %raw-instance-set/single)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (value :scs (single-reg) :target result))
+ (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
+ #.instance-pointer-lowtag
+ #.instance-slots-offset))
+ single-float)
+ (:info index)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (single-reg)))
+ (:result-types single-float)
+ (:generator 4
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst movss (make-ea-for-raw-slot object tmp :index index) value)
+ (move result value)))
+
+(define-vop (raw-instance-init/single)
+ (:args (object :scs (descriptor-reg))
+ (value :scs (single-reg)))
+ (:arg-types * single-float)
+ (:info instance-length index)
+ (:generator 4
+ (inst movss (make-ea-for-raw-slot object instance-length :index index) value)))
+
+(define-vop (raw-instance-ref/double)
+ (:translate %raw-instance-ref/double)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg)))
+ (:arg-types * positive-fixnum)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (double-reg)))
+ (:result-types double-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst shl tmp n-fixnum-tag-bits)
+ (inst sub tmp index)
+ (inst movsd value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
+
+(define-vop (raw-instance-ref-c/double)
+ (:translate %raw-instance-ref/double)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg)))
+ (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
+ #.instance-pointer-lowtag
+ #.instance-slots-offset)))
+ (:info index)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (double-reg)))
+ (:result-types double-float)
+ (:generator 4
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst movsd value (make-ea-for-raw-slot object tmp :index index))))
+
+(define-vop (raw-instance-set/double)
+ (:translate %raw-instance-set/double)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg))
+ (value :scs (double-reg) :target result))
+ (:arg-types * positive-fixnum double-float)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (double-reg)))
+ (:result-types double-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst shl tmp n-fixnum-tag-bits)
+ (inst sub tmp index)
+ (inst movsd (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)
+ (move result value)))
+
+(define-vop (raw-instance-set-c/double)
+ (:translate %raw-instance-set/double)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (value :scs (double-reg) :target result))
+ (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
+ #.instance-pointer-lowtag
+ #.instance-slots-offset))
+ double-float)
+ (:info index)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (double-reg)))
+ (:result-types double-float)
+ (:generator 4
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst movsd (make-ea-for-raw-slot object tmp :index index) value)
+ (move result value)))
+
+(define-vop (raw-instance-init/double)
+ (:args (object :scs (descriptor-reg))
+ (value :scs (double-reg)))
+ (:arg-types * double-float)
+ (:info instance-length index)
+ (:generator 4
+ (inst movsd (make-ea-for-raw-slot object instance-length :index index) value)))
+
+(define-vop (raw-instance-ref/complex-single)
+ (:translate %raw-instance-ref/complex-single)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg)))
+ (:arg-types * positive-fixnum)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (complex-single-reg)))
+ (:result-types complex-single-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst shl tmp n-fixnum-tag-bits)
+ (inst sub tmp index)
+ (inst movq value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
+
+(define-vop (raw-instance-ref-c/complex-single)
+ (:translate %raw-instance-ref/complex-single)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg)))
+ (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
+ #.instance-pointer-lowtag
+ #.instance-slots-offset)))
+ (:info index)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (complex-single-reg)))
+ (:result-types complex-single-float)
+ (:generator 4
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst movq value (make-ea-for-raw-slot object tmp :index index))))
+
+(define-vop (raw-instance-set/complex-single)
+ (:translate %raw-instance-set/complex-single)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg))
+ (value :scs (complex-single-reg) :target result))
+ (:arg-types * positive-fixnum complex-single-float)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (complex-single-reg)))
+ (:result-types complex-single-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst shl tmp n-fixnum-tag-bits)
+ (inst sub tmp index)
+ (move result value)
+ (inst movq (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)))
+
+(define-vop (raw-instance-set-c/complex-single)
+ (:translate %raw-instance-set/complex-single)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (value :scs (complex-single-reg) :target result))
+ (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
+ #.instance-pointer-lowtag
+ #.instance-slots-offset))
+ complex-single-float)
+ (:info index)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (complex-single-reg)))
+ (:result-types complex-single-float)
+ (:generator 4
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (move result value)
+ (inst movq (make-ea-for-raw-slot object tmp :index index) value)))
+
+(define-vop (raw-instance-init/complex-single)
+ (:args (object :scs (descriptor-reg))
+ (value :scs (complex-single-reg)))
+ (:arg-types * complex-single-float)
+ (:info instance-length index)
+ (:generator 4
+ (inst movq (make-ea-for-raw-slot object instance-length :index index) value)))
+
+(define-vop (raw-instance-ref/complex-double)
+ (:translate %raw-instance-ref/complex-double)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg)))
+ (:arg-types * positive-fixnum)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (complex-double-reg)))
+ (:result-types complex-double-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst shl tmp n-fixnum-tag-bits)
+ (inst sub tmp index)
+ (inst movdqu value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :adjustment -8))))
+
+(define-vop (raw-instance-ref-c/complex-double)
+ (:translate %raw-instance-ref/complex-double)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg)))
+ (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
+ #.instance-pointer-lowtag
+ #.instance-slots-offset)))
+ (:info index)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (complex-double-reg)))
+ (:result-types complex-double-float)
+ (:generator 4
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst movdqu value (make-ea-for-raw-slot object tmp :index index :adjustment -8))))
+
+(define-vop (raw-instance-set/complex-double)
+ (:translate %raw-instance-set/complex-double)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg))
+ (value :scs (complex-double-reg) :target result))
+ (:arg-types * positive-fixnum complex-double-float)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (complex-double-reg)))
+ (:result-types complex-double-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst shl tmp n-fixnum-tag-bits)
+ (inst sub tmp index)
+ (move result value)
+ (inst movdqu (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :adjustment -8) value)))
+
+(define-vop (raw-instance-set-c/complex-double)
+ (:translate %raw-instance-set/complex-double)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (value :scs (complex-double-reg) :target result))
+ (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
+ #.instance-pointer-lowtag
+ #.instance-slots-offset))
+ complex-double-float)
+ (:info index)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (complex-double-reg)))
+ (:result-types complex-double-float)
+ (:generator 4
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (move result value)
+ (inst movdqu (make-ea-for-raw-slot object tmp :index index :adjustment -8) value)))
+
+(define-vop (raw-instance-init/complex-double)
+ (:args (object :scs (descriptor-reg))
+ (value :scs (complex-double-reg)))
+ (:arg-types * complex-double-float)
+ (:info instance-length index)
+ (:generator 4
+ (inst movdqu (make-ea-for-raw-slot object instance-length :index index :adjustment -8) value)))