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