From 69e201b4158942147ceade4cb9a47d5f1268cf33 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Wed, 28 Oct 2009 22:48:11 +0000
Subject: [PATCH] Revert previous change.  Instead, make the arithmetic vops
 for mixing complex and floats ensure that the float is converted to a complex
 with the correct imaginary part.  The failed tests from Maxima (rtest_gamma)
 now pass.  (Almost.  The required tolerance is a little too tight for sse2,
 mostly due to a slightly inaccurate exp function. But that's libc's fault,
 not CMUCL's fault.)

---
 compiler/x86/float-sse2.lisp | 34 ++++++++++++++++++++--------------
 1 file changed, 20 insertions(+), 14 deletions(-)

diff --git a/compiler/x86/float-sse2.lisp b/compiler/x86/float-sse2.lisp
index 8ccdfcd50..0c756f22c 100644
--- a/compiler/x86/float-sse2.lisp
+++ b/compiler/x86/float-sse2.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.9 2009/10/28 17:15:45 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.10 2009/10/28 22:48:11 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -942,11 +942,9 @@
                     (signed-reg
                      (inst mov temp x)
                      (note-this-location vop :internal-error)
-		     (inst xorpd y y)
                      (inst ,inst y temp))
                     (signed-stack
                      (note-this-location vop :internal-error)
-		     (inst xorpd y y)
                      (inst ,inst y x)))))))
   (frob %single-float/signed %single-float cvtsi2ss single-reg single-float)
   (frob %double-float/signed %double-float cvtsi2sd double-reg double-float))
@@ -1891,7 +1889,10 @@
 	     (ea-desc (symbolicate "EA-FOR-" base-ea "-DESC"))
 	     (loadinst (ecase size
 			 (single 'movss)
-			 (double 'movsd))))
+			 (double 'movsd)))
+	     (movinst (ecase size
+			(single 'movaps)
+			(double 'movapd))))
 	 `(define-vop (,vop-name)
 	    (:args (x :scs (,complex-reg))
 	           (y :scs (,real-reg ,r-stack descriptor-reg)))
@@ -1904,19 +1905,21 @@
 	    (:temporary (:sc ,complex-reg) tmp)
 	    (:temporary (:sc ,real-reg) rtmp)
 	    (:generator ,cost
+	      ;; Clear out high and low parts of temp, which will
+	      ;; eventually hold y.
 	      (inst xorpd rtmp rtmp)
 	      (sc-case y
 		(,real-reg
-		 (inst movaps rtmp y)
-		 (generate movaps ,fop))
+		 (inst ,loadinst rtmp y)
+		 (generate ,movinst ,fop))
 		(,r-stack
 		 (let ((ea (,ea-stack y)))
 		   (inst ,loadinst rtmp ea)
-		   (generate movaps ,fop)))
+		   (generate ,movinst ,fop)))
 		(descriptor-reg
 		 (let ((ea (,ea-desc y)))
 		   (inst ,loadinst rtmp ea)
-		   (generate movaps ,fop)))))))))
+		   (generate ,movinst ,fop)))))))))
   (complex-op-float single + addps sf 1)
   (complex-op-float single - subps sf 1)
   (complex-op-float double + addpd df 1)
@@ -1948,7 +1951,10 @@
 	     (ea-desc (symbolicate "EA-FOR-" base-ea "-DESC"))
 	     (loadinst (ecase size
 			 (single 'movss)
-			 (double 'movsd))))
+			 (double 'movsd)))
+	     (movinst (ecase size
+			(single 'movaps)
+			(double 'movapd))))
 	 `(define-vop (,vop-name)
 	    (:args (y :scs (,real-reg ,r-stack descriptor-reg))
 	           (x :scs (,complex-reg)))
@@ -1961,19 +1967,19 @@
 	    (:temporary (:sc ,complex-reg) tmp)
 	    (:temporary (:sc ,real-reg) rtmp)
 	    (:generator ,cost
+	      (inst xorpd rtmp rtmp)
 	      (sc-case y
 		(,real-reg
-		 (inst xorpd rtmp rtmp)
-		 (inst movaps rtmp y)
-		 (generate movaps ,fop))
+		 (inst ,loadinst rtmp y)
+		 (generate ,movinst ,fop))
 		(,r-stack
 		 (let ((ea (,ea-stack y)))
 		   (inst ,loadinst rtmp ea)
-		   (generate movaps ,fop)))
+		   (generate ,movinst ,fop)))
 		(descriptor-reg
 		 (let ((ea (,ea-desc y)))
 		   (inst ,loadinst rtmp ea)
-		   (generate movaps ,fop)))))))))
+		   (generate ,movinst ,fop)))))))))
   (complex-op-float single + addps sf 1)
   (complex-op-float double + addpd df 1))
 
-- 
GitLab