1.0.9.18: Instrument COMPUTE-CALLING-FRAME for non-x86 with /noshow0.
[sbcl.git] / src / code / target-sap.lisp
1 ;;;; support for System Area Pointers (SAPs) in the target machine
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!KERNEL")
13
14 ;;; Return T iff the SAP X points to a smaller address then the SAP Y.
15 (defun sap< (x y)
16   (declare (type system-area-pointer x y))
17   (sap< x y))
18
19 ;;; Return T iff the SAP X points to a smaller or the same address as
20 ;;; the SAP Y.
21 (defun sap<= (x y)
22   (declare (type system-area-pointer x y))
23   (sap<= x y))
24
25 ;;; Return T iff the SAP X points to the same address as the SAP Y.
26 (defun sap= (x y)
27   (declare (type system-area-pointer x y))
28   (sap= x y))
29
30 ;;; Return T iff the SAP X points to a larger or the same address as
31 ;;; the SAP Y.
32 (defun sap>= (x y)
33   (declare (type system-area-pointer x y))
34   (sap>= x y))
35
36 ;;; Return T iff the SAP X points to a larger address then the SAP Y.
37 (defun sap> (x y)
38   (declare (type system-area-pointer x y))
39   (sap> x y))
40
41 ;;; Return a new SAP, OFFSET bytes from SAP.
42 (defun sap+ (sap offset)
43   (declare (type system-area-pointer sap)
44            (type (signed-byte #.sb!vm:n-word-bits) offset))
45   (sap+ sap offset))
46
47 ;;; Return the byte offset between SAP1 and SAP2.
48 (defun sap- (sap1 sap2)
49   (declare (type system-area-pointer sap1 sap2))
50   (sap- sap1 sap2))
51
52 ;;; Convert SAP into an integer.
53 (defun sap-int (sap)
54   (declare (type system-area-pointer sap))
55   (sap-int sap))
56
57 ;;; Convert an integer into a SAP.
58 (defun int-sap (int)
59   (declare (type sap-int int))
60   (int-sap int))
61
62 ;;; Return the 8-bit byte at OFFSET bytes from SAP.
63 (defun sap-ref-8 (sap offset)
64   (declare (type system-area-pointer sap)
65            (fixnum offset))
66   (sap-ref-8 sap offset))
67
68 ;;; Return the 16-bit word at OFFSET bytes from SAP.
69 (defun sap-ref-16 (sap offset)
70   (declare (type system-area-pointer sap)
71            (fixnum offset))
72   (sap-ref-16 sap offset))
73
74 ;;; Returns the 32-bit dualword at OFFSET bytes from SAP.
75 (defun sap-ref-32 (sap offset)
76   (declare (type system-area-pointer sap)
77            (fixnum offset))
78   (sap-ref-32 sap offset))
79
80 ;;; Return the 64-bit quadword at OFFSET bytes from SAP.
81 (defun sap-ref-64 (sap offset)
82   (declare (type system-area-pointer sap)
83            (fixnum offset))
84   (sap-ref-64 sap offset))
85
86 ;;; Return the unsigned word of natural size OFFSET bytes from SAP.
87 (defun sap-ref-word (sap offset)
88   (declare (type system-area-pointer sap)
89            (fixnum offset))
90   (sap-ref-word sap offset))
91
92 ;;; Return the 32-bit SAP at OFFSET bytes from SAP.
93 (defun sap-ref-sap (sap offset)
94   (declare (type system-area-pointer sap)
95            (fixnum offset))
96   (sap-ref-sap sap offset))
97
98 ;;; Return the 32-bit SINGLE-FLOAT at OFFSET bytes from SAP.
99 (defun sap-ref-single (sap offset)
100   (declare (type system-area-pointer sap)
101            (fixnum offset))
102   (sap-ref-single sap offset))
103
104 ;;; Return the 64-bit DOUBLE-FLOAT at OFFSET bytes from SAP.
105 (defun sap-ref-double (sap offset)
106   (declare (type system-area-pointer sap)
107            (fixnum offset))
108   (sap-ref-double sap offset))
109
110 ;;; Return the LONG-FLOAT at OFFSET bytes from SAP.
111 #!+(or x86 long-float)
112 (defun sap-ref-long (sap offset)
113   (declare (type system-area-pointer sap)
114            (fixnum offset))
115   (sap-ref-long sap offset))
116
117 ;;; Return the signed 8-bit byte at OFFSET bytes from SAP.
118 (defun signed-sap-ref-8 (sap offset)
119   (declare (type system-area-pointer sap)
120            (fixnum offset))
121   (signed-sap-ref-8 sap offset))
122
123 ;;; Return the signed 16-bit word at OFFSET bytes from SAP.
124 (defun signed-sap-ref-16 (sap offset)
125   (declare (type system-area-pointer sap)
126            (fixnum offset))
127   (signed-sap-ref-16 sap offset))
128
129 ;;; Return the signed 32-bit dualword at OFFSET bytes from SAP.
130 (defun signed-sap-ref-32 (sap offset)
131   (declare (type system-area-pointer sap)
132            (fixnum offset))
133   (signed-sap-ref-32 sap offset))
134
135 ;;; Return the signed 64-bit quadword at OFFSET bytes from SAP.
136 (defun signed-sap-ref-64 (sap offset)
137   (declare (type system-area-pointer sap)
138            (fixnum offset))
139   (signed-sap-ref-64 sap offset))
140
141 ;;; Return the signed word of natural size OFFSET bytes from SAP.
142 (defun signed-sap-ref-word (sap offset)
143   (declare (type system-area-pointer sap)
144            (fixnum offset))
145   (signed-sap-ref-word sap offset))
146
147 (defun %set-sap-ref-8 (sap offset new-value)
148   (declare (type system-area-pointer sap)
149            (fixnum offset)
150            (type (unsigned-byte 8) new-value))
151   (setf (sap-ref-8 sap offset) new-value))
152
153 (defun %set-sap-ref-16 (sap offset new-value)
154   (declare (type system-area-pointer sap)
155            (fixnum offset)
156            (type (unsigned-byte 16) new-value))
157   (setf (sap-ref-16 sap offset) new-value))
158
159 (defun %set-sap-ref-32 (sap offset new-value)
160   (declare (type system-area-pointer sap)
161            (fixnum offset)
162            (type (unsigned-byte 32) new-value))
163   (setf (sap-ref-32 sap offset) new-value))
164
165 (defun %set-sap-ref-64 (sap offset new-value)
166   (declare (type system-area-pointer sap)
167            (fixnum offset)
168            (type (unsigned-byte 64) new-value))
169   (setf (sap-ref-64 sap offset) new-value))
170
171 (defun %set-sap-ref-word (sap offset new-value)
172   (declare (type system-area-pointer sap)
173            (fixnum offset)
174            (type (unsigned-byte #.sb!vm:n-machine-word-bits) new-value))
175   (setf (sap-ref-word sap offset) new-value))
176
177 (defun %set-signed-sap-ref-8 (sap offset new-value)
178   (declare (type system-area-pointer sap)
179            (fixnum offset)
180            (type (signed-byte 8) new-value))
181   (setf (signed-sap-ref-8 sap offset) new-value))
182
183 (defun %set-signed-sap-ref-16 (sap offset new-value)
184   (declare (type system-area-pointer sap)
185            (fixnum offset)
186            (type (signed-byte 16) new-value))
187   (setf (signed-sap-ref-16 sap offset) new-value))
188
189 (defun %set-signed-sap-ref-32 (sap offset new-value)
190   (declare (type system-area-pointer sap)
191            (fixnum offset)
192            (type (signed-byte 32) new-value))
193   (setf (signed-sap-ref-32 sap offset) new-value))
194
195 (defun %set-signed-sap-ref-64 (sap offset new-value)
196   (declare (type system-area-pointer sap)
197            (fixnum offset)
198            (type (signed-byte 64) new-value))
199   (setf (signed-sap-ref-64 sap offset) new-value))
200
201 (defun %set-signed-sap-ref-word (sap offset new-value)
202   (declare (type system-area-pointer sap)
203            (fixnum offset)
204            (type (signed-byte #.sb!vm:n-machine-word-bits) new-value))
205   (setf (signed-sap-ref-word sap offset) new-value))
206
207 (defun %set-sap-ref-sap (sap offset new-value)
208   (declare (type system-area-pointer sap new-value)
209            (fixnum offset))
210   (setf (sap-ref-sap sap offset) new-value))
211
212 (defun %set-sap-ref-single (sap offset new-value)
213   (declare (type system-area-pointer sap)
214            (fixnum offset)
215            (type single-float new-value))
216   (setf (sap-ref-single sap offset) new-value))
217
218 (defun %set-sap-ref-double (sap offset new-value)
219   (declare (type system-area-pointer sap)
220            (fixnum offset)
221            (type double-float new-value))
222   (setf (sap-ref-double sap offset) new-value))
223
224 #!+long-float
225 (defun %set-sap-ref-long (sap offset new-value)
226   (declare (type system-area-pointer sap)
227            (fixnum offset)
228            (type long-float new-value))
229   (setf (sap-ref-long sap offset) new-value))