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