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)))
62 (inst cmpxchg (make-ea :qword :base object
63 :disp (- (* offset n-word-bytes) lowtag))
67 ;;;; symbol hacking VOPs
69 (define-vop (%compare-and-swap-symbol-value)
70 (:translate %compare-and-swap-symbol-value)
71 (:args (symbol :scs (descriptor-reg) :to (:result 1))
72 (old :scs (descriptor-reg any-reg) :target rax)
73 (new :scs (descriptor-reg any-reg)))
74 (:temporary (:sc descriptor-reg :offset rax-offset) rax)
76 (:temporary (:sc descriptor-reg) tls)
77 (:results (result :scs (descriptor-reg any-reg)))
81 ;; This code has two pathological cases: NO-TLS-VALUE-MARKER
82 ;; or UNBOUND-MARKER as NEW: in either case we would end up
83 ;; doing possible damage with CMPXCHG -- so don't do that!
84 (let ((unbound (generate-error-code vop 'unbound-symbol-error symbol))
89 (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag)
90 ;; Thread-local area, no LOCK needed.
91 (inst cmpxchg (make-ea :qword :base thread-base-tn
94 (inst cmp rax no-tls-value-marker-widetag)
97 (inst cmpxchg (make-ea :qword :base symbol
98 :disp (- (* symbol-value-slot n-word-bytes)
104 (inst cmp result unbound-marker-widetag)
105 (inst jmp :e unbound))))
107 (define-vop (%set-symbol-global-value cell-set)
108 (:variant symbol-value-slot other-pointer-lowtag))
110 (define-vop (fast-symbol-global-value cell-ref)
111 (:variant symbol-value-slot other-pointer-lowtag)
113 (:translate symbol-global-value))
115 (define-vop (symbol-global-value)
117 (:translate symbol-global-value)
118 (:args (object :scs (descriptor-reg) :to (:result 1)))
119 (:results (value :scs (descriptor-reg any-reg)))
121 (:save-p :compute-only)
123 (let ((err-lab (generate-error-code vop 'unbound-symbol-error object)))
124 (loadw value object symbol-value-slot other-pointer-lowtag)
125 (inst cmp value unbound-marker-widetag)
126 (inst jmp :e err-lab))))
131 (:args (symbol :scs (descriptor-reg))
132 (value :scs (descriptor-reg any-reg)))
133 (:temporary (:sc descriptor-reg) tls)
135 (let ((global-val (gen-label))
137 (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag)
138 (inst cmp (make-ea :qword :base thread-base-tn :scale 1 :index tls)
139 no-tls-value-marker-widetag)
140 (inst jmp :z global-val)
141 (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls)
144 (emit-label global-val)
145 (storew value symbol symbol-value-slot other-pointer-lowtag)
148 ;; With Symbol-Value, we check that the value isn't the trap object. So
149 ;; Symbol-Value of NIL is NIL.
150 (define-vop (symbol-value)
151 (:translate symbol-value)
153 (:args (object :scs (descriptor-reg) :to (:result 1)))
154 (:results (value :scs (descriptor-reg any-reg)))
156 (:save-p :compute-only)
158 (let* ((check-unbound-label (gen-label))
159 (err-lab (generate-error-code vop 'unbound-symbol-error object))
160 (ret-lab (gen-label)))
161 (loadw value object symbol-tls-index-slot other-pointer-lowtag)
162 (inst mov value (make-ea :qword :base thread-base-tn
163 :index value :scale 1))
164 (inst cmp value no-tls-value-marker-widetag)
165 (inst jmp :ne check-unbound-label)
166 (loadw value object symbol-value-slot other-pointer-lowtag)
167 (emit-label check-unbound-label)
168 (inst cmp value unbound-marker-widetag)
169 (inst jmp :e err-lab)
170 (emit-label ret-lab))))
172 (define-vop (fast-symbol-value symbol-value)
173 ;; KLUDGE: not really fast, in fact, because we're going to have to
174 ;; do a full lookup of the thread-local area anyway. But half of
175 ;; the meaning of FAST-SYMBOL-VALUE is "do not signal an error if
176 ;; unbound", which is used in the implementation of COPY-SYMBOL. --
179 (:translate symbol-value)
181 (let ((ret-lab (gen-label)))
182 (loadw value object symbol-tls-index-slot other-pointer-lowtag)
184 (make-ea :qword :base thread-base-tn :index value :scale 1))
185 (inst cmp value no-tls-value-marker-widetag)
186 (inst jmp :ne ret-lab)
187 (loadw value object symbol-value-slot other-pointer-lowtag)
188 (emit-label ret-lab)))))
192 (define-vop (symbol-value symbol-global-value)
193 (:translate symbol-value))
194 (define-vop (fast-symbol-value fast-symbol-global-value)
195 (:translate symbol-value))
196 (define-vop (set %set-symbol-global-value)))
202 (:args (object :scs (descriptor-reg)))
204 (:temporary (:sc descriptor-reg #+nil(:from (:argument 0))) value)
206 (let ((check-unbound-label (gen-label)))
207 (loadw value object symbol-tls-index-slot other-pointer-lowtag)
209 (make-ea :qword :base thread-base-tn :index value :scale 1))
210 (inst cmp value no-tls-value-marker-widetag)
211 (inst jmp :ne check-unbound-label)
212 (loadw value object symbol-value-slot other-pointer-lowtag)
213 (emit-label check-unbound-label)
214 (inst cmp value unbound-marker-widetag))))
220 (:args (object :scs (descriptor-reg)))
223 (inst cmp (make-ea-for-object-slot object symbol-value-slot
224 other-pointer-lowtag)
225 unbound-marker-widetag)))
228 (define-vop (symbol-hash)
230 (:translate symbol-hash)
231 (:args (symbol :scs (descriptor-reg)))
232 (:results (res :scs (any-reg)))
233 (:result-types positive-fixnum)
235 ;; The symbol-hash slot of NIL holds NIL because it is also the
236 ;; cdr slot, so we have to strip off the three low bits to make sure
237 ;; it is a fixnum. The lowtag selection magic that is required to
238 ;; ensure this is explained in the comment in objdef.lisp
239 (loadw res symbol symbol-hash-slot other-pointer-lowtag)
240 (inst and res (lognot #b111))))
242 ;;;; fdefinition (FDEFN) objects
244 (define-vop (fdefn-fun cell-ref) ; /pfw - alpha
245 (:variant fdefn-fun-slot other-pointer-lowtag))
247 (define-vop (safe-fdefn-fun)
248 (:args (object :scs (descriptor-reg) :to (:result 1)))
249 (:results (value :scs (descriptor-reg any-reg)))
251 (:save-p :compute-only)
253 (loadw value object fdefn-fun-slot other-pointer-lowtag)
254 (inst cmp value nil-value)
255 (let ((err-lab (generate-error-code vop 'undefined-fun-error object)))
256 (inst jmp :e err-lab))))
258 (define-vop (set-fdefn-fun)
260 (:translate (setf fdefn-fun))
261 (:args (function :scs (descriptor-reg) :target result)
262 (fdefn :scs (descriptor-reg)))
263 (:temporary (:sc unsigned-reg) raw)
264 (:temporary (:sc byte-reg) type)
265 (:results (result :scs (descriptor-reg)))
267 (load-type type function (- fun-pointer-lowtag))
269 (make-ea :byte :base function
270 :disp (- (* simple-fun-code-offset n-word-bytes)
271 fun-pointer-lowtag)))
272 (inst cmp type simple-fun-header-widetag)
273 (inst jmp :e NORMAL-FUN)
274 (inst lea raw (make-fixup "closure_tramp" :foreign))
276 (storew function fdefn fdefn-fun-slot other-pointer-lowtag)
277 (storew raw fdefn fdefn-raw-addr-slot other-pointer-lowtag)
278 (move result function)))
280 (define-vop (fdefn-makunbound)
282 (:translate fdefn-makunbound)
283 (:args (fdefn :scs (descriptor-reg) :target result))
284 (:results (result :scs (descriptor-reg)))
286 (storew nil-value fdefn fdefn-fun-slot other-pointer-lowtag)
287 (storew (make-fixup "undefined_tramp" :foreign)
288 fdefn fdefn-raw-addr-slot other-pointer-lowtag)
289 (move result fdefn)))
291 ;;;; binding and unbinding
293 ;;; BIND -- Establish VAL as a binding for SYMBOL. Save the old value and
294 ;;; the symbol on the binding stack and stuff the new value into the
299 (:args (val :scs (any-reg descriptor-reg))
300 (symbol :scs (descriptor-reg)))
301 (:temporary (:sc unsigned-reg) tls-index bsp)
303 (let ((tls-index-valid (gen-label)))
304 (load-binding-stack-pointer bsp)
305 (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
306 (inst add bsp (* binding-size n-word-bytes))
307 (store-binding-stack-pointer bsp)
308 (inst or tls-index tls-index)
309 (inst jmp :ne tls-index-valid)
310 (inst mov tls-index symbol)
311 (inst lea temp-reg-tn
312 (make-ea :qword :disp
313 (make-fixup (ecase (tn-offset tls-index)
314 (#.rax-offset 'alloc-tls-index-in-rax)
315 (#.rcx-offset 'alloc-tls-index-in-rcx)
316 (#.rdx-offset 'alloc-tls-index-in-rdx)
317 (#.rbx-offset 'alloc-tls-index-in-rbx)
318 (#.rsi-offset 'alloc-tls-index-in-rsi)
319 (#.rdi-offset 'alloc-tls-index-in-rdi)
320 (#.r8-offset 'alloc-tls-index-in-r8)
321 (#.r9-offset 'alloc-tls-index-in-r9)
322 (#.r10-offset 'alloc-tls-index-in-r10)
323 (#.r12-offset 'alloc-tls-index-in-r12)
324 (#.r13-offset 'alloc-tls-index-in-r13)
325 (#.r14-offset 'alloc-tls-index-in-r14)
326 (#.r15-offset 'alloc-tls-index-in-r15))
328 (inst call temp-reg-tn)
329 (emit-label tls-index-valid)
330 (inst push (make-ea :qword :base thread-base-tn :scale 1 :index tls-index))
331 (popw bsp (- binding-value-slot binding-size))
332 (storew symbol bsp (- binding-symbol-slot binding-size))
333 (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)
338 (:args (val :scs (any-reg descriptor-reg))
339 (symbol :scs (descriptor-reg)))
340 (:temporary (:sc unsigned-reg) temp bsp)
342 (load-symbol-value bsp *binding-stack-pointer*)
343 (loadw temp symbol symbol-value-slot other-pointer-lowtag)
344 (inst add bsp (* binding-size n-word-bytes))
345 (store-symbol-value bsp *binding-stack-pointer*)
346 (storew temp bsp (- binding-value-slot binding-size))
347 (storew symbol bsp (- binding-symbol-slot binding-size))
348 (storew val symbol symbol-value-slot other-pointer-lowtag)))
352 (:temporary (:sc unsigned-reg) temp bsp tls-index)
354 (load-binding-stack-pointer bsp)
355 ;; Load SYMBOL from stack, and get the TLS-INDEX
356 (loadw temp bsp (- binding-symbol-slot binding-size))
357 (loadw tls-index temp symbol-tls-index-slot other-pointer-lowtag)
358 ;; Load VALUE from stack, the restore it to the TLS area.
359 (loadw temp bsp (- binding-value-slot binding-size))
360 (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)
362 ;; Zero out the stack.
363 (storew 0 bsp (- binding-symbol-slot binding-size))
364 (storew 0 bsp (- binding-value-slot binding-size))
365 (inst sub bsp (* binding-size n-word-bytes))
366 (store-binding-stack-pointer bsp)))
370 (:temporary (:sc unsigned-reg) symbol value bsp)
372 (load-symbol-value bsp *binding-stack-pointer*)
373 (loadw symbol bsp (- binding-symbol-slot binding-size))
374 (loadw value bsp (- binding-value-slot binding-size))
375 (storew value symbol symbol-value-slot other-pointer-lowtag)
376 (storew 0 bsp (- binding-symbol-slot binding-size))
377 (storew 0 bsp (- binding-value-slot binding-size))
378 (inst sub bsp (* binding-size n-word-bytes))
379 (store-symbol-value bsp *binding-stack-pointer*)))
381 (define-vop (unbind-to-here)
382 (:args (where :scs (descriptor-reg any-reg)))
383 (:temporary (:sc unsigned-reg) symbol value bsp #!+sb-thread tls-index)
385 (load-binding-stack-pointer bsp)
390 (loadw symbol bsp (- binding-symbol-slot binding-size))
391 (inst or symbol symbol)
393 ;; Bind stack debug sentinels have the unbound marker in the symbol slot
394 (inst cmp symbol unbound-marker-widetag)
396 (loadw value bsp (- binding-value-slot binding-size))
398 (storew value symbol symbol-value-slot other-pointer-lowtag)
400 (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
402 (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)
404 (storew 0 bsp (- binding-symbol-slot binding-size))
407 (storew 0 bsp (- binding-value-slot binding-size))
408 (inst sub bsp (* binding-size n-word-bytes))
411 (store-binding-stack-pointer bsp)
415 (define-vop (bind-sentinel)
416 (:temporary (:sc unsigned-reg) bsp)
418 (load-binding-stack-pointer bsp)
419 (inst add bsp (* binding-size n-word-bytes))
420 (storew unbound-marker-widetag bsp (- binding-symbol-slot binding-size))
421 (storew rbp-tn bsp (- binding-value-slot binding-size))
422 (store-binding-stack-pointer bsp)))
424 (define-vop (unbind-sentinel)
425 (:temporary (:sc unsigned-reg) bsp)
427 (load-binding-stack-pointer bsp)
428 (storew 0 bsp (- binding-value-slot binding-size))
429 (storew 0 bsp (- binding-symbol-slot binding-size))
430 (inst sub bsp (* binding-size n-word-bytes))
431 (store-binding-stack-pointer bsp)))
436 ;;;; closure indexing
438 (define-full-reffer closure-index-ref *
439 closure-info-offset fun-pointer-lowtag
440 (any-reg descriptor-reg) * %closure-index-ref)
442 (define-full-setter set-funcallable-instance-info *
443 funcallable-instance-info-offset fun-pointer-lowtag
444 (any-reg descriptor-reg) * %set-funcallable-instance-info)
446 (define-full-reffer funcallable-instance-info *
447 funcallable-instance-info-offset fun-pointer-lowtag
448 (descriptor-reg any-reg) * %funcallable-instance-info)
450 (define-vop (closure-ref slot-ref)
451 (:variant closure-info-offset fun-pointer-lowtag))
453 (define-vop (closure-init slot-set)
454 (:variant closure-info-offset fun-pointer-lowtag))
456 (define-vop (closure-init-from-fp)
457 (:args (object :scs (descriptor-reg)))
460 (storew rbp-tn object (+ closure-info-offset offset) fun-pointer-lowtag)))
462 ;;;; value cell hackery
464 (define-vop (value-cell-ref cell-ref)
465 (:variant value-cell-value-slot other-pointer-lowtag))
467 (define-vop (value-cell-set cell-set)
468 (:variant value-cell-value-slot other-pointer-lowtag))
470 ;;;; structure hackery
472 (define-vop (instance-length)
474 (:translate %instance-length)
475 (:args (struct :scs (descriptor-reg)))
476 (:results (res :scs (unsigned-reg)))
477 (:result-types positive-fixnum)
479 (loadw res struct 0 instance-pointer-lowtag)
480 (inst shr res n-widetag-bits)))
482 (define-full-reffer instance-index-ref * instance-slots-offset
483 instance-pointer-lowtag (any-reg descriptor-reg) * %instance-ref)
485 (define-full-setter instance-index-set * instance-slots-offset
486 instance-pointer-lowtag (any-reg descriptor-reg) * %instance-set)
488 (define-full-compare-and-swap %compare-and-swap-instance-ref instance
489 instance-slots-offset instance-pointer-lowtag
490 (any-reg descriptor-reg) *
491 %compare-and-swap-instance-ref)
493 ;;;; code object frobbing
495 (define-full-reffer code-header-ref * 0 other-pointer-lowtag
496 (any-reg descriptor-reg) * code-header-ref)
498 (define-full-setter code-header-set * 0 other-pointer-lowtag
499 (any-reg descriptor-reg) * code-header-set)
501 ;;;; raw instance slot accessors
503 (defun make-ea-for-raw-slot (object index instance-length
504 &optional (adjustment 0))
505 (if (integerp instance-length)
506 ;; For RAW-INSTANCE-INIT/* VOPs, which know the exact instance length
510 :disp (+ (* (- instance-length instance-slots-offset index)
512 (- instance-pointer-lowtag)
516 (make-ea :qword :base object :index instance-length
517 :disp (+ (* (1- instance-slots-offset) n-word-bytes)
518 (- instance-pointer-lowtag)
521 (make-ea :qword :base object :index instance-length
523 :disp (+ (* (1- instance-slots-offset) n-word-bytes)
524 (- instance-pointer-lowtag)
526 (* index (- n-word-bytes))))))))
528 (define-vop (raw-instance-ref/word)
529 (:translate %raw-instance-ref/word)
531 (:args (object :scs (descriptor-reg)) (index :scs (any-reg)))
532 (:arg-types * tagged-num)
533 (:temporary (:sc unsigned-reg) tmp)
534 (:results (value :scs (unsigned-reg)))
535 (:result-types unsigned-num)
537 (loadw tmp object 0 instance-pointer-lowtag)
538 (inst shr tmp n-widetag-bits)
539 (inst shl tmp n-fixnum-tag-bits)
541 (inst mov value (make-ea-for-raw-slot object index tmp))))
543 (define-vop (raw-instance-ref-c/word)
544 (:translate %raw-instance-ref/word)
546 (:args (object :scs (descriptor-reg)))
547 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
548 #.instance-pointer-lowtag
549 #.instance-slots-offset)))
551 (:temporary (:sc unsigned-reg) tmp)
552 (:results (value :scs (unsigned-reg)))
553 (:result-types unsigned-num)
555 (loadw tmp object 0 instance-pointer-lowtag)
556 (inst shr tmp n-widetag-bits)
557 (inst mov value (make-ea-for-raw-slot object index tmp))))
559 (define-vop (raw-instance-set/word)
560 (:translate %raw-instance-set/word)
562 (:args (object :scs (descriptor-reg))
563 (index :scs (any-reg))
564 (value :scs (unsigned-reg) :target result))
565 (:arg-types * tagged-num unsigned-num)
566 (:temporary (:sc unsigned-reg) tmp)
567 (:results (result :scs (unsigned-reg)))
568 (:result-types unsigned-num)
570 (loadw tmp object 0 instance-pointer-lowtag)
571 (inst shr tmp n-widetag-bits)
572 (inst shl tmp n-fixnum-tag-bits)
574 (inst mov (make-ea-for-raw-slot object index tmp) value)
575 (move result value)))
577 (define-vop (raw-instance-set-c/word)
578 (:translate %raw-instance-set/word)
580 (:args (object :scs (descriptor-reg))
581 (value :scs (unsigned-reg) :target result))
582 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
583 #.instance-pointer-lowtag
584 #.instance-slots-offset))
587 (:temporary (:sc unsigned-reg) tmp)
588 (:results (result :scs (unsigned-reg)))
589 (:result-types unsigned-num)
591 (loadw tmp object 0 instance-pointer-lowtag)
592 (inst shr tmp n-widetag-bits)
593 (inst mov (make-ea-for-raw-slot object index tmp) value)
594 (move result value)))
596 (define-vop (raw-instance-init/word)
597 (:args (object :scs (descriptor-reg))
598 (value :scs (unsigned-reg)))
599 (:arg-types * unsigned-num)
600 (:info instance-length index)
602 (inst mov (make-ea-for-raw-slot object index instance-length) value)))
604 (define-vop (raw-instance-atomic-incf-c/word)
605 (:translate %raw-instance-atomic-incf/word)
607 (:args (object :scs (descriptor-reg))
608 (diff :scs (unsigned-reg) :target result))
609 (:arg-types * (:constant (load/store-index #.n-word-bytes
610 #.instance-pointer-lowtag
611 #.instance-slots-offset))
614 (:temporary (:sc unsigned-reg) tmp)
615 (:results (result :scs (unsigned-reg)))
616 (:result-types unsigned-num)
618 (loadw tmp object 0 instance-pointer-lowtag)
619 (inst shr tmp n-widetag-bits)
620 (inst xadd (make-ea-for-raw-slot object index tmp) diff :lock)
623 (define-vop (raw-instance-ref/single)
624 (:translate %raw-instance-ref/single)
626 (:args (object :scs (descriptor-reg))
627 (index :scs (any-reg)))
628 (:arg-types * positive-fixnum)
629 (:temporary (:sc unsigned-reg) tmp)
630 (:results (value :scs (single-reg)))
631 (:result-types single-float)
633 (loadw tmp object 0 instance-pointer-lowtag)
634 (inst shr tmp n-widetag-bits)
635 (inst shl tmp n-fixnum-tag-bits)
637 (inst movss value (make-ea-for-raw-slot object index tmp))))
639 (define-vop (raw-instance-ref-c/single)
640 (:translate %raw-instance-ref/single)
642 (:args (object :scs (descriptor-reg)))
643 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
644 #.instance-pointer-lowtag
645 #.instance-slots-offset)))
647 (:temporary (:sc unsigned-reg) tmp)
648 (:results (value :scs (single-reg)))
649 (:result-types single-float)
651 (loadw tmp object 0 instance-pointer-lowtag)
652 (inst shr tmp n-widetag-bits)
653 (inst movss value (make-ea-for-raw-slot object index tmp))))
655 (define-vop (raw-instance-set/single)
656 (:translate %raw-instance-set/single)
658 (:args (object :scs (descriptor-reg))
659 (index :scs (any-reg))
660 (value :scs (single-reg) :target result))
661 (:arg-types * positive-fixnum single-float)
662 (:temporary (:sc unsigned-reg) tmp)
663 (:results (result :scs (single-reg)))
664 (:result-types single-float)
666 (loadw tmp object 0 instance-pointer-lowtag)
667 (inst shr tmp n-widetag-bits)
668 (inst shl tmp n-fixnum-tag-bits)
670 (inst movss (make-ea-for-raw-slot object index tmp) value)
671 (move result value)))
673 (define-vop (raw-instance-set-c/single)
674 (:translate %raw-instance-set/single)
676 (:args (object :scs (descriptor-reg))
677 (value :scs (single-reg) :target result))
678 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
679 #.instance-pointer-lowtag
680 #.instance-slots-offset))
683 (:temporary (:sc unsigned-reg) tmp)
684 (:results (result :scs (single-reg)))
685 (:result-types single-float)
687 (loadw tmp object 0 instance-pointer-lowtag)
688 (inst shr tmp n-widetag-bits)
689 (inst movss (make-ea-for-raw-slot object index tmp) value)
690 (move result value)))
692 (define-vop (raw-instance-init/single)
693 (:args (object :scs (descriptor-reg))
694 (value :scs (single-reg)))
695 (:arg-types * single-float)
696 (:info instance-length index)
698 (inst movss (make-ea-for-raw-slot object index instance-length) value)))
700 (define-vop (raw-instance-ref/double)
701 (:translate %raw-instance-ref/double)
703 (:args (object :scs (descriptor-reg))
704 (index :scs (any-reg)))
705 (:arg-types * positive-fixnum)
706 (:temporary (:sc unsigned-reg) tmp)
707 (:results (value :scs (double-reg)))
708 (:result-types double-float)
710 (loadw tmp object 0 instance-pointer-lowtag)
711 (inst shr tmp n-widetag-bits)
712 (inst shl tmp n-fixnum-tag-bits)
714 (inst movsd value (make-ea-for-raw-slot object index tmp))))
716 (define-vop (raw-instance-ref-c/double)
717 (:translate %raw-instance-ref/double)
719 (:args (object :scs (descriptor-reg)))
720 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
721 #.instance-pointer-lowtag
722 #.instance-slots-offset)))
724 (:temporary (:sc unsigned-reg) tmp)
725 (:results (value :scs (double-reg)))
726 (:result-types double-float)
728 (loadw tmp object 0 instance-pointer-lowtag)
729 (inst shr tmp n-widetag-bits)
730 (inst movsd value (make-ea-for-raw-slot object index tmp))))
732 (define-vop (raw-instance-set/double)
733 (:translate %raw-instance-set/double)
735 (:args (object :scs (descriptor-reg))
736 (index :scs (any-reg))
737 (value :scs (double-reg) :target result))
738 (:arg-types * positive-fixnum double-float)
739 (:temporary (:sc unsigned-reg) tmp)
740 (:results (result :scs (double-reg)))
741 (:result-types double-float)
743 (loadw tmp object 0 instance-pointer-lowtag)
744 (inst shr tmp n-widetag-bits)
745 (inst shl tmp n-fixnum-tag-bits)
747 (inst movsd (make-ea-for-raw-slot object index tmp) value)
748 (move result value)))
750 (define-vop (raw-instance-set-c/double)
751 (:translate %raw-instance-set/double)
753 (:args (object :scs (descriptor-reg))
754 (value :scs (double-reg) :target result))
755 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
756 #.instance-pointer-lowtag
757 #.instance-slots-offset))
760 (:temporary (:sc unsigned-reg) tmp)
761 (:results (result :scs (double-reg)))
762 (:result-types double-float)
764 (loadw tmp object 0 instance-pointer-lowtag)
765 (inst shr tmp n-widetag-bits)
766 (inst movsd (make-ea-for-raw-slot object index tmp) value)
767 (move result value)))
769 (define-vop (raw-instance-init/double)
770 (:args (object :scs (descriptor-reg))
771 (value :scs (double-reg)))
772 (:arg-types * double-float)
773 (:info instance-length index)
775 (inst movsd (make-ea-for-raw-slot object index instance-length) value)))
777 (define-vop (raw-instance-ref/complex-single)
778 (:translate %raw-instance-ref/complex-single)
780 (:args (object :scs (descriptor-reg))
781 (index :scs (any-reg)))
782 (:arg-types * positive-fixnum)
783 (:temporary (:sc unsigned-reg) tmp)
784 (:results (value :scs (complex-single-reg)))
785 (:result-types complex-single-float)
787 (loadw tmp object 0 instance-pointer-lowtag)
788 (inst shr tmp n-widetag-bits)
789 (inst shl tmp n-fixnum-tag-bits)
791 (inst movq value (make-ea-for-raw-slot object index tmp))))
793 (define-vop (raw-instance-ref-c/complex-single)
794 (:translate %raw-instance-ref/complex-single)
796 (:args (object :scs (descriptor-reg)))
797 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
798 #.instance-pointer-lowtag
799 #.instance-slots-offset)))
801 (:temporary (:sc unsigned-reg) tmp)
802 (:results (value :scs (complex-single-reg)))
803 (:result-types complex-single-float)
805 (loadw tmp object 0 instance-pointer-lowtag)
806 (inst shr tmp n-widetag-bits)
807 (inst movq value (make-ea-for-raw-slot object index tmp))))
809 (define-vop (raw-instance-set/complex-single)
810 (:translate %raw-instance-set/complex-single)
812 (:args (object :scs (descriptor-reg))
813 (index :scs (any-reg))
814 (value :scs (complex-single-reg) :target result))
815 (:arg-types * positive-fixnum complex-single-float)
816 (:temporary (:sc unsigned-reg) tmp)
817 (:results (result :scs (complex-single-reg)))
818 (:result-types complex-single-float)
820 (loadw tmp object 0 instance-pointer-lowtag)
821 (inst shr tmp n-widetag-bits)
822 (inst shl tmp n-fixnum-tag-bits)
825 (inst movq (make-ea-for-raw-slot object index tmp) value)))
827 (define-vop (raw-instance-set-c/complex-single)
828 (:translate %raw-instance-set/complex-single)
830 (:args (object :scs (descriptor-reg))
831 (value :scs (complex-single-reg) :target result))
832 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
833 #.instance-pointer-lowtag
834 #.instance-slots-offset))
835 complex-single-float)
837 (:temporary (:sc unsigned-reg) tmp)
838 (:results (result :scs (complex-single-reg)))
839 (:result-types complex-single-float)
841 (loadw tmp object 0 instance-pointer-lowtag)
842 (inst shr tmp n-widetag-bits)
844 (inst movq (make-ea-for-raw-slot object index tmp) value)))
846 (define-vop (raw-instance-init/complex-single)
847 (:args (object :scs (descriptor-reg))
848 (value :scs (complex-single-reg)))
849 (:arg-types * complex-single-float)
850 (:info instance-length index)
852 (inst movq (make-ea-for-raw-slot object index instance-length) value)))
854 (define-vop (raw-instance-ref/complex-double)
855 (:translate %raw-instance-ref/complex-double)
857 (:args (object :scs (descriptor-reg))
858 (index :scs (any-reg)))
859 (:arg-types * positive-fixnum)
860 (:temporary (:sc unsigned-reg) tmp)
861 (:results (value :scs (complex-double-reg)))
862 (:result-types complex-double-float)
864 (loadw tmp object 0 instance-pointer-lowtag)
865 (inst shr tmp n-widetag-bits)
866 (inst shl tmp n-fixnum-tag-bits)
868 (inst movdqu value (make-ea-for-raw-slot object index tmp -8))))
870 (define-vop (raw-instance-ref-c/complex-double)
871 (:translate %raw-instance-ref/complex-double)
873 (:args (object :scs (descriptor-reg)))
874 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
875 #.instance-pointer-lowtag
876 #.instance-slots-offset)))
878 (:temporary (:sc unsigned-reg) tmp)
879 (:results (value :scs (complex-double-reg)))
880 (:result-types complex-double-float)
882 (loadw tmp object 0 instance-pointer-lowtag)
883 (inst shr tmp n-widetag-bits)
884 (inst movdqu value (make-ea-for-raw-slot object index tmp -8))))
886 (define-vop (raw-instance-set/complex-double)
887 (:translate %raw-instance-set/complex-double)
889 (:args (object :scs (descriptor-reg))
890 (index :scs (any-reg))
891 (value :scs (complex-double-reg) :target result))
892 (:arg-types * positive-fixnum complex-double-float)
893 (:temporary (:sc unsigned-reg) tmp)
894 (:results (result :scs (complex-double-reg)))
895 (:result-types complex-double-float)
897 (loadw tmp object 0 instance-pointer-lowtag)
898 (inst shr tmp n-widetag-bits)
899 (inst shl tmp n-fixnum-tag-bits)
902 (inst movdqu (make-ea-for-raw-slot object index tmp -8) value)))
904 (define-vop (raw-instance-set-c/complex-double)
905 (:translate %raw-instance-set/complex-double)
907 (:args (object :scs (descriptor-reg))
908 (value :scs (complex-double-reg) :target result))
909 (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes
910 #.instance-pointer-lowtag
911 #.instance-slots-offset))
912 complex-double-float)
914 (:temporary (:sc unsigned-reg) tmp)
915 (:results (result :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)
921 (inst movdqu (make-ea-for-raw-slot object index tmp -8) value)))
923 (define-vop (raw-instance-init/complex-double)
924 (:args (object :scs (descriptor-reg))
925 (value :scs (complex-double-reg)))
926 (:arg-types * complex-double-float)
927 (:info instance-length index)
929 (inst movdqu (make-ea-for-raw-slot object index instance-length -8) value)))