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

Contents of /src/code/sap.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (show annotations)
Fri Apr 25 20:49:42 1997 UTC (17 years ago) by dtc
Branch: MAIN
CVS Tags: RELEASE_18a
Branch point for: RELENG_18
Changes since 1.12: +24 -24 lines
Allow signed index on sap-reg functions on the sparc. Fixes some
inconsistencies which showed up on the x86 port.
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.13 1997/04/25 20:49:42 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 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index 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 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index 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 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index 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 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index 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 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index 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 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index 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 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index 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 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
126 (sap-ref-double sap offset))
127
128 (defun signed-sap-ref-8 (sap offset)
129 "Returns the signed 8-bit byte at OFFSET bytes from SAP."
130 (declare (type system-area-pointer sap)
131 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
132 (signed-sap-ref-8 sap offset))
133
134 (defun signed-sap-ref-16 (sap offset)
135 "Returns the signed 16-bit word at OFFSET bytes from SAP."
136 (declare (type system-area-pointer sap)
137 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
138 (signed-sap-ref-16 sap offset))
139
140 (defun signed-sap-ref-32 (sap offset)
141 "Returns the signed 32-bit dualword at OFFSET bytes from SAP."
142 (declare (type system-area-pointer sap)
143 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
144 (signed-sap-ref-32 sap offset))
145
146 #+alpha
147 (defun signed-sap-ref-64 (sap offset)
148 "Returns the signed 64-bit quadword at OFFSET bytes from SAP."
149 (declare (type system-area-pointer sap)
150 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
151 (signed-sap-ref-64 sap offset))
152
153 (defun %set-sap-ref-8 (sap offset new-value)
154 (declare (type system-area-pointer sap)
155 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
156 (type (unsigned-byte 8) new-value))
157 (setf (sap-ref-8 sap offset) new-value))
158
159 (defun %set-sap-ref-16 (sap offset new-value)
160 (declare (type system-area-pointer sap)
161 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
162 (type (unsigned-byte 16) new-value))
163 (setf (sap-ref-16 sap offset) new-value))
164
165 (defun %set-sap-ref-32 (sap offset new-value)
166 (declare (type system-area-pointer sap)
167 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
168 (type (unsigned-byte 32) new-value))
169 (setf (sap-ref-32 sap offset) new-value))
170
171 #+alpha
172 (defun %set-sap-ref-64 (sap offset new-value)
173 (declare (type system-area-pointer sap)
174 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
175 (type (unsigned-byte 64) new-value))
176 (setf (sap-ref-64 sap offset) new-value))
177
178 (defun %set-signed-sap-ref-8 (sap offset new-value)
179 (declare (type system-area-pointer sap)
180 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
181 (type (signed-byte 8) new-value))
182 (setf (signed-sap-ref-8 sap offset) new-value))
183
184 (defun %set-signed-sap-ref-16 (sap offset new-value)
185 (declare (type system-area-pointer sap)
186 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
187 (type (signed-byte 16) new-value))
188 (setf (signed-sap-ref-16 sap offset) new-value))
189
190 (defun %set-signed-sap-ref-32 (sap offset new-value)
191 (declare (type system-area-pointer sap)
192 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
193 (type (signed-byte 32) new-value))
194 (setf (signed-sap-ref-32 sap offset) new-value))
195
196 #+alpha
197 (defun %set-signed-sap-ref-64 (sap offset new-value)
198 (declare (type system-area-pointer sap)
199 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
200 (type (signed-byte 64) new-value))
201 (setf (signed-sap-ref-64 sap offset) new-value))
202
203 (defun %set-sap-ref-sap (sap offset new-value)
204 (declare (type system-area-pointer sap new-value)
205 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
206 (setf (sap-ref-sap sap offset) new-value))
207
208 (defun %set-sap-ref-single (sap offset new-value)
209 (declare (type system-area-pointer sap)
210 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
211 (type single-float new-value))
212 (setf (sap-ref-single sap offset) new-value))
213
214 (defun %set-sap-ref-double (sap offset new-value)
215 (declare (type system-area-pointer sap)
216 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
217 (type double-float new-value))
218 (setf (sap-ref-double sap offset) new-value))
219
220
221
222 ;;;; System memory allocation.
223
224 (alien:def-alien-routine ("os_allocate" allocate-system-memory)
225 system-area-pointer
226 (bytes c-call:unsigned-long))
227
228 (alien:def-alien-routine ("os_allocate_at" allocate-system-memory-at)
229 system-area-pointer
230 (address system-area-pointer)
231 (bytes c-call:unsigned-long))
232
233 (alien:def-alien-routine ("os_reallocate" reallocate-system-memory)
234 system-area-pointer
235 (old system-area-pointer)
236 (old-size c-call:unsigned-long)
237 (new-size c-call:unsigned-long))
238
239 (alien:def-alien-routine ("os_deallocate" deallocate-system-memory)
240 c-call:void
241 (addr system-area-pointer)
242 (bytes c-call:unsigned-long))

  ViewVC Help
Powered by ViewVC 1.1.5