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

Contents of /src/code/sap.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.19 - (hide annotations)
Thu Jan 3 11:41:52 2008 UTC (6 years, 3 months ago) by cshapiro
Branch: MAIN
CVS Tags: merged-unicode-utf16-extfmt-2009-06-11, unicode-utf16-extfmt-2009-03-27, snapshot-2008-08, snapshot-2008-09, sse2-packed-2008-11-12, snapshot-2008-05, snapshot-2008-06, snapshot-2008-07, snapshot-2008-01, snapshot-2008-02, snapshot-2008-03, unicode-string-buffer-impl-base, sse2-base, unicode-string-buffer-base, sse2-packed-base, amd64-dd-start, release-19f-pre1, snapshot-2008-12, snapshot-2008-11, release-19e, unicode-utf16-sync-2008-12, label-2009-03-16, release-19f-base, merge-sse2-packed, merge-with-19f, unicode-snapshot-2009-05, unicode-snapshot-2009-06, unicode-utf16-sync-2008-07, unicode-utf16-sync-2008-09, unicode-utf16-extfmts-sync-2008-12, snapshot-2008-04, unicode-utf16-sync-label-2009-03-16, RELEASE_19f, release-20a-base, unicode-utf16-char-support-2009-03-26, unicode-utf16-char-support-2009-03-25, unicode-utf16-extfmts-pre-sync-2008-11, snapshot-2008-10, unicode-utf16-sync-2008-11, release-19e-pre1, release-19e-pre2, label-2009-03-25, sse2-checkpoint-2008-10-01, sse2-merge-with-2008-11, sse2-merge-with-2008-10, RELEASE_20a, release-20a-pre1, snapshot-2009-11, unicode-utf16-extfmt-2009-06-11, portable-clx-import-2009-06-16, unicode-utf16-string-support, release-19e-base, unicode-utf16-base, portable-clx-base, snapshot-2009-08, snapshot-2009-02, snapshot-2009-01, snapshot-2009-07, snapshot-2009-05, snapshot-2009-04
Branch point for: RELEASE-19F-BRANCH, portable-clx-branch, unicode-string-buffer-branch, sse2-packed-branch, RELEASE-20A-BRANCH, amd64-dd-branch, unicode-string-buffer-impl-branch, unicode-utf16-branch, release-19e-branch, sse2-branch, unicode-utf16-extfmt-branch
Changes since 1.18: +2 -2 lines
Switch the FreeBSD port to use the common floating point trap handling
code.  Rather than introduce a new FreeBSD case to the x86 sigcontext
member accessor routines, collapse all of the system specific routines
down to a common set of routines.

* code/debug-int.lisp - Disable some Darwin-specific code to debug
  NULL mcontext pointers.

* code/float-trap.lisp - Remove ancient FreeBSD-specific code for
  handling floating point signals.

* code/macros.lisp, code/sap.lisp, compiler/saptran.lisp - Include the
  SAP-REF-LONG setter by default on the x86.

* code/x86-vm.lisp - Remove operating system specific sigcontext
  definitions and sigcontext accessors.  Define the alien sigcontext
  as a system area pointer.  Replace the sigcontext accessors with
  foreign function calls that mask the complexity of the underlying
  sigcontext member access.

* compiler/x86/float.lisp - Unconditionally define STORE-LONG-FLOAT.
  This function is used by the %SET-SAP-REF-LONG VOP that underlies
  the SAP-REF-LONG setter.

* compiler/x86/sap.lisp - Unconditionally define %SET-SAP-REF-LONG.
  In the case where there is not a distinct LONG-FLOAT type, admit
  DOUBLE-FLOAT values instead.  The x87 automatically widens values
  pushed onto stack.  This mirrors the behavior of the SAP-REF-LONG
  VOP.

* lisp/Darwin-os.c, lisp/Linux-os.c - Define functions to access
  sigcontext members of interest to Lisp.  Delete the sc_reg function
  and replace its uses with os_sigcontext_reg which is more suitably
  typed.

* lisp/FreeBSD-os.c - Define functions to access sigcontext members of
  interest to Lisp.  We need to be careful about the SSE and non-SSE
  cases for retrieving x87 registers from the saved machine state.
  Define a low-level SIGFPE handler to intercept floating point traps
  and restore the cleared status word bits based on the signal code.
  Get rid of sc_reg for the reasons noted above.

* lisp/Darwin-os.h, lisp/FreeBSD-os.h - Declare the restore_fpu
  function and define a specialized RESTORE_FPU macro.  Remove the
  sc_reg prototype.

