1 ;;;; the VM definition of various primitive memory access VOPs for the
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
15 ;;;; data object ref/set stuff
18 (:args
(object :scs
(descriptor-reg)))
19 (:info name offset lowtag
)
21 (:results
(result :scs
(descriptor-reg any-reg
)))
23 (loadw result object offset lowtag
)))
25 (define-vop (set-slot)
26 (:args
(object :scs
(descriptor-reg))
27 (value :scs
(descriptor-reg any-reg null zero
)))
28 (:info name offset lowtag
#!+gengc remember
)
34 (storew-and-remember-slot value object offset lowtag
)
35 (storew value object offset lowtag
))
37 (storew value object offset lowtag
)))
39 (define-vop (init-slot set-slot
))
41 ;;;; symbol hacking VOPs
43 ;;; The compiler likes to be able to directly SET symbols.
44 (define-vop (set cell-set
)
45 (:variant symbol-value-slot other-pointer-lowtag
))
47 ;;; Do a cell ref with an error check for being unbound.
48 (define-vop (checked-cell-ref)
49 (:args
(object :scs
(descriptor-reg) :target obj-temp
))
50 (:results
(value :scs
(descriptor-reg any-reg
)))
53 (:save-p
:compute-only
)
54 (:temporary
(:scs
(non-descriptor-reg)) temp
)
55 (:temporary
(:scs
(descriptor-reg) :from
(:argument
0)) obj-temp
))
57 ;;; With SYMBOL-VALUE, we check that the value isn't the trap object.
58 ;;; So SYMBOL-VALUE of NIL is NIL.
59 (define-vop (symbol-value checked-cell-ref
)
60 (:translate symbol-value
)
62 (move object obj-temp
)
63 (loadw value obj-temp symbol-value-slot other-pointer-lowtag
)
64 (let ((err-lab (generate-error-code vop
'unbound-symbol-error obj-temp
)))
65 (inst xor value unbound-marker-widetag temp
)
66 (inst beq temp err-lab
))))
68 ;;; like CHECKED-CELL-REF, only we are a predicate to see if the cell
70 (define-vop (boundp-frob)
71 (:args
(object :scs
(descriptor-reg)))
75 (:temporary
(:scs
(descriptor-reg)) value
)
76 (:temporary
(:scs
(non-descriptor-reg)) temp
))
78 (define-vop (boundp boundp-frob
)
81 (loadw value object symbol-value-slot other-pointer-lowtag
)
82 (inst xor value unbound-marker-widetag temp
)
84 (inst beq temp target
)
85 (inst bne temp target
))))
87 (define-vop (fast-symbol-value cell-ref
)
88 (:variant symbol-value-slot other-pointer-lowtag
)
90 (:translate symbol-value
))
92 (define-vop (symbol-hash)
94 (:translate symbol-hash
)
95 (:args
(symbol :scs
(descriptor-reg)))
96 (:results
(res :scs
(any-reg)))
97 (:result-types positive-fixnum
)
99 ;; The symbol-hash slot of NIL holds NIL because it is also the
100 ;; cdr slot, so we have to strip off the two low bits to make sure
101 ;; it is a fixnum. The lowtag selection magic that is required to
102 ;; ensure this is explained in the comment in objdef.lisp
103 (loadw res symbol symbol-hash-slot other-pointer-lowtag
)
104 (inst bic res
#.
(ash lowtag-mask -
1) res
)))
106 ;;; On unithreaded builds these are just copies of the non-global versions.
107 (define-vop (%set-symbol-global-value set
))
108 (define-vop (symbol-global-value symbol-value
)
109 (:translate symbol-global-value
))
110 (define-vop (fast-symbol-global-value fast-symbol-value
)
111 (:translate symbol-global-value
))
113 ;;;; fdefinition (FDEFN) objects
115 (define-vop (fdefn-fun cell-ref
)
116 (:variant fdefn-fun-slot other-pointer-lowtag
))
118 (define-vop (safe-fdefn-fun)
119 (:translate safe-fdefn-fun
)
121 (:args
(object :scs
(descriptor-reg) :target obj-temp
))
122 (:results
(value :scs
(descriptor-reg any-reg
)))
124 (:save-p
:compute-only
)
125 (:temporary
(:scs
(descriptor-reg) :from
(:argument
0)) obj-temp
)
126 (:temporary
(:scs
(non-descriptor-reg)) temp
)
128 (move object obj-temp
)
129 (loadw value obj-temp fdefn-fun-slot other-pointer-lowtag
)
130 (let ((err-lab (generate-error-code vop
'undefined-fun-error obj-temp
)))
131 (inst cmpeq value null-tn temp
)
132 (inst bne temp err-lab
))))
134 (define-vop (set-fdefn-fun)
136 (:translate
(setf fdefn-fun
))
137 (:args
(function :scs
(descriptor-reg) :target result
)
138 (fdefn :scs
(descriptor-reg)))
139 (:temporary
(:scs
(interior-reg)) lip
)
140 (:temporary
(:scs
(non-descriptor-reg)) type
)
141 (:results
(result :scs
(descriptor-reg)))
143 (let ((normal-fn (gen-label)))
144 (load-type type function
(- fun-pointer-lowtag
))
145 (inst xor type simple-fun-header-widetag type
)
147 (- (ash simple-fun-code-offset word-shift
) fun-pointer-lowtag
)
149 (inst beq type normal-fn
)
150 (inst li
(make-fixup "closure_tramp" :foreign
) lip
)
151 (emit-label normal-fn
)
152 (storew lip fdefn fdefn-raw-addr-slot other-pointer-lowtag
)
153 (storew function fdefn fdefn-fun-slot other-pointer-lowtag
)
154 (move function result
))))
157 (define-vop (fdefn-makunbound)
159 (:translate fdefn-makunbound
)
160 (:args
(fdefn :scs
(descriptor-reg) :target result
))
161 (:temporary
(:scs
(non-descriptor-reg)) temp
)
162 (:results
(result :scs
(descriptor-reg)))
164 (storew null-tn fdefn fdefn-fun-slot other-pointer-lowtag
)
165 (inst li
(make-fixup "undefined_tramp" :foreign
) temp
)
167 (storew temp fdefn fdefn-raw-addr-slot other-pointer-lowtag
)))
169 ;;;; binding and Unbinding
171 ;;; Establish VAL as a binding for SYMBOL. Save the old value and the
172 ;;; symbol on the binding stack and stuff the new value into the symbol.
174 ;;; See the "Chapter 9: Specials" of the SBCL Internals Manual.
177 (:args
(val :scs
(any-reg descriptor-reg
))
178 (symbol :scs
(descriptor-reg)))
179 (:temporary
(:scs
(descriptor-reg)) temp
)
181 (loadw temp symbol symbol-value-slot other-pointer-lowtag
)
182 (inst addq bsp-tn
(* 2 n-word-bytes
) bsp-tn
)
183 (storew temp bsp-tn
(- binding-value-slot binding-size
))
184 (storew symbol bsp-tn
(- binding-symbol-slot binding-size
))
185 (#!+gengc storew-and-remember-slot
#!-gengc storew
186 val symbol symbol-value-slot other-pointer-lowtag
)))
190 (:temporary
(:scs
(descriptor-reg)) symbol value
)
192 (loadw symbol bsp-tn
(- binding-symbol-slot binding-size
))
193 (loadw value bsp-tn
(- binding-value-slot binding-size
))
194 (#!+gengc storew-and-remember-slot
#!-gengc storew
195 value symbol symbol-value-slot other-pointer-lowtag
)
196 (storew zero-tn bsp-tn
(- binding-symbol-slot binding-size
))
197 (storew zero-tn bsp-tn
(- binding-value-slot binding-size
))
198 (inst subq bsp-tn
(* 2 n-word-bytes
) bsp-tn
)))
201 (define-vop (unbind-to-here)
202 (:args
(arg :scs
(descriptor-reg any-reg
) :target where
))
203 (:temporary
(:scs
(any-reg) :from
(:argument
0)) where
)
204 (:temporary
(:scs
(descriptor-reg)) symbol value
)
205 (:temporary
(:scs
(non-descriptor-reg)) temp
)
207 (let ((loop (gen-label))
211 (inst cmpeq where bsp-tn temp
)
215 (loadw symbol bsp-tn
(- binding-symbol-slot binding-size
))
216 (loadw value bsp-tn
(- binding-value-slot binding-size
))
217 (inst beq symbol skip
)
218 (#!+gengc storew-and-remember-slot
#!-gengc storew
219 value symbol symbol-value-slot other-pointer-lowtag
)
220 (storew zero-tn bsp-tn
(- binding-symbol-slot binding-size
))
223 (storew zero-tn bsp-tn
(- binding-value-slot binding-size
))
224 (inst subq bsp-tn
(* 2 n-word-bytes
) bsp-tn
)
225 (inst cmpeq where bsp-tn temp
)
230 ;;;; closure indexing
232 (define-full-reffer closure-index-ref
*
233 closure-info-offset fun-pointer-lowtag
234 (descriptor-reg any-reg
) * %closure-index-ref
)
236 (define-full-setter set-funcallable-instance-info
*
237 funcallable-instance-info-offset fun-pointer-lowtag
238 (descriptor-reg any-reg null zero
) * %set-funcallable-instance-info
)
240 (define-full-reffer funcallable-instance-info
*
241 funcallable-instance-info-offset fun-pointer-lowtag
242 (descriptor-reg any-reg
) * %funcallable-instance-info
)
244 (define-vop (closure-ref slot-ref
)
245 (:variant closure-info-offset fun-pointer-lowtag
))
247 (define-vop (closure-init slot-set
)
248 (:variant closure-info-offset fun-pointer-lowtag
))
250 (define-vop (closure-init-from-fp)
251 (:args
(object :scs
(descriptor-reg)))
254 (storew cfp-tn object
(+ closure-info-offset offset
) fun-pointer-lowtag
)))
256 ;;;; value cell hackery
258 (define-vop (value-cell-ref cell-ref
)
259 (:variant value-cell-value-slot other-pointer-lowtag
))
261 (define-vop (value-cell-set cell-set
)
262 (:variant value-cell-value-slot other-pointer-lowtag
))
264 ;;;; instance hackery
266 (define-vop (instance-length)
268 (:translate %instance-length
)
269 (:args
(struct :scs
(descriptor-reg)))
270 (:results
(res :scs
(unsigned-reg)))
271 (:result-types positive-fixnum
)
273 (loadw res struct
0 instance-pointer-lowtag
)
274 (inst srl res n-widetag-bits res
)))
276 (define-full-reffer instance-index-ref
* instance-slots-offset
277 instance-pointer-lowtag
(descriptor-reg any-reg
) * %instance-ref
)
279 (define-full-setter instance-index-set
* instance-slots-offset
280 instance-pointer-lowtag
(descriptor-reg any-reg null zero
) * %instance-set
)
282 ;;;; code object frobbing
284 (define-full-reffer code-header-ref
* 0 other-pointer-lowtag
285 (descriptor-reg any-reg
) * code-header-ref
)
287 (define-full-setter code-header-set
* 0 other-pointer-lowtag
288 (descriptor-reg any-reg null zero
) * code-header-set
)
290 ;;;; mutator accessing
295 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
296 ;; SBCL has never had GENGC. Now that we have Alpha support, it
297 ;; would probably be nice to restore GENGC support so that the Alpha
298 ;; doesn't have to crawl along with stop'n'copy. When we do, the CMU
299 ;; CL code below will need updating to the SBCL way of looking at
300 ;; things, e.g. at least using "SB-KERNEL" or "SB!KERNEL" instead of
301 ;; :KERNEL. -- WHN 2001-05-08
302 (error "This code is stale as of sbcl-0.6.12."))
304 (define-vop (mutator-ub32-ref)
307 (:results
(res :scs
(unsigned-reg)))
308 (:result-types unsigned-num
)
311 (loadw res mutator-tn slot
)))
313 (define-vop (mutator-descriptor-ref mutator-ub32-ref
)
314 (:results
(res :scs
(any-reg descriptor-reg
)))
317 (define-vop (mutator-sap-ref mutator-ub32-ref
)
318 (:results
(res :scs
(sap-reg)))
319 (:result-types system-area-pointer
))
322 (define-vop (mutator-ub32-set)
324 (:args
(arg :scs
(unsigned-reg) :target res
))
325 (:arg-types unsigned-num
)
326 (:results
(res :scs
(unsigned-reg)))
327 (:result-types unsigned-num
)
330 (storew arg mutator-tn slot
)
333 (define-vop (mutator-descriptor-set mutator-ub32-set
)
334 (:args
(arg :scs
(any-reg descriptor-reg null zero
) :target res
))
336 (:results
(res :scs
(any-reg descriptor-reg
)))
339 (define-vop (mutator-sap-set mutator-ub32-set
)
340 (:args
(arg :scs
(sap-reg) :target res
))
341 (:arg-types system-area-pointer
)
342 (:results
(res :scs
(sap-reg)))
343 (:result-types system-area-pointer
))
346 (macrolet ((define-mutator-accessors (slot type writable
)
347 (let ((ref (symbolicate "MUTATOR-" slot
"-REF"))
348 (set (and writable
(symbolicate "MUTATOR-" slot
"-SET")))
349 (offset (symbolicate "MUTATOR-" slot
"-SLOT"))
351 (let ((*package
* (find-package :kernel
)))
352 (symbolicate "MUTATOR-" slot
))))
354 (lisp-type ref-vop set-vop
)
358 'mutator-descriptor-ref
359 'mutator-descriptor-set
))
361 (values '(unsigned-byte 32)
365 (values 'system-area-pointer
369 (export ',fn
:kernel
)
370 (defknown ,fn
() ,lisp-type
(flushable))
371 (define-vop (,ref
,ref-vop
)
375 `((defknown ((setf ,fn
)) (,lisp-type
) ,lisp-type
377 (define-vop (,set
,set-vop
)
378 (:translate
(setf ,fn
))
379 (:variant
,offset
)))))))))
380 (define-mutator-accessors thread
:des t
)
381 (define-mutator-accessors suspends-disabled-count
:ub32 t
)
382 (define-mutator-accessors suspend-pending
:ub32 t
)
383 (define-mutator-accessors control-stack-base
:sap nil
)
384 (define-mutator-accessors control-stack-end
:sap nil
)
385 (define-mutator-accessors current-unwind-protect
:sap nil
)
386 (define-mutator-accessors current-catch-block
:sap nil
)
387 (define-mutator-accessors binding-stack-base
:sap nil
)
388 (define-mutator-accessors binding-stack-end
:sap nil
)
389 (define-mutator-accessors number-stack-base
:sap nil
)
390 (define-mutator-accessors number-stack-end
:sap nil
)
391 (define-mutator-accessors nursery-start
:sap nil
)
392 (define-mutator-accessors nursery-end
:sap nil
)
393 (define-mutator-accessors storebuf-start
:sap nil
)
394 (define-mutator-accessors storebuf-end
:sap nil
)
395 (define-mutator-accessors words-consed
:ub32 nil
))
401 ;;;; raw instance slot accessors
403 (define-vop (raw-instance-ref/word
)
404 (:translate %raw-instance-ref
/word
)
406 (:args
(object :scs
(descriptor-reg))
407 (index :scs
(any-reg)))
408 (:arg-types
* positive-fixnum
)
409 (:results
(value :scs
(unsigned-reg)))
410 (:temporary
(:scs
(non-descriptor-reg)) offset
)
411 (:temporary
(:scs
(interior-reg)) lip
)
412 (:result-types unsigned-num
)
414 (loadw offset object
0 instance-pointer-lowtag
)
415 (inst srl offset n-widetag-bits offset
)
416 (inst sll offset
2 offset
)
417 (inst subq offset index offset
)
418 (inst subq offset n-word-bytes offset
)
419 (inst addq object offset lip
)
422 (- (* instance-slots-offset n-word-bytes
)
423 instance-pointer-lowtag
)
425 (inst mskll value
4 value
)))
427 (define-vop (raw-instance-set/word
)
428 (:translate %raw-instance-set
/word
)
430 (:args
(object :scs
(descriptor-reg))
431 (index :scs
(any-reg))
432 (value :scs
(unsigned-reg)))
433 (:arg-types
* positive-fixnum unsigned-num
)
434 (:results
(result :scs
(unsigned-reg)))
435 (:temporary
(:scs
(non-descriptor-reg)) offset
)
436 (:temporary
(:scs
(interior-reg)) lip
)
437 (:result-types unsigned-num
)
439 (loadw offset object
0 instance-pointer-lowtag
)
440 (inst srl offset n-widetag-bits offset
)
441 (inst sll offset
2 offset
)
442 (inst subq offset index offset
)
443 (inst subq offset n-word-bytes offset
)
444 (inst addq object offset lip
)
447 (- (* instance-slots-offset n-word-bytes
)
448 instance-pointer-lowtag
)
450 (move value result
)))
452 (define-vop (raw-instance-ref/single
)
453 (:translate %raw-instance-ref
/single
)
455 (:args
(object :scs
(descriptor-reg))
456 (index :scs
(any-reg)))
457 (:arg-types
* positive-fixnum
)
458 (:results
(value :scs
(single-reg)))
459 (:temporary
(:scs
(non-descriptor-reg)) offset
)
460 (:temporary
(:scs
(interior-reg)) lip
)
461 (:result-types single-float
)
463 (loadw offset object
0 instance-pointer-lowtag
)
464 (inst srl offset n-widetag-bits offset
)
465 (inst sll offset
2 offset
)
466 (inst subq offset index offset
)
467 (inst subq offset n-word-bytes offset
)
468 (inst addq object offset lip
)
471 (- (* instance-slots-offset n-word-bytes
)
472 instance-pointer-lowtag
)
475 (define-vop (raw-instance-set/single
)
476 (:translate %raw-instance-set
/single
)
478 (:args
(object :scs
(descriptor-reg))
479 (index :scs
(any-reg))
480 (value :scs
(single-reg)))
481 (:arg-types
* positive-fixnum single-float
)
482 (:results
(result :scs
(single-reg)))
483 (:temporary
(:scs
(non-descriptor-reg)) offset
)
484 (:temporary
(:scs
(interior-reg)) lip
)
485 (:result-types single-float
)
487 (loadw offset object
0 instance-pointer-lowtag
)
488 (inst srl offset n-widetag-bits offset
)
489 (inst sll offset
2 offset
)
490 (inst subq offset index offset
)
491 (inst subq offset n-word-bytes offset
)
492 (inst addq object offset lip
)
495 (- (* instance-slots-offset n-word-bytes
)
496 instance-pointer-lowtag
)
498 (unless (location= result value
)
499 (inst fmove value result
))))
501 (define-vop (raw-instance-ref/double
)
502 (:translate %raw-instance-ref
/double
)
504 (:args
(object :scs
(descriptor-reg))
505 (index :scs
(any-reg)))
506 (:arg-types
* positive-fixnum
)
507 (:results
(value :scs
(double-reg)))
508 (:temporary
(:scs
(non-descriptor-reg)) offset
)
509 (:temporary
(:scs
(interior-reg)) lip
)
510 (:result-types double-float
)
512 (loadw offset object
0 instance-pointer-lowtag
)
513 (inst srl offset n-widetag-bits offset
)
514 (inst sll offset
2 offset
)
515 (inst subq offset index offset
)
516 (inst subq offset
(* 2 n-word-bytes
) offset
)
517 (inst addq object offset lip
)
520 (- (* instance-slots-offset n-word-bytes
)
521 instance-pointer-lowtag
)
524 (define-vop (raw-instance-set/double
)
525 (:translate %raw-instance-set
/double
)
527 (:args
(object :scs
(descriptor-reg))
528 (index :scs
(any-reg))
529 (value :scs
(double-reg)))
530 (:arg-types
* positive-fixnum double-float
)
531 (:results
(result :scs
(double-reg)))
532 (:temporary
(:scs
(non-descriptor-reg)) offset
)
533 (:temporary
(:scs
(interior-reg)) lip
)
534 (:result-types double-float
)
536 (loadw offset object
0 instance-pointer-lowtag
)
537 (inst srl offset n-widetag-bits offset
)
538 (inst sll offset
2 offset
)
539 (inst subq offset index offset
)
540 (inst subq offset
(* 2 n-word-bytes
) offset
)
541 (inst addq object offset lip
)
544 (- (* instance-slots-offset n-word-bytes
)
545 instance-pointer-lowtag
)
547 (unless (location= result value
)
548 (inst fmove value result
))))
550 (define-vop (raw-instance-ref/complex-single
)
551 (:translate %raw-instance-ref
/complex-single
)
553 (:args
(object :scs
(descriptor-reg))
554 (index :scs
(any-reg)))
555 (:arg-types
* positive-fixnum
)
556 (:results
(value :scs
(complex-single-reg)))
557 (:temporary
(:scs
(non-descriptor-reg)) offset
)
558 (:temporary
(:scs
(interior-reg)) lip
)
559 (:result-types complex-single-float
)
561 (loadw offset object
0 instance-pointer-lowtag
)
562 (inst srl offset n-widetag-bits offset
)
563 (inst sll offset
2 offset
)
564 (inst subq offset index offset
)
565 (inst subq offset
(* 2 n-word-bytes
) offset
)
566 (inst addq object offset lip
)
568 (complex-double-reg-real-tn value
)
569 (- (* instance-slots-offset n-word-bytes
)
570 instance-pointer-lowtag
)
573 (complex-double-reg-imag-tn value
)
574 (- (* (1+ instance-slots-offset
) n-word-bytes
)
575 instance-pointer-lowtag
)
578 (define-vop (raw-instance-set/complex-single
)
579 (:translate %raw-instance-set
/complex-single
)
581 (:args
(object :scs
(descriptor-reg))
582 (index :scs
(any-reg))
583 (value :scs
(complex-single-reg)))
584 (:arg-types
* positive-fixnum complex-single-float
)
585 (:results
(result :scs
(complex-single-reg)))
586 (:temporary
(:scs
(non-descriptor-reg)) offset
)
587 (:temporary
(:scs
(interior-reg)) lip
)
588 (:result-types complex-single-float
)
590 (loadw offset object
0 instance-pointer-lowtag
)
591 (inst srl offset n-widetag-bits offset
)
592 (inst sll offset
2 offset
)
593 (inst subq offset index offset
)
594 (inst subq offset
(* 2 n-word-bytes
) offset
)
595 (inst addq object offset lip
)
596 (let ((value-real (complex-single-reg-real-tn value
))
597 (result-real (complex-single-reg-real-tn result
)))
600 (- (* instance-slots-offset n-word-bytes
)
601 instance-pointer-lowtag
)
603 (unless (location= result-real value-real
)
604 (inst fmove value-real result-real
)))
605 (let ((value-imag (complex-single-reg-imag-tn value
))
606 (result-imag (complex-single-reg-imag-tn result
)))
609 (- (* (1+ instance-slots-offset
) n-word-bytes
)
610 instance-pointer-lowtag
)
612 (unless (location= result-imag value-imag
)
613 (inst fmove value-imag result-imag
)))))
615 (define-vop (raw-instance-ref/complex-double
)
616 (:translate %raw-instance-ref
/complex-double
)
618 (:args
(object :scs
(descriptor-reg))
619 (index :scs
(any-reg)))
620 (:arg-types
* positive-fixnum
)
621 (:results
(value :scs
(complex-double-reg)))
622 (:temporary
(:scs
(non-descriptor-reg)) offset
)
623 (:temporary
(:scs
(interior-reg)) lip
)
624 (:result-types complex-double-float
)
626 (loadw offset object
0 instance-pointer-lowtag
)
627 (inst srl offset n-widetag-bits offset
)
628 (inst sll offset
2 offset
)
629 (inst subq offset index offset
)
630 (inst subq offset
(* 4 n-word-bytes
) offset
)
631 (inst addq object offset lip
)
633 (complex-double-reg-real-tn value
)
634 (- (* instance-slots-offset n-word-bytes
)
635 instance-pointer-lowtag
)
638 (complex-double-reg-imag-tn value
)
639 (- (* (+ instance-slots-offset
2) n-word-bytes
)
640 instance-pointer-lowtag
)
643 (define-vop (raw-instance-set/complex-double
)
644 (:translate %raw-instance-set
/complex-double
)
646 (:args
(object :scs
(descriptor-reg))
647 (index :scs
(any-reg))
648 (value :scs
(complex-double-reg)))
649 (:arg-types
* positive-fixnum complex-double-float
)
650 (:results
(result :scs
(complex-double-reg)))
651 (:temporary
(:scs
(non-descriptor-reg)) offset
)
652 (:temporary
(:scs
(interior-reg)) lip
)
653 (:result-types complex-double-float
)
655 (loadw offset object
0 instance-pointer-lowtag
)
656 (inst srl offset n-widetag-bits offset
)
657 (inst sll offset
2 offset
)
658 (inst subq offset index offset
)
659 (inst subq offset
(* 4 n-word-bytes
) offset
)
660 (inst addq object offset lip
)
661 (let ((value-real (complex-double-reg-real-tn value
))
662 (result-real (complex-double-reg-real-tn result
)))
665 (- (* instance-slots-offset n-word-bytes
)
666 instance-pointer-lowtag
)
668 (unless (location= result-real value-real
)
669 (inst fmove value-real result-real
)))
670 (let ((value-imag (complex-double-reg-imag-tn value
))
671 (result-imag (complex-double-reg-imag-tn result
)))
674 (- (* (+ instance-slots-offset
2) n-word-bytes
)
675 instance-pointer-lowtag
)
677 (unless (location= result-imag value-imag
)
678 (inst fmove value-imag result-imag
)))))