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)))))