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