0.7.4.22:

[sbcl.git] / src / code / float.lisp

diff --git a/src/code/float.lisp b/src/code/float.lisp
index 3e8f9f5..cc2b750 100644 (file)
--- a/src/code/float.lisp
+++ b/src/code/float.lisp
@@ -1,7 +1,7 @@
-;;;; This file contains the definitions of float specific number
+;;;; This file contains the definitions of float-specific number

 ;;;; support (other than irrational stuff, which is in irrat.) There is
 ;;;; code in here that assumes there are only two float formats: IEEE
 ;;;; support (other than irrational stuff, which is in irrat.) There is
 ;;;; code in here that assumes there are only two float formats: IEEE

-;;;; single and double. (Long-float support has been added, but bugs
+;;;; single and double. (LONG-FLOAT support has been added, but bugs

 ;;;; may still remain due to old code which assumes this dichotomy.)
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; may still remain due to old code which assumes this dichotomy.)
 
 ;;;; This software is part of the SBCL system. See the README file for

@@ -34,7 +34,8 @@
   (declare (type bit sign) (type (unsigned-byte 53) sig)
           (type (unsigned-byte 11) exp))
   (make-double-float (dpb exp sb!vm:double-float-exponent-byte
   (declare (type bit sign) (type (unsigned-byte 53) sig)
           (type (unsigned-byte 11) exp))
   (make-double-float (dpb exp sb!vm:double-float-exponent-byte

-                         (dpb (ash sig -32) sb!vm:double-float-significand-byte
+                         (dpb (ash sig -32)
+                              sb!vm:double-float-significand-byte

                               (if (zerop sign) 0 -1)))
                     (ldb (byte 32 0) sig)))
 #!+(and long-float x86)
                               (if (zerop sign) 0 -1)))
                     (ldb (byte 32 0) sig)))
 #!+(and long-float x86)

@@ -120,8 +121,8 @@
 
 ;;; We don't want to do these DEFCONSTANTs at cross-compilation time,
 ;;; because the cross-compilation host might not support floating
 
 ;;; 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
+;;; point infinities. Putting them inside a LET removes
+;;; toplevel-formness, so that any EVAL-WHEN trickiness in the

 ;;; DEFCONSTANT forms is suppressed.
 (let ()
 (defconstant single-float-positive-infinity
 ;;; DEFCONSTANT forms is suppressed.
 (let ()
 (defconstant single-float-positive-infinity

@@ -195,7 +196,7 @@
      (and (zerop (ldb sb!vm:long-float-exponent-byte (long-float-exp-bits x)))
          (not (zerop x))))))
 
      (and (zerop (ldb sb!vm:long-float-exponent-byte (long-float-exp-bits x)))
          (not (zerop x))))))
 

-(macrolet ((def-frob (name doc single double #!+(and long-float x86) long)
+(macrolet ((def (name doc single double #!+(and long-float x86) long)

             `(defun ,name (x)
                ,doc
                (number-dispatch ((x float))
             `(defun ,name (x)
                ,doc
                (number-dispatch ((x float))

@@ -221,7 +222,7 @@
                             sb!vm:long-float-normal-exponent-max)
                          ,long)))))))
 
                             sb!vm:long-float-normal-exponent-max)
                          ,long)))))))
 

