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

Contents of /src/code/sap.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5