Author: Raymond Toy <rtoy@common-lisp.net>
Date: 2010-11-02
Status: Upstream
Description: Fixes bug in SSE2 VOP for COMPLEX arrays

diff -ru cmucl.orig//src/compiler/x86/float-sse2.lisp cmucl/src/compiler/x86/float-sse2.lisp
--- cmucl.orig//src/compiler/x86/float-sse2.lisp	2010-08-15 17:09:41.000000000 +0200
+++ cmucl/src/compiler/x86/float-sse2.lisp	2010-11-01 13:41:54.860889371 +0100
@@ -1390,13 +1390,19 @@
   (:arg-types complex-single-float)
   (:results (r :scs (single-reg)))
   (:result-types single-float)
+  (:temporary (:sc single-reg) temp)
   (:policy :fast-safe)
   (:note _N"complex float realpart")
   (:generator 3
     (sc-case x
       (complex-single-reg
-       (inst xorps r r)			; temp = 0|0|0|0
-       (inst movss r x))		; r = 0|0|0|x
+       (cond ((location= r x)
+	      (inst xorps temp temp)	; temp = 0|0|0|0
+	      (inst movss temp x)	; temp = 0|0|0|x
+	      (inst movss r temp))	; r = temp
+	     (t
+	      (inst xorps r r)		; temp = 0|0|0|0
+	      (inst movss r x))))	; r = 0|0|0|x
       (complex-single-stack
        (inst movss r (ea-for-csf-real-stack x)))
       (descriptor-reg
@@ -1408,13 +1414,19 @@
   (:arg-types complex-double-float)
   (:results (r :scs (double-reg)))
   (:result-types double-float)
+  (:temporary (:sc double-reg) temp)
   (:policy :fast-safe)
-  (:note _N"complex float realpart")
+  (:note "complex float realpart")
   (:generator 3
     (sc-case x
       (complex-double-reg
-       (inst xorpd r r)			; temp = 0|0
-       (inst movsd r x))		; r = 0|x
+       (cond ((location= r x)
+	      (inst xorpd temp temp)	; temp = 0|0
+	      (inst movsd temp x)	; temp = 0|x
+	      (inst movsd r temp))	; r = temp
+	     (t
+	      (inst xorpd r r)		; r = 0|0
+	      (inst movsd r x))))	; r = 0|x
       (complex-double-stack
        (inst movsd r (ea-for-cdf-real-stack x)))
       (descriptor-reg
@@ -1457,8 +1469,13 @@
   (:generator 3
     (sc-case x
       (complex-double-reg
-       (inst xorpd r r)			; r = 0|0
-       (inst movhlps r x))		; r = 0|b
+       (cond ((location= r x)
+	      (inst xorpd temp temp)	; temp = 0|0
+	      (inst movhlps temp x)	; temp = 0|b
+	      (inst movsd r temp))	; r = temp
+	     (t
+	      (inst xorpd r r)		; r = 0|0
+	      (inst movhlps r x))))	; r = 0|b
       (complex-double-stack
        (inst movsd r (ea-for-cdf-imag-stack x)))
       (descriptor-reg
@@ -1835,7 +1852,7 @@
   (convert-complex %complex-single-float cvtpd2ps complex-single complex-double))
 
 (macrolet
-    ((convert-complex (trans op base-ea to from)
+    ((convert-complex (trans op base-ea to from movinst)
        (let ((name (symbolicate to "/" from))
 	     (from-sc (symbolicate from "-REG"))
 	     (from-sc-stack (symbolicate from "-STACK"))
@@ -1849,21 +1866,27 @@
 	   (:arg-types ,from-type)
 	   (:results (r :scs (,to-sc)))
 	   (:result-types ,to-type)
+	   (:temporary (:sc ,to-sc) temp)
 	   (:policy :fast-safe)
 	   (:generator 1
 	     (sc-case x
 	       (,from-sc
 		;; Need to make sure the imaginary part is zero
-		(inst xorps r r)
-		(inst ,op r x))
+		(cond ((location= x r)
+		       (inst xorps temp temp)
+		       (inst ,op temp x)
+		       (inst ,movinst r temp))
+		      (t
+		       (inst xorps r r)
+		       (inst ,op r x))))
 	       (,from-sc-stack
 		(inst xorps r r)
 		(inst ,op r (,(symbolicate "EA-FOR-" base-ea "-STACK") x)))
 	       (descriptor-reg
 		(inst xorps r r)
 		(inst ,op r (,(symbolicate "EA-FOR-" base-ea "-DESC") x)))))))))
-  (convert-complex %complex-double-float cvtss2sd sf complex-double single)
-  (convert-complex %complex-single-float cvtsd2ss df complex-single double))
+  (convert-complex %complex-double-float cvtss2sd sf complex-double single movapd)
+  (convert-complex %complex-single-float cvtsd2ss df complex-single double movaps))
 
 ;; Add and subtract for two complex arguments
 (macrolet