0.6.11.40:
[sbcl.git] / src / compiler / saptran.lisp
1 ;;;; optimizations for SAP operations
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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.
11
12 (in-package "SB!C")
13 \f
14 ;;;; DEFKNOWNs
15
16 (defknown foreign-symbol-address (simple-string) system-area-pointer
17   (movable flushable))
18
19 (defknown (sap< sap<= sap= sap>= sap>)
20           (system-area-pointer system-area-pointer) boolean
21   (movable flushable))
22
23 (defknown sap+ (system-area-pointer integer) system-area-pointer
24   (movable flushable))
25 (defknown sap- (system-area-pointer system-area-pointer) (signed-byte 32)
26   (movable flushable))
27
28 (defknown sap-int (system-area-pointer) (unsigned-byte #!-alpha 32 #!+alpha 64)
29   (movable flushable))
30 (defknown int-sap ((unsigned-byte #!-alpha 32 #!+alpha 64))
31   system-area-pointer (movable))
32
33 (defknown sap-ref-8 (system-area-pointer fixnum) (unsigned-byte 8)
34   (flushable))
35 (defknown %set-sap-ref-8 (system-area-pointer fixnum (unsigned-byte 8))
36   (unsigned-byte 8)
37   ())
38
39 (defknown sap-ref-16 (system-area-pointer fixnum) (unsigned-byte 16)
40   (flushable))
41 (defknown %set-sap-ref-16 (system-area-pointer fixnum (unsigned-byte 16))
42   (unsigned-byte 16)
43   ())
44
45 (defknown sap-ref-32 (system-area-pointer fixnum) (unsigned-byte 32)
46   (flushable))
47 (defknown %set-sap-ref-32 (system-area-pointer fixnum (unsigned-byte 32))
48   (unsigned-byte 32)
49   ())
50
51 #!+alpha
52 (defknown sap-ref-64 (system-area-pointer fixnum) (unsigned-byte 64)
53   (flushable))
54 #!+alpha
55 (defknown %set-sap-ref-64 (system-area-pointer fixnum (unsigned-byte 64))
56   (unsigned-byte 64)
57   ())
58
59 (defknown signed-sap-ref-8 (system-area-pointer fixnum) (signed-byte 8)
60   (flushable))
61 (defknown %set-signed-sap-ref-8 (system-area-pointer fixnum (signed-byte 8))
62   (signed-byte 8)
63   ())
64
65 (defknown signed-sap-ref-16 (system-area-pointer fixnum) (signed-byte 16)
66   (flushable))
67 (defknown %set-signed-sap-ref-16 (system-area-pointer fixnum (signed-byte 16))
68   (signed-byte 16)
69   ())
70
71 (defknown signed-sap-ref-32 (system-area-pointer fixnum) (signed-byte 32)
72   (flushable))
73 (defknown %set-signed-sap-ref-32 (system-area-pointer fixnum (signed-byte 32))
74   (signed-byte 32)
75   ())
76
77 #!+alpha
78 (defknown signed-sap-ref-64 (system-area-pointer fixnum) (signed-byte 64)
79   (flushable))
80 #!+alpha
81 (defknown %set-signed-sap-ref-64 (system-area-pointer fixnum (signed-byte 64))
82   (signed-byte 64)
83   ())
84
85 (defknown sap-ref-sap (system-area-pointer fixnum) system-area-pointer
86   (flushable))
87 (defknown %set-sap-ref-sap (system-area-pointer fixnum system-area-pointer)
88   system-area-pointer
89   ())
90
91 (defknown sap-ref-single (system-area-pointer fixnum) single-float
92   (flushable))
93 (defknown sap-ref-double (system-area-pointer fixnum) double-float
94   (flushable))
95 #!+(or x86 long-float)
96 (defknown sap-ref-long (system-area-pointer fixnum) long-float
97   (flushable))
98
99 (defknown %set-sap-ref-single
100           (system-area-pointer fixnum single-float) single-float
101   ())
102 (defknown %set-sap-ref-double
103           (system-area-pointer fixnum double-float) double-float
104   ())
105 #!+long-float
106 (defknown %set-sap-ref-long
107           (system-area-pointer fixnum long-float) long-float
108   ())
109 \f
110 ;;;; transforms for converting sap relation operators
111
112 (dolist (info '((sap< <) (sap<= <=) (sap= =) (sap>= >=) (sap> >)))
113   (destructuring-bind (sap-fun int-fun) info
114     (deftransform sap-fun ((x y) '* '* :eval-name t)
115       `(,int-fun (sap-int x) (sap-int y)))))
116 \f
117 ;;;; transforms for optimizing SAP+
118
119 (deftransform sap+ ((sap offset))
120   (cond ((and (constant-continuation-p offset)
121               (eql (continuation-value offset) 0))
122          'sap)
123         (t
124          (extract-function-args sap 'sap+ 2)
125          '(lambda (sap offset1 offset2)
126             (sap+ sap (+ offset1 offset2))))))
127
128 (dolist (fun '(sap-ref-8 %set-sap-ref-8
129                signed-sap-ref-8 %set-signed-sap-ref-8
130                sap-ref-16 %set-sap-ref-16
131                signed-sap-ref-16 %set-signed-sap-ref-16
132                sap-ref-32 %set-sap-ref-32
133                signed-sap-ref-32 %set-signed-sap-ref-32
134                sap-ref-sap %set-sap-ref-sap
135                sap-ref-single %set-sap-ref-single
136                sap-ref-double %set-sap-ref-double
137                #!+(or x86 long-float) sap-ref-long
138                #!+long-float %set-sap-ref-long))
139   (deftransform fun ((sap offset) '* '* :eval-name t)
140     (extract-function-args sap 'sap+ 2)
141     `(lambda (sap offset1 offset2)
142        (,fun sap (+ offset1 offset2)))))