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)))