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