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 (:temporary
(:scs
(interior-reg)) lip
)
34 (:results
(res :scs
(descriptor-reg)))
35 (:note
"SAP to pointer coercion")
37 (with-fixed-allocation (res pa-flag sap-widetag sap-size
:lip lip
)
38 (storew sap res sap-pointer-slot other-pointer-lowtag
))))
40 (define-move-vop move-from-sap
:move
41 (sap-reg) (descriptor-reg))
43 ;;; Move untagged sap values.
44 (define-vop (sap-move)
47 :load-if
(not (location= x y
))))
48 (:results
(y :scs
(sap-reg)
49 :load-if
(not (location= x y
))))
56 (define-move-vop sap-move
:move
60 ;;; Move untagged sap arguments/return-values.
61 (define-vop (move-sap-arg)
65 :load-if
(not (sc-is y sap-reg
))))
67 (:note
"SAP argument move")
73 (store-stack-offset x fp y
)))))
75 (define-move-vop move-sap-arg
:move-arg
76 (descriptor-reg sap-reg
) (sap-reg))
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))
83 ;;;; SAP-INT and INT-SAP
85 (:args
(sap :scs
(sap-reg) :target int
))
86 (:arg-types system-area-pointer
)
87 (:results
(int :scs
(unsigned-reg)))
88 (:result-types unsigned-num
)
95 (:args
(int :scs
(unsigned-reg) :target sap
))
96 (:arg-types unsigned-num
)
97 (:results
(sap :scs
(sap-reg)))
98 (:result-types system-area-pointer
)
104 ;;;; POINTER+ and POINTER-
105 (define-vop (pointer+)
107 (:args
(ptr :scs
(sap-reg))
108 (offset :scs
(signed-reg)))
109 (:arg-types system-area-pointer signed-num
)
110 (:results
(res :scs
(sap-reg)))
111 (:result-types system-area-pointer
)
114 (inst add res ptr offset
)))
116 (define-vop (pointer+-unsigned-c
)
118 (:args
(ptr :scs
(sap-reg)))
120 (:arg-types system-area-pointer
(:constant
(unsigned-byte 8)))
121 (:results
(res :scs
(sap-reg)))
122 (:result-types system-area-pointer
)
125 (inst add res ptr offset
)))
127 (define-vop (pointer+-signed-c
)
129 (:args
(ptr :scs
(sap-reg)))
131 (:arg-types system-area-pointer
(:constant
(integer -
255 -
1)))
132 (:results
(res :scs
(sap-reg)))
133 (:result-types system-area-pointer
)
136 (inst sub res ptr
(- offset
))))
138 (define-vop (pointer-)
140 (:args
(ptr1 :scs
(sap-reg))
141 (ptr2 :scs
(sap-reg)))
142 (:arg-types system-area-pointer system-area-pointer
)
144 (:results
(res :scs
(signed-reg)))
145 (:result-types signed-num
)
147 (inst sub res ptr1 ptr2
)))
149 ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET
150 (macrolet ((def-system-ref-and-set
151 (ref-name set-name sc type size
&key signed
)
153 (define-vop (,ref-name
)
154 (:translate
,ref-name
)
156 (:args
(sap :scs
(sap-reg))
157 (offset :scs
(signed-reg)))
158 (:arg-types system-area-pointer signed-num
)
159 (:results
(result :scs
(,sc
)))
160 (:result-types
,type
)
163 (:byte
(if signed
'ldrsb
'ldrb
))
164 (:short
(if signed
'ldrsh
'ldrh
))
165 (:word
(if signed
'ldrsw
'ldr
))
171 (define-vop (,set-name
)
172 (:translate
,set-name
)
174 (:args
(sap :scs
(sap-reg))
175 (offset :scs
(signed-reg))
176 (value :scs
(,sc
) :target result
))
177 (:arg-types system-area-pointer signed-num
,type
)
178 (:results
(result :scs
(,sc
)))
179 (:result-types
,type
)
189 (unless (location= result value
)
192 '((inst fmov result value
)))
194 '((inst mov result value
))))))))))
195 (def-system-ref-and-set sap-ref-8 %set-sap-ref-8
196 unsigned-reg positive-fixnum
:byte
:signed nil
)
197 (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8
198 signed-reg tagged-num
:byte
:signed t
)
199 (def-system-ref-and-set sap-ref-16 %set-sap-ref-16
200 unsigned-reg positive-fixnum
:short
:signed nil
)
201 (def-system-ref-and-set signed-sap-ref-16 %set-signed-sap-ref-16
202 signed-reg tagged-num
:short
:signed t
)
203 (def-system-ref-and-set sap-ref-32 %set-sap-ref-32
204 unsigned-reg unsigned-num
:word
:signed nil
)
205 (def-system-ref-and-set signed-sap-ref-32 %set-signed-sap-ref-32
206 signed-reg signed-num
:word
:signed t
)
207 (def-system-ref-and-set sap-ref-64 %set-sap-ref-64
208 unsigned-reg unsigned-num
:long
:signed nil
)
209 (def-system-ref-and-set signed-sap-ref-64 %set-signed-sap-ref-64
210 signed-reg signed-num
:long
:signed t
)
211 (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap
212 sap-reg system-area-pointer
:long
)
213 (def-system-ref-and-set sap-ref-lispobj %set-sap-ref-lispobj
214 descriptor-reg
* :long
)
215 (def-system-ref-and-set sap-ref-single %set-sap-ref-single
216 single-reg single-float
:single
)
217 (def-system-ref-and-set sap-ref-double %set-sap-ref-double
218 double-reg double-float
:double
))
220 ;;; Noise to convert normal lisp data objects into SAPs.
221 (define-vop (vector-sap)
222 (:translate vector-sap
)
224 (:args
(vector :scs
(descriptor-reg)))
225 (:results
(sap :scs
(sap-reg)))
226 (:result-types system-area-pointer
)
229 (- (* vector-data-offset n-word-bytes
) other-pointer-lowtag
))))