1.0.29.38: better DESCRIBE
[sbcl.git] / src / compiler / mips / cell.lisp
1 ;;;; the VM definition of various primitive memory access VOPs for
2 ;;;; MIPS
3
4 ;;;; This software is part of the SBCL system. See the README file for
5 ;;;; more information.
6 ;;;;
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.
12
13 (in-package "SB!VM")
14 \f
15 ;;;; Data object ref/set stuff.
16
17 (define-vop (slot)
18   (:args (object :scs (descriptor-reg)))
19   (:info name offset lowtag)
20   (:ignore name)
21   (:results (result :scs (descriptor-reg any-reg)))
22   (:generator 1
23     (loadw result object offset lowtag)))
24
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)
29   (:ignore name)
30   (:results)
31   (:generator 1
32     (storew value object offset lowtag)))
33
34 \f
35 ;;;; Symbol hacking VOPs:
36
37 ;;; The compiler likes to be able to directly SET symbols.
38 ;;;
39 (define-vop (set cell-set)
40   (:variant symbol-value-slot other-pointer-lowtag))
41
42 ;;; Do a cell ref with an error check for being unbound.
43 ;;;
44 (define-vop (checked-cell-ref)
45   (:args (object :scs (descriptor-reg) :target obj-temp))
46   (:results (value :scs (descriptor-reg any-reg)))
47   (:policy :fast-safe)
48   (:vop-var vop)
49   (:save-p :compute-only)
50   (:temporary (:scs (non-descriptor-reg)) temp)
51   (:temporary (:scs (descriptor-reg) :from (:argument 0)) obj-temp))
52
53 ;;; With Symbol-Value, we check that the value isn't the trap object.  So
54 ;;; Symbol-Value of NIL is NIL.
55 ;;;
56 (define-vop (symbol-value checked-cell-ref)
57   (:translate symbol-value)
58   (:generator 9
59     (move obj-temp object)
60     (loadw value obj-temp symbol-value-slot other-pointer-lowtag)
61     (let ((err-lab (generate-error-code vop unbound-symbol-error obj-temp)))
62       (inst xor temp value unbound-marker-widetag)
63       (inst beq temp err-lab)
64       (inst nop))))
65
66 ;;; Like CHECKED-CELL-REF, only we are a predicate to see if the cell is bound.
67 (define-vop (boundp-frob)
68   (:args (object :scs (descriptor-reg)))
69   (:conditional)
70   (:info target not-p)
71   (:policy :fast-safe)
72   (:temporary (:scs (descriptor-reg)) value)
73   (:temporary (:scs (non-descriptor-reg)) temp))
74
75 (define-vop (boundp boundp-frob)
76   (:translate boundp)
77   (:generator 9
78     (loadw value object symbol-value-slot other-pointer-lowtag)
79     (inst xor temp value unbound-marker-widetag)
80     (if not-p
81         (inst beq temp target)
82         (inst bne temp target))
83     (inst nop)))
84
85 (define-vop (fast-symbol-value cell-ref)
86   (:variant symbol-value-slot other-pointer-lowtag)
87   (:policy :fast)
88   (:translate symbol-value))
89
90 (define-vop (symbol-hash)
91   (:policy :fast-safe)
92   (:translate symbol-hash)
93   (:args (symbol :scs (descriptor-reg)))
94   (:temporary (:scs (non-descriptor-reg)) temp)
95   (:results (res :scs (any-reg)))
96   (:result-types positive-fixnum)
97   (:generator 2
98     ;; The symbol-hash slot of NIL holds NIL because it is also the
99     ;; cdr slot, so we have to strip off the two low bits to make sure
100     ;; it is a fixnum.  The lowtag selection magic that is required to
101     ;; ensure this is explained in the comment in objdef.lisp
102     (loadw temp symbol symbol-hash-slot other-pointer-lowtag)
103     (inst srl temp n-fixnum-tag-bits)
104     (inst sll res temp n-fixnum-tag-bits)))
105
106 ;;; On unithreaded builds these are just copies of the non-global versions.
107 (define-vop (%set-symbol-global-value set))
108 (define-vop (symbol-global-value symbol-value)
109   (:translate symbol-global-value))
110 (define-vop (fast-symbol-global-value fast-symbol-value)
111   (:translate symbol-global-value))
112 \f
113 ;;;; Fdefinition (fdefn) objects.
114
115 (define-vop (fdefn-fun cell-ref)
116   (:variant fdefn-fun-slot other-pointer-lowtag))
117
118 (define-vop (safe-fdefn-fun)
119   (:args (object :scs (descriptor-reg) :target obj-temp))
120   (:results (value :scs (descriptor-reg any-reg)))
121   (:vop-var vop)
122   (:save-p :compute-only)
123   (:temporary (:scs (descriptor-reg) :from (:argument 0)) obj-temp)
124   (:generator 10
125     (move obj-temp object)
126     (loadw value obj-temp fdefn-fun-slot other-pointer-lowtag)
127     (let ((err-lab (generate-error-code vop undefined-fun-error obj-temp)))
128       (inst beq value null-tn err-lab))
129     (inst nop)))
130
131 (define-vop (set-fdefn-fun)
132   (:policy :fast-safe)
133   (:translate (setf fdefn-fun))
134   (:args (function :scs (descriptor-reg) :target result)
135          (fdefn :scs (descriptor-reg)))
136   (:temporary (:scs (interior-reg)) lip)
137   (:temporary (:scs (non-descriptor-reg)) type)
138   (:results (result :scs (descriptor-reg)))
139   (:generator 38
140     (let ((normal-fn (gen-label)))
141       (load-type type function (- fun-pointer-lowtag))
142       (inst nop)
143       (inst xor type simple-fun-header-widetag)
144       (inst beq type normal-fn)
145       (inst addu lip function
146             (- (ash simple-fun-code-offset word-shift)
147                fun-pointer-lowtag))
148       (inst li lip (make-fixup "closure_tramp" :foreign))
149       (emit-label normal-fn)
150       (storew lip fdefn fdefn-raw-addr-slot other-pointer-lowtag)
151       (storew function fdefn fdefn-fun-slot other-pointer-lowtag)
152       (move result function))))
153
154 (define-vop (fdefn-makunbound)
155   (:policy :fast-safe)
156   (:translate fdefn-makunbound)
157   (:args (fdefn :scs (descriptor-reg) :target result))
158   (:temporary (:scs (non-descriptor-reg)) temp)
159   (:results (result :scs (descriptor-reg)))
160   (:generator 38
161     (storew null-tn fdefn fdefn-fun-slot other-pointer-lowtag)
162     (inst li temp (make-fixup "undefined_tramp" :foreign))
163     (storew temp fdefn fdefn-raw-addr-slot other-pointer-lowtag)
164     (move result fdefn)))
165
166
167 \f
168 ;;;; Binding and Unbinding.
169
170 ;;; BIND -- Establish VAL as a binding for SYMBOL.  Save the old value and
171 ;;; the symbol on the binding stack and stuff the new value into the
172 ;;; symbol.
173
174 (define-vop (bind)
175   (:args (val :scs (any-reg descriptor-reg))
176          (symbol :scs (descriptor-reg)))
177   (:temporary (:scs (descriptor-reg)) temp)
178   (:generator 5
179     (loadw temp symbol symbol-value-slot other-pointer-lowtag)
180     (inst addu bsp-tn bsp-tn (* 2 n-word-bytes))
181     (storew temp bsp-tn (- binding-value-slot binding-size))
182     (storew symbol bsp-tn (- binding-symbol-slot binding-size))
183     (storew val symbol symbol-value-slot other-pointer-lowtag)))
184
185
186 (define-vop (unbind)
187   (:temporary (:scs (descriptor-reg)) symbol value)
188   (:generator 0
189     (loadw symbol bsp-tn (- binding-symbol-slot binding-size))
190     (loadw value bsp-tn (- binding-value-slot binding-size))
191     (storew value symbol symbol-value-slot other-pointer-lowtag)
192     (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
193     (storew zero-tn bsp-tn (- binding-value-slot binding-size))
194     (inst addu bsp-tn bsp-tn (* -2 n-word-bytes))))
195
196
197 (define-vop (unbind-to-here)
198   (:args (arg :scs (descriptor-reg any-reg) :target where))
199   (:temporary (:scs (any-reg) :from (:argument 0)) where)
200   (:temporary (:scs (descriptor-reg)) symbol value)
201   (:generator 0
202     (let ((loop (gen-label))
203           (skip (gen-label))
204           (done (gen-label)))
205       (move where arg)
206       (inst beq where bsp-tn done)
207       (inst nop)
208
209       (emit-label loop)
210       (loadw symbol bsp-tn (- binding-symbol-slot binding-size))
211       (inst beq symbol skip)
212       (loadw value bsp-tn (- binding-value-slot binding-size))
213       (storew value symbol symbol-value-slot other-pointer-lowtag)
214       (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
215
216       (emit-label skip)
217       (storew zero-tn bsp-tn (- binding-value-slot binding-size))
218       (inst addu bsp-tn bsp-tn (* -2 n-word-bytes))
219       (inst bne where bsp-tn loop)
220       (inst nop)
221
222       (emit-label done))))
223
224
225 \f
226 ;;;; Closure indexing.
227
228 (define-full-reffer closure-index-ref *
229   closure-info-offset fun-pointer-lowtag
230   (descriptor-reg any-reg) * %closure-index-ref)
231
232 (define-full-setter set-funcallable-instance-info *
233   funcallable-instance-info-offset fun-pointer-lowtag
234   (descriptor-reg any-reg null zero) * %set-funcallable-instance-info)
235
236 (define-full-reffer funcallable-instance-info *
237   funcallable-instance-info-offset fun-pointer-lowtag
238   (descriptor-reg any-reg) * %funcallable-instance-info)
239
240 (define-vop (closure-ref slot-ref)
241   (:variant closure-info-offset fun-pointer-lowtag))
242
243 (define-vop (closure-init slot-set)
244   (:variant closure-info-offset fun-pointer-lowtag))
245 \f
246 ;;;; Value Cell hackery.
247
248 (define-vop (value-cell-ref cell-ref)
249   (:variant value-cell-value-slot other-pointer-lowtag))
250
251 (define-vop (value-cell-set cell-set)
252   (:variant value-cell-value-slot other-pointer-lowtag))
253
254
255 \f
256 ;;;; Instance hackery:
257
258 (define-vop (instance-length)
259   (:policy :fast-safe)
260   (:translate %instance-length)
261   (:args (struct :scs (descriptor-reg)))
262   (:temporary (:scs (non-descriptor-reg)) temp)
263   (:results (res :scs (unsigned-reg)))
264   (:result-types positive-fixnum)
265   (:generator 4
266     (loadw temp struct 0 instance-pointer-lowtag)
267     (inst srl res temp n-widetag-bits)))
268
269 (define-full-reffer instance-index-ref * instance-slots-offset
270   instance-pointer-lowtag (descriptor-reg any-reg) * %instance-ref)
271
272 (define-full-setter instance-index-set * instance-slots-offset
273   instance-pointer-lowtag (descriptor-reg any-reg null zero) * %instance-set)
274
275
276 \f
277 ;;;; Code object frobbing.
278
279 (define-full-reffer code-header-ref * 0 other-pointer-lowtag
280   (descriptor-reg any-reg) * code-header-ref)
281
282 (define-full-setter code-header-set * 0 other-pointer-lowtag
283   (descriptor-reg any-reg null zero) * code-header-set)
284
285
286 \f
287 ;;;; raw instance slot accessors
288
289 (define-vop (raw-instance-ref/word)
290   (:translate %raw-instance-ref/word)
291   (:policy :fast-safe)
292   (:args (object :scs (descriptor-reg))
293          (index :scs (any-reg)))
294   (:arg-types * positive-fixnum)
295   (:results (value :scs (unsigned-reg)))
296   (:temporary (:scs (non-descriptor-reg)) offset)
297   (:temporary (:scs (interior-reg)) lip)
298   (:result-types unsigned-num)
299   (:generator 5
300     (loadw offset object 0 instance-pointer-lowtag)
301     (inst srl offset n-widetag-bits)
302     (inst sll offset n-fixnum-tag-bits)
303     (inst subu offset index)
304     (inst subu offset n-word-bytes)
305     (inst addu lip offset object)
306     (inst lw value lip (- (* instance-slots-offset n-word-bytes)
307                           instance-pointer-lowtag))))
308
309 (define-vop (raw-instance-set/word)
310   (:translate %raw-instance-set/word)
311   (:policy :fast-safe)
312   (:args (object :scs (descriptor-reg))
313          (index :scs (any-reg))
314          (value :scs (unsigned-reg) :target result))
315   (:arg-types * positive-fixnum unsigned-num)
316   (:results (result :scs (unsigned-reg)))
317   (:temporary (:scs (non-descriptor-reg)) offset)
318   (:temporary (:scs (interior-reg)) lip)
319   (:result-types unsigned-num)
320   (:generator 5
321     (loadw offset object 0 instance-pointer-lowtag)
322     (inst srl offset n-widetag-bits)
323     (inst sll offset n-fixnum-tag-bits)
324     (inst subu offset index)
325     (inst subu offset n-word-bytes)
326     (inst addu lip offset object)
327     (inst sw value lip (- (* instance-slots-offset n-word-bytes)
328                           instance-pointer-lowtag))
329     (move result value)))
330
331 (define-vop (raw-instance-ref/single)
332   (:translate %raw-instance-ref/single)
333   (:policy :fast-safe)
334   (:args (object :scs (descriptor-reg))
335          (index :scs (any-reg)))
336   (:arg-types * positive-fixnum)
337   (:results (value :scs (single-reg)))
338   (:temporary (:scs (non-descriptor-reg)) offset)
339   (:temporary (:scs (interior-reg)) lip)
340   (:result-types single-float)
341   (:generator 5
342     (loadw offset object 0 instance-pointer-lowtag)
343     (inst srl offset n-widetag-bits)
344     (inst sll offset n-fixnum-tag-bits)
345     (inst subu offset index)
346     (inst subu offset n-word-bytes)
347     (inst addu lip offset object)
348     (inst lwc1 value lip (- (* instance-slots-offset n-word-bytes)
349                             instance-pointer-lowtag))))
350
351 (define-vop (raw-instance-set/single)
352   (:translate %raw-instance-set/single)
353   (:policy :fast-safe)
354   (:args (object :scs (descriptor-reg))
355          (index :scs (any-reg))
356          (value :scs (single-reg) :target result))
357   (:arg-types * positive-fixnum single-float)
358   (:results (result :scs (single-reg)))
359   (:temporary (:scs (non-descriptor-reg)) offset)
360   (:temporary (:scs (interior-reg)) lip)
361   (:result-types single-float)
362   (:generator 5
363     (loadw offset object 0 instance-pointer-lowtag)
364     (inst srl offset n-widetag-bits)
365     (inst sll offset n-fixnum-tag-bits)
366     (inst subu offset index)
367     (inst subu offset n-word-bytes)
368     (inst addu lip offset object)
369     (inst swc1 value lip (- (* instance-slots-offset n-word-bytes)
370                             instance-pointer-lowtag))
371     (unless (location= result value)
372       (inst fmove :single result value))))
373
374 (define-vop (raw-instance-ref/double)
375   (:translate %raw-instance-ref/double)
376   (:policy :fast-safe)
377   (:args (object :scs (descriptor-reg))
378          (index :scs (any-reg)))
379   (:arg-types * positive-fixnum)
380   (:results (value :scs (double-reg)))
381   (:temporary (:scs (non-descriptor-reg)) offset)
382   (:temporary (:scs (interior-reg)) lip)
383   (:result-types double-float)
384   (:generator 5
385     (loadw offset object 0 instance-pointer-lowtag)
386     (inst srl offset n-widetag-bits)
387     (inst sll offset n-fixnum-tag-bits)
388     (inst subu offset index)
389     (inst subu offset (* 2 n-word-bytes))
390     (inst addu lip offset object)
391     (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
392                                instance-pointer-lowtag)))
393       (ecase *backend-byte-order*
394         (:big-endian (inst lwc1 value lip immediate-offset))
395         (:little-endian (inst lwc1-odd value lip immediate-offset))))
396     (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes)
397                                instance-pointer-lowtag)))
398       (ecase *backend-byte-order*
399         (:big-endian (inst lwc1-odd value lip immediate-offset))
400         (:little-endian (inst lwc1 value lip immediate-offset))))))
401
402 (define-vop (raw-instance-set/double)
403   (:translate %raw-instance-set/double)
404   (:policy :fast-safe)
405   (:args (object :scs (descriptor-reg))
406          (index :scs (any-reg))
407          (value :scs (double-reg) :target result))
408   (:arg-types * positive-fixnum double-float)
409   (:results (result :scs (double-reg)))
410   (:temporary (:scs (non-descriptor-reg)) offset)
411   (:temporary (:scs (interior-reg)) lip)
412   (:result-types double-float)
413   (:generator 5
414     (loadw offset object 0 instance-pointer-lowtag)
415     (inst srl offset n-widetag-bits)
416     (inst sll offset n-fixnum-tag-bits)
417     (inst subu offset index)
418     (inst subu offset (* 2 n-word-bytes))
419     (inst addu lip offset object)
420     (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
421                                instance-pointer-lowtag)))
422       (ecase *backend-byte-order*
423         (:big-endian (inst swc1 value lip immediate-offset))
424         (:little-endian (inst swc1-odd value lip immediate-offset))))
425     (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes)
426                                instance-pointer-lowtag)))
427       (ecase *backend-byte-order*
428         (:big-endian (inst swc1-odd value lip immediate-offset))
429         (:little-endian (inst swc1 value lip immediate-offset))))
430     (unless (location= result value)
431       (inst fmove :double result value))))
432
433 (define-vop (raw-instance-ref/complex-single)
434   (:translate %raw-instance-ref/complex-single)
435   (:policy :fast-safe)
436   (:args (object :scs (descriptor-reg))
437          (index :scs (any-reg)))
438   (:arg-types * positive-fixnum)
439   (:results (value :scs (complex-single-reg)))
440   (:temporary (:scs (non-descriptor-reg)) offset)
441   (:temporary (:scs (interior-reg)) lip)
442   (:result-types complex-single-float)
443   (:generator 5
444     (loadw offset object 0 instance-pointer-lowtag)
445     (inst srl offset n-widetag-bits)
446     (inst sll offset n-fixnum-tag-bits)
447     (inst subu offset index)
448     (inst subu offset (* 2 n-word-bytes))
449     (inst addu lip offset object)
450     (inst lwc1
451           (complex-single-reg-real-tn value)
452           lip
453           (- (* instance-slots-offset n-word-bytes)
454              instance-pointer-lowtag))
455     (inst lwc1
456           (complex-single-reg-imag-tn value)
457           lip
458           (- (* (1+ instance-slots-offset) n-word-bytes)
459              instance-pointer-lowtag))))
460
461 (define-vop (raw-instance-set/complex-single)
462   (:translate %raw-instance-set/complex-single)
463   (:policy :fast-safe)
464   (:args (object :scs (descriptor-reg))
465          (index :scs (any-reg))
466          (value :scs (complex-single-reg) :target result))
467   (:arg-types * positive-fixnum complex-single-float)
468   (:results (result :scs (complex-single-reg)))
469   (:temporary (:scs (non-descriptor-reg)) offset)
470   (:temporary (:scs (interior-reg)) lip)
471   (:result-types complex-single-float)
472   (:generator 5
473     (loadw offset object 0 instance-pointer-lowtag)
474     (inst srl offset n-widetag-bits)
475     (inst sll offset n-fixnum-tag-bits)
476     (inst subu offset index)
477     (inst subu offset (* 2 n-word-bytes))
478     (inst addu lip offset object)
479     (let ((value-real (complex-single-reg-real-tn value))
480           (result-real (complex-single-reg-real-tn result)))
481       (inst swc1
482             value-real
483             lip
484             (- (* instance-slots-offset n-word-bytes)
485                instance-pointer-lowtag))
486       (unless (location= result-real value-real)
487         (inst fmove :single result-real value-real)))
488     (let ((value-imag (complex-single-reg-imag-tn value))
489           (result-imag (complex-single-reg-imag-tn result)))
490       (inst swc1
491             value-imag
492             lip
493             (- (* (1+ instance-slots-offset) n-word-bytes)
494                instance-pointer-lowtag))
495       (unless (location= result-imag value-imag)
496         (inst fmove :single result-imag value-imag)))))
497
498 (define-vop (raw-instance-ref/complex-double)
499   (:translate %raw-instance-ref/complex-double)
500   (:policy :fast-safe)
501   (:args (object :scs (descriptor-reg))
502          (index :scs (any-reg)))
503   (:arg-types * positive-fixnum)
504   (:results (value :scs (complex-double-reg)))
505   (:temporary (:scs (non-descriptor-reg)) offset)
506   (:temporary (:scs (interior-reg)) lip)
507   (:result-types complex-double-float)
508   (:generator 5
509     (loadw offset object 0 instance-pointer-lowtag)
510     (inst srl offset n-widetag-bits)
511     (inst sll offset n-fixnum-tag-bits)
512     (inst subu offset index)
513     (inst subu offset (* 4 n-word-bytes))
514     (inst addu lip offset object)
515     (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
516                                instance-pointer-lowtag)))
517       (ecase *backend-byte-order*
518         (:big-endian (inst lwc1
519                            (complex-double-reg-real-tn value)
520                            lip
521                            immediate-offset))
522         (:little-endian (inst lwc1-odd
523                               (complex-double-reg-real-tn value)
524                               lip
525                               immediate-offset))))
526     (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes)
527                                instance-pointer-lowtag)))
528       (ecase *backend-byte-order*
529         (:big-endian (inst lwc1-odd
530                            (complex-double-reg-real-tn value)
531                            lip
532                            immediate-offset))
533         (:little-endian (inst lwc1
534                               (complex-double-reg-real-tn value)
535                               lip
536                               immediate-offset))))
537     (let ((immediate-offset (- (* (+ instance-slots-offset 2) n-word-bytes)
538                                instance-pointer-lowtag)))
539       (ecase *backend-byte-order*
540         (:big-endian (inst lwc1
541                            (complex-double-reg-imag-tn value)
542                            lip
543                            immediate-offset))
544         (:little-endian (inst lwc1-odd
545                               (complex-double-reg-imag-tn value)
546                               lip
547                               immediate-offset))))
548     (let ((immediate-offset (- (* (+ instance-slots-offset 3) n-word-bytes)
549                                instance-pointer-lowtag)))
550       (ecase *backend-byte-order*
551         (:big-endian (inst lwc1-odd
552                            (complex-double-reg-imag-tn value)
553                            lip
554                            immediate-offset))
555         (:little-endian (inst lwc1
556                               (complex-double-reg-imag-tn value)
557                               lip
558                               immediate-offset))))))
559
560 (define-vop (raw-instance-set/complex-double)
561   (:translate %raw-instance-set/complex-double)
562   (:policy :fast-safe)
563   (:args (object :scs (descriptor-reg))
564          (index :scs (any-reg))
565          (value :scs (complex-double-reg) :target result))
566   (:arg-types * positive-fixnum complex-double-float)
567   (:results (result :scs (complex-double-reg)))
568   (:temporary (:scs (non-descriptor-reg)) offset)
569   (:temporary (:scs (interior-reg)) lip)
570   (:result-types complex-double-float)
571   (:generator 5
572     (loadw offset object 0 instance-pointer-lowtag)
573     (inst srl offset n-widetag-bits)
574     (inst sll offset n-fixnum-tag-bits)
575     (inst subu offset index)
576     (inst subu offset (* 4 n-word-bytes))
577     (inst addu lip offset object)
578     (let ((value-real (complex-double-reg-real-tn value))
579           (result-real (complex-double-reg-real-tn result)))
580       (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
581                                  instance-pointer-lowtag)))
582         (ecase *backend-byte-order*
583           (:big-endian (inst swc1
584                              value-real
585                              lip
586                              immediate-offset))
587           (:little-endian (inst swc1-odd
588                                 value-real
589                                 lip
590                                 immediate-offset))))
591       (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes)
592                                  instance-pointer-lowtag)))
593         (ecase *backend-byte-order*
594           (:big-endian (inst swc1-odd
595                              value-real
596                              lip
597                              immediate-offset))
598           (:little-endian (inst swc1
599                                 value-real
600                                 lip
601                                 immediate-offset))))
602       (unless (location= result-real value-real)
603         (inst fmove :double result-real value-real)))
604     (let ((value-imag (complex-double-reg-imag-tn value))
605           (result-imag (complex-double-reg-imag-tn result)))
606       (let ((immediate-offset (- (* (+ instance-slots-offset 2) n-word-bytes)
607                                  instance-pointer-lowtag)))
608         (ecase *backend-byte-order*
609           (:big-endian (inst swc1
610                              value-imag
611                              lip
612                              immediate-offset))
613           (:little-endian (inst swc1-odd
614                                 value-imag
615                                 lip
616                                 immediate-offset))))
617       (let ((immediate-offset (- (* (+ instance-slots-offset 3) n-word-bytes)
618                                  instance-pointer-lowtag)))
619         (ecase *backend-byte-order*
620           (:big-endian (inst swc1-odd
621                              value-imag
622                              lip
623                              immediate-offset))
624           (:little-endian (inst swc1
625                                 value-imag
626                                 lip
627                                 immediate-offset))))
628       (unless (location= result-imag value-imag)
629         (inst fmove :double result-imag value-imag)))))