diff --git a/code/numbers.lisp b/code/numbers.lisp index f8907d6449ae5f2a05f8d4b3e1f460ee85c80774..23c7b21b5959d607d4aee9dbf2b1e21030dfb95d 100644 --- a/code/numbers.lisp +++ b/code/numbers.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.65 2008/08/12 20:38:23 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.66 2009/06/15 01:13:12 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -478,7 +478,7 @@ (complex (,op x (realpart y)) (,op 0 (imagpart y)))) ((complex (or rational float)) - (complex (,op (realpart x) y) (imagpart x))) + (complex (,op (realpart x) y) (,op (imagpart x) 0))) (((foreach fixnum bignum) ratio) (let* ((dy (denominator y)) diff --git a/compiler/x86/float-sse2.lisp b/compiler/x86/float-sse2.lisp index 96ac451e88552c56b918b17f5d034518b49c6d12..52a353a10ca0e39eff3ed7d4ccd98d6cb2939974 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.6 2009/06/14 14:19:19 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.7 2009/06/15 01:13:13 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1868,13 +1868,13 @@ ((generate (movinst opinst) `(cond ((location= x r) - (inst ,opinst x y)) - ((not (location= r y)) + (inst ,opinst x rtmp)) + ((not (location= r rtmp)) (inst ,movinst r x) - (inst ,opinst r y)) + (inst ,opinst r rtmp)) (t (inst ,movinst tmp x) - (inst ,opinst tmp y) + (inst ,opinst tmp rtmp) (inst ,movinst r tmp)))) (complex-op-float (size op fop base-ea cost) (let ((vop-name (symbolicate "COMPLEX-" size "-FLOAT-" @@ -1886,7 +1886,10 @@ (r-type (symbolicate size "-FLOAT")) (r-stack (symbolicate size "-STACK")) (ea-stack (symbolicate "EA-FOR-" base-ea "-STACK")) - (ea-desc (symbolicate "EA-FOR-" base-ea "-DESC"))) + (ea-desc (symbolicate "EA-FOR-" base-ea "-DESC")) + (loadinst (ecase size + (single 'movss) + (double 'movsd)))) `(define-vop (,vop-name) (:args (x :scs (,complex-reg)) (y :scs (,real-reg ,r-stack descriptor-reg))) @@ -1897,43 +1900,38 @@ (:note "inline complex float/float arithmetic") (:translate ,op) (:temporary (:sc ,complex-reg) tmp) + (:temporary (:sc ,real-reg) rtmp) (:generator ,cost (sc-case y (,real-reg + (inst xorpd rtmp rtmp) + (inst movaps rtmp y) (generate movaps ,fop)) (,r-stack (let ((ea (,ea-stack y))) - (cond - ((location= x r) - (inst ,fop x ea)) - (t - (inst movaps r x) - (inst ,fop r ea))))) + (inst ,loadinst rtmp ea) + (generate movaps ,fop))) (descriptor-reg (let ((ea (,ea-desc y))) - (cond - ((location= x r) - (inst ,fop x ea)) - (t - (inst movaps r x) - (inst ,fop r ea))))))))))) - (complex-op-float single + addss sf 1) - (complex-op-float single - subss sf 1) - (complex-op-float double + addsd df 1) - (complex-op-float double - subsd df 1)) + (inst ,loadinst rtmp ea) + (generate movaps ,fop))))))))) + (complex-op-float single + addps sf 1) + (complex-op-float single - subps sf 1) + (complex-op-float double + addpd df 1) + (complex-op-float double - subpd df 1)) ;; Add a float and a complex (macrolet ((generate (movinst opinst) `(cond ((location= x r) - (inst ,opinst x y)) + (inst ,opinst x rtmp)) ((not (location= r y)) (inst ,movinst r x) - (inst ,opinst r y)) + (inst ,opinst r rtmp)) (t (inst ,movinst tmp x) - (inst ,opinst tmp y) + (inst ,opinst tmp rtmp) (inst ,movinst r tmp)))) (complex-op-float (size op fop base-ea cost) (let ((vop-name (symbolicate size "-FLOAT-" @@ -1945,7 +1943,10 @@ (r-type (symbolicate size "-FLOAT")) (r-stack (symbolicate size "-STACK")) (ea-stack (symbolicate "EA-FOR-" base-ea "-STACK")) - (ea-desc (symbolicate "EA-FOR-" base-ea "-DESC"))) + (ea-desc (symbolicate "EA-FOR-" base-ea "-DESC")) + (loadinst (ecase size + (single 'movss) + (double 'movsd)))) `(define-vop (,vop-name) (:args (y :scs (,real-reg ,r-stack descriptor-reg)) (x :scs (,complex-reg))) @@ -1956,28 +1957,23 @@ (:note "inline complex float/float arithmetic") (:translate ,op) (:temporary (:sc ,complex-reg) tmp) + (:temporary (:sc ,real-reg) rtmp) (:generator ,cost (sc-case y (,real-reg + (inst xorpd rtmp rtmp) + (inst movaps rtmp y) (generate movaps ,fop)) (,r-stack (let ((ea (,ea-stack y))) - (cond - ((location= x r) - (inst ,fop x ea)) - (t - (inst movaps r x) - (inst ,fop r ea))))) + (inst ,loadinst rtmp ea) + (generate movaps ,fop))) (descriptor-reg (let ((ea (,ea-desc y))) - (cond - ((location= x r) - (inst ,fop x ea)) - (t - (inst movaps r x) - (inst ,fop r ea))))))))))) - (complex-op-float single + addss sf 1) - (complex-op-float double + addsd df 1)) + (inst ,loadinst rtmp ea) + (generate movaps ,fop))))))))) + (complex-op-float single + addps sf 1) + (complex-op-float double + addpd df 1)) ;; Multiply a complex by a float or a float by a complex. (macrolet