Commit 7264ddad authored by rtoy's avatar rtoy
Browse files


o Remove the deftransform for real + complex and real * complex.
o Always enable the transform for real - complex.

o Add vop to do real + complex
o Add vop to do real * complex
parent a11683dd
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.124 2008/11/13 22:55:40 rtoy Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.125 2008/11/14 20:43:08 rtoy Exp $")
;;; **********************************************************************
......@@ -1522,20 +1522,10 @@
(deftransform conjugate ((z) ((complex ,type)) *)
;; Conjugate of complex number
'(complex (realpart z) (- (imagpart z))))
(deftransform + ((z w) (,real-type (complex ,type)) *)
;; Real + complex: convert to complex + real
'(+ w z))
(deftransform - ((z w) (,real-type (complex ,type)) *)
;; Real - complex. The 0 for the imaginary part is
;; needed so we get the correct signed zero.
'(complex (- z (realpart w)) (- 0 (imagpart w))))
(deftransform * ((z w) (,real-type (complex ,type)) *)
;; Real*complex.
'(complex (* z (realpart w))
(* z (imagpart w))))
(deftransform cis ((z) ((,type)) *)
;; Cis.
'(complex (cos z) (sin z)))
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.3 2008/11/14 01:54:19 rtoy Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.4 2008/11/14 20:43:09 rtoy Exp $")
;;; **********************************************************************
......@@ -1914,8 +1914,64 @@
(complex-op-float double + addsd df 1)
(complex-op-float double - subsd df 1))
;; Multiply a complex by a float. The case of float * complex is
;; handled by a deftransform to convert it to the complex*float case.
;; Add a float and a complex
((generate (movinst opinst)
((location= x r)
(inst ,opinst x y))
((not (location= r y))
(inst ,movinst r x)
(inst ,opinst r y))
(inst ,movinst tmp x)
(inst ,opinst tmp y)
(inst ,movinst r tmp))))
(complex-op-float (size op fop base-ea cost)
(let ((vop-name (symbolicate size "-FLOAT-"
"-" "COMPLEX-" size "-FLOAT"))
(complex-reg (symbolicate "COMPLEX-" size "-REG"))
(real-reg (symbolicate size "-REG"))
(c-type (symbolicate "COMPLEX-" size "-FLOAT"))
(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")))
`(define-vop (,vop-name)
(:args (y :scs (,real-reg ,r-stack descriptor-reg))
(x :scs (,complex-reg)))
(:results (r :scs (,complex-reg)))
(:arg-types ,r-type ,c-type)
(:result-types ,c-type)
(:policy :fast-safe)
(:note "inline complex float/float arithmetic")
(:translate ,op)
(:temporary (:sc ,complex-reg) tmp)
(:generator ,cost
(sc-case y
(generate movaps ,fop))
(let ((ea (,ea-stack y)))
((location= x r)
(inst ,fop x ea))
(inst movaps r x)
(inst ,fop r ea)))))
(let ((ea (,ea-desc y)))
((location= x r)
(inst ,fop x ea))
(inst movaps r x)
(inst ,fop r ea)))))))))))
(complex-op-float single + addss sf 1)
(complex-op-float double + addsd df 1))
;; Multiply a complex by a float or a float by a complex.
((complex-*-float (float-type fmul copy cost)
(let* ((vop-name (symbolicate "COMPLEX-"
......@@ -1948,6 +2004,22 @@
(inst ,copy t0 t0) ; t0 = y|y
(unless (location= x r)
(inst movaps r x)) ; r = xi|xr
(inst ,fmul r t0)))
(define-vop (,vop-name-r)
(:args (x :scs (,real-sc-type))
(y :scs (,complex-sc-type)))
(:results (r :scs (,complex-sc-type)))
(:arg-types ,r-type ,c-type)
(:result-types ,c-type)
(:policy :fast-safe)
(:note "inline complex float arithmetic")
(:translate *)
(:temporary (:scs (,complex-sc-type)) t0)
(:generator ,cost
(inst movaps t0 x) ; t0 = x
(inst ,copy t0 t0) ; t0 = x|x
(unless (location= y r)
(inst movaps r y)) ; r = yi|yr
(inst ,fmul r t0)))))))
(complex-*-float single mulps movlhps 4)
(complex-*-float double mulpd unpcklpd 4))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment