1 ;;;; optimizations for SAP operations
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
17 (deftransform foreign-symbol-address-as-integer ((symbol &optional datap)
18 (simple-string boolean))
19 (if (and (constant-lvar-p symbol) (constant-lvar-p datap))
20 `(sap-int (foreign-symbol-address symbol datap))
21 (give-up-ir1-transform)))
23 (deftransform foreign-symbol-address ((symbol &optional datap)
24 (simple-string &optional boolean))
27 (give-up-ir1-transform)
28 `(foreign-symbol-address symbol))
30 (if (and (constant-lvar-p symbol) (constant-lvar-p datap))
31 (let ((name (lvar-value symbol))
32 (datap (lvar-value datap)))
33 (if (or #+sb-xc-host t ; only static symbols on host
35 (find-foreign-symbol-in-table name *static-foreign-symbols*))
36 `(foreign-symbol-address ,name) ; VOP
37 `(foreign-symbol-dataref-address ,name))) ; VOP
38 (give-up-ir1-transform)))
40 (defknown (sap< sap<= sap= sap>= sap>)
41 (system-area-pointer system-area-pointer) boolean
44 (defknown sap+ (system-area-pointer integer) system-area-pointer
46 (defknown sap- (system-area-pointer system-area-pointer) (signed-byte 32)
49 (defknown sap-int (system-area-pointer) (unsigned-byte #!-alpha 32 #!+alpha 64)
51 (defknown int-sap ((unsigned-byte #!-alpha 32 #!+alpha 64))
52 system-area-pointer (movable))
54 (defknown sap-ref-8 (system-area-pointer fixnum) (unsigned-byte 8)
56 (defknown %set-sap-ref-8 (system-area-pointer fixnum (unsigned-byte 8))
60 (defknown sap-ref-16 (system-area-pointer fixnum) (unsigned-byte 16)
62 (defknown %set-sap-ref-16 (system-area-pointer fixnum (unsigned-byte 16))
66 (defknown sap-ref-32 (system-area-pointer fixnum) (unsigned-byte 32)
68 (defknown %set-sap-ref-32 (system-area-pointer fixnum (unsigned-byte 32))
72 ;; FIXME These are supported natively on alpha and using deftransforms
73 ;; in compiler/x86/sap.lisp, which in OAO$n$ style need copying to
74 ;; other 32 bit systems
75 (defknown sap-ref-64 (system-area-pointer fixnum) (unsigned-byte 64)
77 (defknown %set-sap-ref-64 (system-area-pointer fixnum (unsigned-byte 64))
81 (defknown signed-sap-ref-8 (system-area-pointer fixnum) (signed-byte 8)
83 (defknown %set-signed-sap-ref-8 (system-area-pointer fixnum (signed-byte 8))
87 (defknown signed-sap-ref-16 (system-area-pointer fixnum) (signed-byte 16)
89 (defknown %set-signed-sap-ref-16 (system-area-pointer fixnum (signed-byte 16))
93 (defknown signed-sap-ref-32 (system-area-pointer fixnum) (signed-byte 32)
95 (defknown %set-signed-sap-ref-32 (system-area-pointer fixnum (signed-byte 32))
99 (defknown signed-sap-ref-64 (system-area-pointer fixnum) (signed-byte 64)
101 (defknown %set-signed-sap-ref-64 (system-area-pointer fixnum (signed-byte 64))
105 (defknown sap-ref-sap (system-area-pointer fixnum) system-area-pointer
107 (defknown %set-sap-ref-sap (system-area-pointer fixnum system-area-pointer)
111 (defknown sap-ref-single (system-area-pointer fixnum) single-float
113 (defknown sap-ref-double (system-area-pointer fixnum) double-float
115 #!+(or x86 long-float)
116 (defknown sap-ref-long (system-area-pointer fixnum) long-float
119 (defknown %set-sap-ref-single
120 (system-area-pointer fixnum single-float) single-float
122 (defknown %set-sap-ref-double
123 (system-area-pointer fixnum double-float) double-float
126 (defknown %set-sap-ref-long
127 (system-area-pointer fixnum long-float) long-float
130 ;;;; transforms for converting sap relation operators
132 (macrolet ((def (sap-fun int-fun)
133 `(deftransform ,sap-fun ((x y) * *)
134 `(,',int-fun (sap-int x) (sap-int y)))))
141 ;;;; transforms for optimizing SAP+
143 (deftransform sap+ ((sap offset))
144 (cond ((and (constant-lvar-p offset)
145 (eql (lvar-value offset) 0))
148 (extract-fun-args sap 'sap+ 2)
149 '(lambda (sap offset1 offset2)
150 (sap+ sap (+ offset1 offset2))))))
152 (macrolet ((def (fun)
153 `(deftransform ,fun ((sap offset) * *)
154 (extract-fun-args sap 'sap+ 2)
155 `(lambda (sap offset1 offset2)
156 (,',fun sap (+ offset1 offset2))))))
159 (def signed-sap-ref-8)
160 (def %set-signed-sap-ref-8)
162 (def %set-sap-ref-16)
163 (def signed-sap-ref-16)
164 (def %set-signed-sap-ref-16)
166 (def %set-sap-ref-32)
167 (def signed-sap-ref-32)
168 (def %set-signed-sap-ref-32)
170 (def %set-sap-ref-64)
171 (def signed-sap-ref-64)
172 (def %set-signed-sap-ref-64)
174 (def %set-sap-ref-sap)
176 (def %set-sap-ref-single)
178 (def %set-sap-ref-double)
179 ;; The original CMUCL code had #!+(and x86 long-float) for this first one,
180 ;; but only #!+long-float for the second. This was redundant, since the
181 ;; LONG-FLOAT target feature only exists on X86. So we removed the
182 ;; redundancy. --njf 2002-01-08
183 #!+long-float (def sap-ref-long)
184 #!+long-float (def %set-sap-ref-long))