diff --git a/src/code/irrat-dd.lisp b/src/code/irrat-dd.lisp index 6661f2b1cac62a6f3176802beb78bdcf96738921..381d678385510b29e605285c1e7386b0eec766b7 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 4ccf80a8378292180c737e8011e870c3cb894c5f..078e56f3d54429dca0b2cd2d0f37864f86daa11b 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 d123d183ea9bf53115425bdc69debb96de1490f8..34acdeb27a4bc4c4f919d14f22ed9dc7a58ca6a0 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