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