From bf84dbc8c5bd5478fd36b55f99e119cfff11ca6d Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Fri, 20 Dec 2013 16:47:07 -0800 Subject: [PATCH] Add dd-%sincos and use it as needed instead of calling sin and cos separately. --- src/code/irrat-dd.lisp | 23 +++++++++++++++++++++++ src/code/irrat.lisp | 4 +++- src/compiler/float-tran.lisp | 5 +++-- 3 files changed, 29 insertions(+), 3 deletions(-) diff --git a/src/code/irrat-dd.lisp b/src/code/irrat-dd.lisp index 6661f2b1c..381d67838 100644 --- a/src/code/irrat-dd.lisp +++ b/src/code/irrat-dd.lisp @@ -1191,6 +1191,29 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 (dd-%%tan reduced) (- (/ (dd-%%tan reduced)))))))) +(defun dd-%sincos (x) + (declare (double-double-float x)) + (cond ((< (abs x) (/ pi 4)) + (values (dd-%%sin x) + (dd-%%cos x))) + (t + ;; Argument reduction needed + (multiple-value-bind (n reduced) + (reduce-arg x) + (case (logand n 3) + (0 + (values (dd-%%sin reduced) + (dd-%%cos reduced))) + (1 + (values (dd-%%cos reduced) + (- (dd-%%sin reduced)))) + (2 + (values (- (dd-%%sin reduced)) + (- (dd-%%cos reduced)))) + (3 + (values (- (dd-%%cos reduced)) + (dd-%%sin reduced)))))))) + ;;; dd-%log2 ;;; Base 2 logarithm. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 4ccf80a83..078e56f3d 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -1298,7 +1298,9 @@ (coerce s '(dispatch-type theta))))) #+double-double ((double-double-float) - (complex (cos theta) (sin theta)))))) + (multiple-value-bind (s c) + (dd-%sincos theta) + (complex c s)))))) (defun asin (number) "Return the arc sine of NUMBER." diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index d123d183e..34acdeb27 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -748,8 +748,9 @@ #+double-double (deftransform cis ((z) (double-double-float) *) - ;; Cis. - '(complex (cos z) (sin z))) + `(multiple-value-bind (s c) + (kernel::dd-%sincos x) + (complex c s))) ;;; The argument range is limited on the x86 FP trig. functions. A -- GitLab