-  (def-frob float-infinity-p
+  (def float-infinity-p

     "Return true if the float X is an infinity (+ or -)."
     (zerop (ldb sb!vm:single-float-significand-byte bits))
     (and (zerop (ldb sb!vm:double-float-significand-byte hi))
     "Return true if the float X is an infinity (+ or -)."
     (zerop (ldb sb!vm:single-float-significand-byte bits))
     (and (zerop (ldb sb!vm:double-float-significand-byte hi))

@@ -230,7 +231,7 @@
     (and (zerop (ldb sb!vm:long-float-significand-byte hi))
         (zerop lo)))
 
     (and (zerop (ldb sb!vm:long-float-significand-byte hi))
         (zerop lo)))
 

-  (def-frob float-nan-p
+  (def float-nan-p

     "Return true if the float X is a NaN (Not a Number)."
     (not (zerop (ldb sb!vm:single-float-significand-byte bits)))
     (or (not (zerop (ldb sb!vm:double-float-significand-byte hi)))
     "Return true if the float X is a NaN (Not a Number)."
     (not (zerop (ldb sb!vm:single-float-significand-byte bits)))
     (or (not (zerop (ldb sb!vm:double-float-significand-byte hi)))

@@ -239,7 +240,7 @@
     (or (not (zerop (ldb sb!vm:long-float-significand-byte hi)))
        (not (zerop lo))))
 
     (or (not (zerop (ldb sb!vm:long-float-significand-byte hi)))
        (not (zerop lo))))
 

-  (def-frob float-trapping-nan-p
+  (def float-trapping-nan-p

     "Return true if the float X is a trapping NaN (Not a Number)."
     (zerop (logand (ldb sb!vm:single-float-significand-byte bits)
                   sb!vm:single-float-trapping-nan-bit))
     "Return true if the float X is a trapping NaN (Not a Number)."
     (zerop (logand (ldb sb!vm:single-float-significand-byte bits)
                   sb!vm:single-float-trapping-nan-bit))

@@ -255,7 +256,7 @@
 #!-sb-fluid (declaim (maybe-inline float-precision))
 (defun float-precision (f)
   #!+sb-doc
 #!-sb-fluid (declaim (maybe-inline float-precision))
 (defun float-precision (f)
   #!+sb-doc

-  "Returns a non-negative number of significant digits in its float argument.
+  "Return a non-negative number of significant digits in its float argument.

   Will be less than FLOAT-DIGITS if denormalized or zero."
   (macrolet ((frob (digits bias decode)
               `(cond ((zerop f) 0)
   Will be less than FLOAT-DIGITS if denormalized or zero."
   (macrolet ((frob (digits bias decode)
               `(cond ((zerop f) 0)

@@ -280,7 +281,7 @@
 
 (defun float-sign (float1 &optional (float2 (float 1 float1)))
   #!+sb-doc
 
 (defun float-sign (float1 &optional (float2 (float 1 float1)))
   #!+sb-doc

-  "Returns a floating-point number that has the same sign as
+  "Return a floating-point number that has the same sign as

    float1 and, if float2 is given, has the same absolute value
    as float2."
   (declare (float float1 float2))
    float1 and, if float2 is given, has the same absolute value
    as float2."
   (declare (float float1 float2))

@@ -312,7 +313,6 @@
 (defun float-radix (x)
   #!+sb-doc
   "Return (as an integer) the radix b of its floating-point argument."
 (defun float-radix (x)
   #!+sb-doc
   "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:
   ;; 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:

@@ -364,7 +364,7 @@
          (t
           (values (logior sig sb!vm:single-float-hidden-bit) biased sign)))))
 
          (t
           (values (logior sig sb!vm:single-float-hidden-bit) biased sign)))))
 

-;;; Like INTEGER-DECODE-SINGLE-DENORM, only doubly so.
+;;; like INTEGER-DECODE-SINGLE-DENORM, only doubly so

 (defun integer-decode-double-denorm (x)
   (declare (type double-float x))
   (let* ((high-bits (double-float-high-bits (abs x)))
 (defun integer-decode-double-denorm (x)
   (declare (type double-float x))
   (let* ((high-bits (double-float-high-bits (abs x)))

@@ -396,7 +396,7 @@
                  (truly-the fixnum (- biased extra-bias))
                  sign)))))
 
                  (truly-the fixnum (- biased extra-bias))
                  sign)))))
 

-;;; Like INTEGER-DECODE-SINGLE-FLOAT, only doubly so.
+;;; like INTEGER-DECODE-SINGLE-FLOAT, only doubly so

 (defun integer-decode-double-float (x)
   (declare (double-float x))
   (let* ((abs (abs x))
 (defun integer-decode-double-float (x)
   (declare (double-float x))
   (let* ((abs (abs x))

@@ -475,7 +475,7 @@
 ;;; Dispatch to the correct type-specific i-d-f function.
 (defun integer-decode-float (x)
   #!+sb-doc
 ;;; Dispatch to the correct type-specific i-d-f function.
 (defun integer-decode-float (x)
   #!+sb-doc

-  "Returns three values:
+  "Return three values:

    1) an integer representation of the significand.
    2) the exponent for the power of 2 that the significand must be multiplied
       by to get the actual value. This differs from the DECODE-FLOAT exponent
    1) an integer representation of the significand.
    2) the exponent for the power of 2 that the significand must be multiplied
       by to get the actual value. This differs from the DECODE-FLOAT exponent

@@ -528,7 +528,7 @@
                         bits))
                   biased sign)))))
 
                         bits))
                   biased sign)))))
 

