diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index fa891427ecbdf33ba8f2190cf44d72d70394fea9..11795159cf00960a07d807c4a37ff525c3ce901f 100644
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -653,31 +653,35 @@
 	    ((and (realp number) (realp base))
 	     (cond
 	       ((and (= base 2)
-		     (floatp number)
-		     #+double-double
-		     (not (typep number 'ext:double-double-float))
+		     ;;(floatp number)
 		     (or (plusp number)
 			 (eql number 0.0)
-			 (eql number 0d0)))
-		;; Do the same thing as the deftranform does for
-		;; log base 2 and 10 for non-negative arguments.
+			 (eql number 0d0)
+			 #+double-double
+			 (eql number 0w0)))
+		;; Do the same thing as the deftranform does for log
+		;; base 2 and 10 for non-negative arguments: handle
+		;; the case where number > 0 or equal to +0.
 		(number-dispatch ((number real) (base real))
 		  ((double-float
-		    (foreach integer single-float double-float))
+		    (foreach integer ratio single-float double-float))
 		   (log2 number))
-		  ((single-float
-		    (foreach integer single-float))
+		  (((foreach integer ratio single-float)
+		    (foreach integer ratio single-float))
 		   (float (log2 (float number 1d0)) 1f0))
-		  ((single-float double-float)
+		  (((foreach integer ratio single-float)
+		    double-float)
 		   (log2 (float number 1d0)))
 		  #+double-double
-		  (((foreach integer single-float double-float)
-		    ext:double-double-float)
-		   (log2 (float number 1w0) base))))
+		  (((foreach integer ratio single-float double-float)
+		    double-double-float)
+		   (dd-%log2 (float number 1w0)))
+		  #+double-double
+		  ((double-double-float
+		    (foreach integer ratio single-float double-float double-double-float))
+		   (dd-%log2 number))))
 	       ((and (= base 10)
-		     (floatp number)
-		     #+double-double
-		     (not (typep number 'double-double-float))
+		     ;;(floatp number)
 		     (or (plusp number)
 			 (eql number 0.0)
 			 (eql number 0d0)))
@@ -685,19 +689,22 @@
 		;; log base 2 and 10 for non-negative arguments.
 		(number-dispatch ((number real) (base real))
 		  ((double-float
-		    (foreach double-float single-float integer))
+		    (foreach rational single-float double-float))
 		   (%log10 number))
-		  ((single-float
-		    (foreach single-float integer))
+		  (((foreach integer ratio single-float)
+		    (foreach integer ratio single-float))
 		   (float (%log10 (float number 1d0)) 1f0))
-		  ((single-float double-float)
+		  (((foreach integer ratio single-float)
+		    double-float)
 		   (%log10 (float number 1d0)))
 		  #+double-double
-		  (((foreach integer single-float double-float)
+		  (((foreach integer ratio single-float double-float)
 		    ext:double-double-float)
-		   ;; This could be more accurate!
-		   (/ (log (float number 1w0))
-		      (log 10w0)))))
+		   (dd-%log10 (float number 1w0)))
+		  #+double-double
+		  ((double-double-float
+		    (foreach integer ratio single-float double-float double-double-float))
+		   (dd-%log10 number))))
 	       (t
 		;; CLHS 12.1.4.1 says
 		;;