1.0.27.41: floating point implementation smoothing

To get floating point stuff exactly right, we should build a complete
IEEE float implementation to do calculations in for the cross-compiler.
Since that's not going to happen this millennium, instead try to be
careful when writing code that looks constant-foldable.  Some other
fixups on the way...

6 messages follow:

fix load-time tests in src/code/pred

It turns out that #c(1.1 0) is not portable: it's a REAL in clisp and a
COMPLEX in sbcl.

begin work on floats

Floats Are Hard.  The issue is that the host's float implementation,
even if it agrees with SBCL that SINGLE-FLOAT is IEEE single and
DOUBLE-FLOAT is IEEE double, may not match sbcl idiosyncracy for
idiosyncracy.  For example, clisp doesn't support denormals, so its
LEAST-FOOATIVE-QUUXLE-FLOAT constants are very different from sbcl's:
and sbcl's can't even be represented within the host.  Ugh.

Defining the print-related MIN-E constants is, however, easy enough.

comment (well, #!+long-float) out some floating point constants

The clauses in question were never taken absent #!+long-float anyway.

-0.0 is not portable: many lisps don't respect negative zeros

Use make-unportable-float instead, and hope that this doesn't matter
during cross-compilation...

host floating point differences

Not all lisps think (log 2d0 10d0) is the same.  Compute it accurately
and use LOAD-TIME-VALUE.

tentative attempt at smoothing over host floating point differences

Compute all the necessary constants as double-float bit patterns using
LOAD-TIME-VALUE.

diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index 5e2c8d0..55dbb83 100644 (file)
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -808,8 +808,13 @@
              (values
               (double-from-bits 0 (1+ sb!vm:double-float-normal-exponent-max) 0)
               0))
