1 ;;;; the ARM VM definition of SAP operations
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.
15 ;;;; Moves and coercions:
17 ;;; Move a tagged SAP to an untagged representation.
18 (define-vop (move-to-sap)
19 (:args
(x :scs
(any-reg descriptor-reg
)))
20 (:results
(y :scs
(sap-reg)))
21 (:note
"pointer to SAP coercion")
23 (loadw y x sap-pointer-slot other-pointer-lowtag
)))
25 (define-move-vop move-to-sap
:move
26 (descriptor-reg) (sap-reg))
29 ;;; Move an untagged SAP to a tagged representation.
30 (define-vop (move-from-sap)
31 (:args
(sap :scs
(sap-reg) :to
:save
))
32 (:temporary
(:sc non-descriptor-reg
:offset ocfp-offset
) pa-flag
)
33 (:results
(res :scs
(descriptor-reg)))
34 (:note
"SAP to pointer coercion")
36 (with-fixed-allocation (res pa-flag sap-widetag sap-size
)
37 (storew sap res sap-pointer-slot other-pointer-lowtag
))))
39 (define-move-vop move-from-sap
:move
40 (sap-reg) (descriptor-reg))
42 ;;; Move untagged sap values.
43 (define-vop (sap-move)
46 :load-if
(not (location= x y
))))
47 (:results
(y :scs
(sap-reg)
48 :load-if
(not (location= x y
))))
55 (define-move-vop sap-move
:move
59 ;;; Move untagged sap arguments/return-values.
60 (define-vop (move-sap-arg)
64 :load-if
(not (sc-is y sap-reg
))))
66 (:note
"SAP argument move")
72 (store-stack-offset x fp y
)))))
74 (define-move-vop move-sap-arg
:move-arg
75 (descriptor-reg sap-reg
) (sap-reg))
77 ;;; Use standard MOVE-ARG + coercion to move an untagged sap to a
78 ;;; descriptor passing location.
79 (define-move-vop move-arg
:move-arg
80 (sap-reg) (descriptor-reg))
82 ;;;; SAP-INT and INT-SAP
84 (:args
(sap :scs
(sap-reg) :target int
))
85 (:arg-types system-area-pointer
)
86 (:results
(int :scs
(unsigned-reg)))
87 (:result-types unsigned-num
)
94 (:args
(int :scs
(unsigned-reg) :target sap
))
95 (:arg-types unsigned-num
)
96 (:results
(sap :scs
(sap-reg)))
97 (:result-types system-area-pointer
)
103 ;;;; POINTER+ and POINTER-
104 (define-vop (pointer+)
106 (:args
(ptr :scs
(sap-reg))
107 (offset :scs
(signed-reg)))
108 (:arg-types system-area-pointer signed-num
)
109 (:results
(res :scs
(sap-reg)))
110 (:result-types system-area-pointer
)
113 (inst add res ptr offset
)))
115 (define-vop (pointer+-unsigned-c
)
117 (:args
(ptr :scs
(sap-reg)))
119 (:arg-types system-area-pointer
(:constant
(unsigned-byte 8)))
120 (:results
(res :scs
(sap-reg)))
121 (:result-types system-area-pointer
)
124 (inst add res ptr offset
)))
126 (define-vop (pointer+-signed-c
)
128 (:args
(ptr :scs
(sap-reg)))
130 (:arg-types system-area-pointer
(:constant
(integer -
255 -
1)))
131 (:results
(res :scs
(sap-reg)))
132 (:result-types system-area-pointer
)
135 (inst sub res ptr
(- offset
))))
137 (define-vop (pointer-)
139 (:args
(ptr1 :scs
(sap-reg))
140 (ptr2 :scs
(sap-reg)))
141 (:arg-types system-area-pointer system-area-pointer
)
143 (:results
(res :scs
(signed-reg)))
144 (:result-types signed-num
)
146 (inst sub res ptr1 ptr2
)))
148 ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET
149 (macrolet ((def-system-ref-and-set
150 ;; NOTE: The -C VOPs have been disabled, as the allowed
151 ;; displacements for memory references vary by
152 ;; instruction, are confusing to figure out, and might
153 ;; be sign-magnitude encoded. FIXME: Figure these
154 ;; things out, and re-enable the VOPs.
155 (ref-name set-name sc type size
&key signed use-lip
)
156 (let ((ref-name-c (symbolicate ref-name
"-C"))
157 (set-name-c (symbolicate set-name
"-C")))
158 (declare (ignorable ref-name-c set-name-c
))
160 (define-vop (,ref-name
)
161 (:translate
,ref-name
)
163 (:args
(sap :scs
(sap-reg))
164 (offset :scs
(signed-reg)))
165 (:arg-types system-area-pointer signed-num
)
166 (:results
(result :scs
(,sc
)))
167 (:result-types
,type
)
169 '((:temporary
(:sc interior-reg
) lip
)))
172 '((inst add lip sap offset
)))
174 (:byte
(if signed
'ldrsb
'ldrb
))
175 (:short
(if signed
'ldrsh
'ldrh
))
183 (define-vop (,ref-name-c
)
184 (:translate
,ref-name
)
186 (:args
(sap :scs
(sap-reg)))
187 (:arg-types system-area-pointer
(:constant
(signed-byte 16)))
189 (:results
(result :scs
(,sc
)))
190 (:result-types
,type
)
193 (:byte
(if signed
'ldrsb
'ldrb
))
194 (:short
(if signed
'ldrsh
'ldrh
))
198 result
(@ sap offset
))))
199 (define-vop (,set-name
)
200 (:translate
,set-name
)
202 (:args
(sap :scs
(sap-reg))
203 (offset :scs
(signed-reg))
204 (value :scs
(,sc
) :target result
))
205 (:arg-types system-area-pointer signed-num
,type
)
206 (:results
(result :scs
(,sc
)))
207 (:result-types
,type
)
209 '((:temporary
(:sc interior-reg
) lip
)))
212 '((inst add lip sap offset
)))
222 (unless (location= result value
)
225 '((inst fcpys result value
)))
227 '((inst fcpyd result value
)))
229 '((inst mov result value
)))))))
231 (define-vop (,set-name-c
)
232 (:translate
,set-name
)
234 (:args
(sap :scs
(sap-reg))
235 (value :scs
(,sc
) :target result
))
236 (:arg-types system-area-pointer
(:constant
(signed-byte 16)) ,type
)
238 (:results
(result :scs
(,sc
)))
239 (:result-types
,type
)
247 value
(@ sap offset
))
248 (unless (location= result value
)
251 '((inst fcpys result value
)))
253 '((inst fcpyd result value
)))
255 '((inst mov result value
)))))))))))
256 (def-system-ref-and-set sap-ref-8 %set-sap-ref-8
257 unsigned-reg positive-fixnum
:byte
:signed nil
)
258 (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8
259 signed-reg tagged-num
:byte
:signed t
)
260 (def-system-ref-and-set sap-ref-16 %set-sap-ref-16
261 unsigned-reg positive-fixnum
:short
:signed nil
)
262 (def-system-ref-and-set signed-sap-ref-16 %set-signed-sap-ref-16
263 signed-reg tagged-num
:short
:signed t
)
264 (def-system-ref-and-set sap-ref-32 %set-sap-ref-32
265 unsigned-reg unsigned-num
:long
:signed nil
)
266 (def-system-ref-and-set signed-sap-ref-32 %set-signed-sap-ref-32
267 signed-reg signed-num
:long
:signed t
)
268 (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap
269 sap-reg system-area-pointer
:long
)
270 (def-system-ref-and-set sap-ref-lispobj %set-sap-ref-lispobj
271 descriptor-reg
* :long
)
272 (def-system-ref-and-set sap-ref-single %set-sap-ref-single
273 single-reg single-float
:single
:use-lip t
)
274 (def-system-ref-and-set sap-ref-double %set-sap-ref-double
275 double-reg double-float
:double
:use-lip t
))
277 ;;; Noise to convert normal lisp data objects into SAPs.
278 (define-vop (vector-sap)
279 (:translate vector-sap
)
281 (:args
(vector :scs
(descriptor-reg)))
282 (:results
(sap :scs
(sap-reg)))
283 (:result-types system-area-pointer
)
286 (- (* vector-data-offset n-word-bytes
) other-pointer-lowtag
))))