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

Contents of /src/code/sap.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (hide 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 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     ;;; 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 hallgren 1.10 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/sap.lisp,v 1.10 1994/04/06 17:05:56 hallgren Exp $")
11 wlott 1.1 ;;;
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 hallgren 1.10 #+alpha sap-ref-64 #+alpha signed-sap-ref-64
21 wlott 1.6 sap+ sap- sap< sap<= sap= sap>= sap>
22 wlott 1.9 allocate-system-memory allocate-system-memory-at
23     reallocate-system-memory deallocate-system-memory))
24 wlott 1.1
25 wlott 1.2 (in-package "KERNEL")
26 wlott 1.7 (export '(%set-sap-ref-sap %set-sap-ref-single %set-sap-ref-double
27 wlott 1.8 %set-sap-ref-8 %set-signed-sap-ref-8
28 wlott 1.7 %set-sap-ref-16 %set-signed-sap-ref-16
29 hallgren 1.10 %set-sap-ref-32 %set-signed-sap-ref-32
30     #+alpha %set-sap-ref-64 #+alpha %set-signed-sap-ref-64))
31 wlott 1.2 (in-package "SYSTEM")
32 wlott 1.3
33 wlott 1.4 (use-package "KERNEL")
34 wlott 1.2
35 wlott 1.1
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 wlott 1.5 (sap> x y))
65 wlott 1.1
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 hallgren 1.10 (declare (type (unsigned-byte #-alpha #.vm:word-bits #+alpha 64) int))
85 wlott 1.1 (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 wlott 1.7 "Returns the 16-bit word at OFFSET bytes from SAP."
95 wlott 1.1 (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 wlott 1.7 "Returns the 32-bit dualword at OFFSET bytes from SAP."
101 wlott 1.1 (declare (type system-area-pointer sap)
102     (type index offset))
103     (sap-ref-32 sap offset))
104    
105 hallgren 1.10 #+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 wlott 1.1 (defun sap-ref-sap (sap offset)
113 wlott 1.7 "Returns the 32-bit system-area-pointer at OFFSET bytes from SAP."
114 wlott 1.1 (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 wlott 1.7 "Returns the 32-bit single-float at OFFSET bytes from SAP."
120 wlott 1.1 (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 wlott 1.7 "Returns the 64-bit double-float at OFFSET bytes from SAP."
126 wlott 1.1 (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 wlott 1.7 "Returns the signed 8-bit byte at OFFSET bytes from SAP."
132 wlott 1.1 (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 wlott 1.7 "Returns the signed 16-bit word at OFFSET bytes from SAP."
138 wlott 1.1 (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 wlott 1.7 "Returns the signed 32-bit dualword at OFFSET bytes from SAP."
144 wlott 1.1 (declare (type system-area-pointer sap)
145     (type index offset))
146     (signed-sap-ref-32 sap offset))
147    
148 hallgren 1.10 #+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 wlott 1.1 (defun %set-sap-ref-8 (sap offset new-value)
156     (declare (type system-area-pointer sap)
157     (type index offset)
158 wlott 1.7 (type (unsigned-byte 8) new-value))
159 wlott 1.1 (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 wlott 1.7 (type (unsigned-byte 16) new-value))
165 wlott 1.1 (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 wlott 1.7 (type (unsigned-byte 32) new-value))
171     (setf (sap-ref-32 sap offset) new-value))
172    
173 hallgren 1.10 #+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 wlott 1.7 (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 hallgren 1.10
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 wlott 1.1
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 wlott 1.6 (alien:def-alien-routine ("os_allocate" allocate-system-memory)
227     system-area-pointer
228 wlott 1.9 (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 wlott 1.6 (bytes c-call:unsigned-long))
234 wlott 1.1
235 wlott 1.6 (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 wlott 1.1
241 wlott 1.6 (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