-            ((let ((threshold #.(/ least-positive-double-float
-                                   double-float-epsilon))
+            ((let ((threshold
+                    ;; (/ least-positive-double-float double-float-epsilon)
+                    (load-time-value
+                     #!-long-float
+                     (sb!kernel:make-double-float #x1fffff #xfffffffe)
+                     #!+long-float
+                     (error "(/ least-positive-long-float long-float-epsilon)")))
                    (traps (ldb sb!vm::float-sticky-bits
                                (sb!vm:floating-point-modes))))
                 ;; Overflow raised or (underflow raised and rho <
@@ -886,10 +891,22 @@
   ;; influences the choices of these constants but doesn't say how to
   ;; choose them.  We'll just assume his choices matches our
   ;; implementation of log1p.
-  (let ((t0 #.(/ 1 (sqrt 2.0d0)))
+  (let ((t0 (load-time-value
+             #!-long-float
+             (sb!kernel:make-double-float #x3fe6a09e #x667f3bcd)
+             #!+long-float
+             (error "(/ (sqrt 2l0))")))
+        ;; KLUDGE: if repeatable fasls start failing under some weird
+        ;; xc host, this 1.2d0 might be a good place to examine: while
+        ;; it _should_ be the same in all vaguely-IEEE754 hosts, 1.2
+        ;; is not exactly representable, so something could go wrong.
         (t1 1.2d0)
         (t2 3d0)
-        (ln2 #.(log 2d0))
+        (ln2 (load-time-value
+              #!-long-float
+              (sb!kernel:make-double-float #x3fe62e42 #xfefa39ef)
+              #!+long-float
+              (error "(log 2l0)")))
         (x (float (realpart z) 1.0d0))
         (y (float (imagpart z) 1.0d0)))
     (multiple-value-bind (rho k)
@@ -987,16 +1004,11 @@
       ;; space 0 to get maybe-inline functions inlined
       (declare (optimize (speed 3) (space 0)))
     (cond ((> (abs x)
-              ;; FIXME: this form is hideously broken wrt
-              ;; cross-compilation portability.  Much else in this
-              ;; file is too, of course, sometimes hidden by
-              ;; constant-folding, but this one in particular clearly
-              ;; depends on host and target
-              ;; MOST-POSITIVE-DOUBLE-FLOATs being equal.  -- CSR,
-              ;; 2003-04-20
-              #.(/ (+ (log 2.0d0)
-                      (log most-positive-double-float))
-                   4d0))
+              (load-time-value
+               #!-long-float
+               (sb!kernel:make-double-float #x406633ce #x8fb9f87e)
+               #!+long-float
+               (error "(/ (+ (log 2l0) (log most-positive-long-float)) 4l0)")))
            (coerce-to-complex-type (float-sign x)
                                    (float-sign y) z))
           (t

diff --git a/src/code/pred.lisp b/src/code/pred.lisp
index ee5c9e8..1bd09c7 100644 (file)
--- a/src/code/pred.lisp
+++ b/src/code/pred.lisp
@@ -361,8 +361,9 @@ length and have identical components. Other arrays must be EQ to be EQUAL."
 #!+sb-test
 (let ((test-cases `((0.0 ,(load-time-value (make-unportable-float :single-float-negative-zero)) t)
                     (0.0 1.0 nil)
-                    (#c(1 0) #c(1.0 0) t)
-                    (#c(1.1 0) #c(11/10 0) nil) ; due to roundoff error
+                    (#c(1 0) #c(1.0 0.0) t)
+                    (#c(0 1) #c(0.0 1.0) t)
+                    (#c(1.1 0.0) #c(11/10 0) nil) ; due to roundoff error
                     ("Hello" "hello" t)
                     ("Hello" #(#\h #\E #\l #\l #\o) t)
                     ("Hello" "goodbye" nil))))

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 84f557a..9e302d9 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -1349,9 +1349,9 @@
 ;;; possible extension for the enthusiastic: printing floats in bases
 ;;; other than base 10.
 (defconstant single-float-min-e
-  (nth-value 1 (decode-float least-positive-single-float)))
+  (- 2 sb!vm:single-float-bias sb!vm:single-float-digits))
 (defconstant double-float-min-e
-  (nth-value 1 (decode-float least-positive-double-float)))
+  (- 2 sb!vm:double-float-bias sb!vm:double-float-digits))
 #!+long-float
 (defconstant long-float-min-e
   (nth-value 1 (decode-float least-positive-long-float)))
@@ -1481,7 +1481,20 @@
           (values (float 0.0e0 original-x) 1)
           (let* ((ex (locally (declare (optimize (safety 0)))
                        (the fixnum
-                         (round (* exponent (log 2e0 10))))))
+                         (round (* exponent
+                                   ;; this is the closest double float
+                                   ;; to (log 2 10), but expressed so
+                                   ;; that we're not vulnerable to the
+                                   ;; host lisp's interpretation of
+                                   ;; arithmetic.  (FIXME: it turns
+                                   ;; out that sbcl itself is off by 1
+                                   ;; ulp in this value, which is a
+                                   ;; little unfortunate.)
+                                   (load-time-value
+                                    #!-long-float
+                                    (sb!kernel:make-double-float 1070810131 1352628735)
+                                    #!+long-float
+                                    (error "(log 2 10) not computed")))))))
                  (x (if (minusp ex)
                         (if (float-denormalized-p x)
                             #!-long-float

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 10987c2..fc0b639 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -1096,7 +1096,7 @@
              (t
               ;; (float x (+0.0)) => (or (member -0.0) (float x (0.0)))
               ;; (float x -0.0) => (or (member -0.0) (float x (0.0)))
-              (list (make-member-type :members (list (float -0.0 hi-val)))
+              (list (make-member-type :members (list (float (load-time-value (make-unportable-float :single-float-negative-zero)) hi-val)))
                     (make-numeric-type :class (numeric-type-class type)
                                        :format (numeric-type-format type)
                                        :complexp :real

diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp
index 9e10b3c..183f979 100644 (file)
--- a/src/compiler/x86/float.lisp
+++ b/src/compiler/x86/float.lisp
@@ -189,18 +189,23 @@
   ((fp-constant) (single-reg double-reg #!+long-float long-reg))
   (let ((value (sb!c::constant-value (sb!c::tn-leaf x))))
     (with-empty-tn@fp-top(y)
-      (cond ((zerop value)
+      (cond ((or (eql value 0f0) (eql value 0d0) #!+long-float (eql value 0l0))
              (inst fldz))
             ((= value 1e0)
              (inst fld1))
+            #!+long-float
             ((= value (coerce pi *read-default-float-format*))
              (inst fldpi))
+            #!+long-float
             ((= value (log 10e0 2e0))
              (inst fldl2t))
+            #!+long-float
             ((= value (log 2.718281828459045235360287471352662e0 2e0))
              (inst fldl2e))
+            #!+long-float
             ((= value (log 2e0 10e0))
              (inst fldlg2))
+            #!+long-float
             ((= value (log 2e0 2.718281828459045235360287471352662e0))
              (inst fldln2))
             (t (warn "ignoring bogus i387 constant ~A" value))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 9d4c47f..a9d632f 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.27.40"
+"1.0.27.41"