X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fcross-float.lisp;h=e7236c1dd8b92f49bea4f119dc09d6bb29cc488f;hb=5d6eb238f2d59e6df825cb03aefe2976a130c6ec;hp=ec8f2ab208eeb485e7bce27d155bd979d1037065;hpb=4eb1a6d3ad2b7dcc19ac0ec979a1eb1eb049659a;p=sbcl.git

diff --git a/src/code/cross-float.lisp b/src/code/cross-float.lisp
index ec8f2ab..e7236c1 100644
--- a/src/code/cross-float.lisp
+++ b/src/code/cross-float.lisp
@@ -77,7 +77,13 @@
 		(if (plusp exponent)	; if not obviously denormalized
 		    (do ()
 			(nil)
-		      (cond (;; ordinary termination case
+		      (cond (;; special termination case, denormalized
+			     ;; float number
+			     (zerop exponent)
+			     ;; Denormalized numbers have exponent one
+			     ;; greater than the exponent field.
+			     (return (ash significand -1)))
+			    (;; ordinary termination case
 			     (>= significand (expt 2 23))
 			     (assert (< 0 significand (expt 2 24)))
 			     ;; Exponent 0 is reserved for
@@ -87,12 +93,7 @@
 			     (return (logior (ash exponent 23)
 					     (logand significand
 						     (1- (ash 1 23))))))
-			    (;; special termination case, denormalized
-			     ;; float number
-			     (zerop exponent)
-			     ;; Denormalized numbers have exponent one
-			     ;; greater than the exponent field.
-			     (return (ash significand -1)))
+
 			    (t
 			     ;; Shift as necessary to set bit 24 of
 			     ;; significand.
@@ -111,6 +112,7 @@
 	  (ecase lisp-sign
 	    (1 unsigned-result)
 	    (-1 (logior unsigned-result (- (expt 2 31)))))))))
+
 (defun double-float-bits (x)
   (declare (type double-float x))
   (assert (= (float-radix x) 2))
@@ -126,7 +128,13 @@
 		(if (plusp exponent)	; if not obviously denormalized
 		    (do ()
 			(nil)
-		      (cond (;; ordinary termination case
+		      (cond (;; special termination case, denormalized
+			     ;; float number
+			     (zerop exponent)
+			     ;; Denormalized numbers have exponent one
+			     ;; greater than the exponent field.
+			     (return (ash significand -1)))
+			    (;; ordinary termination case
 			     (>= significand (expt 2 52))
 			     (assert (< 0 significand (expt 2 53)))
 			     ;; Exponent 0 is reserved for
@@ -136,12 +144,6 @@
 			     (return (logior (ash exponent 52)
 					     (logand significand
 						     (1- (ash 1 52))))))
-			    (;; special termination case, denormalized
-			     ;; float number
-			     (zerop exponent)
-			     ;; Denormalized numbers have exponent one
-			     ;; greater than the exponent field.
-			     (return (ash significand -1)))
 			    (t
 			     ;; Shift as necessary to set bit 53 of
 			     ;; significand.
@@ -160,6 +162,7 @@
 	  (ecase lisp-sign
 	    (1 unsigned-result)
 	    (-1 (logior unsigned-result (- (expt 2 63)))))))))
+
 (defun double-float-low-bits (x)
   (declare (type double-float x))
   (if (zerop x)
@@ -170,6 +173,7 @@
       ;; would be nice to make the family of functions have a more
       ;; consistent return convention.
       (logand #xffffffff (double-float-bits x))))
+
 (defun double-float-high-bits (x)
   (declare (type double-float x))
   (if (zerop x)
@@ -181,10 +185,9 @@
 ;;; when trying to optimize the EXPT forms in the MAKE-FOO-FLOAT
 ;;; functions below. See the message
 ;;;   Subject: Re: Compiler bug?
-;;;   From: Raymond Toy <toy@rtp.ericsson.se>
+;;;   From: Raymond Toy
 ;;;   Date: 28 Mar 2001 08:19:59 -0500
-;;;   Message-ID: <4nvgou3u9s.fsf@rtp.ericsson.se>
-;;; on the cmucl-imp@cons.org mailing list. Once the CMU CL folks
+;;; on the cmucl-imp mailing list. Once the CMU CL folks
 ;;; make a bug-fix release, we can get rid of this and go back to
 ;;; calling EXPT directly. -- WHN 2001-04-05
 (defun kludge-opaque-expt (x y)
@@ -217,6 +220,7 @@
 			     (ash 1 23))
 		     (expt 0.5 23))))
 	(* sign (kludge-opaque-expt 2.0 expt) mant))))
+
 (defun make-double-float (hi lo)
   (if (and (zerop hi) (zerop lo)) ; IEEE float special case
       0.0d0