diff --git a/compiler/x86/float-sse2.lisp b/compiler/x86/float-sse2.lisp
index 9fa34b513856ba78b320a12496d8cdfd201d2f30..e003b4ef582c55fc7bbccfdb75ea828ff9ce4f11 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.1.2.8.2.14 2008/10/15 14:08:08 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.1.2.8.2.15 2008/10/15 18:27:34 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1737,65 +1737,173 @@
 ); progn
 
 
-(define-vop (+/complex-double-float)
-  (:translate +)
-  (:args (x :scs (complex-double-reg))
-	 (y :scs (complex-double-reg)))
-  (:arg-types complex-double-float complex-double-float)
-  (:results (r :scs (complex-double-reg)))
-  (:result-types complex-double-float)
-  (:policy :fast-safe)
-  (:generator 1
-    (unless (location= r x)
-      (inst movapd r x))
-    (inst addpd r y)))
-
-(define-vop (+/complex-double-float/double-float)
-  (:translate +)
-  (:args (x :scs (complex-double-reg) :target r)
-	 (y :scs (double-reg) :to :save))
-  (:arg-types complex-double-float double-float)
-  (:results (r :scs (complex-double-reg)))
-  (:result-types complex-double-float)
-  (:temporary (:sc complex-double-reg) tmp)
-  (:policy :fast-safe)
-  (:generator 1
-    (inst xorpd tmp tmp)
-    (inst movsd tmp y)
-    (unless (location= r x)
-      (inst movapd r x))
-    (inst addpd r tmp)))
-
-(define-vop (-/complex-double-float)
-  (:translate -)
-  (:args (x :scs (complex-double-reg) :target r)
-	 (y :scs (complex-double-reg)))
-  (:arg-types complex-double-float complex-double-float)
-  (:results (r :scs (complex-double-reg)))
-  (:result-types complex-double-float)
-  (:policy :fast-safe)
-  (:generator 1
-    (unless (location= r x)
-      (inst movapd r x))
-    (inst subpd r y)))
-
-(define-vop (-/complex-double-float/double-float)
-  (:translate -)
-  (:args (x :scs (complex-double-reg) :target r)
-	 (y :scs (double-reg) :to :save))
-  (:arg-types complex-double-float double-float)
-  (:results (r :scs (complex-double-reg)))
-  (:result-types complex-double-float)
-  (:policy :fast-safe)
-  (:temporary (:sc complex-double-reg) tmp)
-  (:generator 1
-    (inst xorpd tmp tmp)
-    (inst movsd tmp y)			; tmp = 0|y
-    (unless (location= r x)
-      (inst movapd r x))
-    (inst subpd r tmp)))
+;;; Vops for complex arithmetic.  These are usually much faster than
+;;; the compiler-generated code using deftransforms.
 
