1.0.18.3: more conservative arithmetic optimizations

 * Don't convert (op <int> <single>) to (op (float <int> <single>)
   <single) if the integer may be too large for accurate conversion.

diff --git a/NEWS b/NEWS
index d62029c..098042c 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -5,6 +5,8 @@ changes in sbcl-1.0.19 relative to 1.0.18:
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** interval arithmetic during type derivation used inexact integer
        to single-float coercions.
+    ** artihmetic operations involving large integers and single
+       floats give the same results in compiled and interpreted code.
 
 changes in sbcl-1.0.18 relative to 1.0.17:
   * minor incompatible change: SB-SPROF:WITH-PROFILING now by default

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index b05138a..262f867 100644 (file)
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -298,15 +298,29 @@
 \f
 ;;;; float contagion
 
+(defun safe-ctype-for-single-coercion-p (x)
+  ;; See comment in SAFE-SINGLE-COERCION-P -- this deals with the same
+  ;; 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)))
+      (csubtypep x (specifier-type `(integer ,most-negative-exactly-single-float-fixnum
+                                             ,most-positive-exactly-single-float-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
 ;;; we don't, he won't even get so much as an efficiency note.
 (deftransform float-contagion-arg1 ((x y) * * :defun-only t :node node)
-  `(,(lvar-fun-name (basic-combination-fun node))
-    (float x y) y))
+  (if (or (not (types-equal-or-intersect (lvar-type y) (specifier-type 'single-float)))
+          (safe-ctype-for-single-coercion-p (lvar-type x)))
+      `(,(lvar-fun-name (basic-combination-fun node))
+         (float x y) y)
+      (give-up-ir1-transform)))
 (deftransform float-contagion-arg2 ((x y) * * :defun-only t :node node)
-  `(,(lvar-fun-name (basic-combination-fun node))
-    x (float y x)))
+  (if (or (not (types-equal-or-intersect (lvar-type x) (specifier-type 'single-float)))
+          (safe-ctype-for-single-coercion-p (lvar-type y)))
+      `(,(lvar-fun-name (basic-combination-fun node))
+         x (float y x))
+      (give-up-ir1-transform)))
 
 (dolist (x '(+ * / -))
   (%deftransform x '(function (rational float) *) #'float-contagion-arg1)

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 4c3eb78..b261254 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2534,3 +2534,15 @@
                                  (type (member ,x #:g5437 char-code #:g5438) p2))
                         (* 104102267 p2))))
           (floatp (funcall (compile nil form) x))))
+
+;;; misc.622
+(assert (eql
+         (funcall
+           (compile
+            nil
+            '(lambda (p2)
+              (declare (optimize (speed 3) (safety 2) (debug 3) (space 0))
+               (type real p2))
+              (+ 81535869 (the (member 17549.955 #:g35917) p2))))
+           17549.955)
+          (+ 81535869 17549.955)))

diff --git a/version.lisp-expr b/version.lisp-expr
index ca6ebec..2228b13 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.18.2"
+"1.0.18.3"