Silence notes about being specialised EQ templates on x86oids
[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 (defun sap-ref-octets (sap offset count)
69   (declare (type system-area-pointer sap)
70            (fixnum offset count))
71   (let ((buffer (make-array count :element-type '(unsigned-byte 8))))
72     (dotimes (i count)
73       (setf (aref buffer i) (sap-ref-8 sap (+ offset i))))
74     buffer))
75
76 ;;; Return the 16-bit word at OFFSET bytes from SAP.
77 (defun sap-ref-16 (sap offset)
78   (declare (type system-area-pointer sap)
79            (fixnum offset))
80   (sap-ref-16 sap offset))
81
82 ;;; Returns the 32-bit dualword at OFFSET bytes from SAP.
83 (defun sap-ref-32 (sap offset)
84   (declare (type system-area-pointer sap)
85            (fixnum offset))
86   (sap-ref-32 sap offset))
87
88 ;;; Return the 64-bit quadword at OFFSET bytes from SAP.
89 (defun sap-ref-64 (sap offset)
90   (declare (type system-area-pointer sap)
91            (fixnum offset))
92   (sap-ref-64 sap offset))
93
94 ;;; Return the unsigned word of natural size OFFSET bytes from SAP.
95 (defun sap-ref-word (sap offset)
96   (declare (type system-area-pointer sap)
97            (fixnum offset))
98   (sap-ref-word sap offset))
99
100 ;;; Return the 32-bit SAP at OFFSET bytes from SAP.
101 (defun sap-ref-sap (sap offset)
102   (declare (type system-area-pointer sap)
103            (fixnum offset))
104   (sap-ref-sap sap offset))
105
106 ;; Return the LISPOBJ at OFFSET bytes from SAP.
107 (defun sap-ref-lispobj (sap offset)
108   (declare (type system-area-pointer sap)
109            (fixnum offset))
110   (sap-ref-lispobj sap offset))
111
112 ;;; Return the 32-bit SINGLE-FLOAT at OFFSET bytes from SAP.
113 (defun sap-ref-single (sap offset)
114   (declare (type system-area-pointer sap)
115            (fixnum offset))
116   (sap-ref-single sap offset))
117
118 ;;; Return the 64-bit DOUBLE-FLOAT at OFFSET bytes from SAP.
119 (defun sap-ref-double (sap offset)
120   (declare (type system-area-pointer sap)
121            (fixnum offset))
122   (sap-ref-double sap offset))
123
124 ;;; Return the LONG-FLOAT at OFFSET bytes from SAP.
125 #!+(or x86 long-float)
126 (defun sap-ref-long (sap offset)
127   (declare (type system-area-pointer sap)
128            (fixnum offset))
129   (sap-ref-long sap offset))
130
131 ;;; Return the signed 8-bit byte at OFFSET bytes from SAP.
132 (defun signed-sap-ref-8 (sap offset)
133   (declare (type system-area-pointer sap)
134            (fixnum offset))
135   (signed-sap-ref-8 sap offset))
136
137 ;;; Return the signed 16-bit word at OFFSET bytes from SAP.
138 (defun signed-sap-ref-16 (sap offset)
139   (declare (type system-area-pointer sap)
140            (fixnum offset))
141   (signed-sap-ref-16 sap offset))
142
143 ;;; Return the signed 32-bit dualword at OFFSET bytes from SAP.
144 (defun signed-sap-ref-32 (sap offset)
145   (declare (type system-area-pointer sap)
146            (fixnum offset))
147   (signed-sap-ref-32 sap offset))
148
149 ;;; Return the signed 64-bit quadword at OFFSET bytes from SAP.
150 (defun signed-sap-ref-64 (sap offset)
151   (declare (type system-area-pointer sap)
152            (fixnum offset))
153   (signed-sap-ref-64 sap offset))
154
155 ;;; Return the signed word of natural size OFFSET bytes from SAP.
156 (defun signed-sap-ref-word (sap offset)
157   (declare (type system-area-pointer sap)
158            (fixnum offset))
159   (signed-sap-ref-word sap offset))
160
161 (defun %set-sap-ref-8 (sap offset new-value)
162   (declare (type system-area-pointer sap)
163            (fixnum offset)
164            (type (unsigned-byte 8) new-value))
165   (setf (sap-ref-8 sap offset) new-value))
166
167 (defun %set-sap-ref-16 (sap offset new-value)
168   (declare (type system-area-pointer sap)
169            (fixnum offset)
170            (type (unsigned-byte 16) new-value))
171   (setf (sap-ref-16 sap offset) new-value))
172
173 (defun %set-sap-ref-32 (sap offset new-value)
174   (declare (type system-area-pointer sap)
175            (fixnum offset)
176            (type (unsigned-byte 32) new-value))
177   (setf (sap-ref-32 sap offset) new-value))
178
179 (defun %set-sap-ref-64 (sap offset new-value)
180   (declare (type system-area-pointer sap)
181            (fixnum offset)
182            (type (unsigned-byte 64) new-value))
183   (setf (sap-ref-64 sap offset) new-value))
184
185 (defun %set-sap-ref-word (sap offset new-value)
186   (declare (type system-area-pointer sap)
187            (fixnum offset)
188            (type (unsigned-byte #.sb!vm:n-machine-word-bits) new-value))
189   (setf (sap-ref-word sap offset) new-value))
190
191 (defun %set-signed-sap-ref-8 (sap offset new-value)
192   (declare (type system-area-pointer sap)
193            (fixnum offset)
194            (type (signed-byte 8) new-value))
195   (setf (signed-sap-ref-8 sap offset) new-value))
196
197 (defun %set-signed-sap-ref-16 (sap offset new-value)
198   (declare (type system-area-pointer sap)
199            (fixnum offset)
200            (type (signed-byte 16) new-value))
201   (setf (signed-sap-ref-16 sap offset) new-value))
202
203 (defun %set-signed-sap-ref-32 (sap offset new-value)
204   (declare (type system-area-pointer sap)
205            (fixnum offset)
206            (type (signed-byte 32) new-value))
207   (setf (signed-sap-ref-32 sap offset) new-value))
208
209 (defun %set-signed-sap-ref-64 (sap offset new-value)
210   (declare (type system-area-pointer sap)
211            (fixnum offset)
212            (type (signed-byte 64) new-value))
213   (setf (signed-sap-ref-64 sap offset) new-value))
214
215 (defun %set-signed-sap-ref-word (sap offset new-value)
216   (declare (type system-area-pointer sap)
217            (fixnum offset)
218            (type (signed-byte #.sb!vm:n-machine-word-bits) new-value))
219   (setf (signed-sap-ref-word sap offset) new-value))
220
221 (defun %set-sap-ref-sap (sap offset new-value)
222   (declare (type system-area-pointer sap new-value)
223            (fixnum offset))
224   (setf (sap-ref-sap sap offset) new-value))
225
226 (defun %set-sap-ref-lispobj (sap offset new-value)
227   (declare (type system-area-pointer sap)
228            (fixnum offset)
229            (t new-value))
230   (setf (sap-ref-lispobj sap offset) new-value))
231
232 (defun %set-sap-ref-single (sap offset new-value)
233   (declare (type system-area-pointer sap)
234            (fixnum offset)
235            (type single-float new-value))
236   (setf (sap-ref-single sap offset) new-value))
237
238 (defun %set-sap-ref-double (sap offset new-value)
239   (declare (type system-area-pointer sap)
240            (fixnum offset)
241            (type double-float new-value))
242   (setf (sap-ref-double sap offset) new-value))
243
244 #!+long-float
245 (defun %set-sap-ref-long (sap offset new-value)
246   (declare (type system-area-pointer sap)
247            (fixnum offset)
248            (type long-float new-value))
249   (setf (sap-ref-long sap offset) new-value))