X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ffloat.lisp;h=be2fc98583d02667945c6c58232dd41639ef363c;hb=18d4de696bc5063aad026ba62be613c7b07f5fc8;hp=ef111ae95259b249ef8ee892316c41c5b399450d;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/float.lisp b/src/code/float.lisp
index ef111ae..be2fc98 100644
--- a/src/code/float.lisp
+++ b/src/code/float.lisp
@@ -14,9 +14,6 @@
 ;;;; files for more information.
 
 (in-package "SB!KERNEL")
-
-(file-comment
-  "$Header$")
 
 ;;;; utilities
 
@@ -120,34 +117,33 @@
   (long-from-bits 1 sb!vm:long-float-normal-exponent-max
 		  (ldb (byte sb!vm:long-float-digits 0) -1)))
 
-#!+sb-infinities
+;;; We don't want to do these DEFCONSTANTs at cross-compilation time,
+;;; because the cross-compilation host might not support floating
+;;; point infinities.
+(eval-when (:load-toplevel :execute)
 (defconstant single-float-positive-infinity
   (single-from-bits 0 (1+ sb!vm:single-float-normal-exponent-max) 0))
-#!+sb-infinities
 (defconstant short-float-positive-infinity single-float-positive-infinity)
-#!+sb-infinities
 (defconstant single-float-negative-infinity
   (single-from-bits 1 (1+ sb!vm:single-float-normal-exponent-max) 0))
-#!+sb-infinities
 (defconstant short-float-negative-infinity single-float-negative-infinity)
-#!+sb-infinities
 (defconstant double-float-positive-infinity
   (double-from-bits 0 (1+ sb!vm:double-float-normal-exponent-max) 0))
-#!+(and sb-infinities (not long-float))
+#!+(not long-float)
 (defconstant long-float-positive-infinity double-float-positive-infinity)
-#!+(and sb-infinities long-float x86)
+#!+(and long-float x86)
 (defconstant long-float-positive-infinity
   (long-from-bits 0 (1+ sb!vm:long-float-normal-exponent-max)
 		  (ash sb!vm:long-float-hidden-bit 32)))
-#!+sb-infinities
 (defconstant double-float-negative-infinity
   (double-from-bits 1 (1+ sb!vm:double-float-normal-exponent-max) 0))
-#!+(and sb-infinities (not long-float))
+#!+(not long-float)
 (defconstant long-float-negative-infinity double-float-negative-infinity)
-#!+(and sb-infinities long-float x86)
+#!+(and long-float x86)
 (defconstant long-float-negative-infinity
   (long-from-bits 1 (1+ sb!vm:long-float-normal-exponent-max)
 		  (ash sb!vm:long-float-hidden-bit 32)))
+) ; EVAL-WHEN
 
 (defconstant single-float-epsilon
   (single-from-bits 0 (- sb!vm:single-float-bias
@@ -312,9 +308,13 @@
 
 (defun float-radix (x)
   #!+sb-doc
-  "Returns (as an integer) the radix b of its floating-point
-   argument."
-  (declare (type float x) (ignore x))
+  "Return (as an integer) the radix b of its floating-point argument."
+  (declare (type float x))
+  ;; ANSI says this function "should signal an error if [..] argument
+  ;; is not a float". Since X is otherwise ignored, Python doesn't
+  ;; check the type by default, so we have to do it ourself:
+  (unless (floatp x)
+    (error 'type-error :datum x :expected-type 'float))
   2)
 
 ;;;; INTEGER-DECODE-FLOAT and DECODE-FLOAT
@@ -647,9 +647,10 @@
 	  (single-float (single-from-bits sign new-exp sig))
 	  (double-float (double-from-bits sign new-exp sig))))))))
 
-;;; Called when scaling a float overflows, or the original float was a NaN
-;;; or infinity. If overflow errors are trapped, then error, otherwise return
-;;; the appropriate infinity. If a NaN, signal or not as appropriate.
+;;; Called when scaling a float overflows, or the original float was a
+;;; NaN or infinity. If overflow errors are trapped, then error,
+;;; otherwise return the appropriate infinity. If a NaN, signal or not
+;;; as appropriate.
 (defun scale-float-maybe-overflow (x exp)
   (cond
    ((float-infinity-p x)
@@ -668,10 +669,10 @@
     (when (sb!vm:current-float-trap :inexact)
       (error 'floating-point-inexact :operation 'scale-float
 	     :operands (list x exp)))
-    (infinite (* (float-sign x)
-		 (etypecase x
-		   (single-float single-float-positive-infinity)
-		   (double-float double-float-positive-infinity)))))))
+    (* (float-sign x)
+       (etypecase x
+	 (single-float single-float-positive-infinity)
+	 (double-float double-float-positive-infinity))))))
 
 ;;; Scale a single or double float, calling the correct over/underflow
 ;;; functions.
@@ -792,7 +793,7 @@
 		 (let* ((bits (ash bits -1))
 			(len (integer-length bits)))
 		   (cond ((> len digits)
-			  (assert (= len (the fixnum (1+ digits))))
+			  (aver (= len (the fixnum (1+ digits))))
 			  (scale-float (floatit (ash bits -1)) (1+ scale)))
 			 (t
 			  (scale-float (floatit bits) scale)))))
@@ -812,7 +813,7 @@
 	    (let ((extra (- (integer-length fraction-and-guard) digits)))
 	      (declare (fixnum extra))
 	      (cond ((/= extra 1)
-		     (assert (> extra 1)))
+		     (aver (> extra 1)))
 		    ((oddp fraction-and-guard)
 		     (return
 		      (if (zerop rem)
@@ -827,9 +828,9 @@
 	    (incf scale)))))))
 
 #|
-These might be useful if we ever have a machine w/o float/integer conversion
-hardware. For now, we'll use special ops that uninterruptibly frob the
-rounding modes & do ieee round-to-integer.
+These might be useful if we ever have a machine without float/integer
+conversion hardware. For now, we'll use special ops that
+uninterruptibly frob the rounding modes & do ieee round-to-integer.
 
 ;;; The compiler compiles a call to this when we are doing %UNARY-TRUNCATE
 ;;; and the result is known to be a fixnum. We can avoid some generic