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

Contents of /src/code/sap.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.23 - (show annotations)
Mon Apr 19 02:18:04 2010 UTC (3 years, 11 months ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, release-20b-pre1, release-20b-pre2, sparc-tramp-assem-2010-07-19, GIT-CONVERSION, cross-sol-x86-merged, RELEASE_20b, cross-sol-x86-base, snapshot-2010-12, snapshot-2010-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, snapshot-2010-05, snapshot-2010-07, snapshot-2010-06, snapshot-2010-08, cross-sol-x86-2010-12-20, cross-sparc-branch-base, HEAD
Branch point for: cross-sparc-branch, RELEASE-20B-BRANCH, sparc-tramp-assem-branch, cross-sol-x86-branch
Changes since 1.22: +21 -21 lines
Remove _N"" reader macro from docstrings when possible.
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.23 2010/04/19 02:18:04 rtoy Rel $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; This file holds the support for System Area Pointers (saps).
13 ;;;
14 (in-package "SYSTEM")
15 (intl:textdomain "cmucl")
16
17 (export '(system-area-pointer sap-ref-8 sap-ref-16 sap-ref-32 sap-ref-sap
18 signed-sap-ref-8 signed-sap-ref-16 signed-sap-ref-32
19 sap-ref-64 signed-sap-ref-64
20 sap+ sap- sap< sap<= sap= sap>= sap>
21 allocate-system-memory allocate-system-memory-at
22 reallocate-system-memory deallocate-system-memory))
23
24 (in-package "KERNEL")
25 (export '(%set-sap-ref-sap %set-sap-ref-single %set-sap-ref-double
26 %set-sap-ref-8 %set-signed-sap-ref-8
27 %set-sap-ref-16 %set-signed-sap-ref-16
28 %set-sap-ref-32 %set-signed-sap-ref-32
29 %set-sap-ref-64 %set-signed-sap-ref-64))
30 (in-package "SYSTEM")
31
32 (use-package "KERNEL")
33
34
35
36 ;;;; Primitive SAP operations.
37
38 (defun sap< (x y)
39 "Return T iff the SAP X points to a smaller address then the SAP Y."
40 (declare (type system-area-pointer x y))
41 (sap< x y))
42
43 (defun sap<= (x y)
44 "Return T iff the SAP X points to a smaller or the same address as
45 the SAP Y."
46 (declare (type system-area-pointer x y))
47 (sap<= x y))
48
49 (defun sap= (x y)
50 "Return T iff the SAP X points to the same address as the SAP Y."
51 (declare (type system-area-pointer x y))
52 (sap= x y))
53
54 (defun sap>= (x y)
55 "Return T iff the SAP X points to a larger or the same address as
56 the SAP Y."
57 (declare (type system-area-pointer x y))
58 (sap>= x y))
59
60 (defun sap> (x y)
61 "Return T iff the SAP X points to a larger address then the SAP Y."
62 (declare (type system-area-pointer x y))
63 (sap> x y))
64
65 (defun sap+ (sap offset)
66 "Return a new sap OFFSET bytes from SAP."
67 (declare (type system-area-pointer sap)
68 (type (signed-byte #-alpha #.vm:word-bits #+alpha 64) offset))
69 (sap+ sap offset))
70
71 (defun sap- (sap1 sap2)
72 "Return the byte offset between SAP1 and SAP2."
73 (declare (type system-area-pointer sap1 sap2))
74 (sap- sap1 sap2))
75
76 (defun sap-int (sap)
77 "Converts a System Area Pointer into an integer."
78 (declare (type system-area-pointer sap))
79 (sap-int sap))
80
81 (defun int-sap (int)
82 "Converts an integer into a System Area Pointer."
83 (declare (type (unsigned-byte #-alpha #.vm:word-bits #+alpha 64) int))
84 (int-sap int))
85
86 (defun sap-ref-8 (sap offset)
87 "Returns the 8-bit byte at OFFSET bytes from SAP."
88 (declare (type system-area-pointer sap)
89 (type (signed-byte #-alpha #.vm:word-bits #+alpha 64) offset))
90 (sap-ref-8 sap offset))
91
92 (defun sap-ref-16 (sap offset)
93 "Returns the 16-bit word at OFFSET bytes from SAP."
94 (declare (type system-area-pointer sap)
95 (type (signed-byte #-alpha #.(1- vm:word-bits) #+alpha 63) offset))
96 (sap-ref-16 sap offset))
97
98 (defun sap-ref-32 (sap offset)
99 "Returns the 32-bit dualword at OFFSET bytes from SAP."
100 (declare (type system-area-pointer sap)
101 (fixnum offset))
102 (sap-ref-32 sap offset))
103
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 (type (signed-byte #-alpha #.vm:word-bits #+alpha 64) 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 _N"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 (type (signed-byte #-alpha #.vm:word-bits #+alpha 64) 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 (type (signed-byte #-alpha #.(1- vm:word-bits) #+alpha 63) 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 (defun signed-sap-ref-64 (sap offset)
154 "Returns the signed 64-bit quadword at OFFSET bytes from SAP."
155 (declare (type system-area-pointer sap)
156 (fixnum offset))
157 (signed-sap-ref-64 sap offset))
158
159 (defun %set-sap-ref-8 (sap offset new-value)
160 (declare (type system-area-pointer sap)
161 (type (signed-byte #-alpha #.vm:word-bits #+alpha 64) offset)
162 (type (unsigned-byte 8) new-value))
163 (setf (sap-ref-8 sap offset) new-value))
164
165 (defun %set-sap-ref-16 (sap offset new-value)
166 (declare (type system-area-pointer sap)
167 (type (signed-byte #-alpha #.(1- vm:word-bits) #+alpha 63) offset)
168 (type (unsigned-byte 16) new-value))
169 (setf (sap-ref-16 sap offset) new-value))
170
171 (defun %set-sap-ref-32 (sap offset new-value)
172 (declare (type system-area-pointer sap)
173 (fixnum offset)
174 (type (unsigned-byte 32) new-value))
175 (setf (sap-ref-32 sap offset) new-value))
176
177 (defun %set-sap-ref-64 (sap offset new-value)
178 (declare (type system-area-pointer sap)
179 (fixnum offset)
180 (type (unsigned-byte 64) new-value))
181 (setf (sap-ref-64 sap offset) new-value))
182
183 (defun %set-signed-sap-ref-8 (sap offset new-value)
184 (declare (type system-area-pointer sap)
185 (type (signed-byte #-alpha #.vm:word-bits #+alpha 64) offset)
186 (type (signed-byte 8) new-value))
187 (setf (signed-sap-ref-8 sap offset) new-value))
188
189 (defun %set-signed-sap-ref-16 (sap offset new-value)
190 (declare (type system-area-pointer sap)
191 (type (signed-byte #-alpha #.(1- vm:word-bits) #+alpha 63) offset)
192 (type (signed-byte 16) new-value))
193 (setf (signed-sap-ref-16 sap offset) new-value))
194
195 (defun %set-signed-sap-ref-32 (sap offset new-value)
196 (declare (type system-area-pointer sap)
197 (fixnum offset)
198 (type (signed-byte 32) new-value))
199 (setf (signed-sap-ref-32 sap offset) new-value))
200
201 (defun %set-signed-sap-ref-64 (sap offset new-value)
202 (declare (type system-area-pointer sap)
203 (fixnum offset)
204 (type (signed-byte 64) new-value))
205 (setf (signed-sap-ref-64 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 (type (signed-byte #-alpha #.vm:word-bits #+alpha 64) 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 #+(or x86 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))
230
231
232
233 ;;;; System memory allocation.
234
235 (alien:def-alien-routine ("os_allocate" allocate-system-memory)
236 system-area-pointer
237 (bytes c-call:unsigned-long))
238
239 (alien:def-alien-routine ("os_allocate_at" allocate-system-memory-at)
240 system-area-pointer
241 (address system-area-pointer)
242 (bytes c-call:unsigned-long))
243
244 (alien:def-alien-routine ("os_reallocate" reallocate-system-memory)
245 system-area-pointer
246 (old system-area-pointer)
247 (old-size c-call:unsigned-long)
248 (new-size c-call:unsigned-long))
249
250 (alien:def-alien-routine ("os_deallocate" deallocate-system-memory)
251 c-call:void
252 (addr system-area-pointer)
253 (bytes c-call:unsigned-long))

  ViewVC Help
Powered by ViewVC 1.1.5