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 ;; FIXME These are supported natively on alpha and using deftransforms
  52 ;; in compiler/x86/sap.lisp, which in OAO$n$ style need copying to
  53 ;; other 32 bit systems
  54 (defknown sap-ref-64 (system-area-pointer fixnum) (unsigned-byte 64)
  55   (flushable))
  56 (defknown %set-sap-ref-64 (system-area-pointer fixnum (unsigned-byte 64))
  57   (unsigned-byte 64)
  58   ())
  59
  60 (defknown signed-sap-ref-8 (system-area-pointer fixnum) (signed-byte 8)
  61   (flushable))
  62 (defknown %set-signed-sap-ref-8 (system-area-pointer fixnum (signed-byte 8))
  63   (signed-byte 8)
  64   ())
  65
  66 (defknown signed-sap-ref-16 (system-area-pointer fixnum) (signed-byte 16)
  67   (flushable))
  68 (defknown %set-signed-sap-ref-16 (system-area-pointer fixnum (signed-byte 16))
  69   (signed-byte 16)
  70   ())
  71
  72 (defknown signed-sap-ref-32 (system-area-pointer fixnum) (signed-byte 32)
  73   (flushable))
  74 (defknown %set-signed-sap-ref-32 (system-area-pointer fixnum (signed-byte 32))
  75   (signed-byte 32)
  76   ())
  77
  78 (defknown signed-sap-ref-64 (system-area-pointer fixnum) (signed-byte 64)
  79   (flushable))
  80 (defknown %set-signed-sap-ref-64 (system-area-pointer fixnum (signed-byte 64))
  81   (signed-byte 64)
  82   ())
  83
  84 (defknown sap-ref-sap (system-area-pointer fixnum) system-area-pointer
  85   (flushable))
  86 (defknown %set-sap-ref-sap (system-area-pointer fixnum system-area-pointer)
  87   system-area-pointer
  88   ())
  89
  90 (defknown sap-ref-single (system-area-pointer fixnum) single-float
  91   (flushable))
  92 (defknown sap-ref-double (system-area-pointer fixnum) double-float
  93   (flushable))
  94 #!+(or x86 long-float)
  95 (defknown sap-ref-long (system-area-pointer fixnum) long-float
  96   (flushable))
  97
  98 (defknown %set-sap-ref-single
  99           (system-area-pointer fixnum single-float) single-float
 100   ())
 101 (defknown %set-sap-ref-double
 102           (system-area-pointer fixnum double-float) double-float
 103   ())
 104 #!+long-float
 105 (defknown %set-sap-ref-long
 106           (system-area-pointer fixnum long-float) long-float
 107   ())
 108 \f
 109 ;;;; transforms for converting sap relation operators
 110
 111 (macrolet ((def (sap-fun int-fun)
 112              `(deftransform ,sap-fun ((x y) * *)
 113                 `(,',int-fun (sap-int x) (sap-int y)))))
 114   (def sap< <)
 115   (def sap<= <=)
 116   (def sap= =)
 117   (def sap>= >=)
 118   (def sap> >))
 119 \f
 120 ;;;; transforms for optimizing SAP+
 121
 122 (deftransform sap+ ((sap offset))
 123   (cond ((and (constant-lvar-p offset)
 124               (eql (lvar-value offset) 0))
 125          'sap)
 126         (t
 127          (extract-fun-args sap 'sap+ 2)
 128          '(lambda (sap offset1 offset2)
 129             (sap+ sap (+ offset1 offset2))))))
 130
 131 (macrolet ((def (fun)
 132              `(deftransform ,fun ((sap offset) * *)
 133                 (extract-fun-args sap 'sap+ 2)
 134                  `(lambda (sap offset1 offset2)
 135                    (,',fun sap (+ offset1 offset2))))))
 136   (def sap-ref-8)
 137   (def %set-sap-ref-8)
 138   (def signed-sap-ref-8)
 139   (def %set-signed-sap-ref-8)
 140   (def sap-ref-16)
 141   (def %set-sap-ref-16)
 142   (def signed-sap-ref-16)
 143   (def %set-signed-sap-ref-16)
 144   (def sap-ref-32)
 145   (def %set-sap-ref-32)
 146   (def signed-sap-ref-32)
 147   (def %set-signed-sap-ref-32)
 148   (def sap-ref-64)
 149   (def %set-sap-ref-64)
 150   (def signed-sap-ref-64)
 151   (def %set-signed-sap-ref-64)
 152   (def sap-ref-sap)
 153   (def %set-sap-ref-sap)
 154   (def sap-ref-single)
 155   (def %set-sap-ref-single)
 156   (def sap-ref-double)
 157   (def %set-sap-ref-double)
 158   ;; The original CMUCL code had #!+(and x86 long-float) for this first one,
 159   ;; but only #!+long-float for the second.  This was redundant, since the
 160   ;; LONG-FLOAT target feature only exists on X86.  So we removed the
 161   ;; redundancy.  --njf 2002-01-08
 162   #!+long-float (def sap-ref-long)
 163   #!+long-float (def %set-sap-ref-long))