1.0.9.52: copy propagation interfering with local calls
[sbcl.git] / src / compiler / sparc / sap.lisp
1 ;;;; the SPARC VM definition of SAP operations
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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.
11
12 (in-package "SB!VM")
13 \f
14 ;;;; moves and coercions:
15
16 ;;; Move a tagged SAP to an untagged representation.
17 (define-vop (move-to-sap)
18   (:args (x :scs (descriptor-reg)))
19   (:results (y :scs (sap-reg)))
20   (:note "pointer to SAP coercion")
21   (:generator 1
22     (loadw y x sap-pointer-slot other-pointer-lowtag)))
23
24 (define-move-vop move-to-sap :move
25   (descriptor-reg) (sap-reg))
26
27
28 ;;; Move an untagged SAP to a tagged representation.
29 (define-vop (move-from-sap)
30   (:args (sap :scs (sap-reg) :to :save))
31   (:temporary (:scs (non-descriptor-reg)) ndescr)
32   (:results (res :scs (descriptor-reg)))
33   (:note "SAP to pointer coercion")
34   (:generator 20
35     (with-fixed-allocation (res ndescr sap-widetag sap-size)
36       (storew sap res sap-pointer-slot other-pointer-lowtag))))
37
38 (define-move-vop move-from-sap :move
39   (sap-reg) (descriptor-reg))
40
41
42 ;;; Move untagged SAP values.
43 (define-vop (sap-move)
44   (:args (x :target y
45             :scs (sap-reg)
46             :load-if (not (location= x y))))
47   (:results (y :scs (sap-reg)
48                :load-if (not (location= x y))))
49   (:note "SAP move")
50   (:effects)
51   (:affected)
52   (:generator 0
53     (move y x)))
54
55 (define-move-vop sap-move :move
56   (sap-reg) (sap-reg))
57
58
59 ;;; Move untagged SAP arguments/return-values.
60 (define-vop (move-sap-arg)
61   (:args (x :target y
62             :scs (sap-reg))
63          (fp :scs (any-reg)
64              :load-if (not (sc-is y sap-reg))))
65   (:results (y))
66   (:note "SAP argument move")
67   (:generator 0
68     (sc-case y
69       (sap-reg
70        (move y x))
71       (sap-stack
72        (storew x fp (tn-offset y))))))
73
74 (define-move-vop move-sap-arg :move-arg
75   (descriptor-reg sap-reg) (sap-reg))
76
77
78 ;;; Use standard MOVE-ARG + coercion to move an untagged SAP to a
79 ;;; descriptor passing location.
80 (define-move-vop move-arg :move-arg
81   (sap-reg) (descriptor-reg))
82 \f
83 ;;;; SAP-INT and INT-SAP
84
85 (define-vop (sap-int)
86   (:args (sap :scs (sap-reg) :target int))
87   (:arg-types system-area-pointer)
88   (:results (int :scs (unsigned-reg)))
89   (:result-types unsigned-num)
90   (:translate sap-int)
91   (:policy :fast-safe)
92   (:generator 1
93     (move int sap)))
94
95 (define-vop (int-sap)
96   (:args (int :scs (unsigned-reg) :target sap))
97   (:arg-types unsigned-num)
98   (:results (sap :scs (sap-reg)))
99   (:result-types system-area-pointer)
100   (:translate int-sap)
101   (:policy :fast-safe)
102   (:generator 1
103     (move sap int)))
104 \f
105 ;;;; POINTER+ and POINTER-
106
107 (define-vop (pointer+)
108   (:translate sap+)
109   (:args (ptr :scs (sap-reg))
110          (offset :scs (signed-reg)))
111   (:arg-types system-area-pointer signed-num)
112   (:results (res :scs (sap-reg)))
113   (:result-types system-area-pointer)
114   (:policy :fast-safe)
115   (:generator 2
116     (inst add res ptr offset)))
117
118 (define-vop (pointer+-c)
119   (:translate sap+)
120   (:args (ptr :scs (sap-reg)))
121   (:info offset)
122   (:arg-types system-area-pointer (:constant (signed-byte 13)))
123   (:results (res :scs (sap-reg)))
124   (:result-types system-area-pointer)
125   (:policy :fast-safe)
126   (:generator 1
127     (inst add res ptr offset)))
128
129 (define-vop (pointer-)
130   (:translate sap-)
131   (:args (ptr1 :scs (sap-reg))
132          (ptr2 :scs (sap-reg)))
133   (:arg-types system-area-pointer system-area-pointer)
134   (:policy :fast-safe)
135   (:results (res :scs (signed-reg)))
136   (:result-types signed-num)
137   (:generator 1
138     (inst sub res ptr1 ptr2)))
139 \f
140 ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET
141
142 (macrolet ((def-system-ref-and-set (ref-name set-name sc type size &optional signed)
143                (let ((ref-name-c (symbolicate ref-name "-C"))
144                      (set-name-c (symbolicate set-name "-C")))
145                  `(progn
146                    (define-vop (,ref-name)
147                        (:translate ,ref-name)
148                      (:policy :fast-safe)
149                      (:args (sap :scs (sap-reg))
150                       (offset :scs (signed-reg)))
151                      (:arg-types system-area-pointer signed-num)
152                      (:results (result :scs (,sc)))
153                      (:result-types ,type)
154                      (:generator 5
155                       ,@(if (eql size :long-float)
156                             '((load-long-reg result sap offset t))
157                             `((inst ,(ecase size
158                                             (:byte (if signed 'ldsb 'ldub))
159                                             (:short (if signed 'ldsh 'lduh))
160                                             (:long 'ld)
161                                             (:single 'ldf)
162                                             (:double 'lddf))
163                                result sap offset)))))
164                    (define-vop (,ref-name-c)
165                        (:translate ,ref-name)
166                      (:policy :fast-safe)
167                      (:args (sap :scs (sap-reg)))
168                      (:arg-types system-area-pointer (:constant (signed-byte 13)))
169                      (:info offset)
170                      (:results (result :scs (,sc)))
171                      (:result-types ,type)
172                      (:generator 4
173                       ,@(if (eql size :long-float)
174                             '((load-long-reg result sap offset t))
175                             `((inst ,(ecase size
176                                             (:byte (if signed 'ldsb 'ldub))
177                                             (:short (if signed 'ldsh 'lduh))
178                                             (:long 'ld)
179                                             (:single 'ldf)
180                                             (:double 'lddf))
181                                result sap offset)))))
182                    (define-vop (,set-name)
183                        (:translate ,set-name)
184                      (:policy :fast-safe)
185                      (:args (sap :scs (sap-reg))
186                       (offset :scs (signed-reg))
187                       (value :scs (,sc) :target result))
188                      (:arg-types system-area-pointer signed-num ,type)
189                      (:results (result :scs (,sc)))
190                      (:result-types ,type)
191                      (:generator 5
192                       ,@(if (eql size :long-float)
193                             '((store-long-reg value sap offset t))
194                             `((inst ,(ecase size
195                                             (:byte 'stb)
196                                             (:short 'sth)
197                                             (:long 'st)
198                                             (:single 'stf)
199                                             (:double 'stdf))
200                                value sap offset)))
201                       (unless (location= result value)
202                         ,@(case size
203                                 (:single
204                                  '((inst fmovs result value)))
205                                 (:double
206                                  '((move-double-reg result value)))
207                                 (:long-float
208                                  '((move-long-reg result value)))
209                                 (t
210                                  '((inst move result value)))))))
211                    (define-vop (,set-name-c)
212                        (:translate ,set-name)
213                      (:policy :fast-safe)
214                      (:args (sap :scs (sap-reg))
215                       (value :scs (,sc) :target result))
216                      (:arg-types system-area-pointer (:constant (signed-byte 13)) ,type)
217                      (:info offset)
218                      (:results (result :scs (,sc)))
219                      (:result-types ,type)
220                      (:generator 4
221                       ,@(if (eql size :long-float)
222                             '((store-long-reg value sap offset t))
223                             `((inst ,(ecase size
224                                             (:byte 'stb)
225                                             (:short 'sth)
226                                             (:long 'st)
227                                             (:single 'stf)
228                                             (:double 'stdf))
229                                value sap offset)))
230                       (unless (location= result value)
231                         ,@(case size
232                                 (:single
233                                  '((inst fmovs result value)))
234                                 (:double
235                                  '((move-double-reg result value)))
236                                 (:long-float
237                                  '((move-long-reg result value)))
238                                 (t
239                                  '((inst move result value)))))))))))
240
241   (def-system-ref-and-set sap-ref-8 %set-sap-ref-8
242     unsigned-reg positive-fixnum :byte nil)
243   (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8
244     signed-reg tagged-num :byte t)
245   (def-system-ref-and-set sap-ref-16 %set-sap-ref-16
246     unsigned-reg positive-fixnum :short nil)
247   (def-system-ref-and-set signed-sap-ref-16 %set-signed-sap-ref-16
248     signed-reg tagged-num :short t)
249   (def-system-ref-and-set sap-ref-32 %set-sap-ref-32
250     unsigned-reg unsigned-num :long nil)
251   (def-system-ref-and-set signed-sap-ref-32 %set-signed-sap-ref-32
252     signed-reg signed-num :long t)
253   (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap
254     sap-reg system-area-pointer :long)
255   (def-system-ref-and-set sap-ref-single %set-sap-ref-single
256     single-reg single-float :single)
257   (def-system-ref-and-set sap-ref-double %set-sap-ref-double
258     double-reg double-float :double)
259   #!+long-float
260   (def-system-ref-and-set sap-ref-long %set-sap-ref-long
261     long-reg long-float :long-float)
262 ) ; MACROLET
263 \f
264 ;;; noise to convert normal lisp data objects into SAPs.
265
266 (define-vop (vector-sap)
267   (:translate vector-sap)
268   (:policy :fast-safe)
269   (:args (vector :scs (descriptor-reg)))
270   (:results (sap :scs (sap-reg)))
271   (:result-types system-area-pointer)
272   (:generator 2
273     (inst add sap vector
274           (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))))
275 \f
276 ;;; Transforms for 64-bit SAP accessors.
277 (deftransform sap-ref-64 ((sap offset) (* *))
278   '(logior (ash (sap-ref-32 sap offset) 32)
279            (sap-ref-32 sap (+ offset 4))))
280
281 (deftransform signed-sap-ref-64 ((sap offset) (* *))
282   '(logior (ash (signed-sap-ref-32 sap offset) 32)
283            (sap-ref-32 sap (+ 4 offset))))
284
285 (deftransform %set-sap-ref-64 ((sap offset value) (* * *))
286   '(progn
287      (%set-sap-ref-32 sap offset (ash value -32))
288      (%set-sap-ref-32 sap (+ offset 4) (logand value #xffffffff))))
289
290 (deftransform %set-signed-sap-ref-64 ((sap offset value) (* * *))
291   '(progn
292      (%set-signed-sap-ref-32 sap offset (ash value -32))
293      (%set-sap-ref-32 sap (+ 4 offset) (logand value #xffffffff))))