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