[sb-simd-cvs] CVS update: sb-simd/sbcl-src/patch_against_sbcl_0_9_3__08082005 sb-simd/sbcl-src/patch_against_sbcl_0_9_3
Risto Laakso
rlaakso at common-lisp.net
Wed Aug 17 14:09:06 UTC 2005
Update of /project/sb-simd/cvsroot/sb-simd/sbcl-src
In directory common-lisp.net:/tmp/cvs-serv1850/sbcl-src
Modified Files:
patch_against_sbcl_0_9_3
Added Files:
patch_against_sbcl_0_9_3__08082005
Log Message:
Date: Wed Aug 17 16:08:58 2005
Author: rlaakso
Index: sb-simd/sbcl-src/patch_against_sbcl_0_9_3
diff -u sb-simd/sbcl-src/patch_against_sbcl_0_9_3:1.2 sb-simd/sbcl-src/patch_against_sbcl_0_9_3:1.3
--- sb-simd/sbcl-src/patch_against_sbcl_0_9_3:1.2 Mon Aug 8 15:33:25 2005
+++ sb-simd/sbcl-src/patch_against_sbcl_0_9_3 Wed Aug 17 16:08:57 2005
@@ -1,16 +1,160 @@
+diff -x 'CVS*' -Naur src-093/compiler/x86/float.lisp src/compiler/x86/float.lisp
+--- src-093/compiler/x86/float.lisp 2005-08-17 16:56:53.996387102 +0300
++++ src/compiler/x86/float.lisp 2005-08-17 15:04:50.040162831 +0300
+@@ -4308,3 +4308,122 @@
+ (:note "inline dummy FP register bias")
+ (:ignore x)
+ (:generator 0))
++
++
++;; XMM Moves
++
++
++(defun ea-for-xmm-desc (tn)
++ (make-ea :xmmword :base tn
++ :disp (- (* xmm-value-slot n-word-bytes) other-pointer-lowtag)))
++
++(defun ea-for-xmm-stack (tn)
++ (make-ea :xmmword :base ebp-tn
++ :disp (- (* (+ (tn-offset tn)
++ 4)
++ n-word-bytes))))
++
++(define-move-fun (load-xmm 2) (vop x y)
++ ((xmm-stack) (xmm-reg))
++ (inst movdqu y (ea-for-xmm-stack x)))
++
++(define-move-fun (store-xmm 2) (vop x y)
++ ((xmm-reg) (xmm-stack))
++ (inst movdqu (ea-for-xmm-stack y) x))
++
++(define-move-fun (load-xmm-single 2) (vop x y)
++ ((single-stack) (xmm-reg))
++ (inst movss y (ea-for-sf-stack x)))
++
++(define-move-fun (store-xmm-single 2) (vop x y)
++ ((xmm-reg) (single-stack))
++ (inst movss (ea-for-sf-stack y) x))
++
++
++(define-vop (%load-xmm-from-array/single-float)
++ (:policy :fast-safe)
++ (:args (src :scs (descriptor-reg))
++ (index :scs (unsigned-reg)))
++ (:ARG-TYPES SIMPLE-ARRAY-SINGLE-FLOAT fixnum)
++ (:results (dest :scs (xmm-reg)))
++ (:result-types xmm)
++ (:generator 1
++ (inst shl index 2)
++ (inst movdqu dest (make-ea :xmmword :base src :index index
++ :disp (- (* VECTOR-DATA-OFFSET N-WORD-BYTES) OTHER-POINTER-LOWTAG)))))
++
++
++(define-vop (%store-xmm-to-array/single-float)
++ (:policy :fast-safe)
++ (:args (dest :scs (descriptor-reg))
++ (index :scs (unsigned-reg))
++ (src :scs (xmm-reg)))
++ (:ARG-TYPES SIMPLE-ARRAY-SINGLE-FLOAT fixnum XMM)
++ (:generator 1
++ (inst shl index 2)
++ (inst movdqu (make-ea :xmmword :base dest :index index
++ :disp (- (* VECTOR-DATA-OFFSET N-WORD-BYTES) OTHER-POINTER-LOWTAG))
++ src)))
++
++
++(define-vop (xmm-move)
++ (:args (x :scs (xmm-reg) :target y :load-if (not (location= x y))))
++ (:results (y :scs (xmm-reg) :load-if (not (location= x y))))
++ (:note "xmm move")
++ (:generator 0
++ (unless (location= x y)
++ (inst movdqa y x))))
++
++(define-move-vop xmm-move :move (xmm-reg) (xmm-reg))
++
++(define-vop (move-from-xmm)
++ (:args (x :scs (xmm-reg) :to :save))
++ (:results (y :scs (descriptor-reg)))
++ (:node-var node)
++ (:note "xmm to pointer coercion")
++ (:generator 13
++ (with-fixed-allocation (y
++ xmm-widetag
++ xmm-size node)
++ (inst movdqu (ea-for-xmm-desc y) x))))
++
++(define-move-vop move-from-xmm :move (xmm-reg) (descriptor-reg))
++
++(define-vop (move-to-xmm)
++ (:args (x :scs (descriptor-reg)))
++ (:results (y :scs (xmm-reg)))
++ (:note "pointer to xmm coercion")
++ (:generator 2
++ (inst movdqu y (ea-for-xmm-desc x))))
++
++(define-move-vop move-to-xmm :move (descriptor-reg) (xmm-reg))
++
++
++(define-vop (move-xmm-arg)
++ (:args (x :scs (xmm-reg) :target y)
++ (fp :scs (any-reg)
++ :load-if (not (sc-is y xmm-reg))))
++ (:results (y))
++ (:note "xmm argument move")
++ (:generator 6
++ (sc-case y
++ (xmm-reg
++ (unless (location= x y)
++ (inst movdqa y x)))
++
++ (xmm-stack
++ (if (= (tn-offset fp) esp-offset)
++ (let* ((offset (* (tn-offset y) n-word-bytes))
++ (ea (make-ea :xmmword :base fp :disp offset)))
++ (inst movdqu ea x))
++
++ (let ((ea (make-ea :xmmword :base fp
++ :disp (- (* (+ (tn-offset y) 4)
++ n-word-bytes)))))
++ (inst movdqu ea x)))))))
++
++(define-move-vop move-xmm-arg :move-arg (xmm-reg descriptor-reg) (xmm-reg))
++
++(define-move-vop move-arg :move-arg (xmm-reg) (descriptor-reg))
++
++
diff -x 'CVS*' -Naur src-093/compiler/x86/insts.lisp src/compiler/x86/insts.lisp
--- src-093/compiler/x86/insts.lisp 2005-08-05 16:13:29.000000000 +0300
-+++ src/compiler/x86/insts.lisp 2005-08-08 16:30:23.352842152 +0300
-@@ -192,6 +192,8 @@
++++ src/compiler/x86/insts.lisp 2005-08-16 10:39:07.027823783 +0300
+@@ -39,13 +39,16 @@
+ #(ax cx dx bx sp bp si di))
+ (defparameter *dword-reg-names*
+ #(eax ecx edx ebx esp ebp esi edi))
++(defparameter *xmmword-reg-names*
++ #(xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7))
+
+ (defun print-reg-with-width (value width stream dstate)
+ (declare (ignore dstate))
+ (princ (aref (ecase width
+ (:byte *byte-reg-names*)
+ (:word *word-reg-names*)
+- (:dword *dword-reg-names*))
++ (:dword *dword-reg-names*)
++ (:xmmword *xmmword-reg-names*))
+ value)
+ stream)
+ ;; XXX plus should do some source-var notes
+@@ -192,6 +195,8 @@
(:byte 8)
(:word 16)
(:dword 32)
+ (:qword 64)
-+ (:dqword 128)
++ (:xmmword 128)
(:float 32)
(:double 64)))
-@@ -671,7 +673,7 @@
+@@ -671,14 +676,14 @@
(defun reg-tn-encoding (tn)
(declare (type tn tn))
@@ -19,27 +163,53 @@
(let ((offset (tn-offset tn)))
(logior (ash (logand offset 1) 2)
(ash offset -1))))
-@@ -718,6 +720,8 @@
+
+ (defstruct (ea (:constructor make-ea (size &key base index scale disp))
+ (:copier nil))
+- (size nil :type (member :byte :word :dword))
++ (size nil :type (member :byte :word :dword :xmmword))
+ (base nil :type (or tn null))
+ (index nil :type (or tn null))
+ (scale 1 :type (member 1 2 4 8))
+@@ -718,6 +723,8 @@
(ecase (sb-name (sc-sb (tn-sc thing)))
(registers
(emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing)))
-+ (sse-registers
++ (xmm-registers
+ (emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing)))
(stack
;; Convert stack tns into an index off of EBP.
(let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes))))
-@@ -830,6 +834,10 @@
+@@ -830,6 +837,19 @@
(and (tn-p thing)
(eq (sb-name (sc-sb (tn-sc thing))) 'registers)))
-+(defun sse-register-p (thing)
++(defun xmm-register-p (thing)
+ (and (tn-p thing)
-+ (eq (sb-name (sc-sb (tn-sc thing))) 'sse-registers)))
++ (eq (sb-name (sc-sb (tn-sc thing))) 'xmm-registers)
++ (member (sc-name (tn-sc thing)) *xmmword-sc-names*)
++ t))
++
++(defun xmm-ea-p (thing)
++ (typecase thing
++ (ea (eq (ea-size thing) :xmmword))
++ (tn
++ (and (member (sc-name (tn-sc thing)) *xmmword-sc-names*) t))
++ (t nil)))
+
(defun accumulator-p (thing)
(and (register-p thing)
(= (tn-offset thing) 0)))
-@@ -2042,6 +2050,1339 @@
+@@ -859,6 +879,8 @@
+ :float)
+ (#.*double-sc-names*
+ :double)
++ (#.*xmmword-sc-names*
++ :xmmword)
+ (t
+ (error "can't tell the size of ~S ~S" thing (sc-name (tn-sc thing))))))
+ (ea
+@@ -2042,6 +2064,1419 @@
(:emitter
(emit-header-data segment return-pc-header-widetag)))
@@ -1203,7 +1373,7 @@
+ (SEGMENT DST SRC)
+ (:EMITTER
+ (COND
-+ ((SSE-REGISTER-P DST) (EMIT-BYTE SEGMENT 102)
++ ((XMM-REGISTER-P DST) (EMIT-BYTE SEGMENT 102)
+ (EMIT-BYTE SEGMENT 15) (EMIT-BYTE SEGMENT 40)
+ (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
+ (T (EMIT-BYTE SEGMENT 102)
@@ -1215,7 +1385,7 @@
+ (SEGMENT DST SRC)
+ (:EMITTER
+ (COND
-+ ((SSE-REGISTER-P DST) (EMIT-BYTE SEGMENT 15)
++ ((XMM-REGISTER-P DST) (EMIT-BYTE SEGMENT 15)
+ (EMIT-BYTE SEGMENT 40)
+ (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
+ (T (EMIT-BYTE SEGMENT 15)
@@ -1226,7 +1396,7 @@
+ (SEGMENT DST SRC)
+ (:EMITTER
+ (COND
-+ ((SSE-REGISTER-P DST) (EMIT-BYTE SEGMENT 102)
++ ((XMM-REGISTER-P DST) (EMIT-BYTE SEGMENT 102)
+ (EMIT-BYTE SEGMENT 15) (EMIT-BYTE SEGMENT 110)
+ (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
+ (T (EMIT-BYTE SEGMENT 102)
@@ -1238,7 +1408,7 @@
+ (SEGMENT DST SRC)
+ (:EMITTER
+ (COND
-+ ((SSE-REGISTER-P DST) (EMIT-BYTE SEGMENT 102)
++ ((XMM-REGISTER-P DST) (EMIT-BYTE SEGMENT 102)
+ (EMIT-BYTE SEGMENT 15) (EMIT-BYTE SEGMENT 111)
+ (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
+ (T (EMIT-BYTE SEGMENT 102)
@@ -1250,7 +1420,7 @@
+ (SEGMENT DST SRC)
+ (:EMITTER
+ (COND
-+ ((SSE-REGISTER-P DST) (EMIT-BYTE SEGMENT 243)
++ ((XMM-REGISTER-P DST) (EMIT-BYTE SEGMENT 243)
+ (EMIT-BYTE SEGMENT 15) (EMIT-BYTE SEGMENT 111)
+ (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
+ (T (EMIT-BYTE SEGMENT 243)
@@ -1262,7 +1432,7 @@
+ (SEGMENT DST SRC)
+ (:EMITTER
+ (COND
-+ ((SSE-REGISTER-P DST) (EMIT-BYTE SEGMENT 102)
++ ((XMM-REGISTER-P DST) (EMIT-BYTE SEGMENT 102)
+ (EMIT-BYTE SEGMENT 15) (EMIT-BYTE SEGMENT 22)
+ (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
+ (T (EMIT-BYTE SEGMENT 102)
@@ -1274,7 +1444,7 @@
+ (SEGMENT DST SRC)
+ (:EMITTER
+ (COND
-+ ((SSE-REGISTER-P DST) (EMIT-BYTE SEGMENT 15)
++ ((XMM-REGISTER-P DST) (EMIT-BYTE SEGMENT 15)
+ (EMIT-BYTE SEGMENT 22)
+ (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
+ (T (EMIT-BYTE SEGMENT 15)
@@ -1285,7 +1455,7 @@
+ (SEGMENT DST SRC)
+ (:EMITTER
+ (COND
-+ ((SSE-REGISTER-P DST) (EMIT-BYTE SEGMENT 102)
++ ((XMM-REGISTER-P DST) (EMIT-BYTE SEGMENT 102)
+ (EMIT-BYTE SEGMENT 15) (EMIT-BYTE SEGMENT 18)
+ (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
+ (T (EMIT-BYTE SEGMENT 102)
@@ -1297,7 +1467,7 @@
+ (SEGMENT DST SRC)
+ (:EMITTER
+ (COND
-+ ((SSE-REGISTER-P DST) (EMIT-BYTE SEGMENT 15)
++ ((XMM-REGISTER-P DST) (EMIT-BYTE SEGMENT 15)
+ (EMIT-BYTE SEGMENT 18)
+ (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
+ (T (EMIT-BYTE SEGMENT 15)
@@ -1308,7 +1478,7 @@
+ (SEGMENT DST SRC)
+ (:EMITTER
+ (COND
-+ ((SSE-REGISTER-P DST) (EMIT-BYTE SEGMENT 243)
++ ((XMM-REGISTER-P DST) (EMIT-BYTE SEGMENT 243)
+ (EMIT-BYTE SEGMENT 15) (EMIT-BYTE SEGMENT 126)
+ (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
+ (T (EMIT-BYTE SEGMENT 102)
@@ -1320,7 +1490,7 @@
+ (SEGMENT DST SRC)
+ (:EMITTER
+ (COND
-+ ((SSE-REGISTER-P DST) (EMIT-BYTE SEGMENT 242)
++ ((XMM-REGISTER-P DST) (EMIT-BYTE SEGMENT 242)
+ (EMIT-BYTE SEGMENT 15) (EMIT-BYTE SEGMENT 16)
+ (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
+ (T (EMIT-BYTE SEGMENT 242)
@@ -1332,7 +1502,7 @@
+ (SEGMENT DST SRC)
+ (:EMITTER
+ (COND
-+ ((SSE-REGISTER-P DST) (EMIT-BYTE SEGMENT 243)
++ ((XMM-REGISTER-P DST) (EMIT-BYTE SEGMENT 243)
+ (EMIT-BYTE SEGMENT 15) (EMIT-BYTE SEGMENT 16)
+ (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
+ (T (EMIT-BYTE SEGMENT 243)
@@ -1344,7 +1514,7 @@
+ (SEGMENT DST SRC)
+ (:EMITTER
+ (COND
-+ ((SSE-REGISTER-P DST) (EMIT-BYTE SEGMENT 102)
++ ((XMM-REGISTER-P DST) (EMIT-BYTE SEGMENT 102)
+ (EMIT-BYTE SEGMENT 15) (EMIT-BYTE SEGMENT 16)
+ (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
+ (T (EMIT-BYTE SEGMENT 102)
@@ -1356,13 +1526,93 @@
+ (SEGMENT DST SRC)
+ (:EMITTER
+ (COND
-+ ((SSE-REGISTER-P DST) (EMIT-BYTE SEGMENT 15)
++ ((XMM-REGISTER-P DST) (EMIT-BYTE SEGMENT 15)
+ (EMIT-BYTE SEGMENT 16)
+ (EMIT-EA SEGMENT SRC (REG-TN-ENCODING DST)))
+ (T (EMIT-BYTE SEGMENT 15)
+ (EMIT-BYTE SEGMENT 17)
+ (EMIT-EA SEGMENT DST (REG-TN-ENCODING SRC))))))
+
++(DEFINE-INSTRUCTION PSLLD-IB
++ (SEGMENT DST AMOUNT)
++ (:EMITTER (EMIT-BYTE SEGMENT 102)
++ (EMIT-BYTE SEGMENT 15)
++ (EMIT-BYTE SEGMENT 114)
++ (EMIT-EA SEGMENT DST 6)
++ (EMIT-BYTE SEGMENT AMOUNT)))
++
++(DEFINE-INSTRUCTION PSLLDQ-IB
++ (SEGMENT DST AMOUNT)
++ (:EMITTER (EMIT-BYTE SEGMENT 102)
++ (EMIT-BYTE SEGMENT 15)
++ (EMIT-BYTE SEGMENT 115)
++ (EMIT-EA SEGMENT DST 7)
++ (EMIT-BYTE SEGMENT AMOUNT)))
++
++(DEFINE-INSTRUCTION PSLLQ-IB
++ (SEGMENT DST AMOUNT)
++ (:EMITTER (EMIT-BYTE SEGMENT 102)
++ (EMIT-BYTE SEGMENT 15)
++ (EMIT-BYTE SEGMENT 115)
++ (EMIT-EA SEGMENT DST 6)
++ (EMIT-BYTE SEGMENT AMOUNT)))
++
++(DEFINE-INSTRUCTION PSLLW-IB
++ (SEGMENT DST AMOUNT)
++ (:EMITTER (EMIT-BYTE SEGMENT 102)
++ (EMIT-BYTE SEGMENT 15)
++ (EMIT-BYTE SEGMENT 113)
++ (EMIT-EA SEGMENT DST 6)
++ (EMIT-BYTE SEGMENT AMOUNT)))
++
++(DEFINE-INSTRUCTION PSRAD-IB
++ (SEGMENT DST AMOUNT)
++ (:EMITTER (EMIT-BYTE SEGMENT 102)
++ (EMIT-BYTE SEGMENT 15)
++ (EMIT-BYTE SEGMENT 114)
++ (EMIT-EA SEGMENT DST 4)
++ (EMIT-BYTE SEGMENT AMOUNT)))
++
++(DEFINE-INSTRUCTION PSRAW-IB
++ (SEGMENT DST AMOUNT)
++ (:EMITTER (EMIT-BYTE SEGMENT 102)
++ (EMIT-BYTE SEGMENT 15)
++ (EMIT-BYTE SEGMENT 113)
++ (EMIT-EA SEGMENT DST 4)
++ (EMIT-BYTE SEGMENT AMOUNT)))
++
++(DEFINE-INSTRUCTION PSRLD-IB
++ (SEGMENT DST AMOUNT)
++ (:EMITTER (EMIT-BYTE SEGMENT 102)
++ (EMIT-BYTE SEGMENT 15)
++ (EMIT-BYTE SEGMENT 114)
++ (EMIT-EA SEGMENT DST 2)
++ (EMIT-BYTE SEGMENT AMOUNT)))
++
++(DEFINE-INSTRUCTION PSRLDQ-IB
++ (SEGMENT DST AMOUNT)
++ (:EMITTER (EMIT-BYTE SEGMENT 102)
++ (EMIT-BYTE SEGMENT 15)
++ (EMIT-BYTE SEGMENT 115)
++ (EMIT-EA SEGMENT DST 3)
++ (EMIT-BYTE SEGMENT AMOUNT)))
++
++(DEFINE-INSTRUCTION PSRLQ-IB
++ (SEGMENT DST AMOUNT)
++ (:EMITTER (EMIT-BYTE SEGMENT 102)
++ (EMIT-BYTE SEGMENT 15)
++ (EMIT-BYTE SEGMENT 115)
++ (EMIT-EA SEGMENT DST 2)
++ (EMIT-BYTE SEGMENT AMOUNT)))
++
++(DEFINE-INSTRUCTION PSRLW-IB
++ (SEGMENT DST AMOUNT)
++ (:EMITTER (EMIT-BYTE SEGMENT 102)
++ (EMIT-BYTE SEGMENT 15)
++ (EMIT-BYTE SEGMENT 113)
++ (EMIT-EA SEGMENT DST 2)
++ (EMIT-BYTE SEGMENT AMOUNT)))
++
+
+
+;;; CPUID
@@ -1381,14 +1631,14 @@
;;;; FIXME: This section said "added by jrd", which should end up in CREDITS.
diff -x 'CVS*' -Naur src-093/compiler/x86/vm.lisp src/compiler/x86/vm.lisp
--- src-093/compiler/x86/vm.lisp 2005-08-05 16:13:29.000000000 +0300
-+++ src/compiler/x86/vm.lisp 2005-08-08 16:32:19.609588299 +0300
++++ src/compiler/x86/vm.lisp 2005-08-17 13:06:11.717026836 +0300
@@ -21,7 +21,8 @@
(defvar *byte-register-names* (make-array 8 :initial-element nil))
(defvar *word-register-names* (make-array 16 :initial-element nil))
(defvar *dword-register-names* (make-array 16 :initial-element nil))
- (defvar *float-register-names* (make-array 8 :initial-element nil)))
+ (defvar *float-register-names* (make-array 8 :initial-element nil))
-+ (defvar *dqword-register-names* (make-array 8 :initial-element nil)))
++ (defvar *xmmword-register-names* (make-array 8 :initial-element nil)))
(macrolet ((defreg (name offset size)
(let ((offset-sym (symbolicate name "-OFFSET"))
@@ -1397,15 +1647,15 @@
(defregset *float-regs* fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7)
+ ;; sse registers
-+ (defreg xmm0 0 :dqword)
-+ (defreg xmm1 1 :dqword)
-+ (defreg xmm2 2 :dqword)
-+ (defreg xmm3 3 :dqword)
-+ (defreg xmm4 4 :dqword)
-+ (defreg xmm5 5 :dqword)
-+ (defreg xmm6 6 :dqword)
-+ (defreg xmm7 7 :dqword)
-+ (defregset *sse-regs* xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7)
++ (defreg xmm0 0 :xmmword)
++ (defreg xmm1 1 :xmmword)
++ (defreg xmm2 2 :xmmword)
++ (defreg xmm3 3 :xmmword)
++ (defreg xmm4 4 :xmmword)
++ (defreg xmm5 5 :xmmword)
++ (defreg xmm6 6 :xmmword)
++ (defreg xmm7 7 :xmmword)
++ (defregset *xmm-regs* xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7)
+
;; registers used to pass arguments
;;
@@ -1414,33 +1664,55 @@
;;; the new way:
(define-storage-base float-registers :finite :size 8)
-+(define-storage-base sse-registers :finite :size 8)
++(define-storage-base xmm-registers :finite :size 8)
+
(define-storage-base stack :unbounded :size 8)
(define-storage-base constant :non-packed)
(define-storage-base immediate-constant :non-packed)
-@@ -320,6 +334,8 @@
- :save-p t
- :alternate-scs (complex-long-stack))
+@@ -186,6 +200,7 @@
+ (sap-stack stack) ; System area pointers.
+ (single-stack stack) ; single-floats
+ (double-stack stack :element-size 2) ; double-floats.
++ (xmm-stack stack :element-size 4) ; xmm
+ #!+long-float
+ (long-stack stack :element-size 3) ; long-floats.
+ (complex-single-stack stack :element-size 2) ; complex-single-floats
+@@ -290,6 +305,12 @@
+ :save-p t
+ :alternate-scs (double-stack))
-+ (sse-reg sse-registers
-+ :locations #.*sse-regs*)
- ;; a catch or unwind block
- (catch-block stack :element-size kludge-nondeterministic-catch-block-size))
-
-@@ -337,6 +353,7 @@
++ ;; non-descriptor XMMs
++ (xmm-reg xmm-registers
++ :locations #.*xmm-regs*
++ :save-p t
++ :alternate-scs (xmm-stack))
++
+ ;; non-descriptor LONG-FLOATs
+ #!+long-float
+ (long-reg float-registers
+@@ -337,6 +358,7 @@
;;; These are used to (at least) determine operand size.
(defparameter *float-sc-names* '(single-reg))
(defparameter *double-sc-names* '(double-reg double-stack))
-+(defparameter *dqword-sc-names* '(sse-reg))
++(defparameter *xmmword-sc-names* '(xmm-reg))
) ; EVAL-WHEN
;;;; miscellaneous TNs for the various registers
-@@ -444,6 +461,7 @@
+@@ -359,7 +381,8 @@
+ (def-misc-reg-tns unsigned-reg eax ebx ecx edx ebp esp edi esi)
+ (def-misc-reg-tns word-reg ax bx cx dx bp sp di si)
+ (def-misc-reg-tns byte-reg al ah bl bh cl ch dl dh)
+- (def-misc-reg-tns single-reg fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7))
++ (def-misc-reg-tns single-reg fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7)
++ (def-misc-reg-tns xmm-reg xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7))
+
+ ;;; TNs for registers used to pass arguments
+ (defparameter *register-arg-tns*
+@@ -444,6 +467,7 @@
;; FIXME: Shouldn't this be an ERROR?
(format nil "<unknown reg: off=~W, sc=~A>" offset sc-name))))
(float-registers (format nil "FR~D" offset))
-+ (sse-registers (format nil "XMM~D" offset))
++ (xmm-registers (format nil "XMM~D" offset))
(stack (format nil "S~D" offset))
(constant (format nil "Const~D" offset))
(immediate-constant "Immed")
More information about the Sb-simd-cvs
mailing list