1 ;;;; various primitive memory access VOPs for the x86 VM
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 ;;;; data object ref/set stuff
17 (:args (object :scs (descriptor-reg)))
18 (:info name offset lowtag)
20 (:results (result :scs (descriptor-reg any-reg)))
22 (loadw result object offset lowtag)))
24 (define-vop (set-slot)
25 (:args (object :scs (descriptor-reg))
26 (value :scs (descriptor-reg any-reg immediate)))
27 (:temporary (:sc descriptor-reg) temp)
28 (:info name offset lowtag)
32 (if (sc-is value immediate)
33 (let ((val (tn-value value)))
34 (move-immediate (make-ea :qword
36 :disp (- (* offset n-word-bytes)
42 (+ nil-value (static-symbol-offset val)))
44 (logior (ash (char-code val) n-widetag-bits)
47 ;; Else, value not immediate.
48 (storew value object offset lowtag))))
50 (define-vop (compare-and-swap-slot)
51 (:args (object :scs (descriptor-reg) :to :eval)
52 (old :scs (descriptor-reg any-reg) :target rax)
53 (new :scs (descriptor-reg any-reg)))
54 (:temporary (:sc descriptor-reg :offset rax-offset
55 :from (:argument 1) :to :result :target result)
57 (:info name offset lowtag)
59 (:results (result :scs (descriptor-reg any-reg)))
64 (inst cmpxchg (make-ea :qword :base object
65 :disp (- (* offset n-word-bytes) lowtag))
69 ;;;; symbol hacking VOPs
71 (define-vop (%compare-and-swap-symbol-value)
72 (:translate %compare-and-swap-symbol-value)
73 (:args (symbol :scs (descriptor-reg) :to (:result 1))
74 (old :scs (descriptor-reg any-reg) :target rax)
75 (new :scs (descriptor-reg any-reg)))
76 (:temporary (:sc descriptor-reg :offset rax-offset) rax)
78 (:temporary (:sc descriptor-reg) tls)
79 (:results (result :scs (descriptor-reg any-reg)))
83 ;; This code has two pathological cases: NO-TLS-VALUE-MARKER
84 ;; or UNBOUND-MARKER as NEW: in either case we would end up
85 ;; doing possible damage with CMPXCHG -- so don't do that!
86 (let ((unbound (generate-error-code vop 'unbound-symbol-error symbol))
91 (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag)
92 ;; Thread-local area, no LOCK needed.
93 (inst cmpxchg (make-ea :qword :base thread-base-tn
96 (inst cmp rax no-tls-value-marker-widetag)
100 (inst cmpxchg (make-ea :qword :base symbol
101 :disp (- (* symbol-value-slot n-word-bytes)
102 other-pointer-lowtag)
107 (inst cmp result unbound-marker-widetag)
108 (inst jmp :e unbound))))
110 ;;; these next two cf the sparc version, by jrd.
111 ;;; FIXME: Deref this ^ reference.
114 ;;; The compiler likes to be able to directly SET symbols.
117 (:args (symbol :scs (descriptor-reg))
118 (value :scs (descriptor-reg any-reg)))
119 (:temporary (:sc descriptor-reg) tls)
120 ;;(:policy :fast-safe)
122 (let ((global-val (gen-label))
124 (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag)
125 (inst cmp (make-ea :qword :base thread-base-tn :scale 1 :index tls)
126 no-tls-value-marker-widetag)
127 (inst jmp :z global-val)
128 (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls)
131 (emit-label global-val)
132 (storew value symbol symbol-value-slot other-pointer-lowtag)
135 ;; unithreaded it's a lot simpler ...
137 (define-vop (set cell-set)
138 (:variant symbol-value-slot other-pointer-lowtag))
140 ;;; With Symbol-Value, we check that the value isn't the trap object. So
141 ;;; Symbol-Value of NIL is NIL.
143 (define-vop (symbol-value)
144 (:translate symbol-value)
146 (:args (object :scs (descriptor-reg) :to (:result 1)))
147 (:results (value :scs (descriptor-reg any-reg)))
149 (:save-p :compute-only)
151 (let* ((check-unbound-label (gen-label))
152 (err-lab (generate-error-code vop 'unbound-symbol-error object))
153 (ret-lab (gen-label)))
154 (loadw value object symbol-tls-index-slot other-pointer-lowtag)
155 (inst mov value (make-ea :qword :base thread-base-tn
156 :index value :scale 1))
157 (inst cmp value no-tls-value-marker-widetag)
158 (inst jmp :ne check-unbound-label)
159 (loadw value object symbol-value-slot other-pointer-lowtag)
160 (emit-label check-unbound-label)
161 (inst cmp value unbound-marker-widetag)
162 (inst jmp :e err-lab)
163 (emit-label ret-lab))))
166 (define-vop (fast-symbol-value symbol-value)
167 ;; KLUDGE: not really fast, in fact, because we're going to have to
168 ;; do a full lookup of the thread-local area anyway. But half of
169 ;; the meaning of FAST-SYMBOL-VALUE is "do not signal an error if
170 ;; unbound", which is used in the implementation of COPY-SYMBOL. --
173 (:translate symbol-value)
175 (let ((ret-lab (gen-label)))
176 (loadw value object symbol-tls-index-slot other-pointer-lowtag)
178 (make-ea :qword :base thread-base-tn :index value :scale 1))
179 (inst cmp value no-tls-value-marker-widetag)
180 (inst jmp :ne ret-lab)
181 (loadw value object symbol-value-slot other-pointer-lowtag)
182 (emit-label ret-lab))))
185 (define-vop (symbol-value)
186 (:translate symbol-value)
188 (:args (object :scs (descriptor-reg) :to (:result 1)))
189 (:results (value :scs (descriptor-reg any-reg)))
191 (:save-p :compute-only)
193 (let ((err-lab (generate-error-code vop 'unbound-symbol-error object)))
194 (loadw value object symbol-value-slot other-pointer-lowtag)
195 (inst cmp value unbound-marker-widetag)
196 (inst jmp :e err-lab))))
199 (define-vop (fast-symbol-value cell-ref)
200 (:variant symbol-value-slot other-pointer-lowtag)
202 (:translate symbol-value))
204 (defknown locked-symbol-global-value-add (symbol fixnum) fixnum ())
206 (define-vop (locked-symbol-global-value-add)
207 (:args (object :scs (descriptor-reg) :to :result)
208 (value :scs (any-reg) :target result))
209 (:arg-types * tagged-num)
210 (:results (result :scs (any-reg) :from (:argument 1)))
212 (:translate locked-symbol-global-value-add)
213 (:result-types tagged-num)
218 (inst add (make-ea :qword :base object
219 :disp (- (* symbol-value-slot n-word-bytes)
220 other-pointer-lowtag))
227 (:args (object :scs (descriptor-reg)))
230 (:temporary (:sc descriptor-reg #+nil(:from (:argument 0))) value)
232 (let ((check-unbound-label (gen-label)))
233 (loadw value object symbol-tls-index-slot other-pointer-lowtag)
235 (make-ea :qword :base thread-base-tn :index value :scale 1))
236 (inst cmp value no-tls-value-marker-widetag)
237 (inst jmp :ne check-unbound-label)
238 (loadw value object symbol-value-slot other-pointer-lowtag)
239 (emit-label check-unbound-label)
240 (inst cmp value unbound-marker-widetag)
241 (inst jmp (if not-p :e :ne) target))))
247 (:args (object :scs (descriptor-reg)))
251 (inst cmp (make-ea-for-object-slot object symbol-value-slot
252 other-pointer-lowtag)
253 unbound-marker-widetag)
254 (inst jmp (if not-p :e :ne) target)))
257 (define-vop (symbol-hash)
259 (:translate symbol-hash)
260 (:args (symbol :scs (descriptor-reg)))
261 (:results (res :scs (any-reg)))
262 (:result-types positive-fixnum)
264 ;; The symbol-hash slot of NIL holds NIL because it is also the
265 ;; cdr slot, so we have to strip off the three low bits to make sure
266 ;; it is a fixnum. The lowtag selection magic that is required to
267 ;; ensure this is explained in the comment in objdef.lisp
268 (loadw res symbol symbol-hash-slot other-pointer-lowtag)
269 (inst and res (lognot #b111))))
271 ;;;; fdefinition (FDEFN) objects
273 (define-vop (fdefn-fun cell-ref) ; /pfw - alpha
274 (:variant fdefn-fun-slot other-pointer-lowtag))
276 (define-vop (safe-fdefn-fun)
277 (:args (object :scs (descriptor-reg) :to (:result 1)))
278 (:results (value :scs (descriptor-reg any-reg)))
280 (:save-p :compute-only)
282 (loadw value object fdefn-fun-slot other-pointer-lowtag)
283 (inst cmp value nil-value)
284 (let ((err-lab (generate-error-code vop 'undefined-fun-error object)))
285 (inst jmp :e err-lab))))
287 (define-vop (set-fdefn-fun)
289 (:translate (setf fdefn-fun))
290 (:args (function :scs (descriptor-reg) :target result)
291 (fdefn :scs (descriptor-reg)))
292 (:temporary (:sc unsigned-reg) raw)
293 (:temporary (:sc byte-reg) type)
294 (:results (result :scs (descriptor-reg)))
296 (load-type type function (- fun-pointer-lowtag))
298 (make-ea :byte :base function
299 :disp (- (* simple-fun-code-offset n-word-bytes)
300 fun-pointer-lowtag)))
301 (inst cmp type simple-fun-header-widetag)
302 (inst jmp :e NORMAL-FUN)
303 (inst lea raw (make-fixup "closure_tramp" :foreign))
305 (storew function fdefn fdefn-fun-slot other-pointer-lowtag)
306 (storew raw fdefn fdefn-raw-addr-slot other-pointer-lowtag)
307 (move result function)))
309 (define-vop (fdefn-makunbound)
311 (:translate fdefn-makunbound)
312 (:args (fdefn :scs (descriptor-reg) :target result))
313 (:results (result :scs (descriptor-reg)))
315 (storew nil-value fdefn fdefn-fun-slot other-pointer-lowtag)
316 (storew (make-fixup "undefined_tramp" :foreign)
317 fdefn fdefn-raw-addr-slot other-pointer-lowtag)
318 (move result fdefn)))
320 ;;;; binding and unbinding
322 ;;; BIND -- Establish VAL as a binding for SYMBOL. Save the old value and
323 ;;; the symbol on the binding stack and stuff the new value into the
328 (:args (val :scs (any-reg descriptor-reg))
329 (symbol :scs (descriptor-reg)))
330 (:temporary (:sc unsigned-reg) tls-index bsp)
332 (let ((tls-index-valid (gen-label)))
333 (load-binding-stack-pointer bsp)
334 (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
335 (inst add bsp (* binding-size n-word-bytes))
336 (store-binding-stack-pointer bsp)
337 (inst or tls-index tls-index)
338 (inst jmp :ne tls-index-valid)
339 (inst mov tls-index symbol)
340 (inst lea temp-reg-tn
341 (make-ea :qword :disp
342 (make-fixup (ecase (tn-offset tls-index)
343 (#.rax-offset 'alloc-tls-index-in-rax)
344 (#.rcx-offset 'alloc-tls-index-in-rcx)
345 (#.rdx-offset 'alloc-tls-index-in-rdx)
346 (#.rbx-offset 'alloc-tls-index-in-rbx)
347 (#.rsi-offset 'alloc-tls-index-in-rsi)
348 (#.rdi-offset 'alloc-tls-index-in-rdi)
349 (#.r8-offset 'alloc-tls-index-in-r8)
350 (#.r9-offset 'alloc-tls-index-in-r9)
351 (#.r10-offset 'alloc-tls-index-in-r10)
352 (#.r12-offset 'alloc-tls-index-in-r12)
353 (#.r13-offset 'alloc-tls-index-in-r13)
354 (#.r14-offset 'alloc-tls-index-in-r14)
355 (#.r15-offset 'alloc-tls-index-in-r15))
357 (inst call temp-reg-tn)
358 (emit-label tls-index-valid)
359 (inst push (make-ea :qword :base thread-base-tn :scale 1 :index tls-index))
360 (popw bsp (- binding-value-slot binding-size))
361 (storew symbol bsp (- binding-symbol-slot binding-size))
362 (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)
367 (:args (val :scs (any-reg descriptor-reg))
368 (symbol :scs (descriptor-reg)))
369 (:temporary (:sc unsigned-reg) temp bsp)
371 (load-symbol-value bsp *binding-stack-pointer*)
372 (loadw temp symbol symbol-value-slot other-pointer-lowtag)
373 (inst add bsp (* binding-size n-word-bytes))
374 (store-symbol-value bsp *binding-stack-pointer*)
375 (storew temp bsp (- binding-value-slot binding-size))
376 (storew symbol bsp (- binding-symbol-slot binding-size))
377 (storew val symbol symbol-value-slot other-pointer-lowtag)))
381 (:temporary (:sc unsigned-reg) temp bsp tls-index)
383 (load-binding-stack-pointer bsp)
384 ;; Load SYMBOL from stack, and get the TLS-INDEX
385 (loadw temp bsp (- binding-symbol-slot binding-size))
386 (loadw tls-index temp symbol-tls-index-slot other-pointer-lowtag)
387 ;; Load VALUE from stack, the restore it to the TLS area.
388 (loadw temp bsp (- binding-value-slot binding-size))
389 (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)
391 ;; Zero out the stack.
392 (storew 0 bsp (- binding-symbol-slot binding-size))
393 (storew 0 bsp (- binding-value-slot binding-size))
394 (inst sub bsp (* binding-size n-word-bytes))
395 (store-binding-stack-pointer bsp)))
399 (:temporary (:sc unsigned-reg) symbol value bsp)
401 (load-symbol-value bsp *binding-stack-pointer*)
402 (loadw symbol bsp (- binding-symbol-slot binding-size))
403 (loadw value bsp (- binding-value-slot binding-size))
404 (storew value symbol symbol-value-slot other-pointer-lowtag)
405 (storew 0 bsp (- binding-symbol-slot binding-size))
406 (storew 0 bsp (- binding-value-slot binding-size))
407 (inst sub bsp (* binding-size n-word-bytes))
408 (store-symbol-value bsp *binding-stack-pointer*)))
410 (define-vop (unbind-to-here)
411 (:args (where :scs (descriptor-reg any-reg)))
412 (:temporary (:sc unsigned-reg) symbol value bsp #!+sb-thread tls-index)
414 (load-binding-stack-pointer bsp)
419 (loadw symbol bsp (- binding-symbol-slot binding-size))
420 (inst or symbol symbol)
422 ;; Bind stack debug sentinels have the unbound marker in the symbol slot
423 (inst cmp symbol unbound-marker-widetag)
425 (loadw value bsp (- binding-value-slot binding-size))
427 (storew value symbol symbol-value-slot other-pointer-lowtag)
429 (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
431 (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)
433 (storew 0 bsp (- binding-symbol-slot binding-size))
436 (storew 0 bsp (- binding-value-slot binding-size))
437 (inst sub bsp (* binding-size n-word-bytes))
440 (store-binding-stack-pointer bsp)
444 (define-vop (bind-sentinel)
445 (:temporary (:sc unsigned-reg) bsp)
447 (load-binding-stack-pointer bsp)
448 (inst add bsp (* binding-size n-word-bytes))
449 (storew unbound-marker-widetag bsp (- binding-symbol-slot binding-size))
450 (storew rbp-tn bsp (- binding-value-slot binding-size))
451 (store-binding-stack-pointer bsp)))
453 (define-vop (unbind-sentinel)
454 (:temporary (:sc unsigned-reg) bsp)
456 (load-binding-stack-pointer bsp)
457 (storew 0 bsp (- binding-value-slot binding-size))
458 (storew 0 bsp (- binding-symbol-slot binding-size))
459 (inst sub bsp (* binding-size n-word-bytes))
460 (store-binding-stack-pointer bsp)))
465 ;;;; closure indexing
467 (define-full-reffer closure-index-ref *
468 closure-info-offset fun-pointer-lowtag
469 (any-reg descriptor-reg) * %closure-index-ref)
471 (define-full-setter set-funcallable-instance-info *
472 funcallable-instance-info-offset fun-pointer-lowtag
473 (any-reg descriptor-reg) * %set-funcallable-instance-info)
475 (define-full-reffer funcallable-instance-info *
476 funcallable-instance-info-offset fun-pointer-lowtag
477 (descriptor-reg any-reg) * %funcallable-instance-info)
479 (define-vop (closure-ref slot-ref)
480 (:variant closure-info-offset fun-pointer-lowtag))
482 (define-vop (closure-init slot-set)
483 (:variant closure-info-offset fun-pointer-lowtag))
485 ;;;; value cell hackery
487 (define-vop (value-cell-ref cell-ref)
488 (:variant value-cell-value-slot other-pointer-lowtag))
490 (define-vop (value-cell-set cell-set)
491 (:variant value-cell-value-slot other-pointer-lowtag))
493 ;;;; structure hackery
495 (define-vop (instance-length)
497 (:translate %instance-length)
498 (:args (struct :scs (descriptor-reg)))
499 (:results (res :scs (unsigned-reg)))
500 (:result-types positive-fixnum)
502 (loadw res struct 0 instance-pointer-lowtag)
503 (inst shr res n-widetag-bits)))
505 (define-full-reffer instance-index-ref * instance-slots-offset
506 instance-pointer-lowtag (any-reg descriptor-reg) * %instance-ref)
508 (define-full-setter instance-index-set * instance-slots-offset
509 instance-pointer-lowtag (any-reg descriptor-reg) * %instance-set)
511 (define-full-compare-and-swap %compare-and-swap-instance-ref instance
512 instance-slots-offset instance-pointer-lowtag
513 (any-reg descriptor-reg) *
514 %compare-and-swap-instance-ref)
516 ;;;; code object frobbing
518 (define-full-reffer code-header-ref * 0 other-pointer-lowtag
519 (any-reg descriptor-reg) * code-header-ref)
521 (define-full-setter code-header-set * 0 other-pointer-lowtag
522 (any-reg descriptor-reg) * code-header-set)
524 ;;;; raw instance slot accessors
526 (defun make-ea-for-raw-slot (object index instance-length
527 &optional (adjustment 0))
528 (if (integerp instance-length)
529 ;; For RAW-INSTANCE-INIT/* VOPs, which know the exact instance length
533 :disp (+ (* (- instance-length instance-slots-offset index)
535 (- instance-pointer-lowtag)
539 (make-ea :qword :base object :index instance-length
540 :disp (+ (* (1- instance-slots-offset) n-word-bytes)
541 (- instance-pointer-lowtag)
544 (make-ea :qword :base object :index instance-length
546 :disp (+ (* (1- instance-slots-offset) n-word-bytes)
547 (- instance-pointer-lowtag)
549 (* index (- n-word-bytes))))))))
551 (define-vop (raw-instance-ref/word)
552 (:translate %raw-instance-ref/word)
554 (:args (object :scs (descriptor-reg)) (index :scs (any-reg)))
555 (:arg-types * tagged-num)
556 (:temporary (:sc unsigned-reg) tmp)
557 (:results (value :scs (unsigned-reg)))
558 (:result-types unsigned-num)
560 (loadw tmp object 0 instance-pointer-lowtag)
561 (inst shr tmp n-widetag-bits)
564 (inst mov value (make-ea-for-raw-slot object index tmp))))
566 (define-vop (raw-instance-ref-c/word)
567 (:translate %raw-instance-ref/word)
569 (:args (object :scs (descriptor-reg)))
570 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
571 #.instance-pointer-lowtag
572 #.instance-slots-offset)))
574 (:temporary (:sc unsigned-reg) tmp)
575 (:results (value :scs (unsigned-reg)))
576 (:result-types unsigned-num)
578 (loadw tmp object 0 instance-pointer-lowtag)
579 (inst shr tmp n-widetag-bits)
580 (inst mov value (make-ea-for-raw-slot object index tmp))))
582 (define-vop (raw-instance-set/word)
583 (:translate %raw-instance-set/word)
585 (:args (object :scs (descriptor-reg))
586 (index :scs (any-reg))
587 (value :scs (unsigned-reg) :target result))
588 (:arg-types * tagged-num unsigned-num)
589 (:temporary (:sc unsigned-reg) tmp)
590 (:results (result :scs (unsigned-reg)))
591 (:result-types unsigned-num)
593 (loadw tmp object 0 instance-pointer-lowtag)
594 (inst shr tmp n-widetag-bits)
597 (inst mov (make-ea-for-raw-slot object index tmp) value)
598 (move result value)))
600 (define-vop (raw-instance-set-c/word)
601 (:translate %raw-instance-set/word)
603 (:args (object :scs (descriptor-reg))
604 (value :scs (unsigned-reg) :target result))
605 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
606 #.instance-pointer-lowtag
607 #.instance-slots-offset))
610 (:temporary (:sc unsigned-reg) tmp)
611 (:results (result :scs (unsigned-reg)))
612 (:result-types unsigned-num)
614 (loadw tmp object 0 instance-pointer-lowtag)
615 (inst shr tmp n-widetag-bits)
616 (inst mov (make-ea-for-raw-slot object index tmp) value)
617 (move result value)))
619 (define-vop (raw-instance-init/word)
620 (:args (object :scs (descriptor-reg))
621 (value :scs (unsigned-reg)))
622 (:arg-types * unsigned-num)
623 (:info instance-length index)
625 (inst mov (make-ea-for-raw-slot object index instance-length) value)))
627 (define-vop (raw-instance-atomic-incf-c/word)
628 (:translate %raw-instance-atomic-incf/word)
630 (:args (object :scs (descriptor-reg))
631 (diff :scs (signed-reg) :target result))
632 (:arg-types * (:constant (load/store-index #.n-word-bytes
633 #.instance-pointer-lowtag
634 #.instance-slots-offset))
637 (:temporary (:sc unsigned-reg) tmp)
638 (:results (result :scs (unsigned-reg)))
639 (:result-types unsigned-num)
641 (loadw tmp object 0 instance-pointer-lowtag)
642 (inst shr tmp n-widetag-bits)
645 (inst xadd (make-ea-for-raw-slot object index tmp) diff)
648 (define-vop (raw-instance-ref/single)
649 (:translate %raw-instance-ref/single)
651 (:args (object :scs (descriptor-reg))
652 (index :scs (any-reg)))
653 (:arg-types * positive-fixnum)
654 (:temporary (:sc unsigned-reg) tmp)
655 (:results (value :scs (single-reg)))
656 (:result-types single-float)
658 (loadw tmp object 0 instance-pointer-lowtag)
659 (inst shr tmp n-widetag-bits)
662 (inst movss value (make-ea-for-raw-slot object index tmp))))
664 (define-vop (raw-instance-ref-c/single)
665 (:translate %raw-instance-ref/single)
667 (:args (object :scs (descriptor-reg)))
668 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
669 #.instance-pointer-lowtag
670 #.instance-slots-offset)))
672 (:temporary (:sc unsigned-reg) tmp)
673 (:results (value :scs (single-reg)))
674 (:result-types single-float)
676 (loadw tmp object 0 instance-pointer-lowtag)
677 (inst shr tmp n-widetag-bits)
678 (inst movss value (make-ea-for-raw-slot object index tmp))))
680 (define-vop (raw-instance-set/single)
681 (:translate %raw-instance-set/single)
683 (:args (object :scs (descriptor-reg))
684 (index :scs (any-reg))
685 (value :scs (single-reg) :target result))
686 (:arg-types * positive-fixnum single-float)
687 (:temporary (:sc unsigned-reg) tmp)
688 (:results (result :scs (single-reg)))
689 (:result-types single-float)
691 (loadw tmp object 0 instance-pointer-lowtag)
692 (inst shr tmp n-widetag-bits)
695 (inst movss (make-ea-for-raw-slot object index tmp) value)
696 (unless (location= result value)
697 (inst movss result value))))
699 (define-vop (raw-instance-set-c/single)
700 (:translate %raw-instance-set/single)
702 (:args (object :scs (descriptor-reg))
703 (value :scs (single-reg) :target result))
704 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
705 #.instance-pointer-lowtag
706 #.instance-slots-offset))
709 (:temporary (:sc unsigned-reg) tmp)
710 (:results (result :scs (single-reg)))
711 (:result-types single-float)
713 (loadw tmp object 0 instance-pointer-lowtag)
714 (inst shr tmp n-widetag-bits)
715 (inst movss (make-ea-for-raw-slot object index tmp) value)
716 (unless (location= result value)
717 (inst movss result value))))
719 (define-vop (raw-instance-init/single)
720 (:args (object :scs (descriptor-reg))
721 (value :scs (single-reg)))
722 (:arg-types * single-float)
723 (:info instance-length index)
725 (inst movss (make-ea-for-raw-slot object index instance-length) value)))
727 (define-vop (raw-instance-ref/double)
728 (:translate %raw-instance-ref/double)
730 (:args (object :scs (descriptor-reg))
731 (index :scs (any-reg)))
732 (:arg-types * positive-fixnum)
733 (:temporary (:sc unsigned-reg) tmp)
734 (:results (value :scs (double-reg)))
735 (:result-types double-float)
737 (loadw tmp object 0 instance-pointer-lowtag)
738 (inst shr tmp n-widetag-bits)
741 (inst movsd value (make-ea-for-raw-slot object index tmp))))
743 (define-vop (raw-instance-ref-c/double)
744 (:translate %raw-instance-ref/double)
746 (:args (object :scs (descriptor-reg)))
747 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
748 #.instance-pointer-lowtag
749 #.instance-slots-offset)))
751 (:temporary (:sc unsigned-reg) tmp)
752 (:results (value :scs (double-reg)))
753 (:result-types double-float)
755 (loadw tmp object 0 instance-pointer-lowtag)
756 (inst shr tmp n-widetag-bits)
757 (inst movsd value (make-ea-for-raw-slot object index tmp))))
759 (define-vop (raw-instance-set/double)
760 (:translate %raw-instance-set/double)
762 (:args (object :scs (descriptor-reg))
763 (index :scs (any-reg))
764 (value :scs (double-reg) :target result))
765 (:arg-types * positive-fixnum double-float)
766 (:temporary (:sc unsigned-reg) tmp)
767 (:results (result :scs (double-reg)))
768 (:result-types double-float)
770 (loadw tmp object 0 instance-pointer-lowtag)
771 (inst shr tmp n-widetag-bits)
774 (inst movsd (make-ea-for-raw-slot object index tmp) value)
775 (unless (location= result value)
776 (inst movsd result value))))
778 (define-vop (raw-instance-set-c/double)
779 (:translate %raw-instance-set/double)
781 (:args (object :scs (descriptor-reg))
782 (value :scs (double-reg) :target result))
783 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
784 #.instance-pointer-lowtag
785 #.instance-slots-offset))
788 (:temporary (:sc unsigned-reg) tmp)
789 (:results (result :scs (double-reg)))
790 (:result-types double-float)
792 (loadw tmp object 0 instance-pointer-lowtag)
793 (inst shr tmp n-widetag-bits)
794 (inst movsd (make-ea-for-raw-slot object index tmp) value)
795 (unless (location= result value)
796 (inst movsd result value))))
798 (define-vop (raw-instance-init/double)
799 (:args (object :scs (descriptor-reg))
800 (value :scs (double-reg)))
801 (:arg-types * double-float)
802 (:info instance-length index)
804 (inst movsd (make-ea-for-raw-slot object index instance-length) value)))
806 (define-vop (raw-instance-ref/complex-single)
807 (:translate %raw-instance-ref/complex-single)
809 (:args (object :scs (descriptor-reg))
810 (index :scs (any-reg)))
811 (:arg-types * positive-fixnum)
812 (:temporary (:sc unsigned-reg) tmp)
813 (:results (value :scs (complex-single-reg)))
814 (:result-types complex-single-float)
816 (loadw tmp object 0 instance-pointer-lowtag)
817 (inst shr tmp n-widetag-bits)
820 (let ((real-tn (complex-single-reg-real-tn value)))
821 (inst movss real-tn (make-ea-for-raw-slot object index tmp)))
822 (let ((imag-tn (complex-single-reg-imag-tn value)))
823 (inst movss imag-tn (make-ea-for-raw-slot object index tmp 4)))))
825 (define-vop (raw-instance-ref-c/complex-single)
826 (:translate %raw-instance-ref/complex-single)
828 (:args (object :scs (descriptor-reg)))
829 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
830 #.instance-pointer-lowtag
831 #.instance-slots-offset)))
833 (:temporary (:sc unsigned-reg) tmp)
834 (:results (value :scs (complex-single-reg)))
835 (:result-types complex-single-float)
837 (loadw tmp object 0 instance-pointer-lowtag)
838 (inst shr tmp n-widetag-bits)
839 (let ((real-tn (complex-single-reg-real-tn value)))
840 (inst movss real-tn (make-ea-for-raw-slot object index tmp)))
841 (let ((imag-tn (complex-single-reg-imag-tn value)))
842 (inst movss imag-tn (make-ea-for-raw-slot object index tmp 4)))))
844 (define-vop (raw-instance-set/complex-single)
845 (:translate %raw-instance-set/complex-single)
847 (:args (object :scs (descriptor-reg))
848 (index :scs (any-reg))
849 (value :scs (complex-single-reg) :target result))
850 (:arg-types * positive-fixnum complex-single-float)
851 (:temporary (:sc unsigned-reg) tmp)
852 (:results (result :scs (complex-single-reg)))
853 (:result-types complex-single-float)
855 (loadw tmp object 0 instance-pointer-lowtag)
856 (inst shr tmp n-widetag-bits)
859 (let ((value-real (complex-single-reg-real-tn value))
860 (result-real (complex-single-reg-real-tn result)))
861 (inst movss (make-ea-for-raw-slot object index tmp) value-real)
862 (unless (location= value-real result-real)
863 (inst movss result-real value-real)))
864 (let ((value-imag (complex-single-reg-imag-tn value))
865 (result-imag (complex-single-reg-imag-tn result)))
866 (inst movss (make-ea-for-raw-slot object index tmp 4) value-imag)
867 (unless (location= value-imag result-imag)
868 (inst movss result-imag value-imag)))))
870 (define-vop (raw-instance-set-c/complex-single)
871 (:translate %raw-instance-set/complex-single)
873 (:args (object :scs (descriptor-reg))
874 (value :scs (complex-single-reg) :target result))
875 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
876 #.instance-pointer-lowtag
877 #.instance-slots-offset))
878 complex-single-float)
880 (:temporary (:sc unsigned-reg) tmp)
881 (:results (result :scs (complex-single-reg)))
882 (:result-types complex-single-float)
884 (loadw tmp object 0 instance-pointer-lowtag)
885 (inst shr tmp n-widetag-bits)
886 (let ((value-real (complex-single-reg-real-tn value))
887 (result-real (complex-single-reg-real-tn result)))
888 (inst movss (make-ea-for-raw-slot object index tmp) value-real)
889 (unless (location= value-real result-real)
890 (inst movss result-real value-real)))
891 (let ((value-imag (complex-single-reg-imag-tn value))
892 (result-imag (complex-single-reg-imag-tn result)))
893 (inst movss (make-ea-for-raw-slot object index tmp 4) value-imag)
894 (unless (location= value-imag result-imag)
895 (inst movss result-imag value-imag)))))
897 (define-vop (raw-instance-init/complex-single)
898 (:args (object :scs (descriptor-reg))
899 (value :scs (complex-single-reg)))
900 (:arg-types * complex-single-float)
901 (:info instance-length index)
903 (let ((value-real (complex-single-reg-real-tn value)))
904 (inst movss (make-ea-for-raw-slot object index instance-length) value-real))
905 (let ((value-imag (complex-single-reg-imag-tn value)))
906 (inst movss (make-ea-for-raw-slot object index instance-length 4) value-imag))))
908 (define-vop (raw-instance-ref/complex-double)
909 (:translate %raw-instance-ref/complex-double)
911 (:args (object :scs (descriptor-reg))
912 (index :scs (any-reg)))
913 (:arg-types * positive-fixnum)
914 (:temporary (:sc unsigned-reg) tmp)
915 (:results (value :scs (complex-double-reg)))
916 (:result-types complex-double-float)
918 (loadw tmp object 0 instance-pointer-lowtag)
919 (inst shr tmp n-widetag-bits)
922 (let ((real-tn (complex-double-reg-real-tn value)))
923 (inst movsd real-tn (make-ea-for-raw-slot object index tmp -8)))
924 (let ((imag-tn (complex-double-reg-imag-tn value)))
925 (inst movsd imag-tn (make-ea-for-raw-slot object index tmp)))))
927 (define-vop (raw-instance-ref-c/complex-double)
928 (:translate %raw-instance-ref/complex-double)
930 (:args (object :scs (descriptor-reg)))
931 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
932 #.instance-pointer-lowtag
933 #.instance-slots-offset)))
935 (:temporary (:sc unsigned-reg) tmp)
936 (:results (value :scs (complex-double-reg)))
937 (:result-types complex-double-float)
939 (loadw tmp object 0 instance-pointer-lowtag)
940 (inst shr tmp n-widetag-bits)
941 (let ((real-tn (complex-double-reg-real-tn value)))
942 (inst movsd real-tn (make-ea-for-raw-slot object index tmp -8)))
943 (let ((imag-tn (complex-double-reg-imag-tn value)))
944 (inst movsd imag-tn (make-ea-for-raw-slot object index tmp)))))
946 (define-vop (raw-instance-set/complex-double)
947 (:translate %raw-instance-set/complex-double)
949 (:args (object :scs (descriptor-reg))
950 (index :scs (any-reg))
951 (value :scs (complex-double-reg) :target result))
952 (:arg-types * positive-fixnum complex-double-float)
953 (:temporary (:sc unsigned-reg) tmp)
954 (:results (result :scs (complex-double-reg)))
955 (:result-types complex-double-float)
957 (loadw tmp object 0 instance-pointer-lowtag)
958 (inst shr tmp n-widetag-bits)
961 (let ((value-real (complex-double-reg-real-tn value))
962 (result-real (complex-double-reg-real-tn result)))
963 (inst movsd (make-ea-for-raw-slot object index tmp -8) value-real)
964 (unless (location= value-real result-real)
965 (inst movsd result-real value-real)))
966 (let ((value-imag (complex-double-reg-imag-tn value))
967 (result-imag (complex-double-reg-imag-tn result)))
968 (inst movsd (make-ea-for-raw-slot object index tmp) value-imag)
969 (unless (location= value-imag result-imag)
970 (inst movsd result-imag value-imag)))))
972 (define-vop (raw-instance-set-c/complex-double)
973 (:translate %raw-instance-set/complex-double)
975 (:args (object :scs (descriptor-reg))
976 (value :scs (complex-double-reg) :target result))
977 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
978 #.instance-pointer-lowtag
979 #.instance-slots-offset))
980 complex-double-float)
982 (:temporary (:sc unsigned-reg) tmp)
983 (:results (result :scs (complex-double-reg)))
984 (:result-types complex-double-float)
986 (loadw tmp object 0 instance-pointer-lowtag)
987 (inst shr tmp n-widetag-bits)
988 (let ((value-real (complex-double-reg-real-tn value))
989 (result-real (complex-double-reg-real-tn result)))
990 (inst movsd (make-ea-for-raw-slot object index tmp -8) value-real)
991 (unless (location= value-real result-real)
992 (inst movsd result-real value-real)))
993 (let ((value-imag (complex-double-reg-imag-tn value))
994 (result-imag (complex-double-reg-imag-tn result)))
995 (inst movsd (make-ea-for-raw-slot object index tmp) value-imag)
996 (unless (location= value-imag result-imag)
997 (inst movsd result-imag value-imag)))))
999 (define-vop (raw-instance-init/complex-double)
1000 (:args (object :scs (descriptor-reg))
1001 (value :scs (complex-double-reg)))
1002 (:arg-types * complex-double-float)
1003 (:info instance-length index)
1005 (let ((value-real (complex-double-reg-real-tn value)))
1006 (inst movsd (make-ea-for-raw-slot object index instance-length -8) value-real))
1007 (let ((value-imag (complex-double-reg-imag-tn value)))
1008 (inst movsd (make-ea-for-raw-slot object index instance-length) value-imag))))