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

Contents of /src/code/sap.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.17 - (show annotations)
Wed Sep 15 15:14:12 1999 UTC (14 years, 7 months ago) by dtc
Branch: MAIN
CVS Tags: snapshot-2003-10, release-18e-base, remove_negative_zero_not_zero, dynamic-extent-base, LINKAGE_TABLE, PRE_LINKAGE_TABLE, sparc_gencgc_merge, release-18e-pre2, cold-pcl-base, sparc_gencgc, UNICODE-BASE, release-18e, lisp-executable-base, release-18e-pre1
Branch point for: sparc_gencgc_branch, dynamic-extent, UNICODE-BRANCH, lisp-executable, release-18e-branch, cold-pcl
Changes since 1.16: +3 -7 lines
Enable the SAP-ref-64 accessors on all ports.
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.17 1999/09/15 15:14:12 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 sap-ref-64 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 %set-sap-ref-64 %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 (defun sap-ref-64 (sap offset)
104 "Returns the 64-bit quadword at OFFSET bytes from SAP."
105 (declare (type system-area-pointer sap)
106 (fixnum offset))
107 (sap-ref-64 sap offset))
108
109 (defun sap-ref-sap (sap offset)
110 "Returns the 32-bit system-area-pointer at OFFSET bytes from SAP."
111 (declare (type system-area-pointer sap)
112 (fixnum offset))
113 (sap-ref-sap sap offset))
114
115 (defun sap-ref-single (sap offset)
116 "Returns the 32-bit single-float at OFFSET bytes from SAP."
117 (declare (type system-area-pointer sap)
118 (fixnum offset))
119 (sap-ref-single sap offset))
120
121 (defun sap-ref-double (sap offset)
122 "Returns the 64-bit double-float at OFFSET bytes from SAP."
123 (declare (type system-area-pointer sap)
124 (fixnum offset))
125 (sap-ref-double sap offset))
126
127 #+(or x86 long-float)
128 (defun sap-ref-long (sap offset)
129 "Returns the long-float at OFFSET bytes from SAP."
130 (declare (type system-area-pointer sap)
131 (fixnum offset))
132 (sap-ref-long sap offset))
133
134 (defun signed-sap-ref-8 (sap offset)
135 "Returns the signed 8-bit byte at OFFSET bytes from SAP."
136 (declare (type system-area-pointer sap)
137 (fixnum offset))
138 (signed-sap-ref-8 sap offset))
139
140 (defun signed-sap-ref-16 (sap offset)
141 "Returns the signed 16-bit word at OFFSET bytes from SAP."
142 (declare (type system-area-pointer sap)
143 (fixnum offset))
144 (signed-sap-ref-16 sap offset))
145
146 (defun signed-sap-ref-32 (sap offset)
147 "Returns the signed 32-bit dualword at OFFSET bytes from SAP."
148 (declare (type system-area-pointer sap)
149 (fixnum offset))
150 (signed-sap-ref-32 sap offset))
151
152 (defun signed-sap-ref-64 (sap offset)
153 "Returns the signed 64-bit quadword at OFFSET bytes from SAP."
154 (declare (type system-area-pointer sap)
155 (fixnum offset))
156 (signed-sap-ref-64 sap offset))
157
158 (defun %set-sap-ref-8 (sap offset new-value)
159 (declare (type system-area-pointer sap)
160 (fixnum offset)
161 (type (unsigned-byte 8) new-value))
162 (setf (sap-ref-8 sap offset) new-value))
163
164 (defun %set-sap-ref-16 (sap offset new-value)
165 (declare (type system-area-pointer sap)
166 (fixnum offset)
167 (type (unsigned-byte 16) new-value))
168 (setf (sap-ref-16 sap offset) new-value))
169
170 (defun %set-sap-ref-32 (sap offset new-value)
171 (declare (type system-area-pointer sap)
172 (fixnum offset)
173 (type (unsigned-byte 32) new-value))
174 (setf (sap-ref-32 sap offset) new-value))
175
176 (defun %set-sap-ref-64 (sap offset new-value)
177 (declare (type system-area-pointer sap)
178 (fixnum offset)
179 (type (unsigned-byte 64) new-value))
180 (setf (sap-ref-64 sap offset) new-value))
181
182 (defun %set-signed-sap-ref-8 (sap offset new-value)
183 (declare (type system-area-pointer sap)
184 (fixnum offset)
185 (type (signed-byte 8) new-value))
186 (setf (signed-sap-ref-8 sap offset) new-value))
187
188 (defun %set-signed-sap-ref-16 (sap offset new-value)
189 (declare (type system-area-pointer sap)
190 (fixnum offset)
191 (type (signed-byte 16) new-value))
192 (setf (signed-sap-ref-16 sap offset) new-value))
193
194 (defun %set-signed-sap-ref-32 (sap offset new-value)
195 (declare (type system-area-pointer sap)
196 (fixnum offset)
197 (type (signed-byte 32) new-value))
198 (setf (signed-sap-ref-32 sap offset) new-value))
199
200 (defun %set-signed-sap-ref-64 (sap offset new-value)
201 (declare (type system-area-pointer sap)
202 (fixnum offset)
203 (type (signed-byte 64) new-value))
204 (setf (signed-sap-ref-64 sap offset) new-value))
205
206 (defun %set-sap-ref-sap (sap offset new-value)
207 (declare (type system-area-pointer sap new-value)
208 (fixnum offset))
209 (setf (sap-ref-sap sap offset) new-value))
210
211 (defun %set-sap-ref-single (sap offset new-value)
212 (declare (type system-area-pointer sap)
213 (fixnum offset)
214 (type single-float new-value))
215 (setf (sap-ref-single sap offset) new-value))
216
217 (defun %set-sap-ref-double (sap offset new-value)
218 (declare (type system-area-pointer sap)
219 (fixnum offset)
220 (type double-float new-value))
221 (setf (sap-ref-double sap offset) new-value))
222
223 #+long-float
224 (defun %set-sap-ref-long (sap offset new-value)
225 (declare (type system-area-pointer sap)
226 (fixnum offset)
227 (type long-float new-value))
228 (setf (sap-ref-long sap offset) new-value))
229
230
231
232 ;;;; System memory allocation.
233
234 (alien:def-alien-routine ("os_allocate" allocate-system-memory)
235 system-area-pointer
236 (bytes c-call:unsigned-long))
237
238 (alien:def-alien-routine ("os_allocate_at" allocate-system-memory-at)
239 system-area-pointer
240 (address system-area-pointer)
241 (bytes c-call:unsigned-long))
242
243 (alien:def-alien-routine ("os_reallocate" reallocate-system-memory)
244 system-area-pointer
245 (old system-area-pointer)
246 (old-size c-call:unsigned-long)
247 (new-size c-call:unsigned-long))
248
249 (alien:def-alien-routine ("os_deallocate" deallocate-system-memory)
250 c-call:void
251 (addr system-area-pointer)
252 (bytes c-call:unsigned-long))

  ViewVC Help
Powered by ViewVC 1.1.5