From 04f74c8cbe98704aa761e187741984bc8fe3983f Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 30 Jun 2008 09:18:32 +0000
Subject: [PATCH] 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.
---
 NEWS                         |  2 ++
 src/compiler/float-tran.lisp | 22 ++++++++++++++++++----
 tests/compiler.pure.lisp     | 12 ++++++++++++
 version.lisp-expr            |  2 +-
 4 files changed, 33 insertions(+), 5 deletions(-)

diff --git a/NEWS b/NEWS
index d62029cd8..098042c52 100644
--- 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 b05138a03..262f86777 100644
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -298,15 +298,29 @@
 
 ;;;; 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 4c3eb78ac..b2612549e 100644
--- 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 ca6ebec18..2228b1332 100644
--- 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"
-- 
2.11.4.GIT