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

Contents of /src/code/sap.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.15 - (hide annotations)
Wed Mar 4 14:56:34 1998 UTC (16 years, 1 month ago) by dtc
Branch: MAIN
Changes since 1.14: +24 -46 lines
Update the Alpha, MIPS, and HPPA ports to accept a signed offset to
the sap-ref and sap-set VOPs; all the ports now use the same
convention.
1 wlott 1.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 dtc 1.15 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/sap.lisp,v 1.15 1998/03/04 14:56:34 dtc Exp $")
9 wlott 1.1 ;;;
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 hallgren 1.10 #+alpha sap-ref-64 #+alpha signed-sap-ref-64
19 wlott 1.6 sap+ sap- sap< sap<= sap= sap>= sap>
20 wlott 1.9 allocate-system-memory allocate-system-memory-at
21     reallocate-system-memory deallocate-system-memory))
22 wlott 1.1
23 wlott 1.2 (in-package "KERNEL")
24 wlott 1.7 (export '(%set-sap-ref-sap %set-sap-ref-single %set-sap-ref-double
25 wlott 1.8 %set-sap-ref-8 %set-signed-sap-ref-8
26 wlott 1.7 %set-sap-ref-16 %set-signed-sap-ref-16
27 hallgren 1.10 %set-sap-ref-32 %set-signed-sap-ref-32
28     #+alpha %set-sap-ref-64 #+alpha %set-signed-sap-ref-64))
29 wlott 1.2 (in-package "SYSTEM")
30 wlott 1.3
31 wlott 1.4 (use-package "KERNEL")
32 wlott 1.2
33 wlott 1.1
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 wlott 1.5 (sap> x y))
63 wlott 1.1
64     (defun sap+ (sap offset)
65     "Return a new sap OFFSET bytes from SAP."
66     (declare (type system-area-pointer sap)
67 dtc 1.15 (fixnum offset))
68 wlott 1.1 (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 hallgren 1.10 (declare (type (unsigned-byte #-alpha #.vm:word-bits #+alpha 64) int))
83 wlott 1.1 (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 dtc 1.15 (fixnum offset))
89 wlott 1.1 (sap-ref-8 sap offset))
90    
91     (defun sap-ref-16 (sap offset)
92 wlott 1.7 "Returns the 16-bit word at OFFSET bytes from SAP."
93 wlott 1.1 (declare (type system-area-pointer sap)
94 dtc 1.15 (fixnum offset))
95 wlott 1.1 (sap-ref-16 sap offset))
96    
97     (defun sap-ref-32 (sap offset)
98 wlott 1.7 "Returns the 32-bit dualword at OFFSET bytes from SAP."
99 wlott 1.1 (declare (type system-area-pointer sap)
100 dtc 1.15 (fixnum offset))
101 wlott 1.1 (sap-ref-32 sap offset))
102    
103 hallgren 1.10 #+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 dtc 1.15 (fixnum offset))
108 hallgren 1.10 (sap-ref-64 sap offset))
109    
110 wlott 1.1 (defun sap-ref-sap (sap offset)
111 wlott 1.7 "Returns the 32-bit system-area-pointer at OFFSET bytes from SAP."
112 wlott 1.1 (declare (type system-area-pointer sap)
113 dtc 1.15 (fixnum offset))
114 wlott 1.1 (sap-ref-sap sap offset))
115    
116     (defun sap-ref-single (sap offset)
117 wlott 1.7 "Returns the 32-bit single-float at OFFSET bytes from SAP."
118 wlott 1.1 (declare (type system-area-pointer sap)
119 dtc 1.15 (fixnum offset))
120 wlott 1.1 (sap-ref-single sap offset))
121    
122     (defun sap-ref-double (sap offset)
123 wlott 1.7 "Returns the 64-bit double-float at OFFSET bytes from SAP."
124 wlott 1.1 (declare (type system-area-pointer sap)
125 dtc 1.15 (fixnum offset))
126 wlott 1.1 (sap-ref-double sap offset))
127    
128 dtc 1.14 #+x86
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 wlott 1.1 (defun signed-sap-ref-8 (sap offset)
136 wlott 1.7 "Returns the signed 8-bit byte at OFFSET bytes from SAP."
137 wlott 1.1 (declare (type system-area-pointer sap)
138 dtc 1.15 (fixnum offset))
139 wlott 1.1 (signed-sap-ref-8 sap offset))
140    
141     (defun signed-sap-ref-16 (sap offset)
142 wlott 1.7 "Returns the signed 16-bit word at OFFSET bytes from SAP."
143 wlott 1.1 (declare (type system-area-pointer sap)
144 dtc 1.15 (fixnum offset))
145 wlott 1.1 (signed-sap-ref-16 sap offset))
146    
147     (defun signed-sap-ref-32 (sap offset)
148 wlott 1.7 "Returns the signed 32-bit dualword at OFFSET bytes from SAP."
149 wlott 1.1 (declare (type system-area-pointer sap)
150 dtc 1.15 (fixnum offset))
151 wlott 1.1 (signed-sap-ref-32 sap offset))
152    
153 hallgren 1.10 #+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 dtc 1.15 (fixnum offset))
158 hallgren 1.10 (signed-sap-ref-64 sap offset))
159    
160 wlott 1.1 (defun %set-sap-ref-8 (sap offset new-value)
161     (declare (type system-area-pointer sap)
162 dtc 1.15 (fixnum offset)
163 wlott 1.7 (type (unsigned-byte 8) new-value))
164 wlott 1.1 (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 dtc 1.15 (fixnum offset)
169 wlott 1.7 (type (unsigned-byte 16) new-value))
170 wlott 1.1 (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 dtc 1.15 (fixnum offset)
175 wlott 1.7 (type (unsigned-byte 32) new-value))
176     (setf (sap-ref-32 sap offset) new-value))
177    
178 hallgren 1.10 #+alpha
179     (defun %set-sap-ref-64 (sap offset new-value)
180     (declare (type system-area-pointer sap)
181 dtc 1.15 (fixnum offset)
182 hallgren 1.10 (type (unsigned-byte 64) new-value))
183     (setf (sap-ref-64 sap offset) new-value))
184    
185 wlott 1.7 (defun %set-signed-sap-ref-8 (sap offset new-value)
186     (declare (type system-area-pointer sap)
187 dtc 1.15 (fixnum offset)
188 wlott 1.7 (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 dtc 1.15 (fixnum offset)
194 wlott 1.7 (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 dtc 1.15 (fixnum offset)
200 wlott 1.7 (type (signed-byte 32) new-value))
201     (setf (signed-sap-ref-32 sap offset) new-value))
202 hallgren 1.10
203     #+alpha
204     (defun %set-signed-sap-ref-64 (sap offset new-value)
205     (declare (type system-area-pointer sap)
206 dtc 1.15 (fixnum offset)
207 hallgren 1.10 (type (signed-byte 64) new-value))
208     (setf (signed-sap-ref-64 sap offset) new-value))
209 wlott 1.1
210     (defun %set-sap-ref-sap (sap offset new-value)
211     (declare (type system-area-pointer sap new-value)
212 dtc 1.15 (fixnum offset))
213 wlott 1.1 (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 dtc 1.15 (fixnum offset)
218 wlott 1.1 (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 dtc 1.15 (fixnum offset)
224 wlott 1.1 (type double-float new-value))
225     (setf (sap-ref-double sap offset) new-value))
226    
227    
228    
229     ;;;; System memory allocation.
230    
231 wlott 1.6 (alien:def-alien-routine ("os_allocate" allocate-system-memory)
232     system-area-pointer
233 wlott 1.9 (bytes c-call:unsigned-long))
234    
235     (alien:def-alien-routine ("os_allocate_at" allocate-system-memory-at)
236     system-area-pointer
237     (address system-area-pointer)
238 wlott 1.6 (bytes c-call:unsigned-long))
239 wlott 1.1
240 wlott 1.6 (alien:def-alien-routine ("os_reallocate" reallocate-system-memory)
241     system-area-pointer
242     (old system-area-pointer)
243     (old-size c-call:unsigned-long)
244     (new-size c-call:unsigned-long))
245 wlott 1.1
246 wlott 1.6 (alien:def-alien-routine ("os_deallocate" deallocate-system-memory)
247     c-call:void
248     (addr system-area-pointer)
249     (bytes c-call:unsigned-long))

  ViewVC Help
Powered by ViewVC 1.1.5