X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffloat.lisp;h=4f411f20c275999b44aa73b4e33fc3e53df6f87a;hb=a96369c72588c5457d71d6aaea35f2c450b19ef5;hp=bb60ed5607e0852d07f090a95f279b75c9847d26;hpb=5ec8d0c1c8b7939818b75118b472fac1af554f9a;p=sbcl.git

diff --git a/src/code/float.lisp b/src/code/float.lisp
index bb60ed5..4f411f2 100644
--- 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
-;;;; 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
@@ -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
-			  (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)
@@ -195,7 +196,7 @@
      (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))
@@ -221,7 +222,7 @@
 			     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))
@@ -230,7 +231,7 @@
     (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)))
@@ -239,7 +240,7 @@
     (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))
@@ -309,15 +310,17 @@
     #!+long-float
     ((long-float) sb!vm:long-float-digits)))
 
-(defun float-radix (x)
-  #!+sb-doc
-  "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)
+(setf (fdefinition 'float-radix)
+      ;; FIXME: Python flushes unused variable X in CLAMBDA, then
+      ;; flushes unused reference to X in XEP together with type
+      ;; check. When this is fixed, rewrite this definition in an
+      ;; ordinary form. -- APD, 2002-10-21
+      (lambda (x)
+        #!+sb-doc
+        "Return (as an integer) the radix b of its floating-point argument."
+        (unless (floatp x)
+          (error 'type-error :datum x :expected-type 'float))
+        2))
 
 ;;;; INTEGER-DECODE-FLOAT and DECODE-FLOAT
 
@@ -363,7 +366,7 @@
 	  (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)))
@@ -395,7 +398,7 @@
 		  (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))
@@ -527,7 +530,7 @@
 			 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)
@@ -540,7 +543,7 @@
 	    (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))