patch_against_sbcl_0_9_3-1.0.txt

   1 diff -Naur src-093/compiler/x86/insts.lisp src/compiler/x86/insts.lisp
   2 --- src-093/compiler/x86/insts.lisp     2005-08-05 15:31:17.723664255 +0300
   3 +++ src/compiler/x86/insts.lisp 2005-08-05 15:42:36.536109257 +0300
   4 @@ -192,6 +192,7 @@
   5      (:byte 8)
   6      (:word 16)
   7      (:dword 32)
   8 +    (:dqword 128)
   9      (:float 32)
  10      (:double 64)))
  11
  12 @@ -671,7 +672,7 @@
  13
  14  (defun reg-tn-encoding (tn)
  15    (declare (type tn tn))
  16 -  (aver (eq (sb-name (sc-sb (tn-sc tn))) 'registers))
  17 +;  (aver (eq (sb-name (sc-sb (tn-sc tn))) 'registers))
  18    (let ((offset (tn-offset tn)))
  19      (logior (ash (logand offset 1) 2)
  20              (ash offset -1))))
  21 @@ -718,6 +719,8 @@
  22       (ecase (sb-name (sc-sb (tn-sc thing)))
  23         (registers
  24          (emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing)))
  25 +       (sse-registers
  26 +        (emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing)))
  27         (stack
  28          ;; Convert stack tns into an index off of EBP.
  29          (let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes))))
  30 @@ -830,6 +833,10 @@
  31    (and (tn-p thing)
  32         (eq (sb-name (sc-sb (tn-sc thing))) 'registers)))
  33
  34 +(defun sse-register-p (thing)
  35 +  (and (tn-p thing)
  36 +       (eq (sb-name (sc-sb (tn-sc thing))) 'sse-registers)))
  37 +
  38  (defun accumulator-p (thing)
  39    (and (register-p thing)
  40         (= (tn-offset thing) 0)))
  41 @@ -2042,6 +2049,123 @@
  42    (:emitter
  43     (emit-header-data segment return-pc-header-widetag)))
  44  \f
  45 +
  46 +;;;; SSE instructions
  47 +;;;;
  48 +;;;; Automatically generated
  49 +
  50 +
  51 +(DEFINE-INSTRUCTION ADDPS
  52 +                    (SEGMENT DST SRC)
  53 +                    (:EMITTER (EMIT-BYTE SEGMENT 15)
  54 +                              (EMIT-BYTE SEGMENT 88)
  55 +                              (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST))))
  56 +
  57 +(DEFINE-INSTRUCTION ADDSUBPS
  58 +                    (SEGMENT DST SRC)
  59 +                    (:EMITTER (EMIT-BYTE SEGMENT 242)
  60 +                              (EMIT-BYTE SEGMENT 15)
  61 +                              (EMIT-BYTE SEGMENT 208)
  62 +                              (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST))))
  63 +
  64 +(DEFINE-INSTRUCTION ANDNPS
  65 +                    (SEGMENT DST SRC)
  66 +                    (:EMITTER (EMIT-BYTE SEGMENT 15)
  67 +                              (EMIT-BYTE SEGMENT 85)
  68 +                              (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST))))
  69 +
  70 +(DEFINE-INSTRUCTION ANDPS
  71 +                    (SEGMENT DST SRC)
  72 +                    (:EMITTER (EMIT-BYTE SEGMENT 15)
  73 +                              (EMIT-BYTE SEGMENT 84)
  74 +                              (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST))))
  75 +
  76 +(DEFINE-INSTRUCTION DIVPS
  77 +                    (SEGMENT DST SRC)
  78 +                    (:EMITTER (EMIT-BYTE SEGMENT 15)
  79 +                              (EMIT-BYTE SEGMENT 94)
  80 +                              (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST))))
  81 +
  82 +(DEFINE-INSTRUCTION MAXPS
  83 +                    (SEGMENT DST SRC)
  84 +                    (:EMITTER (EMIT-BYTE SEGMENT 15)
  85 +                              (EMIT-BYTE SEGMENT 95)
  86 +                              (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST))))
  87 +
  88 +(DEFINE-INSTRUCTION MINPS
  89 +                    (SEGMENT DST SRC)
  90 +                    (:EMITTER (EMIT-BYTE SEGMENT 15)
  91 +                              (EMIT-BYTE SEGMENT 93)
  92 +                              (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST))))
  93 +
  94 +(DEFINE-INSTRUCTION MULPS
  95 +                    (SEGMENT DST SRC)
  96 +                    (:EMITTER (EMIT-BYTE SEGMENT 15)
  97 +                              (EMIT-BYTE SEGMENT 89)
  98 +                              (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST))))
  99 +
 100 +(DEFINE-INSTRUCTION ORPS
 101 +                    (SEGMENT DST SRC)
 102 +                    (:EMITTER (EMIT-BYTE SEGMENT 15)
 103 +                              (EMIT-BYTE SEGMENT 86)
 104 +                              (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST))))
 105 +
 106 +(DEFINE-INSTRUCTION RCPPS
 107 +                    (SEGMENT DST SRC)
 108 +                    (:EMITTER (EMIT-BYTE SEGMENT 15)
 109 +                              (EMIT-BYTE SEGMENT 83)
 110 +                              (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST))))
 111 +
 112 +(DEFINE-INSTRUCTION RSQRTPS
 113 +                    (SEGMENT DST SRC)
 114 +                    (:EMITTER (EMIT-BYTE SEGMENT 15)
 115 +                              (EMIT-BYTE SEGMENT 82)
 116 +                              (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST))))
 117 +
 118 +(DEFINE-INSTRUCTION SQRTPS
 119 +                    (SEGMENT DST SRC)
 120 +                    (:EMITTER (EMIT-BYTE SEGMENT 15)
 121 +                              (EMIT-BYTE SEGMENT 81)
 122 +                              (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST))))
 123 +
 124 +(DEFINE-INSTRUCTION SUBPS
 125 +                    (SEGMENT DST SRC)
 126 +                    (:EMITTER (EMIT-BYTE SEGMENT 15)
 127 +                              (EMIT-BYTE SEGMENT 92)
 128 +                              (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST))))
 129 +
 130 +(DEFINE-INSTRUCTION XORPS
 131 +                    (SEGMENT DST SRC)
 132 +                    (:EMITTER (EMIT-BYTE SEGMENT 15)
 133 +                              (EMIT-BYTE SEGMENT 87)
 134 +                              (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST))))
 135 +
 136 +;;; SSE MOVE
 137 +
 138 +(DEFINE-INSTRUCTION MOVUPS (SEGMENT DST SRC)
 139 +  (:EMITTER
 140 +   (COND
 141 +     ((SSE-REGISTER-P DST)
 142 +      (EMIT-BYTE SEGMENT 15)
 143 +      (EMIT-BYTE SEGMENT 16)
 144 +      (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
 145 +     (T (EMIT-BYTE SEGMENT 15)
 146 +       (EMIT-BYTE SEGMENT 17)
 147 +       (EMIT-EA SEGMENT DST (REG-TN-ENCODING SRC))))))
 148 +
 149 +
 150 +;;; CPUID
 151 +
 152 +
 153 +(define-instruction cpuid (segment)
 154 +  (:emitter
 155 +   (emit-byte segment #x0F)
 156 +   (emit-byte segment #xA2)))
 157 +
 158 +
 159 +
 160 +
 161 +
 162  ;;;; fp instructions
 163  ;;;;
 164  ;;;; FIXME: This section said "added by jrd", which should end up in CREDITS.
 165 diff -Naur src-093/compiler/x86/vm.lisp src/compiler/x86/vm.lisp
 166 --- src-093/compiler/x86/vm.lisp        2005-08-05 15:32:19.810183044 +0300
 167 +++ src/compiler/x86/vm.lisp    2005-08-05 15:38:26.784310770 +0300
 168 @@ -21,7 +21,8 @@
 169    (defvar *byte-register-names* (make-array 8 :initial-element nil))
 170    (defvar *word-register-names* (make-array 16 :initial-element nil))
 171    (defvar *dword-register-names* (make-array 16 :initial-element nil))
 172 -  (defvar *float-register-names* (make-array 8 :initial-element nil)))
 173 +  (defvar *float-register-names* (make-array 8 :initial-element nil))
 174 +  (defvar *dqword-register-names* (make-array 8 :initial-element nil)))
 175
 176  (macrolet ((defreg (name offset size)
 177               (let ((offset-sym (symbolicate name "-OFFSET"))
 178 @@ -91,6 +92,17 @@
 179    (defreg fr7 7 :float)
 180    (defregset *float-regs* fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7)
 181
 182 +  ;; sse registers
 183 +  (defreg xmm0 0 :dqword)
 184 +  (defreg xmm1 1 :dqword)
 185 +  (defreg xmm2 2 :dqword)
 186 +  (defreg xmm3 3 :dqword)
 187 +  (defreg xmm4 4 :dqword)
 188 +  (defreg xmm5 5 :dqword)
 189 +  (defreg xmm6 6 :dqword)
 190 +  (defreg xmm7 7 :dqword)
 191 +  (defregset *sse-regs* xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7)
 192 +
 193    ;; registers used to pass arguments
 194    ;;
 195    ;; the number of arguments/return values passed in registers
 196 @@ -118,6 +130,8 @@
 197  ;;; the new way:
 198  (define-storage-base float-registers :finite :size 8)
 199
 200 +(define-storage-base sse-registers :finite :size 8)
 201 +
 202  (define-storage-base stack :unbounded :size 8)
 203  (define-storage-base constant :non-packed)
 204  (define-storage-base immediate-constant :non-packed)
 205 @@ -320,6 +334,8 @@
 206                      :save-p t
 207                      :alternate-scs (complex-long-stack))
 208
 209 +  (sse-reg sse-registers
 210 +          :locations #.*sse-regs*)
 211    ;; a catch or unwind block
 212    (catch-block stack :element-size kludge-nondeterministic-catch-block-size))
 213
 214 @@ -337,6 +353,7 @@
 215  ;;; These are used to (at least) determine operand size.
 216  (defparameter *float-sc-names* '(single-reg))
 217  (defparameter *double-sc-names* '(double-reg double-stack))
 218 +(defparameter *dqword-sc-names* '(sse-reg))
 219  ) ; EVAL-WHEN
 220  \f
 221  ;;;; miscellaneous TNs for the various registers
 222 @@ -444,6 +461,7 @@
 223               ;; FIXME: Shouldn't this be an ERROR?
 224               (format nil "<unknown reg: off=~W, sc=~A>" offset sc-name))))
 225        (float-registers (format nil "FR~D" offset))
 226 +      (sse-registers (format nil "XMM~D" offset))
 227        (stack (format nil "S~D" offset))
 228        (constant (format nil "Const~D" offset))
 229        (immediate-constant "Immed")