-;;; Like DECODE-SINGLE-DENORM, only doubly so.
+;;; like DECODE-SINGLE-DENORM, only doubly so

 (defun decode-double-denorm (x)
   (declare (double-float x))
   (multiple-value-bind (sig exp sign) (integer-decode-double-denorm x)
 (defun decode-double-denorm (x)
   (declare (double-float x))
   (multiple-value-bind (sig exp sign) (integer-decode-double-denorm x)

@@ -541,7 +541,7 @@
            (truly-the fixnum (+ exp sb!vm:double-float-digits))
            (float sign x))))
 
            (truly-the fixnum (+ exp sb!vm:double-float-digits))
            (float sign x))))
 

-;;; Like DECODE-SINGLE-FLOAT, only doubly so.
+;;; like DECODE-SINGLE-FLOAT, only doubly so

 (defun decode-double-float (x)
   (declare (double-float x))
   (let* ((abs (abs x))
 (defun decode-double-float (x)
   (declare (double-float x))
   (let* ((abs (abs x))

@@ -600,7 +600,7 @@
 ;;; Dispatch to the appropriate type-specific function.
 (defun decode-float (f)
   #!+sb-doc
 ;;; Dispatch to the appropriate type-specific function.
 (defun decode-float (f)
   #!+sb-doc

-  "Returns three values:
+  "Return three values:

    1) a floating-point number representing the significand. This is always
       between 0.5 (inclusive) and 1.0 (exclusive).
    2) an integer representing the exponent.
    1) a floating-point number representing the significand. This is always
       between 0.5 (inclusive) and 1.0 (exclusive).
    2) an integer representing the exponent.

@@ -722,7 +722,7 @@
 ;;; Dispatch to the correct type-specific scale-float function.
 (defun scale-float (f ex)
   #!+sb-doc
 ;;; Dispatch to the correct type-specific scale-float function.
 (defun scale-float (f ex)
   #!+sb-doc

-  "Returns the value (* f (expt (float 2 f) ex)), but with no unnecessary loss
+  "Return the value (* f (expt (float 2 f) ex)), but with no unnecessary loss

   of precision or overflow."
   (number-dispatch ((f float))
     ((single-float)
   of precision or overflow."
   (number-dispatch ((f float))
     ((single-float)

@@ -865,19 +865,19 @@ uninterruptibly frob the rounding modes & do ieee round-to-integer.
           (exp (ldb sb!vm:double-float-exponent-byte hi-bits))
           (frac (logior (ldb sb!vm:double-float-significand-byte hi-bits)
                         sb!vm:double-float-hidden-bit))
           (exp (ldb sb!vm:double-float-exponent-byte hi-bits))
           (frac (logior (ldb sb!vm:double-float-significand-byte hi-bits)
                         sb!vm:double-float-hidden-bit))

-          (shift (- exp (- sb!vm:double-float-digits sb!vm:word-bits)
+          (shift (- exp (- sb!vm:double-float-digits sb!vm:n-word-bits)

                     sb!vm:double-float-bias)))
       (when (> exp sb!vm:double-float-normal-exponent-max)
        (error 'floating-point-invalid-operation :operator 'truncate
               :operands (list x)))
                     sb!vm:double-float-bias)))
       (when (> exp sb!vm:double-float-normal-exponent-max)
        (error 'floating-point-invalid-operation :operator 'truncate
               :operands (list x)))

-      (if (<= shift (- sb!vm:word-bits sb!vm:double-float-digits))
+      (if (<= shift (- sb!vm:n-word-bits sb!vm:double-float-digits))

          0
          (let* ((res-hi (ash frac shift))
                 (res (if (plusp shift)
                          (logior res-hi
                                  (the fixnum
                                       (ash (double-float-low-bits x)
          0
          (let* ((res-hi (ash frac shift))
                 (res (if (plusp shift)
                          (logior res-hi
                                  (the fixnum
                                       (ash (double-float-low-bits x)

-                                           (- shift sb!vm:word-bits))))
+                                           (- shift sb!vm:n-word-bits))))

                          res-hi)))
            (declare (type (unsigned-byte 31) res-hi res))
            (if (minusp hi-bits)
                          res-hi)))
            (declare (type (unsigned-byte 31) res-hi res))
            (if (minusp hi-bits)