* lisp/Linux-os.h - Remove the sc_reg prototype.

* lisp/os.h - Add prototypes for the new os_sigcontext functions.

* lisp/x86-lispregs.h - Redefine SC_REG and SC_PC to expand out to the
  new os_sigcontext functions.  Redfine SC_SP to expand out to SC_REG.
  Eliminate all platform-specific defintions of SC_PC and SC_SP.
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 cshapiro 1.19 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/sap.lisp,v 1.19 2008/01/03 11:41:52 cshapiro Rel $")
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 dtc 1.17 sap-ref-64 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 dtc 1.17 %set-sap-ref-64 %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 toy 1.18 (type (signed-byte #-alpha #.vm:word-bits #+alpha 64) 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 toy 1.18 (type (signed-byte #-alpha #.vm:word-bits #+alpha 64) 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 toy 1.18 (type (signed-byte #-alpha #.(1- vm:word-bits) #+alpha 63) 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 (defun sap-ref-64 (sap offset)
104     "Returns the 64-bit quadword at OFFSET bytes from SAP."
105     (declare (type system-area-pointer sap)
106 dtc 1.15 (fixnum offset))
107 hallgren 1.10 (sap-ref-64 sap offset))
108    
109 wlott 1.1 (defun sap-ref-sap (sap offset)
110 wlott 1.7 "Returns the 32-bit system-area-pointer at OFFSET bytes from SAP."
111 wlott 1.1 (declare (type system-area-pointer sap)
112 toy 1.18 (type (signed-byte #-alpha #.vm:word-bits #+alpha 64) offset))
113 wlott 1.1 (sap-ref-sap sap offset))
114    
115     (defun sap-ref-single (sap offset)
116 wlott 1.7 "Returns the 32-bit single-float at OFFSET bytes from SAP."
117 wlott 1.1 (declare (type system-area-pointer sap)
118 dtc 1.15 (fixnum offset))
119 wlott 1.1 (sap-ref-single sap offset))
120    
121     (defun sap-ref-double (sap offset)
122 wlott 1.7 "Returns the 64-bit double-float at OFFSET bytes from SAP."
123 wlott 1.1 (declare (type system-area-pointer sap)
124 dtc 1.15 (fixnum offset))
125 wlott 1.1 (sap-ref-double sap offset))
126    
127 dtc 1.16 #+(or x86 long-float)
128 dtc 1.14 (defun sap-ref-long (sap offset)
129     "Returns the long-float at OFFSET bytes from SAP."
130     (declare (type system-area-pointer sap)
131     (fixnum offset))
132     (sap-ref-long sap offset))
133    
134 wlott 1.1 (defun signed-sap-ref-8 (sap offset)
135 wlott 1.7 "Returns the signed 8-bit byte at OFFSET bytes from SAP."
136 wlott 1.1 (declare (type system-area-pointer sap)
137 toy 1.18 (type (signed-byte #-alpha #.vm:word-bits #+alpha 64) offset))
138 wlott 1.1 (signed-sap-ref-8 sap offset))
139    
140     (defun signed-sap-ref-16 (sap offset)
141 wlott 1.7 "Returns the signed 16-bit word at OFFSET bytes from SAP."
142 wlott 1.1 (declare (type system-area-pointer sap)
143 toy 1.18 (type (signed-byte #-alpha #.(1- vm:word-bits) #+alpha 63) offset))
144 wlott 1.1 (signed-sap-ref-16 sap offset))
145    
146     (defun signed-sap-ref-32 (sap offset)
147 wlott 1.7 "Returns the signed 32-bit dualword at OFFSET bytes from SAP."
148 wlott 1.1 (declare (type system-area-pointer sap)
149 dtc 1.15 (fixnum offset))
150 wlott 1.1 (signed-sap-ref-32 sap offset))
151    
152 hallgren 1.10 (defun signed-sap-ref-64 (sap offset)
153     "Returns the signed 64-bit quadword at OFFSET bytes from SAP."
154     (declare (type system-area-pointer sap)
155 dtc 1.15 (fixnum offset))
156 hallgren 1.10 (signed-sap-ref-64 sap offset))
157    
158 wlott 1.1 (defun %set-sap-ref-8 (sap offset new-value)
159     (declare (type system-area-pointer sap)
160 toy 1.18 (type (signed-byte #-alpha #.vm:word-bits #+alpha 64) offset)
161 wlott 1.7 (type (unsigned-byte 8) new-value))
162 wlott 1.1 (setf (sap-ref-8 sap offset) new-value))
163    
164     (defun %set-sap-ref-16 (sap offset new-value)
165     (declare (type system-area-pointer sap)
166 toy 1.18 (type (signed-byte #-alpha #.(1- vm:word-bits) #+alpha 63) offset)
167 wlott 1.7 (type (unsigned-byte 16) new-value))
168 wlott 1.1 (setf (sap-ref-16 sap offset) new-value))
169    
170     (defun %set-sap-ref-32 (sap offset new-value)
171     (declare (type system-area-pointer sap)
172 dtc 1.15 (fixnum offset)
173 wlott 1.7 (type (unsigned-byte 32) new-value))
174     (setf (sap-ref-32 sap offset) new-value))
175    
176 hallgren 1.10 (defun %set-sap-ref-64 (sap offset new-value)
177     (declare (type system-area-pointer sap)
178 dtc 1.15 (fixnum offset)
179 hallgren 1.10 (type (unsigned-byte 64) new-value))
180     (setf (sap-ref-64 sap offset) new-value))
181    
182 wlott 1.7 (defun %set-signed-sap-ref-8 (sap offset new-value)
183     (declare (type system-area-pointer sap)
184 toy 1.18 (type (signed-byte #-alpha #.vm:word-bits #+alpha 64) offset)
185 wlott 1.7 (type (signed-byte 8) new-value))
186     (setf (signed-sap-ref-8 sap offset) new-value))
187    
188     (defun %set-signed-sap-ref-16 (sap offset new-value)
189     (declare (type system-area-pointer sap)
190 toy 1.18 (type (signed-byte #-alpha #.(1- vm:word-bits) #+alpha 63) offset)
191 wlott 1.7 (type (signed-byte 16) new-value))
192     (setf (signed-sap-ref-16 sap offset) new-value))
193    
194     (defun %set-signed-sap-ref-32 (sap offset new-value)
195     (declare (type system-area-pointer sap)
196 dtc 1.15 (fixnum offset)
197 wlott 1.7 (type (signed-byte 32) new-value))
198     (setf (signed-sap-ref-32 sap offset) new-value))
199 hallgren 1.10
200     (defun %set-signed-sap-ref-64 (sap offset new-value)
201     (declare (type system-area-pointer sap)
202 dtc 1.15 (fixnum offset)
203 hallgren 1.10 (type (signed-byte 64) new-value))
204     (setf (signed-sap-ref-64 sap offset) new-value))
205 wlott 1.1
206     (defun %set-sap-ref-sap (sap offset new-value)
207     (declare (type system-area-pointer sap new-value)
208 toy 1.18 (type (signed-byte #-alpha #.vm:word-bits #+alpha 64) offset))
209 wlott 1.1 (setf (sap-ref-sap sap offset) new-value))
210    
211     (defun %set-sap-ref-single (sap offset new-value)
212     (declare (type system-area-pointer sap)
213 dtc 1.15 (fixnum offset)
214 wlott 1.1 (type single-float new-value))
215     (setf (sap-ref-single sap offset) new-value))
216    
217     (defun %set-sap-ref-double (sap offset new-value)
218     (declare (type system-area-pointer sap)
219 dtc 1.15 (fixnum offset)
220 wlott 1.1 (type double-float new-value))
221     (setf (sap-ref-double sap offset) new-value))
222 dtc 1.16
223 cshapiro 1.19 #+(or x86 long-float)
224 dtc 1.16 (defun %set-sap-ref-long (sap offset new-value)
225     (declare (type system-area-pointer sap)
226     (fixnum offset)
227     (type long-float new-value))
228     (setf (sap-ref-long sap offset) new-value))
229 wlott 1.1
230    
231    
232     ;;;; System memory allocation.
233    
234 wlott 1.6 (alien:def-alien-routine ("os_allocate" allocate-system-memory)
235     system-area-pointer
236 wlott 1.9 (bytes c-call:unsigned-long))
237    
238     (alien:def-alien-routine ("os_allocate_at" allocate-system-memory-at)
239     system-area-pointer
240     (address system-area-pointer)
241 wlott 1.6 (bytes c-call:unsigned-long))
242 wlott 1.1
243 wlott 1.6 (alien:def-alien-routine ("os_reallocate" reallocate-system-memory)
244     system-area-pointer
245     (old system-area-pointer)
246     (old-size c-call:unsigned-long)
247     (new-size c-call:unsigned-long))
248 wlott 1.1
249 wlott 1.6 (alien:def-alien-routine ("os_deallocate" deallocate-system-memory)
250     c-call:void
251     (addr system-area-pointer)
252     (bytes c-call:unsigned-long))

  ViewVC Help
Powered by ViewVC 1.1.5