CMUCL commit: RELEASE-20B-BRANCH src/compiler/x86 (float-sse2.lisp insts.lisp)

[Raymond Toy]

    Date: Sunday, August 15, 2010 @ 11:09:41
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/compiler/x86
     Tag: RELEASE-20B-BRANCH

Modified: float-sse2.lisp insts.lisp

Merge fix from HEAD to allow comparing NaNs in =.


-----------------+
 float-sse2.lisp |   14 +++++++-------
 insts.lisp      |    7 +++++--
 2 files changed, 12 insertions(+), 9 deletions(-)


Index: src/compiler/x86/float-sse2.lisp
diff -u src/compiler/x86/float-sse2.lisp:1.16.2.1 src/compiler/x86/float-sse2.lisp:1.16.2.2
--- src/compiler/x86/float-sse2.lisp:1.16.2.1	Fri Aug  6 14:02:03 2010
+++ src/compiler/x86/float-sse2.lisp	Sun Aug 15 11:09:41 2010
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group at cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.16.2.1 2010-08-06 18:02:03 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.16.2.2 2010-08-15 15:09:41 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -879,7 +879,7 @@
   (:vop-var vop)
   (:generator 3
     (note-this-location vop :internal-error)
-    (inst comiss x y)
+    (inst ucomiss x y)
     ;; if PF&CF, there was a NaN involved => not equal
     ;; otherwise, ZF => equal
     (cond (not-p
@@ -897,7 +897,7 @@
   (:vop-var vop)
   (:generator 3
     (note-this-location vop :internal-error)
-    (inst comisd x y)
+    (inst ucomisd x y)
     (cond (not-p
            (inst jmp :p target)
            (inst jmp :ne target))
@@ -907,7 +907,7 @@
              (inst jmp :e target)
              (emit-label not-lab))))))
 
-(define-vop (<double-float double-float-compare)
+(define-vop (</double-float double-float-compare)
   (:translate <)
   (:info target not-p)
   (:generator 3
@@ -921,7 +921,7 @@
              (inst jmp :c target)
              (emit-label not-lab))))))
 
-(define-vop (<single-float single-float-compare)
+(define-vop (</single-float single-float-compare)
   (:translate <)
   (:info target not-p)
   (:generator 3
@@ -935,7 +935,7 @@
              (inst jmp :c target)
              (emit-label not-lab))))))
 
-(define-vop (>double-float double-float-compare)
+(define-vop (>/double-float double-float-compare)
   (:translate >)
   (:info target not-p)
   (:generator 3
@@ -949,7 +949,7 @@
              (inst jmp :a target)
              (emit-label not-lab))))))
 
-(define-vop (>single-float single-float-compare)
+(define-vop (>/single-float single-float-compare)
   (:translate >)
   (:info target not-p)
   (:generator 3
Index: src/compiler/x86/insts.lisp
diff -u src/compiler/x86/insts.lisp:1.35 src/compiler/x86/insts.lisp:1.35.4.1
--- src/compiler/x86/insts.lisp:1.35	Fri Mar 19 11:19:01 2010
+++ src/compiler/x86/insts.lisp	Sun Aug 15 11:09:41 2010
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group at cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/compiler/x86/insts.lisp,v 1.35 2010-03-19 15:19:01 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/compiler/x86/insts.lisp,v 1.35.4.1 2010-08-15 15:09:41 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -3140,6 +3140,8 @@
   ;; comparison
   (define-regular-sse-inst comisd   #x66 #x2f)
   (define-regular-sse-inst comiss   nil  #x2f)
+  (define-regular-sse-inst ucomisd   #x66 #x2e)
+  (define-regular-sse-inst ucomiss   nil  #x2e)
   ;; arithmetic
   (define-regular-sse-inst addsd    #xf2 #x58)
   (define-regular-sse-inst addpd    #x66 #x58 t)
@@ -3495,6 +3497,8 @@
     ((packed-shift (name imm-op reg-op reg)
        ;; We don't support the MMX version.
        `(define-instruction ,name (segment dst src)
+	  (:declare (type (satisfies xmm-register-p) dst)
+		    (type (or fixnum (satisfies xmm-register-p)) src))
 	  (:printer ext-xmm-mem ((prefix #x66) (op ,reg-op)))
 	  (:printer ext-xmm-mem ((prefix #x66) (op ,imm-op)
 				 (reg ,reg)
@@ -3508,7 +3512,6 @@
 		  (emit-mod-reg-r/m-byte segment #b11 ,reg (reg-tn-encoding dst))
 		  (emit-byte segment src))
 		 (t
-		  (assert (xmm-register-p src))
 		  (emit-regular-sse-inst segment dst src #x66 ,reg-op)))))))
   (packed-shift psrlq #x73 #xd3 2)
   (packed-shift psrld #x72 #xd2 2)