-(define-vop (*/complex-double-float)
+;; Negate a complex
+(macrolet
+    ((negate-complex (type shift xor amount)
+       (let ((name (symbolicate "%NEGATE/COMPLEX-" type "-FLOAT"))
+	     (sc-type (symbolicate "COMPLEX-" type "-FLOAT"))
+	     (sc (symbolicate "COMPLEX-" type "-REG")))
+	 `(define-vop (,name)
+	    (:translate %negate)
+	    (:args (x :scs (,sc) :target r))
+	    (:arg-types ,sc-type)
+	    (:results (r :scs (,sc)))
+	    (:result-types ,sc-type)
+	    (:policy :fast-safe)
+	    (:temporary (:scs (,sc)) t0)
+	    (:generator 1
+	      (inst pcmpeqd t0 t0)	; all ones
+	      (inst ,shift t0 ,amount)	; #x8000...0000
+	      (unless (location= x r)
+		(inst movaps r x))
+	      (inst ,xor r t0))))))
+  (negate-complex single pslld xorps 31)
+  (negate-complex double psllq xorpd 63))
+
+;; Add and subtract for two complex arguments
+(macrolet
+    ((generate (movinst opinst commutative)
+       `(cond
+	 ((location= x r)
+	  (inst ,opinst x y))
+	 ((and ,commutative (location= y r))
+	  (inst ,opinst y x))
+	 ((not (location= r y))
+	  (inst ,movinst r x)
+	  (inst ,opinst r y))
+	 (t
+	  (inst ,movinst tmp x)
+	  (inst ,opinst tmp y)
+	  (inst ,movinst r tmp))))
+     (complex-add/sub (op inst float-type cost &optional commutative)
+       (let* ((vop-name (symbolicate (symbol-name op) "/COMPLEX-" float-type "-FLOAT"))
+	      (c-type (symbolicate "COMPLEX-" float-type "-FLOAT"))
+	      (complex-reg (symbolicate "COMPLEX-" float-type "-REG")))
+	 `(define-vop (,vop-name)
+	   (:args (x :scs (,complex-reg) :target r)
+	          (y :scs (,complex-reg)))
+	   (:results (r :scs (,complex-reg)))
+	   (:arg-types ,c-type ,c-type)
+	   (:result-types ,c-type)
+	   (:policy :fast-safe)
+	   (:note "inline complex float arithmetic")
+	   (:translate ,op)
+	   (:temporary (:sc ,complex-reg) tmp)
+	   (:generator ,cost
+	     (generate movaps ,inst ,commutative))))))
+  (complex-add/sub + addps single 1 t)
+  (complex-add/sub + addpd double 1 t)
+  (complex-add/sub - subps single 1)
+  (complex-add/sub - subpd double 1))
+
+;; Add and subtract a complex and a float
+(macrolet
+    ((generate (movinst opinst)
+       `(cond
+	 ((location= x r)
+	  (inst ,opinst x y))
+	 ((not (location= r y))
+	  (inst ,movinst r x)
+	  (inst ,opinst r y))
+	 (t
+	  (inst ,movinst tmp x)
+	  (inst ,opinst tmp y)
+	  (inst ,movinst r tmp))))
+     (complex-op-float (size op fop cost)
+       (let ((vop-name (symbolicate "COMPLEX-" size "-FLOAT-"
+				    op
+				    "-" size "-FLOAT"))
+	     (complex-reg (symbolicate "COMPLEX-" size "-REG"))
+	     (real-reg (symbolicate size "-REG"))
+	     (c-type (symbolicate "COMPLEX-" size "-FLOAT"))
+	     (r-type (symbolicate size "-FLOAT")))
+	 `(define-vop (,vop-name)
+	      (:args (x :scs (,complex-reg))
+	             (y :scs (,real-reg)))
+	    (:results (r :scs (,complex-reg)))
+	    (:arg-types ,c-type ,r-type)
+	    (:result-types ,c-type)
+	    (:policy :fast-safe)
+	    (:note "inline complex float/float arithmetic")
+	    (:translate ,op)
+	    (:temporary (:scs (,complex-reg)) tmp)
+	    (:generator ,cost
+	      (generate movaps ,fop))))))
+  (complex-op-float single + addss 1)
+  (complex-op-float single - subss 1)
+  (complex-op-float double + addsd 1)
+  (complex-op-float double - subsd 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.
+(macrolet
+    ((complex-*-float (float-type fmul copy cost)
+       (let* ((vop-name (symbolicate "COMPLEX-"
+				     float-type
+				     "-FLOAT-*-"
+				     float-type
+				     "-FLOAT"))
+	      (vop-name-r (symbolicate float-type
+				       "-FLOAT-*-COMPLEX-"
+				       float-type
+				       "-FLOAT"))
+	      (complex-sc-type (symbolicate "COMPLEX-" float-type "-REG"))
+	      (real-sc-type (symbolicate float-type "-REG"))
+	      (c-type (symbolicate "COMPLEX-" float-type "-FLOAT"))
+	      (r-type (symbolicate float-type "-FLOAT")))
+	 `(progn
+	   ;; Complex * float
+	   (define-vop (,vop-name)
+	     (:args (x :scs (,complex-sc-type))
+	            (y :scs (,real-sc-type)))
+	     (:results (r :scs (,complex-sc-type)))
+	     (:arg-types ,c-type ,r-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 y)	; t0 = y
+	       (inst ,copy t0 t0)	; t0 = y|y
+	       (unless (location= x r)
+		 (inst movaps r x))	; r = xi|xr
+	       (inst ,fmul r t0)))))))
+  (complex-*-float single mulps movlhps 4)
+  (complex-*-float double mulpd unpcklps 4))
+
+;; Divide a complex by a real
+(macrolet
+    ((complex-/-float (float-type fdiv copy cost)
+       (let* ((vop-name (symbolicate "COMPLEX-" float-type "-FLOAT-/-"
+				     float-type "-FLOAT"))
+	      (complex-sc-type (symbolicate "COMPLEX-" float-type "-REG"))
+	      (real-sc-type (symbolicate float-type "-REG"))
+	      (c-type (symbolicate "COMPLEX-" float-type "-FLOAT"))
+	      (r-type (symbolicate float-type "-FLOAT")))
+	 `(define-vop (,vop-name)
+	   (:args (x :scs (,complex-sc-type)) (y :scs (,real-sc-type)))
+	   (:results (r :scs (,complex-sc-type)))
+	   (:arg-types ,c-type ,r-type)
+	   (:result-types ,c-type)
+	   (:policy :fast-safe)
+	   (:note "inline complex float arithmetic")
+	   (:translate /)
+	   (:temporary (:sc ,complex-sc-type) t0)
+	   (:generator ,cost
+	     (inst movaps t0 y)		; t0 = u|y or u|u|u|y
+	     ,copy			; t0 = y|y or y|y|y|y
+	     (unless (location= x r)
+	       (inst movaps r x))
+	     (inst ,fdiv r t0))))))
+  (complex-/-float single divps (inst shufps t0 t0 0) 4)
+  (complex-/-float double divpd (inst unpcklpd t0 t0) 4))
+
+
+(define-vop (sse3-*/complex-double-float)
   (:translate *)
   (:args (x :scs (complex-double-reg))
 	 (y :scs (complex-double-reg)))
@@ -1848,96 +1956,6 @@
     (inst addpd t2 t1)			; t2 = a*d+b*c | a*c-b*d
     (inst movapd r t2)))
 
-(define-vop (*/complex-double-float/double-float)
-  (:translate *)
-  (:args (x :scs (complex-double-reg))
-	 (y :scs (double-reg)))
-  (:arg-types complex-double-float double-float)
-  (:results (r :scs (complex-double-reg)))
-  (:result-types complex-double-float)
-  (:policy :fast-safe)
-  (:temporary (:scs (complex-double-reg)) t0 t1 t2)
-  (:temporary (:scs (unsigned-reg)) tmp)
-  (:generator 1
-    (inst movapd t0 y)
-    (inst movlhps t0 t0)		; t0 = y|y
-    (inst movapd r x)
-    (inst mulpd r t0)))
-
-
-;; Divide a complex by a double-float
-(define-vop (//complex-double-float/double-float)
-  (:translate /)
-  (:args (x :scs (complex-double-reg))
-	 (y :scs (double-reg)))
-  (:arg-types complex-double-float double-float)
-  (:results (r :scs (complex-double-reg)))
-  (:result-types complex-double-float)
-  (:policy :fast-safe)
-  (:temporary (:scs (complex-double-reg)) t0)
-  (:generator 1
-    (inst movsd t0 y)			; t0 = 0|y
-    (inst unpcklpd t0 t0)		; t0 = y|y
-    (inst movapd r x)			; r = b|a (x = a+b*i)
-    (inst divpd r t0)))			; r = b/y|a/y
-
-(define-vop (+/complex-single-float)
-  (:translate +)
-  (:args (x :scs (complex-single-reg) :target r)
-	 (y :scs (complex-single-reg)))
-  (:arg-types complex-single-float complex-single-float)
-  (:results (r :scs (complex-single-reg)))
-  (:result-types complex-single-float)
-  (:policy :fast-safe)
-  (:generator 1
-    (unless (location= r x)
-      (inst movaps r x))
-    (inst addps r y)))
-
-(define-vop (+/complex-single-float/single-float)
-  (:translate +)
-  (:args (x :scs (complex-single-reg) :target r)
-	 (y :scs (single-reg)))
-  (:arg-types complex-single-float single-float)
-  (:results (r :scs (complex-single-reg)))
-  (:result-types complex-single-float)
-  (:temporary (:sc complex-single-reg) tmp)
-  (:policy :fast-safe)
-  (:generator 1
-    (unless (location= r x)
-      (inst movaps r x))
-    (inst xorps tmp tmp)
-    (inst movss tmp y)
-    (inst addps r tmp)))
-
-(define-vop (-/complex-single-float)
-  (:translate -)
-  (:args (x :scs (complex-single-reg) :target r)
-	 (y :scs (complex-single-reg)))
-  (:arg-types complex-single-float complex-single-float)
-  (:results (r :scs (complex-single-reg)))
-  (:result-types complex-single-float)
-  (:policy :fast-safe)
-  (:generator 1
-    (unless (location= r x)
-      (inst movaps r x))
-    (inst subps r y)))
-
-(define-vop (-/complex-single-float/single-float)
-  (:translate -)
-  (:args (x :scs (complex-single-reg) :target r)
-	 (y :scs (single-reg)))
-  (:arg-types complex-single-float single-float)
-  (:results (r :scs (complex-single-reg)))
-  (:result-types complex-single-float)
-  (:temporary (:sc complex-single-reg) tmp)
-  (:policy :fast-safe)
-  (:generator 1
-    (unless (location= r x)
-      (inst movaps r x))
-    (inst xorps tmp tmp)
-    (inst movss tmp y)
-    (inst subps r tmp)))
 
 (define-vop (*/complex-single-float)
   (:translate *)
@@ -1956,71 +1974,15 @@
     ;; x = a+b*i = b|a
     ;; y = c+d*i = d|c
     ;; r = a*c-b*d + i*(a*d+b*c)
-    (inst movaps t0 x)			; t0 = b|a
     (inst movaps t1 y)			; t1 = d|c
     (inst movaps t2 y)			; t2 = d|c
     (inst shufps t1 t1 #b0000)		; t1 = c|c
     (inst shufps t2 t2 #b0101)		; t2 = d|d
-    (inst mulps t1 t0)			; t1 = b*c|a*c
-    (inst mulps t2 t0)			; t2 = b*d|a*d
+    (inst mulps t1 x)			; t1 = b*c|a*c
+    (inst mulps t2 x)			; t2 = b*d|a*d
+    (inst shufps t2 t2 1)		; t2 = a*d|b*d
     (inst mov tmp #x80000000)
     (inst movd t0 tmp)			; t0 = 0|0|0|#x80000000
-    (inst shufps t0 t0 #b0001)		; t0 = 0|0|#x80000000|0
-    (inst xorps t2 t0)			; t2 = -b*d|a*d
-    (inst shufps t2 t2 1)		; t2 = a*d|-b*d
+    (inst xorps t2 t0)			; t2 = a*d|-b*d
     (inst addps t2 t1)			; t2 = a*d+b*c | a*c-b*d
     (inst movaps r t2)))
-
-(define-vop (*/complex-single-float/single-float)
-  (:translate *)
-  (:args (x :scs (complex-single-reg))
-	 (y :scs (single-reg)))
-  (:arg-types complex-single-float single-float)
-  (:results (r :scs (complex-single-reg)))
-  (:result-types complex-single-float)
-  (:policy :fast-safe)
-  (:temporary (:scs (complex-single-reg)) t0 t1 t2)
-  (:temporary (:scs (unsigned-reg)) tmp)
-  (:generator 1
-    (inst movaps t0 y)
-    (inst unpcklps t0 t0)
-    (inst movaps r x)
-    (inst mulpd r t0)))
-
-;; Divide a complex by a single-float
-(define-vop (//complex-single-float/single-float)
-  (:translate /)
-  (:args (x :scs (complex-single-reg))
-	 (y :scs (single-reg)))
-  (:arg-types complex-single-float single-float)
-  (:results (r :scs (complex-single-reg)))
-  (:result-types complex-single-float)
-  (:policy :fast-safe)
-  (:temporary (:scs (complex-single-reg)) t0)
-  (:generator 1
-    (inst movss t0 y)			; t0 = 0|y
-    (inst shufps t0 t0 1)		; t0 = y|y
-    (inst movaps r x)			; r = b|a (x = a+b*i)
-    (inst divps r t0)))
-
-(macrolet
-    ((frob (type shift xor amount)
-       (let ((name (symbolicate "%NEGATE/COMPLEX-" type "-FLOAT"))
-	     (sc-type (symbolicate "COMPLEX-" type "-FLOAT"))
-	     (sc (symbolicate "COMPLEX-" type "-REG")))
-	 `(define-vop (,name)
-	    (:translate %negate)
-	    (:args (x :scs (,sc) :target r))
-	    (:arg-types ,sc-type)
-	    (:results (r :scs (,sc)))
-	    (:result-types ,sc-type)
-	    (:policy :fast-safe)
-	    (:temporary (:scs (,sc)) t0)
-	    (:generator 1
-	      (inst pcmpeqd t0 t0)	; all ones
-	      (inst ,shift t0 ,amount)	; #x8000...0000
-	      (unless (location= x r)
-		(inst movaps r x))
-	      (inst ,xor r t0))))))
-  (frob single pslld xorps 31)
-  (frob double psllq xorpd 63))