diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp
index 8cb95532e824e3114e9960caa1569bc7d9c283a3..b75357ecfdcd00ac9187fc2844594b35f1a910ae 100644
--- a/compiler/float-tran.lisp
+++ b/compiler/float-tran.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/compiler/float-tran.lisp,v 1.110 2007/02/03 22:10:19 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.111 2007/05/09 03:18:09 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1799,6 +1799,7 @@
 
 
 (declaim (inline two-prod))
+#-ppc
 (defun two-prod (a b)
   "Compute fl(a*b) and err(a*b)"
   (declare (double-float a b))
@@ -1815,7 +1816,18 @@
 		    (* a-lo b-lo))))
 	  (values p e))))))
 
+#+ppc
+(defun two-prod (a b)
+  "Compute fl(a*b) and err(a*b)"
+  (declare (double-float a b))
+  ;; PPC has a fused multiply-subtract instruction that can be used
+  ;; here, so use it.
+  (let* ((p (* a b))
+	 (err (vm::fused-multiply-subtract a b p)))
+    (values p err)))
+
 (declaim (inline two-sqr))
+#-ppc
 (defun two-sqr (a)
   "Compute fl(a*a) and err(a*b).  This is a more efficient
   implementation of two-prod"
@@ -1827,6 +1839,14 @@
 		      (* 2 a-hi a-lo))
 		   (* a-lo a-lo))))))
 
+#+ppc
+(defun two-sqr (a)
+  "Compute fl(a*a) and err(a*b).  This is a more efficient
+  implementation of two-prod"
+  (declare (double-float a))
+  (let ((q (* a a)))
+    (values q (vm::fused-multiply-subtract a a q))))
+
 (declaim (maybe-inline mul-dd-d))
 (defun mul-dd-d (a0 a1 b)
   (declare (double-float a0 a1 b)
diff --git a/compiler/ppc/float.lisp b/compiler/ppc/float.lisp
index f112d9884235c6e71c2fdd2d83f5ee78d3c52660..587958f801cc9dc420ffcca29e9bac6589b718a2 100644
--- a/compiler/ppc/float.lisp
+++ b/compiler/ppc/float.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/ppc/float.lisp,v 1.12 2007/04/20 01:55:14 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/float.lisp,v 1.13 2007/05/09 03:18:09 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1455,3 +1455,37 @@
 	(when (= rd rs2)
 	  (setf fs2 nil)))
       (values fop (list fs1 fs2)))))
+
+
+(defknown (vm::fused-multiply-subtract vm::fused-multiply-add)
+    (double-float double-float double-float)
+  double-float
+  (movable flushable))
+
+(export '(fused-multiply-subtract fused-multiply-subtract))
+
+(define-vop (fused-multiply-subtract/double)
+  (:args (x :scs (double-reg))
+         (y :scs (double-reg))
+	 (z :scs (double-reg)))
+  (:results (r :scs (double-reg)))
+  (:arg-types double-float double-float double-float)
+  (:result-types double-float)
+  (:translate vm::fused-multiply-subtract)
+  (:policy :fast-safe)
+  (:generator 1
+    ;; r = x*y - z	       
+	      (inst fmsub r x y z)))
+
+(define-vop (fused-multiply-add/double)
+  (:args (x :scs (double-reg))
+         (y :scs (double-reg))
+	 (z :scs (double-reg)))
+  (:results (r :scs (double-reg)))
+  (:arg-types double-float double-float double-float)
+  (:result-types double-float)
+  (:translate vm::fused-multiply-add)
+  (:policy :fast-safe)
+  (:generator 1
+    ;; r = x*y + z
+    (inst fmadd r x y z)))