diff --git a/code/numbers.lisp b/code/numbers.lisp
index fe80a658924ffe425f9cf79cb795fe124b4e432f..c027f8360e6c1a56d08b8fc3527235bab3ed72d0 100644
--- a/code/numbers.lisp
+++ b/code/numbers.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.7 1990/07/08 11:48:19 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.8 1990/07/09 14:13:42 ram Exp $
 ;;;
 ;;; This file contains the definitions of most number functions.
 ;;;
@@ -1312,8 +1312,10 @@
 (defun integer-decode-single-float (x)
   (declare (single-float x))
   (let ((bits (single-float-bits (abs x))))
-    (values (logior (ldb single-float-significand-byte bits)
-		    single-float-hidden-bit)
+    (values (if (zerop x)
+		0
+		(logior (ldb single-float-significand-byte bits)
+			single-float-hidden-bit))
 	    (truly-the single-float-exponent
 		       (- (ldb single-float-exponent-byte bits)
 			  single-float-bias
@@ -1325,10 +1327,12 @@
   (let* ((abs (abs x))
 	 (hi (double-float-high-bits abs))
 	 (lo (double-float-low-bits abs)))
-    (values (logior (ash (logior (ldb double-float-significand-byte hi)
-				 double-float-hidden-bit)
-			 32)
-		    lo)
+    (values (if (zerop x)
+		0
+		(logior (ash (logior (ldb double-float-significand-byte hi)
+				     double-float-hidden-bit)
+			     32)
+			lo))
 	    (truly-the double-float-exponent
 		       (- (ldb double-float-exponent-byte hi)
 			  double-float-bias
@@ -1354,8 +1358,10 @@
 (defun decode-single-float (x)
   (declare (single-float x))
   (let ((bits (single-float-bits (abs x))))
-    (values (make-single-float
-	     (dpb single-float-bias single-float-exponent-byte bits))
+    (values (if (zerop x)
+		0f0
+		(make-single-float
+		 (dpb single-float-bias single-float-exponent-byte bits)))
 	    (truly-the single-float-exponent
 		       (- (ldb single-float-exponent-byte bits)
 			  single-float-bias))
@@ -1366,9 +1372,11 @@
   (let* ((abs (abs x))
 	 (hi (double-float-high-bits abs))
 	 (lo (double-float-low-bits abs)))
-    (values (make-double-float
-	     (dpb double-float-bias double-float-exponent-byte hi)
-	     lo)
+    (values (if (zerop x)
+		0d0
+		(make-double-float
+		 (dpb double-float-bias double-float-exponent-byte hi)
+		 lo))
 	    (truly-the double-float-exponent
 		       (- (ldb double-float-exponent-byte hi)
 			  double-float-bias))
@@ -1392,30 +1400,34 @@
 
 (defun scale-single-float (x exp)
   (declare (single-float x) (fixnum exp))
-  (let* ((bits (single-float-bits x))
-	 (new-exp (+ (ldb single-float-exponent-byte bits)
-		     exp)))
-    (unless (<= single-float-normal-exponent-min
-		new-exp
-		single-float-normal-exponent-max)
-      (error "Floating point over/underflow scaling ~S by ~S." x exp))
-
-    (make-single-float (dpb new-exp single-float-exponent-byte bits))))
+  (if (zerop x)
+      x
+      (let* ((bits (single-float-bits x))
+	     (new-exp (+ (ldb single-float-exponent-byte bits)
+			 exp)))
+	(unless (<= single-float-normal-exponent-min
+		    new-exp
+		    single-float-normal-exponent-max)
+	  (error "Floating point over/underflow scaling ~S by ~S." x exp))
+	
+	(make-single-float (dpb new-exp single-float-exponent-byte bits)))))
 
 (defun scale-double-float (x exp)
   (declare (double-float x) (fixnum exp))
-  (let ((hi (double-float-high-bits x))
-	(lo (double-float-low-bits x)))
-    (let ((new-exp (+ (ldb double-float-exponent-byte hi)
-		      exp)))
-      (unless (<= double-float-normal-exponent-min
-		  new-exp
-		  double-float-normal-exponent-max)
-	(error "Floating point over/underflow scaling ~S by ~S." x exp))
-
-      (make-double-float
-       (dpb new-exp double-float-exponent-byte hi)
-       lo))))
+  (if (zerop x)
+      x
+      (let ((hi (double-float-high-bits x))
+	    (lo (double-float-low-bits x)))
+	(let ((new-exp (+ (ldb double-float-exponent-byte hi)
+			  exp)))
+	  (unless (<= double-float-normal-exponent-min
+		      new-exp
+		      double-float-normal-exponent-max)
+	    (error "Floating point over/underflow scaling ~S by ~S." x exp))
+	  
+	  (make-double-float
+	   (dpb new-exp double-float-exponent-byte hi)
+	   lo)))))
 
 (defun scale-float (f ex)
   "Returns the value (* f (expt (float b f) e))"