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 (init-slot set-slot))
52 (define-vop (compare-and-swap-slot)
53 (:args (object :scs (descriptor-reg) :to :eval)
54 (old :scs (descriptor-reg any-reg) :target rax)
55 (new :scs (descriptor-reg any-reg)))
56 (:temporary (:sc descriptor-reg :offset rax-offset
57 :from (:argument 1) :to :result :target result)
59 (:info name offset lowtag)
61 (: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)
99 (inst cmpxchg (make-ea :qword :base symbol
100 :disp (- (* symbol-value-slot n-word-bytes)
101 other-pointer-lowtag)
106 (inst cmp result unbound-marker-widetag)
107 (inst jmp :e unbound))))
109 (define-vop (%set-symbol-global-value cell-set)
110 (:variant symbol-value-slot other-pointer-lowtag))
112 (define-vop (fast-symbol-global-value cell-ref)
113 (:variant symbol-value-slot other-pointer-lowtag)
115 (:translate symbol-global-value))
117 (define-vop (symbol-global-value)
119 (:translate symbol-global-value)
120 (:args (object :scs (descriptor-reg) :to (:result 1)))
121 (:results (value :scs (descriptor-reg any-reg)))
123 (:save-p :compute-only)
125 (let ((err-lab (generate-error-code vop 'unbound-symbol-error object)))
126 (loadw value object symbol-value-slot other-pointer-lowtag)
127 (inst cmp value unbound-marker-widetag)
128 (inst jmp :e err-lab))))
133 (:args (symbol :scs (descriptor-reg))
134 (value :scs (descriptor-reg any-reg)))
135 (:temporary (:sc descriptor-reg) tls)
137 (let ((global-val (gen-label))
139 (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag)
140 (inst cmp (make-ea :qword :base thread-base-tn :scale 1 :index tls)
141 no-tls-value-marker-widetag)
142 (inst jmp :z global-val)
143 (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls)
146 (emit-label global-val)
147 (storew value symbol symbol-value-slot other-pointer-lowtag)
150 ;; With Symbol-Value, we check that the value isn't the trap object. So
151 ;; Symbol-Value of NIL is NIL.
152 (define-vop (symbol-value)
153 (:translate symbol-value)
155 (:args (object :scs (descriptor-reg) :to (:result 1)))
156 (:results (value :scs (descriptor-reg any-reg)))
158 (:save-p :compute-only)
160 (let* ((check-unbound-label (gen-label))
161 (err-lab (generate-error-code vop 'unbound-symbol-error object))
162 (ret-lab (gen-label)))
163 (loadw value object symbol-tls-index-slot other-pointer-lowtag)
164 (inst mov value (make-ea :qword :base thread-base-tn
165 :index value :scale 1))
166 (inst cmp value no-tls-value-marker-widetag)
167 (inst jmp :ne check-unbound-label)
168 (loadw value object symbol-value-slot other-pointer-lowtag)
169 (emit-label check-unbound-label)
170 (inst cmp value unbound-marker-widetag)
171 (inst jmp :e err-lab)
172 (emit-label ret-lab))))
174 (define-vop (fast-symbol-value symbol-value)
175 ;; KLUDGE: not really fast, in fact, because we're going to have to
176 ;; do a full lookup of the thread-local area anyway. But half of
177 ;; the meaning of FAST-SYMBOL-VALUE is "do not signal an error if
178 ;; unbound", which is used in the implementation of COPY-SYMBOL. --
181 (:translate symbol-value)
183 (let ((ret-lab (gen-label)))
184 (loadw value object symbol-tls-index-slot other-pointer-lowtag)
186 (make-ea :qword :base thread-base-tn :index value :scale 1))
187 (inst cmp value no-tls-value-marker-widetag)
188 (inst jmp :ne ret-lab)
189 (loadw value object symbol-value-slot other-pointer-lowtag)
190 (emit-label ret-lab)))))
194 (define-vop (symbol-value symbol-global-value)
195 (:translate symbol-value))
196 (define-vop (fast-symbol-value fast-symbol-global-value)
197 (:translate symbol-value))
198 (define-vop (set %set-symbol-global-value)))
204 (:args (object :scs (descriptor-reg)))
206 (:temporary (:sc descriptor-reg #+nil(:from (:argument 0))) value)
208 (let ((check-unbound-label (gen-label)))
209 (loadw value object symbol-tls-index-slot other-pointer-lowtag)
211 (make-ea :qword :base thread-base-tn :index value :scale 1))
212 (inst cmp value no-tls-value-marker-widetag)
213 (inst jmp :ne check-unbound-label)
214 (loadw value object symbol-value-slot other-pointer-lowtag)
215 (emit-label check-unbound-label)
216 (inst cmp value unbound-marker-widetag))))
222 (:args (object :scs (descriptor-reg)))
225 (inst cmp (make-ea-for-object-slot object symbol-value-slot
226 other-pointer-lowtag)
227 unbound-marker-widetag)))
230 (define-vop (symbol-hash)
232 (:translate symbol-hash)
233 (:args (symbol :scs (descriptor-reg)))
234 (:results (res :scs (any-reg)))
235 (:result-types positive-fixnum)
237 ;; The symbol-hash slot of NIL holds NIL because it is also the
238 ;; cdr slot, so we have to strip off the three low bits to make sure
239 ;; it is a fixnum. The lowtag selection magic that is required to
240 ;; ensure this is explained in the comment in objdef.lisp
241 (loadw res symbol symbol-hash-slot other-pointer-lowtag)
242 (inst and res (lognot fixnum-tag-mask))))
244 ;;;; fdefinition (FDEFN) objects
246 (define-vop (fdefn-fun cell-ref) ; /pfw - alpha
247 (:variant fdefn-fun-slot other-pointer-lowtag))
249 (define-vop (safe-fdefn-fun)
250 (:args (object :scs (descriptor-reg) :to (:result 1)))
251 (:results (value :scs (descriptor-reg any-reg)))
253 (:save-p :compute-only)
255 (loadw value object fdefn-fun-slot other-pointer-lowtag)
256 (inst cmp value nil-value)
257 (let ((err-lab (generate-error-code vop 'undefined-fun-error object)))
258 (inst jmp :e err-lab))))
260 (define-vop (set-fdefn-fun)
262 (:translate (setf fdefn-fun))
263 (:args (function :scs (descriptor-reg) :target result)
264 (fdefn :scs (descriptor-reg)))
265 (:temporary (:sc unsigned-reg) raw)
266 (:temporary (:sc unsigned-reg) type)
267 (:results (result :scs (descriptor-reg)))
269 (load-type type function (- fun-pointer-lowtag))
271 (make-ea :byte :base function
272 :disp (- (* simple-fun-code-offset n-word-bytes)
273 fun-pointer-lowtag)))
274 (inst cmp (reg-in-size type :byte) simple-fun-header-widetag)
275 (inst jmp :e NORMAL-FUN)
276 (inst mov raw (make-fixup "closure_tramp" :foreign))
278 (storew function fdefn fdefn-fun-slot other-pointer-lowtag)
279 (storew raw fdefn fdefn-raw-addr-slot other-pointer-lowtag)
280 (move result function)))
282 (define-vop (fdefn-makunbound)
284 (:translate fdefn-makunbound)
285 (:args (fdefn :scs (descriptor-reg) :target result))
286 (:results (result :scs (descriptor-reg)))
288 (storew nil-value fdefn fdefn-fun-slot other-pointer-lowtag)
289 (storew (make-fixup "undefined_tramp" :foreign)
290 fdefn fdefn-raw-addr-slot other-pointer-lowtag)
291 (move result fdefn)))
293 ;;;; binding and unbinding
295 ;;; BIND -- Establish VAL as a binding for SYMBOL. Save the old value and
296 ;;; the symbol on the binding stack and stuff the new value into the
301 (:args (val :scs (any-reg descriptor-reg))
302 (symbol :scs (descriptor-reg)))
303 (:temporary (:sc unsigned-reg) tls-index bsp)
305 (let ((tls-index-valid (gen-label)))
306 (load-binding-stack-pointer bsp)
307 (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
308 (inst add bsp (* binding-size n-word-bytes))
309 (store-binding-stack-pointer bsp)
310 (inst test tls-index tls-index)
311 (inst jmp :ne tls-index-valid)
312 (inst mov tls-index symbol)
313 (inst mov temp-reg-tn
314 (make-fixup (ecase (tn-offset tls-index)
315 (#.rax-offset 'alloc-tls-index-in-rax)
316 (#.rcx-offset 'alloc-tls-index-in-rcx)
317 (#.rdx-offset 'alloc-tls-index-in-rdx)
318 (#.rbx-offset 'alloc-tls-index-in-rbx)
319 (#.rsi-offset 'alloc-tls-index-in-rsi)
320 (#.rdi-offset 'alloc-tls-index-in-rdi)
321 (#.r8-offset 'alloc-tls-index-in-r8)
322 (#.r9-offset 'alloc-tls-index-in-r9)
323 (#.r10-offset 'alloc-tls-index-in-r10)
324 (#.r12-offset 'alloc-tls-index-in-r12)
325 (#.r13-offset 'alloc-tls-index-in-r13)
326 (#.r14-offset 'alloc-tls-index-in-r14)
327 (#.r15-offset 'alloc-tls-index-in-r15))
329 (inst call temp-reg-tn)
330 (emit-label tls-index-valid)
331 (inst push (make-ea :qword :base thread-base-tn :scale 1 :index tls-index))
332 (popw bsp (- binding-value-slot binding-size))
333 (storew symbol bsp (- binding-symbol-slot binding-size))
334 (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)
339 (:args (val :scs (any-reg descriptor-reg))
340 (symbol :scs (descriptor-reg)))
341 (:temporary (:sc unsigned-reg) temp bsp)
343 (load-symbol-value bsp *binding-stack-pointer*)
344 (loadw temp symbol symbol-value-slot other-pointer-lowtag)
345 (inst add bsp (* binding-size n-word-bytes))
346 (store-symbol-value bsp *binding-stack-pointer*)
347 (storew temp bsp (- binding-value-slot binding-size))
348 (storew symbol bsp (- binding-symbol-slot binding-size))
349 (storew val symbol symbol-value-slot other-pointer-lowtag)))
353 (:temporary (:sc unsigned-reg) temp bsp tls-index)
355 (load-binding-stack-pointer bsp)
356 ;; Load SYMBOL from stack, and get the TLS-INDEX
357 (loadw temp bsp (- binding-symbol-slot binding-size))
358 (loadw tls-index temp symbol-tls-index-slot other-pointer-lowtag)
359 ;; Load VALUE from stack, the restore it to the TLS area.
360 (loadw temp bsp (- binding-value-slot binding-size))
361 (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)
363 ;; Zero out the stack.
364 (storew 0 bsp (- binding-symbol-slot binding-size))
365 (storew 0 bsp (- binding-value-slot binding-size))
366 (inst sub bsp (* binding-size n-word-bytes))
367 (store-binding-stack-pointer bsp)))
371 (:temporary (:sc unsigned-reg) symbol value bsp)
373 (load-symbol-value bsp *binding-stack-pointer*)
374 (loadw symbol bsp (- binding-symbol-slot binding-size))
375 (loadw value bsp (- binding-value-slot binding-size))
376 (storew value symbol symbol-value-slot other-pointer-lowtag)
377 (storew 0 bsp (- binding-symbol-slot binding-size))
378 (storew 0 bsp (- binding-value-slot binding-size))
379 (inst sub bsp (* binding-size n-word-bytes))
380 (store-symbol-value bsp *binding-stack-pointer*)))
382 (define-vop (unbind-to-here)
383 (:args (where :scs (descriptor-reg any-reg)))
384 (:temporary (:sc unsigned-reg) symbol value bsp #!+sb-thread tls-index)
386 (load-binding-stack-pointer bsp)
391 (loadw symbol bsp (- binding-symbol-slot binding-size))
392 (inst test symbol symbol)
394 ;; Bind stack debug sentinels have the unbound marker in the symbol slot
395 (inst cmp symbol unbound-marker-widetag)
397 (loadw value bsp (- binding-value-slot binding-size))
399 (storew value symbol symbol-value-slot other-pointer-lowtag)
401 (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
403 (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)
405 (storew 0 bsp (- binding-symbol-slot binding-size))
408 (storew 0 bsp (- binding-value-slot binding-size))
409 (inst sub bsp (* binding-size n-word-bytes))
412 (store-binding-stack-pointer bsp)
416 (define-vop (bind-sentinel)
417 (:temporary (:sc unsigned-reg) bsp)
419 (load-binding-stack-pointer bsp)
420 (inst add bsp (* binding-size n-word-bytes))
421 (storew unbound-marker-widetag bsp (- binding-symbol-slot binding-size))
422 (storew rbp-tn bsp (- binding-value-slot binding-size))
423 (store-binding-stack-pointer bsp)))
425 (define-vop (unbind-sentinel)
426 (:temporary (:sc unsigned-reg) bsp)
428 (load-binding-stack-pointer bsp)
429 (storew 0 bsp (- binding-value-slot binding-size))
430 (storew 0 bsp (- binding-symbol-slot binding-size))
431 (inst sub bsp (* binding-size n-word-bytes))
432 (store-binding-stack-pointer bsp)))
437 ;;;; closure indexing
439 (define-full-reffer closure-index-ref *
440 closure-info-offset fun-pointer-lowtag
441 (any-reg descriptor-reg) * %closure-index-ref)
443 (define-full-setter set-funcallable-instance-info *
444 funcallable-instance-info-offset fun-pointer-lowtag
445 (any-reg descriptor-reg) * %set-funcallable-instance-info)
447 (define-full-reffer funcallable-instance-info *
448 funcallable-instance-info-offset fun-pointer-lowtag
449 (descriptor-reg any-reg) * %funcallable-instance-info)
451 (define-vop (closure-ref slot-ref)
452 (:variant closure-info-offset fun-pointer-lowtag))
454 (define-vop (closure-init slot-set)
455 (:variant closure-info-offset fun-pointer-lowtag))
457 (define-vop (closure-init-from-fp)
458 (:args (object :scs (descriptor-reg)))
461 (storew rbp-tn object (+ closure-info-offset offset) fun-pointer-lowtag)))
463 ;;;; value cell hackery
465 (define-vop (value-cell-ref cell-ref)
466 (:variant value-cell-value-slot other-pointer-lowtag))
468 (define-vop (value-cell-set cell-set)
469 (:variant value-cell-value-slot other-pointer-lowtag))
471 ;;;; structure hackery
473 (define-vop (instance-length)
475 (:translate %instance-length)
476 (:args (struct :scs (descriptor-reg)))
477 (:results (res :scs (unsigned-reg)))
478 (:result-types positive-fixnum)
480 (loadw res struct 0 instance-pointer-lowtag)
481 (inst shr res n-widetag-bits)))
483 (define-full-reffer instance-index-ref * instance-slots-offset
484 instance-pointer-lowtag (any-reg descriptor-reg) * %instance-ref)
486 (define-full-setter instance-index-set * instance-slots-offset
487 instance-pointer-lowtag (any-reg descriptor-reg) * %instance-set)
489 (define-full-compare-and-swap %compare-and-swap-instance-ref instance
490 instance-slots-offset instance-pointer-lowtag
491 (any-reg descriptor-reg) *
492 %compare-and-swap-instance-ref)
494 ;;;; code object frobbing
496 (define-full-reffer code-header-ref * 0 other-pointer-lowtag
497 (any-reg descriptor-reg) * code-header-ref)
499 (define-full-setter code-header-set * 0 other-pointer-lowtag
500 (any-reg descriptor-reg) * code-header-set)
502 ;;;; raw instance slot accessors
504 (defun make-ea-for-raw-slot (object instance-length
505 &key (index nil) (adjustment 0) (scale 1))
506 (if (integerp instance-length)
507 ;; For RAW-INSTANCE-INIT/* VOPs, which know the exact instance length
511 :disp (+ (* (- instance-length instance-slots-offset index)
513 (- instance-pointer-lowtag)
517 (make-ea :qword :base object :index instance-length :scale scale
518 :disp (+ (* (1- instance-slots-offset) n-word-bytes)
519 (- instance-pointer-lowtag)
522 (make-ea :qword :base object :index instance-length
524 :disp (+ (* (1- instance-slots-offset) n-word-bytes)
525 (- instance-pointer-lowtag)
527 (* index (- n-word-bytes))))))))
529 (define-vop (raw-instance-ref/word)
530 (:translate %raw-instance-ref/word)
532 (:args (object :scs (descriptor-reg)) (index :scs (any-reg)))
533 (:arg-types * tagged-num)
534 (:temporary (:sc unsigned-reg) tmp)
535 (:results (value :scs (unsigned-reg)))
536 (:result-types unsigned-num)
538 (loadw tmp object 0 instance-pointer-lowtag)
539 (inst shr tmp n-widetag-bits)
540 (inst shl tmp n-fixnum-tag-bits)
542 (inst mov value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
544 (define-vop (raw-instance-ref-c/word)
545 (:translate %raw-instance-ref/word)
547 (:args (object :scs (descriptor-reg)))
548 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
549 #.instance-pointer-lowtag
550 #.instance-slots-offset)))
552 (:temporary (:sc unsigned-reg) tmp)
553 (:results (value :scs (unsigned-reg)))
554 (:result-types unsigned-num)
556 (loadw tmp object 0 instance-pointer-lowtag)
557 (inst shr tmp n-widetag-bits)
558 (inst mov value (make-ea-for-raw-slot object tmp :index index))))
560 (define-vop (raw-instance-set/word)
561 (:translate %raw-instance-set/word)
563 (:args (object :scs (descriptor-reg))
564 (index :scs (any-reg))
565 (value :scs (unsigned-reg) :target result))
566 (:arg-types * tagged-num unsigned-num)
567 (:temporary (:sc unsigned-reg) tmp)
568 (:results (result :scs (unsigned-reg)))
569 (:result-types unsigned-num)
571 (loadw tmp object 0 instance-pointer-lowtag)
572 (inst shr tmp n-widetag-bits)
573 (inst shl tmp n-fixnum-tag-bits)
575 (inst mov (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)
576 (move result value)))
578 (define-vop (raw-instance-set-c/word)
579 (:translate %raw-instance-set/word)
581 (:args (object :scs (descriptor-reg))
582 (value :scs (unsigned-reg) :target result))
583 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
584 #.instance-pointer-lowtag
585 #.instance-slots-offset))
588 (:temporary (:sc unsigned-reg) tmp)
589 (:results (result :scs (unsigned-reg)))
590 (:result-types unsigned-num)
592 (loadw tmp object 0 instance-pointer-lowtag)
593 (inst shr tmp n-widetag-bits)
594 (inst mov (make-ea-for-raw-slot object tmp :index index) value)
595 (move result value)))
597 (define-vop (raw-instance-init/word)
598 (:args (object :scs (descriptor-reg))
599 (value :scs (unsigned-reg)))
600 (:arg-types * unsigned-num)
601 (:info instance-length index)
603 (inst mov (make-ea-for-raw-slot object instance-length :index index) value)))
605 (define-vop (raw-instance-atomic-incf-c/word)
606 (:translate %raw-instance-atomic-incf/word)
608 (:args (object :scs (descriptor-reg))
609 (diff :scs (unsigned-reg) :target result))
610 (:arg-types * (:constant (load/store-index #.n-word-bytes
611 #.instance-pointer-lowtag
612 #.instance-slots-offset))
615 (:temporary (:sc unsigned-reg) tmp)
616 (:results (result :scs (unsigned-reg)))
617 (:result-types unsigned-num)
619 (loadw tmp object 0 instance-pointer-lowtag)
620 (inst shr tmp n-widetag-bits)
621 (inst xadd (make-ea-for-raw-slot object tmp :index index) diff :lock)
624 (define-vop (raw-instance-ref/single)
625 (:translate %raw-instance-ref/single)
627 (:args (object :scs (descriptor-reg))
628 (index :scs (any-reg)))
629 (:arg-types * positive-fixnum)
630 (:temporary (:sc unsigned-reg) tmp)
631 (:results (value :scs (single-reg)))
632 (:result-types single-float)
634 (loadw tmp object 0 instance-pointer-lowtag)
635 (inst shr tmp n-widetag-bits)
636 (inst shl tmp n-fixnum-tag-bits)
638 (inst movss value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
640 (define-vop (raw-instance-ref-c/single)
641 (:translate %raw-instance-ref/single)
643 (:args (object :scs (descriptor-reg)))
644 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
645 #.instance-pointer-lowtag
646 #.instance-slots-offset)))
648 (:temporary (:sc unsigned-reg) tmp)
649 (:results (value :scs (single-reg)))
650 (:result-types single-float)
652 (loadw tmp object 0 instance-pointer-lowtag)
653 (inst shr tmp n-widetag-bits)
654 (inst movss value (make-ea-for-raw-slot object tmp :index index))))
656 (define-vop (raw-instance-set/single)
657 (:translate %raw-instance-set/single)
659 (:args (object :scs (descriptor-reg))
660 (index :scs (any-reg))
661 (value :scs (single-reg) :target result))
662 (:arg-types * positive-fixnum single-float)
663 (:temporary (:sc unsigned-reg) tmp)
664 (:results (result :scs (single-reg)))
665 (:result-types single-float)
667 (loadw tmp object 0 instance-pointer-lowtag)
668 (inst shr tmp n-widetag-bits)
669 (inst shl tmp n-fixnum-tag-bits)
671 (inst movss (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)
672 (move result value)))
674 (define-vop (raw-instance-set-c/single)
675 (:translate %raw-instance-set/single)
677 (:args (object :scs (descriptor-reg))
678 (value :scs (single-reg) :target result))
679 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
680 #.instance-pointer-lowtag
681 #.instance-slots-offset))
684 (:temporary (:sc unsigned-reg) tmp)
685 (:results (result :scs (single-reg)))
686 (:result-types single-float)
688 (loadw tmp object 0 instance-pointer-lowtag)
689 (inst shr tmp n-widetag-bits)
690 (inst movss (make-ea-for-raw-slot object tmp :index index) value)
691 (move result value)))
693 (define-vop (raw-instance-init/single)
694 (:args (object :scs (descriptor-reg))
695 (value :scs (single-reg)))
696 (:arg-types * single-float)
697 (:info instance-length index)
699 (inst movss (make-ea-for-raw-slot object instance-length :index index) value)))
701 (define-vop (raw-instance-ref/double)
702 (:translate %raw-instance-ref/double)
704 (:args (object :scs (descriptor-reg))
705 (index :scs (any-reg)))
706 (:arg-types * positive-fixnum)
707 (:temporary (:sc unsigned-reg) tmp)
708 (:results (value :scs (double-reg)))
709 (:result-types double-float)
711 (loadw tmp object 0 instance-pointer-lowtag)
712 (inst shr tmp n-widetag-bits)
713 (inst shl tmp n-fixnum-tag-bits)
715 (inst movsd value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
717 (define-vop (raw-instance-ref-c/double)
718 (:translate %raw-instance-ref/double)
720 (:args (object :scs (descriptor-reg)))
721 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
722 #.instance-pointer-lowtag
723 #.instance-slots-offset)))
725 (:temporary (:sc unsigned-reg) tmp)
726 (:results (value :scs (double-reg)))
727 (:result-types double-float)
729 (loadw tmp object 0 instance-pointer-lowtag)
730 (inst shr tmp n-widetag-bits)
731 (inst movsd value (make-ea-for-raw-slot object tmp :index index))))
733 (define-vop (raw-instance-set/double)
734 (:translate %raw-instance-set/double)
736 (:args (object :scs (descriptor-reg))
737 (index :scs (any-reg))
738 (value :scs (double-reg) :target result))
739 (:arg-types * positive-fixnum double-float)
740 (:temporary (:sc unsigned-reg) tmp)
741 (:results (result :scs (double-reg)))
742 (:result-types double-float)
744 (loadw tmp object 0 instance-pointer-lowtag)
745 (inst shr tmp n-widetag-bits)
746 (inst shl tmp n-fixnum-tag-bits)
748 (inst movsd (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)
749 (move result value)))
751 (define-vop (raw-instance-set-c/double)
752 (:translate %raw-instance-set/double)
754 (:args (object :scs (descriptor-reg))
755 (value :scs (double-reg) :target result))
756 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
757 #.instance-pointer-lowtag
758 #.instance-slots-offset))
761 (:temporary (:sc unsigned-reg) tmp)
762 (:results (result :scs (double-reg)))
763 (:result-types double-float)
765 (loadw tmp object 0 instance-pointer-lowtag)
766 (inst shr tmp n-widetag-bits)
767 (inst movsd (make-ea-for-raw-slot object tmp :index index) value)
768 (move result value)))
770 (define-vop (raw-instance-init/double)
771 (:args (object :scs (descriptor-reg))
772 (value :scs (double-reg)))
773 (:arg-types * double-float)
774 (:info instance-length index)
776 (inst movsd (make-ea-for-raw-slot object instance-length :index index) value)))
778 (define-vop (raw-instance-ref/complex-single)
779 (:translate %raw-instance-ref/complex-single)
781 (:args (object :scs (descriptor-reg))
782 (index :scs (any-reg)))
783 (:arg-types * positive-fixnum)
784 (:temporary (:sc unsigned-reg) tmp)
785 (:results (value :scs (complex-single-reg)))
786 (:result-types complex-single-float)
788 (loadw tmp object 0 instance-pointer-lowtag)
789 (inst shr tmp n-widetag-bits)
790 (inst shl tmp n-fixnum-tag-bits)
792 (inst movq value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
794 (define-vop (raw-instance-ref-c/complex-single)
795 (:translate %raw-instance-ref/complex-single)
797 (:args (object :scs (descriptor-reg)))
798 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
799 #.instance-pointer-lowtag
800 #.instance-slots-offset)))
802 (:temporary (:sc unsigned-reg) tmp)
803 (:results (value :scs (complex-single-reg)))
804 (:result-types complex-single-float)
806 (loadw tmp object 0 instance-pointer-lowtag)
807 (inst shr tmp n-widetag-bits)
808 (inst movq value (make-ea-for-raw-slot object tmp :index index))))
810 (define-vop (raw-instance-set/complex-single)
811 (:translate %raw-instance-set/complex-single)
813 (:args (object :scs (descriptor-reg))
814 (index :scs (any-reg))
815 (value :scs (complex-single-reg) :target result))
816 (:arg-types * positive-fixnum complex-single-float)
817 (:temporary (:sc unsigned-reg) tmp)
818 (:results (result :scs (complex-single-reg)))
819 (:result-types complex-single-float)
821 (loadw tmp object 0 instance-pointer-lowtag)
822 (inst shr tmp n-widetag-bits)
823 (inst shl tmp n-fixnum-tag-bits)
826 (inst movq (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)))
828 (define-vop (raw-instance-set-c/complex-single)
829 (:translate %raw-instance-set/complex-single)
831 (:args (object :scs (descriptor-reg))
832 (value :scs (complex-single-reg) :target result))
833 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
834 #.instance-pointer-lowtag
835 #.instance-slots-offset))
836 complex-single-float)
838 (:temporary (:sc unsigned-reg) tmp)
839 (:results (result :scs (complex-single-reg)))
840 (:result-types complex-single-float)
842 (loadw tmp object 0 instance-pointer-lowtag)
843 (inst shr tmp n-widetag-bits)
845 (inst movq (make-ea-for-raw-slot object tmp :index index) value)))
847 (define-vop (raw-instance-init/complex-single)
848 (:args (object :scs (descriptor-reg))
849 (value :scs (complex-single-reg)))
850 (:arg-types * complex-single-float)
851 (:info instance-length index)
853 (inst movq (make-ea-for-raw-slot object instance-length :index index) value)))
855 (define-vop (raw-instance-ref/complex-double)
856 (:translate %raw-instance-ref/complex-double)
858 (:args (object :scs (descriptor-reg))
859 (index :scs (any-reg)))
860 (:arg-types * positive-fixnum)
861 (:temporary (:sc unsigned-reg) tmp)
862 (:results (value :scs (complex-double-reg)))
863 (:result-types complex-double-float)
865 (loadw tmp object 0 instance-pointer-lowtag)
866 (inst shr tmp n-widetag-bits)
867 (inst shl tmp n-fixnum-tag-bits)
869 (inst movdqu value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :adjustment -8))))
871 (define-vop (raw-instance-ref-c/complex-double)
872 (:translate %raw-instance-ref/complex-double)
874 (:args (object :scs (descriptor-reg)))
875 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
876 #.instance-pointer-lowtag
877 #.instance-slots-offset)))
879 (:temporary (:sc unsigned-reg) tmp)
880 (:results (value :scs (complex-double-reg)))
881 (:result-types complex-double-float)
883 (loadw tmp object 0 instance-pointer-lowtag)
884 (inst shr tmp n-widetag-bits)
885 (inst movdqu value (make-ea-for-raw-slot object tmp :index index :adjustment -8))))
887 (define-vop (raw-instance-set/complex-double)
888 (:translate %raw-instance-set/complex-double)
890 (:args (object :scs (descriptor-reg))
891 (index :scs (any-reg))
892 (value :scs (complex-double-reg) :target result))
893 (:arg-types * positive-fixnum complex-double-float)
894 (:temporary (:sc unsigned-reg) tmp)
895 (:results (result :scs (complex-double-reg)))
896 (:result-types complex-double-float)
898 (loadw tmp object 0 instance-pointer-lowtag)
899 (inst shr tmp n-widetag-bits)
900 (inst shl tmp n-fixnum-tag-bits)
903 (inst movdqu (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :adjustment -8) value)))
905 (define-vop (raw-instance-set-c/complex-double)
906 (:translate %raw-instance-set/complex-double)
908 (:args (object :scs (descriptor-reg))
909 (value :scs (complex-double-reg) :target result))
910 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
911 #.instance-pointer-lowtag
912 #.instance-slots-offset))
913 complex-double-float)
915 (:temporary (:sc unsigned-reg) tmp)
916 (:results (result :scs (complex-double-reg)))
917 (:result-types complex-double-float)
919 (loadw tmp object 0 instance-pointer-lowtag)
920 (inst shr tmp n-widetag-bits)
922 (inst movdqu (make-ea-for-raw-slot object tmp :index index :adjustment -8) value)))
924 (define-vop (raw-instance-init/complex-double)
925 (:args (object :scs (descriptor-reg))
926 (value :scs (complex-double-reg)))
927 (:arg-types * complex-double-float)
928 (:info instance-length index)
930 (inst movdqu (make-ea-for-raw-slot object instance-length :index index :adjustment -8) value)))