[Sbcl-commits] master: allow coercion of large fixnums to floats outside x86

[Nikodemus S. <de...@us...>]

The branch "master" has been updated in SBCL:
       via  b198954cf7fd7750bfbba91b94b660f2ad891101 (commit)
      from  2612849876e000af9b3c1f52cddb04cef0841f37 (commit)

- Log -----------------------------------------------------------------
commit b198954cf7fd7750bfbba91b94b660f2ad891101
Author: Nikodemus Siivola <nik...@ra...>
Date:   Sun Oct 23 16:04:36 2011 +0300

    allow coercion of large fixnums to floats outside x86
    
     The reason we need guard against this on x86 is due to the FPU there always
     using double-precision internally, which can lead to us deriving an
     inconsistent type unless the fixnum is exactly represented by a single-float.
    
     However, no such danger exists outside x86.
    
     (Test-suite already contains tests for this.)
---
 NEWS                         |    3 ++
 src/compiler/float-tran.lisp |    5 +++-
 src/compiler/srctran.lisp    |   55 +++++++++++++++++++++++------------------
 tests/compiler.pure.lisp     |   12 +++++++++
 4 files changed, 50 insertions(+), 25 deletions(-)

diff --git a/NEWS b/NEWS
index 76ca271..7cdd4a7 100644
--- a/NEWS
+++ b/NEWS
@@ -23,6 +23,9 @@ changes relative to sbcl-1.0.54:
     generally behave better when errors occur during printing.
   * optimization: the compiler is smarter about representation selection for
     floating point constants used in full calls.
+  * optimization: the compiler no longer refuses to coerce large fixnums to
+    single floats inline, except on x86 where this limitation is still
+    necessary.
   * bug fix: deadlock detection could report the same deadlock twice, for
     two different threads. Now a single deadlock is reported exactly once.
   * bug fix: interval-arithmetic division during type derivation did not
diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index bd7e427..68c1ccd 100644
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -331,8 +331,11 @@
   ;; problem, but in the context of evaluated and compiled (+ <int> <single>)
   ;; giving different result if we fail to check for this.
   (or (not (csubtypep x (specifier-type 'integer)))
+      #!+x86
       (csubtypep x (specifier-type `(integer ,most-negative-exactly-single-float-fixnum
-                                             ,most-positive-exactly-single-float-fixnum)))))
+                                             ,most-positive-exactly-single-float-fixnum)))
+      #!-x86
+      (csubtypep x (specifier-type 'fixnum))))
 
 ;;; Do some stuff to recognize when the loser is doing mixed float and
 ;;; rational arithmetic, or different float types, and fix it up. If
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index a43f1db..16accff 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -371,30 +371,37 @@
 
 (defun safe-single-coercion-p (x)
   (or (typep x 'single-float)
-      ;; Fix for bug 420, and related issues: during type derivation we often
-      ;; end up deriving types for both
-      ;;
-      ;;   (some-op <int> <single>)
-      ;; and
-      ;;   (some-op (coerce <int> 'single-float) <single>)
-      ;;
-      ;; or other equivalent transformed forms. The problem with this is that
-      ;; on some platforms like x86 (+ <int> <single>) is on the machine level
-      ;; equivalent of
-      ;;
-      ;;   (coerce (+ (coerce <int> 'double-float)
-      ;;              (coerce <single> 'double-float))
-      ;;           'single-float)
-      ;;
-      ;; so if the result of (coerce <int> 'single-float) is not exact, the
-      ;; derived types for the transformed forms will have an empty
-      ;; intersection -- which in turn means that the compiler will conclude
-      ;; that the call never returns, and all hell breaks lose when it *does*
-      ;; return at runtime. (This affects not just +, but other operators are
-      ;; well.)
-      (and (not (typep x `(or (integer * (,most-negative-exactly-single-float-fixnum))
-                              (integer (,most-positive-exactly-single-float-fixnum) *))))
-           (<= most-negative-single-float x most-positive-single-float))))
+      (and
+       ;; Fix for bug 420, and related issues: during type derivation we often
+       ;; end up deriving types for both
+       ;;
+       ;;   (some-op <int> <single>)
+       ;; and
+       ;;   (some-op (coerce <int> 'single-float) <single>)
+       ;;
+       ;; or other equivalent transformed forms. The problem with this
+       ;; is that on x86 (+ <int> <single>) is on the machine level
+       ;; equivalent of
+       ;;
+       ;;   (coerce (+ (coerce <int> 'double-float)
+       ;;              (coerce <single> 'double-float))
+       ;;           'single-float)
+       ;;
+       ;; so if the result of (coerce <int> 'single-float) is not exact, the
+       ;; derived types for the transformed forms will have an empty
+       ;; intersection -- which in turn means that the compiler will conclude
+       ;; that the call never returns, and all hell breaks lose when it *does*
+       ;; return at runtime. (This affects not just +, but other operators are
+       ;; well.)
+       ;;
+       ;; See also: SAFE-CTYPE-FOR-SINGLE-COERCION-P
+       ;;
+       ;; FIXME: If we ever add SSE-support for x86, this conditional needs to
+       ;; change.
+       #!+x86
+       (not (typep x `(or (integer * (,most-negative-exactly-single-float-fixnum))
+                          (integer (,most-positive-exactly-single-float-fixnum) *))))
+       (<= most-negative-single-float x most-positive-single-float))))
 
 ;;; Apply a binary operator OP to two bounds X and Y. The result is
 ;;; NIL if either is NIL. Otherwise bound is computed and the result
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index a7118fb..52e4c12 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4120,3 +4120,15 @@
                          (declare (double-float x))
                          (unknown-fun 1.0d0 (+ 1.0d0 x))))))
     (assert (equal '(1.0d0) (ctu:find-code-constants fun :type 'double-float)))))
+
+(with-test (:name :fixnum+float-coerces-fixnum
+            :skipped-on :x86)
+  (let ((fun (compile nil
+                      `(lambda (x y)
+                         (declare (fixnum x)
+                                  (single-float y))
+                         (+ x y)))))
+    (assert (not (ctu:find-named-callees fun)))
+    (assert (not (search "GENERIC"
+                         (with-output-to-string (s)
+                           (disassemble fun :stream s)))))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL