;;;; files for more information.
(in-package "SB!KERNEL")
-
-(file-comment
- "$Header$")
\f
;;;; utilities
(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
(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)
\f
;;;; INTEGER-DECODE-FLOAT and DECODE-FLOAT
(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)
(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.
(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)))))
(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)
(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