[cmucl-cvs] CMUCL commit: src/compiler/x86 (float-sse2.lisp) - cmucl-cvs - mailman3.common-lisp.net

28 Oct 2010

Date: Wednesday, October 27, 2010 @ 20:00:48
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/compiler/x86
Modified: float-sse2.lisp
Fix critical bug in realpart/imagpart.
o realpart/complex-single-float, realpart/complex-double-float, 
  imagpart/complex-double-float, %complex-double-float, and
  %complex-single-float were zeroing out the result register
  which is ok, except when the result register and the source register
  are the same.  Use a temp register in this case.
This bit of code tickles the bug:
(defun zot-r (z)
      (declare (type (simple-array (complex double-float) (*)) z))
      (realpart (aref z 0)))
(defun zot-i (z)
      (declare (type (simple-array (complex double-float) (*)) z))
      (imagpart (aref z 0)))
(let ((z (make-array 1 :element-type '(complex double-float)
    		 :initial-element #c(42d0 -42d0))))
      (zot-r z))
(let ((z (make-array 1 :element-type '(complex double-float)
    		 :initial-element #c(42d0 -42d0))))
      (zot-i z))
The correct results are 42d0 and -42d0, not 0d0, of course.
-----------------+
 float-sse2.lisp |   49 ++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 36 insertions(+), 13 deletions(-)
Index: src/compiler/x86/float-sse2.lisp
diff -u src/compiler/x86/float-sse2.lisp:1.18 src/compiler/x86/float-sse2.lisp:1.19

--- src/compiler/x86/float-sse2.lisp:1.18	Wed Aug 11 17:29:49 2010
+++ src/compiler/x86/float-sse2.lisp	Wed Oct 27 20:00:48 2010
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.18 2010-08-11 21:29:49 rtoy Rel $")
+  "$Header: /project/cmucl/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.19 2010-10-28 00:00:48 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -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

    