0.7.13.7:
[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            (fixnum 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 #!+alpha
82 (defun sap-ref-64 (sap offset)
83   (declare (type system-area-pointer sap)
84            (fixnum offset))
85   (sap-ref-64 sap offset))
86
87 ;;; Return the 32-bit SAP at OFFSET bytes from SAP.
88 (defun sap-ref-sap (sap offset)
89   (declare (type system-area-pointer sap)
90            (fixnum offset))
91   (sap-ref-sap sap offset))
92
93 ;;; Return the 32-bit SINGLE-FLOAT at OFFSET bytes from SAP.
94 (defun sap-ref-single (sap offset)
95   (declare (type system-area-pointer sap)
96            (fixnum offset))
97   (sap-ref-single sap offset))
98
99 ;;; Return the 64-bit DOUBLE-FLOAT at OFFSET bytes from SAP.
100 (defun sap-ref-double (sap offset)
101   (declare (type system-area-pointer sap)
102            (fixnum offset))
103   (sap-ref-double sap offset))
104
105 ;;; Return the LONG-FLOAT at OFFSET bytes from SAP.
106 #!+(or x86 long-float)
107 (defun sap-ref-long (sap offset)
108   (declare (type system-area-pointer sap)
109            (fixnum offset))
110   (sap-ref-long sap offset))
111
112 ;;; Return the signed 8-bit byte at OFFSET bytes from SAP.
113 (defun signed-sap-ref-8 (sap offset)
114   (declare (type system-area-pointer sap)
115            (fixnum offset))
116   (signed-sap-ref-8 sap offset))
117
118 ;;; Return the signed 16-bit word at OFFSET bytes from SAP.
119 (defun signed-sap-ref-16 (sap offset)
120   (declare (type system-area-pointer sap)
121            (fixnum offset))
122   (signed-sap-ref-16 sap offset))
123
124 ;;; Return the signed 32-bit dualword at OFFSET bytes from SAP.
125 (defun signed-sap-ref-32 (sap offset)
126   (declare (type system-area-pointer sap)
127            (fixnum offset))
128   (signed-sap-ref-32 sap offset))
129
130 ;;; Return the signed 64-bit quadword at OFFSET bytes from SAP.
131 #!+alpha
132 (defun signed-sap-ref-64 (sap offset)
133   (declare (type system-area-pointer sap)
134            (fixnum offset))
135   (signed-sap-ref-64 sap offset))
136
137 (defun %set-sap-ref-8 (sap offset new-value)
138   (declare (type system-area-pointer sap)
139            (fixnum offset)
140            (type (unsigned-byte 8) new-value))
141   (setf (sap-ref-8 sap offset) new-value))
142
143 (defun %set-sap-ref-16 (sap offset new-value)
144   (declare (type system-area-pointer sap)
145            (fixnum offset)
146            (type (unsigned-byte 16) new-value))
147   (setf (sap-ref-16 sap offset) new-value))
148
149 (defun %set-sap-ref-32 (sap offset new-value)
150   (declare (type system-area-pointer sap)
151            (fixnum offset)
152            (type (unsigned-byte 32) new-value))
153   (setf (sap-ref-32 sap offset) new-value))
154
155 #!+alpha
156 (defun %set-sap-ref-64 (sap offset new-value)
157   (declare (type system-area-pointer sap)
158            (fixnum offset)
159            (type (unsigned-byte 64) new-value))
160   (setf (sap-ref-64 sap offset) new-value))
161
162 (defun %set-signed-sap-ref-8 (sap offset new-value)
163   (declare (type system-area-pointer sap)
164            (fixnum offset)
165            (type (signed-byte 8) new-value))
166   (setf (signed-sap-ref-8 sap offset) new-value))
167
168 (defun %set-signed-sap-ref-16 (sap offset new-value)
169   (declare (type system-area-pointer sap)
170            (fixnum offset)
171            (type (signed-byte 16) new-value))
172   (setf (signed-sap-ref-16 sap offset) new-value))
173
174 (defun %set-signed-sap-ref-32 (sap offset new-value)
175   (declare (type system-area-pointer sap)
176            (fixnum offset)
177            (type (signed-byte 32) new-value))
178   (setf (signed-sap-ref-32 sap offset) new-value))
179
180 #!+alpha
181 (defun %set-signed-sap-ref-64 (sap offset new-value)
182   (declare (type system-area-pointer sap)
183            (fixnum offset)
184            (type (signed-byte 64) new-value))
185   (setf (signed-sap-ref-64 sap offset) new-value))
186
187 (defun %set-sap-ref-sap (sap offset new-value)
188   (declare (type system-area-pointer sap new-value)
189            (fixnum offset))
190   (setf (sap-ref-sap sap offset) new-value))
191
192 (defun %set-sap-ref-single (sap offset new-value)
193   (declare (type system-area-pointer sap)
194            (fixnum offset)
195            (type single-float new-value))
196   (setf (sap-ref-single sap offset) new-value))
197
198 (defun %set-sap-ref-double (sap offset new-value)
199   (declare (type system-area-pointer sap)
200            (fixnum offset)
201            (type double-float new-value))
202   (setf (sap-ref-double sap offset) new-value))
203
204 #!+long-float
205 (defun %set-sap-ref-long (sap offset new-value)
206   (declare (type system-area-pointer sap)
207            (fixnum offset)
208            (type long-float new-value))
209   (setf (sap-ref-long sap offset) new-value))