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 #!+linkage-table
  17 (deftransform foreign-symbol-address ((symbol &optional datap) (simple-string boolean))
  18   (if (and (constant-lvar-p symbol) (constant-lvar-p datap))
  19       `(sap-int (foreign-symbol-sap symbol datap))
  20       (give-up-ir1-transform)))
  21
  22 (deftransform foreign-symbol-sap ((symbol &optional datap)
  23                                       (simple-string &optional boolean))
  24     #!-linkage-table
  25     (if (null datap)
  26         (give-up-ir1-transform)
  27         `(foreign-symbol-sap symbol))
  28     #!+linkage-table
  29     (if (and (constant-lvar-p symbol) (constant-lvar-p datap))
  30         (let ((name (lvar-value symbol))
  31               (datap (lvar-value datap)))
  32           (if (or #+sb-xc-host t ; only static symbols on host
  33                   (not datap)
  34                   (find-foreign-symbol-in-table name *static-foreign-symbols*))
  35               `(foreign-symbol-sap ,name) ; VOP
  36               `(foreign-symbol-dataref-sap ,name))) ; VOP
  37         (give-up-ir1-transform)))
  38
  39 (defknown (sap< sap<= sap= sap>= sap>)
  40           (system-area-pointer system-area-pointer) boolean
  41   (movable flushable))
  42
  43 (defknown sap+ (system-area-pointer integer) system-area-pointer
  44   (movable flushable))
  45 (defknown sap- (system-area-pointer system-area-pointer)
  46                (signed-byte #.sb!vm::n-word-bits)
  47   (movable flushable))
  48
  49 (defknown sap-int (system-area-pointer)
  50   (unsigned-byte #.sb!vm::n-machine-word-bits)
  51   (movable flushable))
  52 (defknown int-sap ((unsigned-byte #.sb!vm::n-machine-word-bits))
  53   system-area-pointer (movable))
  54
  55 (defknown sap-ref-8 (system-area-pointer fixnum) (unsigned-byte 8)
  56   (flushable))
  57 (defknown %set-sap-ref-8 (system-area-pointer fixnum (unsigned-byte 8))
  58   (unsigned-byte 8)
  59   ())
  60
  61 (defknown sap-ref-16 (system-area-pointer fixnum) (unsigned-byte 16)
  62   (flushable))
  63 (defknown %set-sap-ref-16 (system-area-pointer fixnum (unsigned-byte 16))
  64   (unsigned-byte 16)
  65   ())
  66
  67 (defknown sap-ref-32 (system-area-pointer fixnum) (unsigned-byte 32)
  68   (flushable))
  69 (defknown %set-sap-ref-32 (system-area-pointer fixnum (unsigned-byte 32))
  70   (unsigned-byte 32)
  71   ())
  72
  73 ;; FIXME These are supported natively on alpha and using deftransforms
  74 ;; in compiler/x86/sap.lisp, which in OAO$n$ style need copying to
  75 ;; other 32 bit systems
  76 (defknown sap-ref-64 (system-area-pointer fixnum) (unsigned-byte 64)
  77   (flushable))
  78 (defknown %set-sap-ref-64 (system-area-pointer fixnum (unsigned-byte 64))
  79   (unsigned-byte 64)
  80   ())
  81
  82 (defknown sap-ref-word (system-area-pointer fixnum)
  83   (unsigned-byte #.sb!vm::n-machine-word-bits)
  84   (flushable))
  85 (defknown %set-sap-ref-word
  86     (system-area-pointer fixnum (unsigned-byte #.sb!vm::n-machine-word-bits))
  87   (unsigned-byte #.sb!vm::n-machine-word-bits)
  88   ())
  89
  90 (defknown signed-sap-ref-8 (system-area-pointer fixnum) (signed-byte 8)
  91   (flushable))
  92 (defknown %set-signed-sap-ref-8 (system-area-pointer fixnum (signed-byte 8))
  93   (signed-byte 8)
  94   ())
  95
  96 (defknown signed-sap-ref-16 (system-area-pointer fixnum) (signed-byte 16)
  97   (flushable))
  98 (defknown %set-signed-sap-ref-16 (system-area-pointer fixnum (signed-byte 16))
  99   (signed-byte 16)
 100   ())
 101
 102 (defknown signed-sap-ref-32 (system-area-pointer fixnum) (signed-byte 32)
 103   (flushable))
 104 (defknown %set-signed-sap-ref-32 (system-area-pointer fixnum (signed-byte 32))
 105   (signed-byte 32)
 106   ())
 107
 108 (defknown signed-sap-ref-64 (system-area-pointer fixnum) (signed-byte 64)
 109   (flushable))
 110 (defknown %set-signed-sap-ref-64 (system-area-pointer fixnum (signed-byte 64))
 111   (signed-byte 64)
 112   ())
 113
 114 (defknown signed-sap-ref-word (system-area-pointer fixnum)
 115   (signed-byte #.sb!vm::n-machine-word-bits)
 116   (flushable))
 117 (defknown %set-signed-sap-ref-word
 118     (system-area-pointer fixnum (signed-byte #.sb!vm::n-machine-word-bits))
 119   (signed-byte #.sb!vm::n-machine-word-bits)
 120   ())
 121
 122 (defknown sap-ref-sap (system-area-pointer fixnum) system-area-pointer
 123   (flushable))
 124 (defknown %set-sap-ref-sap (system-area-pointer fixnum system-area-pointer)
 125   system-area-pointer
 126   ())
 127
 128 (defknown sap-ref-single (system-area-pointer fixnum) single-float
 129   (flushable))
 130 (defknown sap-ref-double (system-area-pointer fixnum) double-float
 131   (flushable))
 132 #!+(or x86 long-float)
 133 (defknown sap-ref-long (system-area-pointer fixnum) long-float
 134   (flushable))
 135
 136 (defknown %set-sap-ref-single
 137           (system-area-pointer fixnum single-float) single-float
 138   ())
 139 (defknown %set-sap-ref-double
 140           (system-area-pointer fixnum double-float) double-float
 141   ())
 142 #!+long-float
 143 (defknown %set-sap-ref-long
 144           (system-area-pointer fixnum long-float) long-float
 145   ())
 146 \f
 147 ;;;; transforms for converting sap relation operators
 148
 149 (macrolet ((def (sap-fun int-fun)
 150              `(deftransform ,sap-fun ((x y) * *)
 151                 `(,',int-fun (sap-int x) (sap-int y)))))
 152   (def sap< <)
 153   (def sap<= <=)
 154   (def sap= =)
 155   (def sap>= >=)
 156   (def sap> >))
 157 \f
 158 ;;;; transforms for optimizing SAP+
 159
 160 (deftransform sap+ ((sap offset))
 161   (cond ((and (constant-lvar-p offset)
 162               (eql (lvar-value offset) 0))
 163          'sap)
 164         (t
 165          (extract-fun-args sap 'sap+ 2)
 166          '(lambda (sap offset1 offset2)
 167             (sap+ sap (+ offset1 offset2))))))
 168
 169 (macrolet ((def (fun &optional setp)
 170              `(deftransform ,fun ((sap offset ,@(when setp `(new-value))) * *)
 171                 (extract-fun-args sap 'sap+ 2)
 172                  `(lambda (sap offset1 offset2 ,@',(when setp `(new-value)))
 173                    (,',fun sap (+ offset1 offset2) ,@',(when setp `(new-value)))))))
 174   (def sap-ref-8)
 175   (def %set-sap-ref-8 t)
 176   (def signed-sap-ref-8)
 177   (def %set-signed-sap-ref-8 t)
 178   (def sap-ref-16)
 179   (def %set-sap-ref-16 t)
 180   (def signed-sap-ref-16)
 181   (def %set-signed-sap-ref-16 t)
 182   (def sap-ref-32)
 183   (def %set-sap-ref-32 t)
 184   (def signed-sap-ref-32)
 185   (def %set-signed-sap-ref-32 t)
 186   (def sap-ref-64)
 187   (def %set-sap-ref-64 t)
 188   (def signed-sap-ref-64)
 189   (def %set-signed-sap-ref-64 t)
 190   (def sap-ref-sap)
 191   (def %set-sap-ref-sap t)
 192   (def sap-ref-single)
 193   (def %set-sap-ref-single t)
 194   (def sap-ref-double)
 195   (def %set-sap-ref-double t)
 196   ;; The original CMUCL code had #!+(and x86 long-float) for this first one,
 197   ;; but only #!+long-float for the second.  This was redundant, since the
 198   ;; LONG-FLOAT target feature only exists on X86.  So we removed the
 199   ;; redundancy.  --njf 2002-01-08
 200   #!+long-float (def sap-ref-long)
 201   #!+long-float (def %set-sap-ref-long t))
 202
 203 (macrolet ((def (fun args 32-bit 64-bit)
 204                `(deftransform ,fun (,args)
 205                   (ecase sb!vm::n-word-bits
 206                     (32 '(,32-bit ,@args))
 207                     (64 '(,64-bit ,@args))))))
 208   (def sap-ref-word (sap offset) sap-ref-32 sap-ref-64)
 209   (def signed-sap-ref-word (sap offset) signed-sap-ref-32 signed-sap-ref-64)
 210   (def %set-sap-ref-word (sap offset value)
 211     %set-sap-ref-32 %set-sap-ref-64)
 212   (def %set-signed-sap-ref-word (sap offset value)
 213     %set-signed-sap-ref-32 %set-signed-sap-ref-64))