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

Contents of /src/code/sap.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (hide annotations)
Fri Apr 25 20:49:42 1997 UTC (16 years, 11 months 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 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.13 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/sap.lisp,v 1.13 1997/04/25 20:49:42 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.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index 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.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index 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.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index 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.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index 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.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index 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.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index 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.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index 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.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
126 wlott 1.1 (sap-ref-double sap offset))
127    
128     (defun signed-sap-ref-8 (sap offset)
129 wlott 1.7 "Returns the signed 8-bit byte at OFFSET bytes from SAP."
130 wlott 1.1 (declare (type system-area-pointer sap)
131 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
132 wlott 1.1 (signed-sap-ref-8 sap offset))
133    
134     (defun signed-sap-ref-16 (sap offset)
135 wlott 1.7 "Returns the signed 16-bit word at OFFSET bytes from SAP."
136 wlott 1.1 (declare (type system-area-pointer sap)
137 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
138 wlott 1.1 (signed-sap-ref-16 sap offset))
139    
140     (defun signed-sap-ref-32 (sap offset)
141 wlott 1.7 "Returns the signed 32-bit dualword at OFFSET bytes from SAP."
142 wlott 1.1 (declare (type system-area-pointer sap)
143 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
144 wlott 1.1 (signed-sap-ref-32 sap offset))
145    
146 hallgren 1.10 #+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 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
151 hallgren 1.10 (signed-sap-ref-64 sap offset))
152    
153 wlott 1.1 (defun %set-sap-ref-8 (sap offset new-value)
154     (declare (type system-area-pointer sap)
155 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
156 wlott 1.7 (type (unsigned-byte 8) new-value))
157 wlott 1.1 (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 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
162 wlott 1.7 (type (unsigned-byte 16) new-value))
163 wlott 1.1 (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 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
168 wlott 1.7 (type (unsigned-byte 32) new-value))
169     (setf (sap-ref-32 sap offset) new-value))
170    
171 hallgren 1.10 #+alpha
172     (defun %set-sap-ref-64 (sap offset new-value)
173     (declare (type system-area-pointer sap)
174 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
175 hallgren 1.10 (type (unsigned-byte 64) new-value))
176     (setf (sap-ref-64 sap offset) new-value))
177    
178 wlott 1.7 (defun %set-signed-sap-ref-8 (sap offset new-value)
179     (declare (type system-area-pointer sap)
180 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
181 wlott 1.7 (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 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
187 wlott 1.7 (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 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
193 wlott 1.7 (type (signed-byte 32) new-value))
194     (setf (signed-sap-ref-32 sap offset) new-value))
195 hallgren 1.10
196     #+alpha
197     (defun %set-signed-sap-ref-64 (sap offset new-value)
198     (declare (type system-area-pointer sap)
199 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
200 hallgren 1.10 (type (signed-byte 64) new-value))
201     (setf (signed-sap-ref-64 sap offset) new-value))
202 wlott 1.1
203     (defun %set-sap-ref-sap (sap offset new-value)
204     (declare (type system-area-pointer sap new-value)
205 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
206 wlott 1.1 (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 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
211 wlott 1.1 (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 dtc 1.13 #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
217 wlott 1.1 (type double-float new-value))
218     (setf (sap-ref-double sap offset) new-value))
219    
220    
221    
222     ;;;; System memory allocation.
223    
224 wlott 1.6 (alien:def-alien-routine ("os_allocate" allocate-system-memory)
225     system-area-pointer
226 wlott 1.9 (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 wlott 1.6 (bytes c-call:unsigned-long))
232 wlott 1.1
233 wlott 1.6 (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 wlott 1.1
239 wlott 1.6 (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