X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffloat.lisp;h=ffd5f5b4ed7098925d849f04f313e82effeeb9ca;hb=bee53328c93be3433477821131ab805557476c8b;hp=f9abfd9ef998f38c5f051dc8d45f5a1e5e4d30f2;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/code/float.lisp b/src/code/float.lisp index f9abfd9..ffd5f5b 100644 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -19,9 +19,10 @@ (eval-when (:compile-toplevel :load-toplevel :execute) -;;; These functions let us create floats from bits with the significand -;;; uniformly represented as an integer. This is less efficient for double -;;; floats, but is more convenient when making special values, etc. +;;; These functions let us create floats from bits with the +;;; significand uniformly represented as an integer. This is less +;;; efficient for double floats, but is more convenient when making +;;; special values, etc. (defun single-from-bits (sign exp sig) (declare (type bit sign) (type (unsigned-byte 24) sig) (type (unsigned-byte 8) exp)) @@ -117,34 +118,35 @@ (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. Putting them inside a LET remove +;;; top-level-formness, so that any EVAL-WHEN trickiness in the +;;; DEFCONSTANT forms is suppressed. +(let () (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))) +) ; LET-to-suppress-possible-EVAL-WHENs (defconstant single-float-epsilon (single-from-bits 0 (- sb!vm:single-float-bias @@ -309,9 +311,12 @@ (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." + ;; 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 @@ -644,9 +649,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) @@ -665,10 +671,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. @@ -789,7 +795,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))))) @@ -809,7 +815,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) @@ -824,9 +830,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