diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index 5f24bf9a4325e12ec89648a3fc148b9bafd7b15d..2591907ae9b839236d431cae34598da311a398a8 100644
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -598,7 +598,17 @@
 					(float 2 float-type)))))))))
     (etypecase x
       (float
-       (/ (log (float x float-type)) (log-of-2 float-type)))
+       (multiple-value-bind (f e s)
+	   (decode-float x)
+	 ;; If x = 2^e*f then log2(x) = e + log2(f) = e +
+	 ;; log(f)/log(2). Accuracy could be improved some since this
+	 ;; has 2 rounding operations instead of just 1 for
+	 ;; log(x)/log(2).
+	 (let ((log2 (+ e (/ (log (float f float-type))
+			     (log-of-2 float-type)))))
+	   (if (minusp s)
+	       (complex log2 (log-2-pi float-type))
+	       log2))))
       (ratio
        (let ((top (numerator x))
 	     (bot (denominator x)))
diff --git a/tests/float.lisp b/tests/float.lisp
index 6fe1f50f78693b0dd66cbfc2bf2ec264246f9d1b..ff07270a242f7171de4b90ee4467cdbdf779709c 100644
--- a/tests/float.lisp
+++ b/tests/float.lisp
@@ -10,3 +10,8 @@
 					 (declare (type (double-float (0d0)) x))
 					 (decode-float x)))
 			1d0)))
+
+(define-test log2
+  (loop for k from -1074 to 1023 do
+    (let ((x (scale-float 1d0 k)))
+      (assert-equal k (log x 2)))))