[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
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")
participants (1)
-
rlaaksoï¼ common-lisp.net