75756ec12af1f26e5d27a4966463aecd4a070774
[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 zero-tn 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 zero-tn target)
82         (inst bne temp zero-tn 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   (:results (res :scs (any-reg)))
95   (:result-types positive-fixnum)
96   (:temporary (:scs (any-reg)) temp)
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     ;;
103     ;; wow, MIPS sucks (or I do) -- CSR, 2004-05-20
104     (inst li temp (fixnumize -1))
105     (loadw res symbol symbol-hash-slot other-pointer-lowtag)
106     (inst and res temp)))
107 \f
108 ;;;; Fdefinition (fdefn) objects.
109
110 (define-vop (fdefn-fun cell-ref)
111   (:variant fdefn-fun-slot other-pointer-lowtag))
112
113 (define-vop (safe-fdefn-fun)
114   (:args (object :scs (descriptor-reg) :target obj-temp))
115   (:results (value :scs (descriptor-reg any-reg)))
116   (:vop-var vop)
117   (:save-p :compute-only)
118   (:temporary (:scs (descriptor-reg) :from (:argument 0)) obj-temp)
119   (:generator 10
120     (move obj-temp object)
121     (loadw value obj-temp fdefn-fun-slot other-pointer-lowtag)
122     (let ((err-lab (generate-error-code vop undefined-fun-error obj-temp)))
123       (inst beq value null-tn err-lab))
124     (inst nop)))
125
126 (define-vop (set-fdefn-fun)
127   (:policy :fast-safe)
128   (:translate (setf fdefn-fun))
129   (:args (function :scs (descriptor-reg) :target result)
130          (fdefn :scs (descriptor-reg)))
131   (:temporary (:scs (interior-reg)) lip)
132   (:temporary (:scs (non-descriptor-reg)) type)
133   (:results (result :scs (descriptor-reg)))
134   (:generator 38
135     (let ((normal-fn (gen-label)))
136       (load-type type function (- fun-pointer-lowtag))
137       (inst nop)
138       (inst xor type simple-fun-header-widetag)
139       (inst beq type zero-tn normal-fn)
140       (inst addu lip function
141             (- (ash simple-fun-code-offset word-shift)
142                fun-pointer-lowtag))
143       (inst li lip (make-fixup "closure_tramp" :foreign))
144       (emit-label normal-fn)
145       (storew lip fdefn fdefn-raw-addr-slot other-pointer-lowtag)
146       (storew function fdefn fdefn-fun-slot other-pointer-lowtag)
147       (move result function))))
148
149 (define-vop (fdefn-makunbound)
150   (:policy :fast-safe)
151   (:translate fdefn-makunbound)
152   (:args (fdefn :scs (descriptor-reg) :target result))
153   (:temporary (:scs (non-descriptor-reg)) temp)
154   (:results (result :scs (descriptor-reg)))
155   (:generator 38
156     (storew null-tn fdefn fdefn-fun-slot other-pointer-lowtag)
157     (inst li temp (make-fixup "undefined_tramp" :foreign))
158     (storew temp fdefn fdefn-raw-addr-slot other-pointer-lowtag)
159     (move result fdefn)))
160
161
162 \f
163 ;;;; Binding and Unbinding.
164
165 ;;; BIND -- Establish VAL as a binding for SYMBOL.  Save the old value and
166 ;;; the symbol on the binding stack and stuff the new value into the
167 ;;; symbol.
168
169 (define-vop (bind)
170   (:args (val :scs (any-reg descriptor-reg))
171          (symbol :scs (descriptor-reg)))
172   (:temporary (:scs (descriptor-reg)) temp)
173   (:generator 5
174     (loadw temp symbol symbol-value-slot other-pointer-lowtag)
175     (inst addu bsp-tn bsp-tn (* 2 n-word-bytes))
176     (storew temp bsp-tn (- binding-value-slot binding-size))
177     (storew symbol bsp-tn (- binding-symbol-slot binding-size))
178     (storew val symbol symbol-value-slot other-pointer-lowtag)))
179
180
181 (define-vop (unbind)
182   (:temporary (:scs (descriptor-reg)) symbol value)
183   (:generator 0
184     (loadw symbol bsp-tn (- binding-symbol-slot binding-size))
185     (loadw value bsp-tn (- binding-value-slot binding-size))
186     (storew value symbol symbol-value-slot other-pointer-lowtag)
187     (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
188     (storew zero-tn bsp-tn (- binding-value-slot binding-size))
189     (inst addu bsp-tn bsp-tn (* -2 n-word-bytes))))
190
191
192 (define-vop (unbind-to-here)
193   (:args (arg :scs (descriptor-reg any-reg) :target where))
194   (:temporary (:scs (any-reg) :from (:argument 0)) where)
195   (:temporary (:scs (descriptor-reg)) symbol value)
196   (:generator 0
197     (let ((loop (gen-label))
198           (skip (gen-label))
199           (done (gen-label)))
200       (move where arg)
201       (inst beq where bsp-tn done)
202       (inst nop)
203
204       (emit-label loop)
205       (loadw symbol bsp-tn (- binding-symbol-slot binding-size))
206       (inst beq symbol zero-tn skip)
207       (loadw value bsp-tn (- binding-value-slot binding-size))
208       (storew value symbol symbol-value-slot other-pointer-lowtag)
209       (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
210
211       (emit-label skip)
212       (storew zero-tn bsp-tn (- binding-value-slot binding-size))
213       (inst addu bsp-tn bsp-tn (* -2 n-word-bytes))
214       (inst bne where bsp-tn loop)
215       (inst nop)
216
217       (emit-label done))))
218
219
220 \f
221 ;;;; Closure indexing.
222
223 (define-full-reffer closure-index-ref *
224   closure-info-offset fun-pointer-lowtag
225   (descriptor-reg any-reg) * %closure-index-ref)
226
227 (define-full-setter set-funcallable-instance-info *
228   funcallable-instance-info-offset fun-pointer-lowtag
229   (descriptor-reg any-reg null zero) * %set-funcallable-instance-info)
230
231 (define-full-reffer funcallable-instance-info *
232   funcallable-instance-info-offset fun-pointer-lowtag
233   (descriptor-reg any-reg) * %funcallable-instance-info)
234
235 (define-vop (closure-ref slot-ref)
236   (:variant closure-info-offset fun-pointer-lowtag))
237
238 (define-vop (closure-init slot-set)
239   (:variant closure-info-offset fun-pointer-lowtag))
240 \f
241 ;;;; Value Cell hackery.
242
243 (define-vop (value-cell-ref cell-ref)
244   (:variant value-cell-value-slot other-pointer-lowtag))
245
246 (define-vop (value-cell-set cell-set)
247   (:variant value-cell-value-slot other-pointer-lowtag))
248
249
250 \f
251 ;;;; Instance hackery:
252
253 (define-vop (instance-length)
254   (:policy :fast-safe)
255   (:translate %instance-length)
256   (:args (struct :scs (descriptor-reg)))
257   (:temporary (:scs (non-descriptor-reg)) temp)
258   (:results (res :scs (unsigned-reg)))
259   (:result-types positive-fixnum)
260   (:generator 4
261     (loadw temp struct 0 instance-pointer-lowtag)
262     (inst srl res temp n-widetag-bits)))
263
264 (define-full-reffer instance-index-ref * instance-slots-offset
265   instance-pointer-lowtag (descriptor-reg any-reg) * %instance-ref)
266
267 (define-full-setter instance-index-set * instance-slots-offset
268   instance-pointer-lowtag (descriptor-reg any-reg null zero) * %instance-set)
269
270
271 \f
272 ;;;; Code object frobbing.
273
274 (define-full-reffer code-header-ref * 0 other-pointer-lowtag
275   (descriptor-reg any-reg) * code-header-ref)
276
277 (define-full-setter code-header-set * 0 other-pointer-lowtag
278   (descriptor-reg any-reg null zero) * code-header-set)
279
280
281 \f
282 ;;;; raw instance slot accessors
283
284 (define-vop (raw-instance-ref/word)
285   (:translate %raw-instance-ref/word)
286   (:policy :fast-safe)
287   (:args (object :scs (descriptor-reg))
288          (index :scs (any-reg)))
289   (:arg-types * positive-fixnum)
290   (:results (value :scs (unsigned-reg)))
291   (:temporary (:scs (non-descriptor-reg)) offset)
292   (:temporary (:scs (interior-reg)) lip)
293   (:result-types unsigned-num)
294   (:generator 5
295     (loadw offset object 0 instance-pointer-lowtag)
296     (inst srl offset n-widetag-bits)
297     (inst sll offset 2)
298     (inst subu offset index)
299     (inst subu offset n-word-bytes)
300     (inst addu lip offset object)
301     (inst lw value lip (- (* instance-slots-offset n-word-bytes)
302                           instance-pointer-lowtag))))
303
304 (define-vop (raw-instance-set/word)
305   (:translate %raw-instance-set/word)
306   (:policy :fast-safe)
307   (:args (object :scs (descriptor-reg))
308          (index :scs (any-reg))
309          (value :scs (unsigned-reg) :target result))
310   (:arg-types * positive-fixnum unsigned-num)
311   (:results (result :scs (unsigned-reg)))
312   (:temporary (:scs (non-descriptor-reg)) offset)
313   (:temporary (:scs (interior-reg)) lip)
314   (:result-types unsigned-num)
315   (:generator 5
316     (loadw offset object 0 instance-pointer-lowtag)
317     (inst srl offset n-widetag-bits)
318     (inst sll offset 2)
319     (inst subu offset index)
320     (inst subu offset n-word-bytes)
321     (inst addu lip offset object)
322     (inst sw value lip (- (* instance-slots-offset n-word-bytes)
323                           instance-pointer-lowtag))
324     (move result value)))
325
326 (define-vop (raw-instance-ref/single)
327   (:translate %raw-instance-ref/single)
328   (:policy :fast-safe)
329   (:args (object :scs (descriptor-reg))
330          (index :scs (any-reg)))
331   (:arg-types * positive-fixnum)
332   (:results (value :scs (single-reg)))
333   (:temporary (:scs (non-descriptor-reg)) offset)
334   (:temporary (:scs (interior-reg)) lip)
335   (:result-types single-float)
336   (:generator 5
337     (loadw offset object 0 instance-pointer-lowtag)
338     (inst srl offset n-widetag-bits)
339     (inst sll offset 2)
340     (inst subu offset index)
341     (inst subu offset n-word-bytes)
342     (inst addu lip offset object)
343     (inst lwc1 value lip (- (* instance-slots-offset n-word-bytes)
344                             instance-pointer-lowtag))))
345
346 (define-vop (raw-instance-set/single)
347   (:translate %raw-instance-set/single)
348   (:policy :fast-safe)
349   (:args (object :scs (descriptor-reg))
350          (index :scs (any-reg))
351          (value :scs (single-reg) :target result))
352   (:arg-types * positive-fixnum single-float)
353   (:results (result :scs (single-reg)))
354   (:temporary (:scs (non-descriptor-reg)) offset)
355   (:temporary (:scs (interior-reg)) lip)
356   (:result-types single-float)
357   (:generator 5
358     (loadw offset object 0 instance-pointer-lowtag)
359     (inst srl offset n-widetag-bits)
360     (inst sll offset 2)
361     (inst subu offset index)
362     (inst subu offset n-word-bytes)
363     (inst addu lip offset object)
364     (inst swc1 value lip (- (* instance-slots-offset n-word-bytes)
365                             instance-pointer-lowtag))
366     (unless (location= result value)
367       (inst fmove :single result value))))
368
369 (define-vop (raw-instance-ref/double)
370   (:translate %raw-instance-ref/double)
371   (:policy :fast-safe)
372   (:args (object :scs (descriptor-reg))
373          (index :scs (any-reg)))
374   (:arg-types * positive-fixnum)
375   (:results (value :scs (double-reg)))
376   (:temporary (:scs (non-descriptor-reg)) offset)
377   (:temporary (:scs (interior-reg)) lip)
378   (:result-types double-float)
379   (:generator 5
380     (loadw offset object 0 instance-pointer-lowtag)
381     (inst srl offset n-widetag-bits)
382     (inst sll offset 2)
383     (inst subu offset index)
384     (inst subu offset (* 2 n-word-bytes))
385     (inst addu lip offset object)
386     (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
387                                instance-pointer-lowtag)))
388       (ecase *backend-byte-order*
389         (:big-endian (inst lwc1 value lip immediate-offset))
390         (:little-endian (inst lwc1-odd value lip immediate-offset))))
391     (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes)
392                                instance-pointer-lowtag)))
393       (ecase *backend-byte-order*
394         (:big-endian (inst lwc1-odd value lip immediate-offset))
395         (:little-endian (inst lwc1 value lip immediate-offset))))))
396
397 (define-vop (raw-instance-set/double)
398   (:translate %raw-instance-set/double)
399   (:policy :fast-safe)
400   (:args (object :scs (descriptor-reg))
401          (index :scs (any-reg))
402          (value :scs (double-reg) :target result))
403   (:arg-types * positive-fixnum double-float)
404   (:results (result :scs (double-reg)))
405   (:temporary (:scs (non-descriptor-reg)) offset)
406   (:temporary (:scs (interior-reg)) lip)
407   (:result-types double-float)
408   (:generator 5
409     (loadw offset object 0 instance-pointer-lowtag)
410     (inst srl offset n-widetag-bits)
411     (inst sll offset 2)
412     (inst subu offset index)
413     (inst subu offset (* 2 n-word-bytes))
414     (inst addu lip offset object)
415     (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
416                                instance-pointer-lowtag)))
417       (ecase *backend-byte-order*
418         (:big-endian (inst swc1 value lip immediate-offset))
419         (:little-endian (inst swc1-odd value lip immediate-offset))))
420     (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes)
421                                instance-pointer-lowtag)))
422       (ecase *backend-byte-order*
423         (:big-endian (inst swc1-odd value lip immediate-offset))
424         (:little-endian (inst swc1 value lip immediate-offset))))
425     (unless (location= result value)
426       (inst fmove :double result value))))
427
428 (define-vop (raw-instance-ref/complex-single)
429   (:translate %raw-instance-ref/complex-single)
430   (:policy :fast-safe)
431   (:args (object :scs (descriptor-reg))
432          (index :scs (any-reg)))
433   (:arg-types * positive-fixnum)
434   (:results (value :scs (complex-single-reg)))
435   (:temporary (:scs (non-descriptor-reg)) offset)
436   (:temporary (:scs (interior-reg)) lip)
437   (:result-types complex-single-float)
438   (:generator 5
439     (loadw offset object 0 instance-pointer-lowtag)
440     (inst srl offset n-widetag-bits)
441     (inst sll offset 2)
442     (inst subu offset index)
443     (inst subu offset (* 2 n-word-bytes))
444     (inst addu lip offset object)
445     (inst lwc1
446           (complex-single-reg-real-tn value)
447           lip
448           (- (* instance-slots-offset n-word-bytes)
449              instance-pointer-lowtag))
450     (inst lwc1
451           (complex-single-reg-imag-tn value)
452           lip
453           (- (* (1+ instance-slots-offset) n-word-bytes)
454              instance-pointer-lowtag))))
455
456 (define-vop (raw-instance-set/complex-single)
457   (:translate %raw-instance-set/complex-single)
458   (:policy :fast-safe)
459   (:args (object :scs (descriptor-reg))
460          (index :scs (any-reg))
461          (value :scs (complex-single-reg) :target result))
462   (:arg-types * positive-fixnum complex-single-float)
463   (:results (result :scs (complex-single-reg)))
464   (:temporary (:scs (non-descriptor-reg)) offset)
465   (:temporary (:scs (interior-reg)) lip)
466   (:result-types complex-single-float)
467   (:generator 5
468     (loadw offset object 0 instance-pointer-lowtag)
469     (inst srl offset n-widetag-bits)
470     (inst sll offset 2)
471     (inst subu offset index)
472     (inst subu offset (* 2 n-word-bytes))
473     (inst addu lip offset object)
474     (let ((value-real (complex-single-reg-real-tn value))
475           (result-real (complex-single-reg-real-tn result)))
476       (inst swc1
477             value-real
478             lip
479             (- (* instance-slots-offset n-word-bytes)
480                instance-pointer-lowtag))
481       (unless (location= result-real value-real)
482         (inst fmove :single result-real value-real)))
483     (let ((value-imag (complex-single-reg-imag-tn value))
484           (result-imag (complex-single-reg-imag-tn result)))
485       (inst swc1
486             value-imag
487             lip
488             (- (* (1+ instance-slots-offset) n-word-bytes)
489                instance-pointer-lowtag))
490       (unless (location= result-imag value-imag)
491         (inst fmove :single result-imag value-imag)))))
492
493 (define-vop (raw-instance-ref/complex-double)
494   (:translate %raw-instance-ref/complex-double)
495   (:policy :fast-safe)
496   (:args (object :scs (descriptor-reg))
497          (index :scs (any-reg)))
498   (:arg-types * positive-fixnum)
499   (:results (value :scs (complex-double-reg)))
500   (:temporary (:scs (non-descriptor-reg)) offset)
501   (:temporary (:scs (interior-reg)) lip)
502   (:result-types complex-double-float)
503   (:generator 5
504     (loadw offset object 0 instance-pointer-lowtag)
505     (inst srl offset n-widetag-bits)
506     (inst sll offset 2)
507     (inst subu offset index)
508     (inst subu offset (* 4 n-word-bytes))
509     (inst addu lip offset object)
510     (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
511                                instance-pointer-lowtag)))
512       (ecase *backend-byte-order*
513         (:big-endian (inst lwc1
514                            (complex-double-reg-real-tn value)
515                            lip
516                            immediate-offset))
517         (:little-endian (inst lwc1-odd
518                               (complex-double-reg-real-tn value)
519                               lip
520                               immediate-offset))))
521     (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes)
522                                instance-pointer-lowtag)))
523       (ecase *backend-byte-order*
524         (:big-endian (inst lwc1-odd
525                            (complex-double-reg-real-tn value)
526                            lip
527                            immediate-offset))
528         (:little-endian (inst lwc1
529                               (complex-double-reg-real-tn value)
530                               lip
531                               immediate-offset))))
532     (let ((immediate-offset (- (* (+ instance-slots-offset 2) n-word-bytes)
533                                instance-pointer-lowtag)))
534       (ecase *backend-byte-order*
535         (:big-endian (inst lwc1
536                            (complex-double-reg-imag-tn value)
537                            lip
538                            immediate-offset))
539         (:little-endian (inst lwc1-odd
540                               (complex-double-reg-imag-tn value)
541                               lip
542                               immediate-offset))))
543     (let ((immediate-offset (- (* (+ instance-slots-offset 3) n-word-bytes)
544                                instance-pointer-lowtag)))
545       (ecase *backend-byte-order*
546         (:big-endian (inst lwc1-odd
547                            (complex-double-reg-imag-tn value)
548                            lip
549                            immediate-offset))
550         (:little-endian (inst lwc1
551                               (complex-double-reg-imag-tn value)
552                               lip
553                               immediate-offset))))))
554
555 (define-vop (raw-instance-set/complex-double)
556   (:translate %raw-instance-set/complex-double)
557   (:policy :fast-safe)
558   (:args (object :scs (descriptor-reg))
559          (index :scs (any-reg))
560          (value :scs (complex-double-reg) :target result))
561   (:arg-types * positive-fixnum complex-double-float)
562   (:results (result :scs (complex-double-reg)))
563   (:temporary (:scs (non-descriptor-reg)) offset)
564   (:temporary (:scs (interior-reg)) lip)
565   (:result-types complex-double-float)
566   (:generator 5
567     (loadw offset object 0 instance-pointer-lowtag)
568     (inst srl offset n-widetag-bits)
569     (inst sll offset 2)
570     (inst subu offset index)
571     (inst subu offset (* 4 n-word-bytes))
572     (inst addu lip offset object)
573     (let ((value-real (complex-double-reg-real-tn value))
574           (result-real (complex-double-reg-real-tn result)))
575       (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
576                                  instance-pointer-lowtag)))
577         (ecase *backend-byte-order*
578           (:big-endian (inst swc1
579                              value-real
580                              lip
581                              immediate-offset))
582           (:little-endian (inst swc1-odd
583                                 value-real
584                                 lip
585                                 immediate-offset))))
586       (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes)
587                                  instance-pointer-lowtag)))
588         (ecase *backend-byte-order*
589           (:big-endian (inst swc1-odd
590                              value-real
591                              lip
592                              immediate-offset))
593           (:little-endian (inst swc1
594                                 value-real
595                                 lip
596                                 immediate-offset))))
597       (unless (location= result-real value-real)
598         (inst fmove :double result-real value-real)))
599     (let ((value-imag (complex-double-reg-imag-tn value))
600           (result-imag (complex-double-reg-imag-tn result)))
601       (let ((immediate-offset (- (* (+ instance-slots-offset 2) n-word-bytes)
602                                  instance-pointer-lowtag)))
603         (ecase *backend-byte-order*
604           (:big-endian (inst swc1
605                              value-imag
606                              lip
607                              immediate-offset))
608           (:little-endian (inst swc1-odd
609                                 value-imag
610                                 lip
611                                 immediate-offset))))
612       (let ((immediate-offset (- (* (+ instance-slots-offset 3) n-word-bytes)
613                                  instance-pointer-lowtag)))
614         (ecase *backend-byte-order*
615           (:big-endian (inst swc1-odd
616                              value-imag
617                              lip
618                              immediate-offset))
619           (:little-endian (inst swc1
620                                 value-imag
621                                 lip
622                                 immediate-offset))))
623       (unless (location= result-imag value-imag)
624         (inst fmove :double result-imag value-imag)))))