/[cmucl]/src/code/sap.lisp
ViewVC logotype

Contents of /src/code/sap.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.16 - (show annotations)
Sat Mar 21 08:12:04 1998 UTC (16 years, 1 month ago) by dtc
Branch: MAIN
Changes since 1.15: +9 -2 lines
Long-float support.
1 ;;; -*- Package: SYSTEM -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; This code was written as part of the CMU Common Lisp project at
5 ;;; Carnegie Mellon University, and has been placed in the public domain.
6 ;;;
7 (ext:file-comment
8 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/sap.lisp,v 1.16 1998/03/21 08:12:04 dtc Exp $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; This file holds the support for System Area Pointers (saps).
13 ;;;
14 (in-package "SYSTEM")
15
16 (export '(system-area-pointer sap-ref-8 sap-ref-16 sap-ref-32 sap-ref-sap
17 signed-sap-ref-8 signed-sap-ref-16 signed-sap-ref-32
18 #+alpha sap-ref-64 #+alpha signed-sap-ref-64
19 sap+ sap- sap< sap<= sap= sap>= sap>
20 allocate-system-memory allocate-system-memory-at
21 reallocate-system-memory deallocate-system-memory))
22
23 (in-package "KERNEL")
24 (export '(%set-sap-ref-sap %set-sap-ref-single %set-sap-ref-double
25 %set-sap-ref-8 %set-signed-sap-ref-8
26 %set-sap-ref-16 %set-signed-sap-ref-16
27 %set-sap-ref-32 %set-signed-sap-ref-32
28 #+alpha %set-sap-ref-64 #+alpha %set-signed-sap-ref-64))
29 (in-package "SYSTEM")
30
31 (use-package "KERNEL")
32
33
34
35 ;;;; Primitive SAP operations.
36
37 (defun sap< (x y)
38 "Return T iff the SAP X points to a smaller address then the SAP Y."
39 (declare (type system-area-pointer x y))
40 (sap< x y))
41
42 (defun sap<= (x y)
43 "Return T iff the SAP X points to a smaller or the same address as
44 the SAP Y."
45 (declare (type system-area-pointer x y))
46 (sap<= x y))
47
48 (defun sap= (x y)
49 "Return T iff the SAP X points to the same address as the SAP Y."
50 (declare (type system-area-pointer x y))
51 (sap= x y))
52
53 (defun sap>= (x y)
54 "Return T iff the SAP X points to a larger or the same address as
55 the SAP Y."
56 (declare (type system-area-pointer x y))
57 (sap>= x y))
58
59 (defun sap> (x y)
60 "Return T iff the SAP X points to a larger address then the SAP Y."
61 (declare (type system-area-pointer x y))
62 (sap> x y))
63
64 (defun sap+ (sap offset)
65 "Return a new sap OFFSET bytes from SAP."
66 (declare (type system-area-pointer sap)
67 (fixnum offset))
68 (sap+ sap offset))
69
70 (defun sap- (sap1 sap2)
71 "Return the byte offset between SAP1 and SAP2."
72 (declare (type system-area-pointer sap1 sap2))
73 (sap- sap1 sap2))
74
75 (defun sap-int (sap)
76 "Converts a System Area Pointer into an integer."
77 (declare (type system-area-pointer sap))
78 (sap-int sap))
79
80 (defun int-sap (int)
81 "Converts an integer into a System Area Pointer."
82 (declare (type (unsigned-byte #-alpha #.vm:word-bits #+alpha 64) int))
83 (int-sap int))
84
85 (defun sap-ref-8 (sap offset)
86 "Returns the 8-bit byte at OFFSET bytes from SAP."
87 (declare (type system-area-pointer sap)
88 (fixnum offset))
89 (sap-ref-8 sap offset))
90
91 (defun sap-ref-16 (sap offset)
92 "Returns the 16-bit word at OFFSET bytes from SAP."
93 (declare (type system-area-pointer sap)
94 (fixnum offset))
95 (sap-ref-16 sap offset))
96
97 (defun sap-ref-32 (sap offset)
98 "Returns the 32-bit dualword at OFFSET bytes from SAP."
99 (declare (type system-area-pointer sap)
100 (fixnum offset))
101 (sap-ref-32 sap offset))
102
103 #+alpha
104 (defun sap-ref-64 (sap offset)
105 "Returns the 64-bit quadword at OFFSET bytes from SAP."
106 (declare (type system-area-pointer sap)
107 (fixnum offset))
108 (sap-ref-64 sap offset))
109
110 (defun sap-ref-sap (sap offset)
111 "Returns the 32-bit system-area-pointer at OFFSET bytes from SAP."
112 (declare (type system-area-pointer sap)
113 (fixnum offset))
114 (sap-ref-sap sap offset))
115
116 (defun sap-ref-single (sap offset)
117 "Returns the 32-bit single-float at OFFSET bytes from SAP."
118 (declare (type system-area-pointer sap)
119 (fixnum offset))
120 (sap-ref-single sap offset))
121
122 (defun sap-ref-double (sap offset)
123 "Returns the 64-bit double-float at OFFSET bytes from SAP."
124 (declare (type system-area-pointer sap)
125 (fixnum offset))
126 (sap-ref-double sap offset))
127
128 #+(or x86 long-float)
129 (defun sap-ref-long (sap offset)
130 "Returns the long-float at OFFSET bytes from SAP."
131 (declare (type system-area-pointer sap)
132 (fixnum offset))
133 (sap-ref-long sap offset))
134
135 (defun signed-sap-ref-8 (sap offset)
136 "Returns the signed 8-bit byte at OFFSET bytes from SAP."
137 (declare (type system-area-pointer sap)
138 (fixnum offset))
139 (signed-sap-ref-8 sap offset))
140
141 (defun signed-sap-ref-16 (sap offset)
142 "Returns the signed 16-bit word at OFFSET bytes from SAP."
143 (declare (type system-area-pointer sap)
144 (fixnum offset))
145 (signed-sap-ref-16 sap offset))
146
147 (defun signed-sap-ref-32 (sap offset)
148 "Returns the signed 32-bit dualword at OFFSET bytes from SAP."
149 (declare (type system-area-pointer sap)
150 (fixnum offset))
151 (signed-sap-ref-32 sap offset))
152
153 #+alpha
154 (defun signed-sap-ref-64 (sap offset)
155 "Returns the signed 64-bit quadword at OFFSET bytes from SAP."
156 (declare (type system-area-pointer sap)
157 (fixnum offset))
158 (signed-sap-ref-64 sap offset))
159
160 (defun %set-sap-ref-8 (sap offset new-value)
161 (declare (type system-area-pointer sap)
162 (fixnum offset)
163 (type (unsigned-byte 8) new-value))
164 (setf (sap-ref-8 sap offset) new-value))
165
166 (defun %set-sap-ref-16 (sap offset new-value)
167 (declare (type system-area-pointer sap)
168 (fixnum offset)
169 (type (unsigned-byte 16) new-value))
170 (setf (sap-ref-16 sap offset) new-value))
171
172 (defun %set-sap-ref-32 (sap offset new-value)
173 (declare (type system-area-pointer sap)
174 (fixnum offset)
175 (type (unsigned-byte 32) new-value))
176 (setf (sap-ref-32 sap offset) new-value))
177
178 #+alpha
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-signed-sap-ref-8 (sap offset new-value)
186 (declare (type system-area-pointer sap)
187 (fixnum offset)
188 (type (signed-byte 8) new-value))
189 (setf (signed-sap-ref-8 sap offset) new-value))
190
191 (defun %set-signed-sap-ref-16 (sap offset new-value)
192 (declare (type system-area-pointer sap)
193 (fixnum offset)
194 (type (signed-byte 16) new-value))
195 (setf (signed-sap-ref-16 sap offset) new-value))
196
197 (defun %set-signed-sap-ref-32 (sap offset new-value)
198 (declare (type system-area-pointer sap)
199 (fixnum offset)
200 (type (signed-byte 32) new-value))
201 (setf (signed-sap-ref-32 sap offset) new-value))
202
203 #+alpha
204 (defun %set-signed-sap-ref-64 (sap offset new-value)
205 (declare (type system-area-pointer sap)
206 (fixnum offset)
207 (type (signed-byte 64) new-value))
208 (setf (signed-sap-ref-64 sap offset) new-value))
209
210 (defun %set-sap-ref-sap (sap offset new-value)
211 (declare (type system-area-pointer sap new-value)
212 (fixnum offset))
213 (setf (sap-ref-sap sap offset) new-value))
214
215 (defun %set-sap-ref-single (sap offset new-value)
216 (declare (type system-area-pointer sap)
217 (fixnum offset)
218 (type single-float new-value))
219 (setf (sap-ref-single sap offset) new-value))
220
221 (defun %set-sap-ref-double (sap offset new-value)
222 (declare (type system-area-pointer sap)
223 (fixnum offset)
224 (type double-float new-value))
225 (setf (sap-ref-double sap offset) new-value))
226
227 #+long-float
228 (defun %set-sap-ref-long (sap offset new-value)
229 (declare (type system-area-pointer sap)
230 (fixnum offset)
231 (type long-float new-value))
232 (setf (sap-ref-long sap offset) new-value))
233
234
235
236 ;;;; System memory allocation.
237
238 (alien:def-alien-routine ("os_allocate" allocate-system-memory)
239 system-area-pointer
240 (bytes c-call:unsigned-long))
241
242 (alien:def-alien-routine ("os_allocate_at" allocate-system-memory-at)
243 system-area-pointer
244 (address system-area-pointer)
245 (bytes c-call:unsigned-long))
246
247 (alien:def-alien-routine ("os_reallocate" reallocate-system-memory)
248 system-area-pointer
249 (old system-area-pointer)
250 (old-size c-call:unsigned-long)
251 (new-size c-call:unsigned-long))
252
253 (alien:def-alien-routine ("os_deallocate" deallocate-system-memory)
254 c-call:void
255 (addr system-area-pointer)
256 (bytes c-call:unsigned-long))

  ViewVC Help
Powered by ViewVC 1.1.5