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 ;;;; symbol hacking VOPs
41 ;;; The compiler likes to be able to directly SET symbols.
42 (define-vop (set cell-set
)
43 (:variant symbol-value-slot other-pointer-lowtag
))
45 ;;; Do a cell ref with an error check for being unbound.
46 (define-vop (checked-cell-ref)
47 (:args
(object :scs
(descriptor-reg) :target obj-temp
))
48 (:results
(value :scs
(descriptor-reg any-reg
)))
51 (:save-p
:compute-only
)
52 (:temporary
(:scs
(non-descriptor-reg)) temp
)
53 (:temporary
(:scs
(descriptor-reg) :from
(:argument
0)) obj-temp
))
55 ;;; With SYMBOL-VALUE, we check that the value isn't the trap object.
56 ;;; So SYMBOL-VALUE of NIL is NIL.
57 (define-vop (symbol-value checked-cell-ref
)
58 (:translate symbol-value
)
60 (move object obj-temp
)
61 (loadw value obj-temp symbol-value-slot other-pointer-lowtag
)
62 (let ((err-lab (generate-error-code vop unbound-symbol-error obj-temp
)))
63 (inst xor value unbound-marker-widetag temp
)
64 (inst beq temp err-lab
))))
66 ;;; like CHECKED-CELL-REF, only we are a predicate to see if the cell
68 (define-vop (boundp-frob)
69 (:args
(object :scs
(descriptor-reg)))
73 (:temporary
(:scs
(descriptor-reg)) value
)
74 (:temporary
(:scs
(non-descriptor-reg)) temp
))
76 (define-vop (boundp boundp-frob
)
79 (loadw value object symbol-value-slot other-pointer-lowtag
)
80 (inst xor value unbound-marker-widetag temp
)
82 (inst beq temp target
)
83 (inst bne temp target
))))
85 (define-vop (fast-symbol-value cell-ref
)
86 (:variant symbol-value-slot other-pointer-lowtag
)
88 (:translate symbol-value
))
90 (define-vop (symbol-hash)
92 (:translate symbol-hash
)
93 (:args
(symbol :scs
(descriptor-reg)))
94 (:results
(res :scs
(any-reg)))
95 (:result-types positive-fixnum
)
97 ;; The symbol-hash slot of NIL holds NIL because it is also the
98 ;; cdr slot, so we have to strip off the two low bits to make sure
99 ;; it is a fixnum. The lowtag selection magic that is required to
100 ;; ensure this is explained in the comment in objdef.lisp
101 (loadw res symbol symbol-hash-slot other-pointer-lowtag
)
102 (inst bic res
#.
(ash lowtag-mask -
1) res
)))
104 ;;;; fdefinition (FDEFN) objects
106 (define-vop (fdefn-fun cell-ref
)
107 (:variant fdefn-fun-slot other-pointer-lowtag
))
109 (define-vop (safe-fdefn-fun)
110 (:args
(object :scs
(descriptor-reg) :target obj-temp
))
111 (:results
(value :scs
(descriptor-reg any-reg
)))
113 (:save-p
:compute-only
)
114 (:temporary
(:scs
(descriptor-reg) :from
(:argument
0)) obj-temp
)
115 (:temporary
(:scs
(non-descriptor-reg)) temp
)
117 (move object obj-temp
)
118 (loadw value obj-temp fdefn-fun-slot other-pointer-lowtag
)
119 (let ((err-lab (generate-error-code vop undefined-fun-error obj-temp
)))
120 (inst cmpeq value null-tn temp
)
121 (inst bne temp err-lab
))))
123 (define-vop (set-fdefn-fun)
125 (:translate
(setf fdefn-fun
))
126 (:args
(function :scs
(descriptor-reg) :target result
)
127 (fdefn :scs
(descriptor-reg)))
128 (:temporary
(:scs
(interior-reg)) lip
)
129 (:temporary
(:scs
(non-descriptor-reg)) type
)
130 (:results
(result :scs
(descriptor-reg)))
132 (let ((normal-fn (gen-label)))
133 (load-type type function
(- fun-pointer-lowtag
))
134 (inst xor type simple-fun-header-widetag type
)
136 (- (ash simple-fun-code-offset word-shift
) fun-pointer-lowtag
)
138 (inst beq type normal-fn
)
139 (inst li
(make-fixup "closure_tramp" :foreign
) lip
)
140 (emit-label normal-fn
)
141 (storew lip fdefn fdefn-raw-addr-slot other-pointer-lowtag
)
142 (storew function fdefn fdefn-fun-slot other-pointer-lowtag
)
143 (move function result
))))
146 (define-vop (fdefn-makunbound)
148 (:translate fdefn-makunbound
)
149 (:args
(fdefn :scs
(descriptor-reg) :target result
))
150 (:temporary
(:scs
(non-descriptor-reg)) temp
)
151 (:results
(result :scs
(descriptor-reg)))
153 (storew null-tn fdefn fdefn-fun-slot other-pointer-lowtag
)
154 (inst li
(make-fixup "undefined_tramp" :foreign
) temp
)
156 (storew temp fdefn fdefn-raw-addr-slot other-pointer-lowtag
)))
158 ;;;; binding and Unbinding
160 ;;; Establish VAL as a binding for SYMBOL. Save the old value and the
161 ;;; symbol on the binding stack and stuff the new value into the symbol.
163 (:args
(val :scs
(any-reg descriptor-reg
))
164 (symbol :scs
(descriptor-reg)))
165 (:temporary
(:scs
(descriptor-reg)) temp
)
167 (loadw temp symbol symbol-value-slot other-pointer-lowtag
)
168 (inst addq bsp-tn
(* 2 n-word-bytes
) bsp-tn
)
169 (storew temp bsp-tn
(- binding-value-slot binding-size
))
170 (storew symbol bsp-tn
(- binding-symbol-slot binding-size
))
171 (#!+gengc storew-and-remember-slot
#!-gengc storew
172 val symbol symbol-value-slot other-pointer-lowtag
)))
176 (:temporary
(:scs
(descriptor-reg)) symbol value
)
178 (loadw symbol bsp-tn
(- binding-symbol-slot binding-size
))
179 (loadw value bsp-tn
(- binding-value-slot binding-size
))
180 (#!+gengc storew-and-remember-slot
#!-gengc storew
181 value symbol symbol-value-slot other-pointer-lowtag
)
182 (storew zero-tn bsp-tn
(- binding-symbol-slot binding-size
))
183 (inst subq bsp-tn
(* 2 n-word-bytes
) bsp-tn
)))
186 (define-vop (unbind-to-here)
187 (:args
(arg :scs
(descriptor-reg any-reg
) :target where
))
188 (:temporary
(:scs
(any-reg) :from
(:argument
0)) where
)
189 (:temporary
(:scs
(descriptor-reg)) symbol value
)
190 (:temporary
(:scs
(non-descriptor-reg)) temp
)
192 (let ((loop (gen-label))
196 (inst cmpeq where bsp-tn temp
)
200 (loadw symbol bsp-tn
(- binding-symbol-slot binding-size
))
201 (loadw value bsp-tn
(- binding-value-slot binding-size
))
202 (inst beq symbol skip
)
203 (#!+gengc storew-and-remember-slot
#!-gengc storew
204 value symbol symbol-value-slot other-pointer-lowtag
)
205 (storew zero-tn bsp-tn
(- binding-symbol-slot binding-size
))
208 (inst subq bsp-tn
(* 2 n-word-bytes
) bsp-tn
)
209 (inst cmpeq where bsp-tn temp
)
214 ;;;; closure indexing
216 (define-full-reffer closure-index-ref
*
217 closure-info-offset fun-pointer-lowtag
218 (descriptor-reg any-reg
) * %closure-index-ref
)
220 (define-full-setter set-funcallable-instance-info
*
221 funcallable-instance-info-offset fun-pointer-lowtag
222 (descriptor-reg any-reg null zero
) * %set-funcallable-instance-info
)
224 (define-full-reffer funcallable-instance-info
*
225 funcallable-instance-info-offset fun-pointer-lowtag
226 (descriptor-reg any-reg
) * %funcallable-instance-info
)
228 (define-vop (funcallable-instance-lexenv cell-ref
)
229 (:variant funcallable-instance-lexenv-slot fun-pointer-lowtag
))
231 (define-vop (closure-ref slot-ref
)
232 (:variant closure-info-offset fun-pointer-lowtag
))
234 (define-vop (closure-init slot-set
)
235 (:variant closure-info-offset fun-pointer-lowtag
))
237 ;;;; value cell hackery
239 (define-vop (value-cell-ref cell-ref
)
240 (:variant value-cell-value-slot other-pointer-lowtag
))
242 (define-vop (value-cell-set cell-set
)
243 (:variant value-cell-value-slot other-pointer-lowtag
))
245 ;;;; instance hackery
247 (define-vop (instance-length)
249 (:translate %instance-length
)
250 (:args
(struct :scs
(descriptor-reg)))
251 (:results
(res :scs
(unsigned-reg)))
252 (:result-types positive-fixnum
)
254 (loadw res struct
0 instance-pointer-lowtag
)
255 (inst srl res n-widetag-bits res
)))
257 (define-vop (instance-ref slot-ref
)
258 (:variant instance-slots-offset instance-pointer-lowtag
)
260 (:translate %instance-ref
)
261 (:arg-types instance
(:constant index
)))
263 (define-vop (instance-set slot-set
)
265 (:translate %instance-set
)
266 (:variant instance-slots-offset instance-pointer-lowtag
)
267 (:arg-types instance
(:constant index
) *))
269 (define-full-reffer instance-index-ref
* instance-slots-offset
270 instance-pointer-lowtag
(descriptor-reg any-reg
) * %instance-ref
)
272 (define-full-setter instance-index-set
* instance-slots-offset
273 instance-pointer-lowtag
(descriptor-reg any-reg null zero
) * %instance-set
)
275 ;;;; code object frobbing
277 (define-full-reffer code-header-ref
* 0 other-pointer-lowtag
278 (descriptor-reg any-reg
) * code-header-ref
)
280 (define-full-setter code-header-set
* 0 other-pointer-lowtag
281 (descriptor-reg any-reg null zero
) * code-header-set
)
283 ;;;; mutator accessing
288 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
289 ;; SBCL has never had GENGC. Now that we have Alpha support, it
290 ;; would probably be nice to restore GENGC support so that the Alpha
291 ;; doesn't have to crawl along with stop'n'copy. When we do, the CMU
292 ;; CL code below will need updating to the SBCL way of looking at
293 ;; things, e.g. at least using "SB-KERNEL" or "SB!KERNEL" instead of
294 ;; :KERNEL. -- WHN 2001-05-08
295 (error "This code is stale as of sbcl-0.6.12."))
297 (define-vop (mutator-ub32-ref)
300 (:results
(res :scs
(unsigned-reg)))
301 (:result-types unsigned-num
)
304 (loadw res mutator-tn slot
)))
306 (define-vop (mutator-descriptor-ref mutator-ub32-ref
)
307 (:results
(res :scs
(any-reg descriptor-reg
)))
310 (define-vop (mutator-sap-ref mutator-ub32-ref
)
311 (:results
(res :scs
(sap-reg)))
312 (:result-types system-area-pointer
))
315 (define-vop (mutator-ub32-set)
317 (:args
(arg :scs
(unsigned-reg) :target res
))
318 (:arg-types unsigned-num
)
319 (:results
(res :scs
(unsigned-reg)))
320 (:result-types unsigned-num
)
323 (storew arg mutator-tn slot
)
326 (define-vop (mutator-descriptor-set mutator-ub32-set
)
327 (:args
(arg :scs
(any-reg descriptor-reg null zero
) :target res
))
329 (:results
(res :scs
(any-reg descriptor-reg
)))
332 (define-vop (mutator-sap-set mutator-ub32-set
)
333 (:args
(arg :scs
(sap-reg) :target res
))
334 (:arg-types system-area-pointer
)
335 (:results
(res :scs
(sap-reg)))
336 (:result-types system-area-pointer
))
339 (macrolet ((define-mutator-accessors (slot type writable
)
340 (let ((ref (symbolicate "MUTATOR-" slot
"-REF"))
341 (set (and writable
(symbolicate "MUTATOR-" slot
"-SET")))
342 (offset (symbolicate "MUTATOR-" slot
"-SLOT"))
344 (let ((*package
* (find-package :kernel
)))
345 (symbolicate "MUTATOR-" slot
))))
347 (lisp-type ref-vop set-vop
)
351 'mutator-descriptor-ref
352 'mutator-descriptor-set
))
354 (values '(unsigned-byte 32)
358 (values 'system-area-pointer
362 (export ',fn
:kernel
)
363 (defknown ,fn
() ,lisp-type
(flushable))
364 (define-vop (,ref
,ref-vop
)
368 `((defknown ((setf ,fn
)) (,lisp-type
) ,lisp-type
370 (define-vop (,set
,set-vop
)
371 (:translate
(setf ,fn
))
372 (:variant
,offset
)))))))))
373 (define-mutator-accessors thread
:des t
)
374 (define-mutator-accessors suspends-disabled-count
:ub32 t
)
375 (define-mutator-accessors suspend-pending
:ub32 t
)
376 (define-mutator-accessors control-stack-base
:sap nil
)
377 (define-mutator-accessors control-stack-end
:sap nil
)
378 (define-mutator-accessors current-unwind-protect
:sap nil
)
379 (define-mutator-accessors current-catch-block
:sap nil
)
380 (define-mutator-accessors binding-stack-base
:sap nil
)
381 (define-mutator-accessors binding-stack-end
:sap nil
)
382 (define-mutator-accessors number-stack-base
:sap nil
)
383 (define-mutator-accessors number-stack-end
:sap nil
)
384 (define-mutator-accessors nursery-start
:sap nil
)
385 (define-mutator-accessors nursery-end
:sap nil
)
386 (define-mutator-accessors storebuf-start
:sap nil
)
387 (define-mutator-accessors storebuf-end
:sap nil
)
388 (define-mutator-accessors words-consed
:ub32 nil
))
394 ;;;; raw instance slot accessors
396 (define-vop (raw-instance-ref/word
)
397 (:translate %raw-instance-ref
/word
)
399 (:args
(object :scs
(descriptor-reg))
400 (index :scs
(any-reg)))
401 (:arg-types
* positive-fixnum
)
402 (:results
(value :scs
(unsigned-reg)))
403 (:temporary
(:scs
(non-descriptor-reg)) offset
)
404 (:temporary
(:scs
(interior-reg)) lip
)
405 (:result-types unsigned-num
)
407 (loadw offset object
0 instance-pointer-lowtag
)
408 (inst srl offset n-widetag-bits offset
)
409 (inst sll offset
2 offset
)
410 (inst subq offset index offset
)
411 (inst subq offset n-word-bytes offset
)
412 (inst addq object offset lip
)
415 (- (* instance-slots-offset n-word-bytes
)
416 instance-pointer-lowtag
)
418 (inst mskll value
4 value
)))
420 (define-vop (raw-instance-set/word
)
421 (:translate %raw-instance-set
/word
)
423 (:args
(object :scs
(descriptor-reg))
424 (index :scs
(any-reg))
425 (value :scs
(unsigned-reg)))
426 (:arg-types
* positive-fixnum unsigned-num
)
427 (:results
(result :scs
(unsigned-reg)))
428 (:temporary
(:scs
(non-descriptor-reg)) offset
)
429 (:temporary
(:scs
(interior-reg)) lip
)
430 (:result-types unsigned-num
)
432 (loadw offset object
0 instance-pointer-lowtag
)
433 (inst srl offset n-widetag-bits offset
)
434 (inst sll offset
2 offset
)
435 (inst subq offset index offset
)
436 (inst subq offset n-word-bytes offset
)
437 (inst addq object offset lip
)
440 (- (* instance-slots-offset n-word-bytes
)
441 instance-pointer-lowtag
)
443 (move value result
)))
445 (define-vop (raw-instance-ref/single
)
446 (:translate %raw-instance-ref
/single
)
448 (:args
(object :scs
(descriptor-reg))
449 (index :scs
(any-reg)))
450 (:arg-types
* positive-fixnum
)
451 (:results
(value :scs
(single-reg)))
452 (:temporary
(:scs
(non-descriptor-reg)) offset
)
453 (:temporary
(:scs
(interior-reg)) lip
)
454 (:result-types single-float
)
456 (loadw offset object
0 instance-pointer-lowtag
)
457 (inst srl offset n-widetag-bits offset
)
458 (inst sll offset
2 offset
)
459 (inst subq offset index offset
)
460 (inst subq offset n-word-bytes offset
)
461 (inst addq object offset lip
)
464 (- (* instance-slots-offset n-word-bytes
)
465 instance-pointer-lowtag
)
468 (define-vop (raw-instance-set/single
)
469 (:translate %raw-instance-set
/single
)
471 (:args
(object :scs
(descriptor-reg))
472 (index :scs
(any-reg))
473 (value :scs
(single-reg)))
474 (:arg-types
* positive-fixnum single-float
)
475 (:results
(result :scs
(single-reg)))
476 (:temporary
(:scs
(non-descriptor-reg)) offset
)
477 (:temporary
(:scs
(interior-reg)) lip
)
478 (:result-types single-float
)
480 (loadw offset object
0 instance-pointer-lowtag
)
481 (inst srl offset n-widetag-bits offset
)
482 (inst sll offset
2 offset
)
483 (inst subq offset index offset
)
484 (inst subq offset n-word-bytes offset
)
485 (inst addq object offset lip
)
488 (- (* instance-slots-offset n-word-bytes
)
489 instance-pointer-lowtag
)
491 (unless (location= result value
)
492 (inst fmove value result
))))
494 (define-vop (raw-instance-ref/double
)
495 (:translate %raw-instance-ref
/double
)
497 (:args
(object :scs
(descriptor-reg))
498 (index :scs
(any-reg)))
499 (:arg-types
* positive-fixnum
)
500 (:results
(value :scs
(double-reg)))
501 (:temporary
(:scs
(non-descriptor-reg)) offset
)
502 (:temporary
(:scs
(interior-reg)) lip
)
503 (:result-types double-float
)
505 (loadw offset object
0 instance-pointer-lowtag
)
506 (inst srl offset n-widetag-bits offset
)
507 (inst sll offset
2 offset
)
508 (inst subq offset index offset
)
509 (inst subq offset
(* 2 n-word-bytes
) offset
)
510 (inst addq object offset lip
)
513 (- (* instance-slots-offset n-word-bytes
)
514 instance-pointer-lowtag
)
517 (define-vop (raw-instance-set/double
)
518 (:translate %raw-instance-set
/double
)
520 (:args
(object :scs
(descriptor-reg))
521 (index :scs
(any-reg))
522 (value :scs
(double-reg)))
523 (:arg-types
* positive-fixnum double-float
)
524 (:results
(result :scs
(double-reg)))
525 (:temporary
(:scs
(non-descriptor-reg)) offset
)
526 (:temporary
(:scs
(interior-reg)) lip
)
527 (:result-types double-float
)
529 (loadw offset object
0 instance-pointer-lowtag
)
530 (inst srl offset n-widetag-bits offset
)
531 (inst sll offset
2 offset
)
532 (inst subq offset index offset
)
533 (inst subq offset
(* 2 n-word-bytes
) offset
)
534 (inst addq object offset lip
)
537 (- (* instance-slots-offset n-word-bytes
)
538 instance-pointer-lowtag
)
540 (unless (location= result value
)
541 (inst fmove value result
))))
543 (define-vop (raw-instance-ref/complex-single
)
544 (:translate %raw-instance-ref
/complex-single
)
546 (:args
(object :scs
(descriptor-reg))
547 (index :scs
(any-reg)))
548 (:arg-types
* positive-fixnum
)
549 (:results
(value :scs
(complex-single-reg)))
550 (:temporary
(:scs
(non-descriptor-reg)) offset
)
551 (:temporary
(:scs
(interior-reg)) lip
)
552 (:result-types complex-single-float
)
554 (loadw offset object
0 instance-pointer-lowtag
)
555 (inst srl offset n-widetag-bits offset
)
556 (inst sll offset
2 offset
)
557 (inst subq offset index offset
)
558 (inst subq offset
(* 2 n-word-bytes
) offset
)
559 (inst addq object offset lip
)
561 (complex-double-reg-real-tn value
)
562 (- (* instance-slots-offset n-word-bytes
)
563 instance-pointer-lowtag
)
566 (complex-double-reg-imag-tn value
)
567 (- (* (1+ instance-slots-offset
) n-word-bytes
)
568 instance-pointer-lowtag
)
571 (define-vop (raw-instance-set/complex-single
)
572 (:translate %raw-instance-set
/complex-single
)
574 (:args
(object :scs
(descriptor-reg))
575 (index :scs
(any-reg))
576 (value :scs
(complex-single-reg)))
577 (:arg-types
* positive-fixnum complex-single-float
)
578 (:results
(result :scs
(complex-single-reg)))
579 (:temporary
(:scs
(non-descriptor-reg)) offset
)
580 (:temporary
(:scs
(interior-reg)) lip
)
581 (:result-types complex-single-float
)
583 (loadw offset object
0 instance-pointer-lowtag
)
584 (inst srl offset n-widetag-bits offset
)
585 (inst sll offset
2 offset
)
586 (inst subq offset index offset
)
587 (inst subq offset
(* 2 n-word-bytes
) offset
)
588 (inst addq object offset lip
)
589 (let ((value-real (complex-single-reg-real-tn value
))
590 (result-real (complex-single-reg-real-tn result
)))
593 (- (* instance-slots-offset n-word-bytes
)
594 instance-pointer-lowtag
)
596 (unless (location= result-real value-real
)
597 (inst fmove value-real result-real
)))
598 (let ((value-imag (complex-single-reg-imag-tn value
))
599 (result-imag (complex-single-reg-imag-tn result
)))
602 (- (* (1+ instance-slots-offset
) n-word-bytes
)
603 instance-pointer-lowtag
)
605 (unless (location= result-imag value-imag
)
606 (inst fmove value-imag result-imag
)))))
608 (define-vop (raw-instance-ref/complex-double
)
609 (:translate %raw-instance-ref
/complex-double
)
611 (:args
(object :scs
(descriptor-reg))
612 (index :scs
(any-reg)))
613 (:arg-types
* positive-fixnum
)
614 (:results
(value :scs
(complex-double-reg)))
615 (:temporary
(:scs
(non-descriptor-reg)) offset
)
616 (:temporary
(:scs
(interior-reg)) lip
)
617 (:result-types complex-double-float
)
619 (loadw offset object
0 instance-pointer-lowtag
)
620 (inst srl offset n-widetag-bits offset
)
621 (inst sll offset
2 offset
)
622 (inst subq offset index offset
)
623 (inst subq offset
(* 4 n-word-bytes
) offset
)
624 (inst addq object offset lip
)
626 (complex-double-reg-real-tn value
)
627 (- (* instance-slots-offset n-word-bytes
)
628 instance-pointer-lowtag
)
631 (complex-double-reg-imag-tn value
)
632 (- (* (+ instance-slots-offset
2) n-word-bytes
)
633 instance-pointer-lowtag
)
636 (define-vop (raw-instance-set/complex-double
)
637 (:translate %raw-instance-set
/complex-double
)
639 (:args
(object :scs
(descriptor-reg))
640 (index :scs
(any-reg))
641 (value :scs
(complex-double-reg)))
642 (:arg-types
* positive-fixnum complex-double-float
)
643 (:results
(result :scs
(complex-double-reg)))
644 (:temporary
(:scs
(non-descriptor-reg)) offset
)
645 (:temporary
(:scs
(interior-reg)) lip
)
646 (:result-types complex-double-float
)
648 (loadw offset object
0 instance-pointer-lowtag
)
649 (inst srl offset n-widetag-bits offset
)
650 (inst sll offset
2 offset
)
651 (inst subq offset index offset
)
652 (inst subq offset
(* 4 n-word-bytes
) offset
)
653 (inst addq object offset lip
)
654 (let ((value-real (complex-double-reg-real-tn value
))
655 (result-real (complex-double-reg-real-tn result
)))
658 (- (* instance-slots-offset n-word-bytes
)
659 instance-pointer-lowtag
)
661 (unless (location= result-real value-real
)
662 (inst fmove value-real result-real
)))
663 (let ((value-imag (complex-double-reg-imag-tn value
))
664 (result-imag (complex-double-reg-imag-tn result
)))
667 (- (* (+ instance-slots-offset
2) n-word-bytes
)
668 instance-pointer-lowtag
)
670 (unless (location= result-imag value-imag
)
671 (inst fmove value-imag result-imag
)))))