X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsrctran.lisp;h=16accff9e535c3f8e03fccaf71884d8e1c3d8ae6;hb=f7faed97898dd0e94a18b0d1fca03aaa0fe24ab0;hp=90ebeede4ba8a3f4daf6f9c983cb6c2d766978d8;hpb=3254e1b6fb33e4ff5be5f37ba4bbcc34ca151cf7;p=sbcl.git

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 90ebeed..16accff 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -350,15 +350,20 @@
 (defun bound-func (f x)
   (declare (type function f))
   (and x
-       (with-float-traps-masked (:underflow :overflow :inexact :divide-by-zero)
-         ;; With these traps masked, we might get things like infinity
-         ;; or negative infinity returned. Check for this and return
-         ;; NIL to indicate unbounded.
-         (let ((y (funcall f (type-bound-number x))))
-           (if (and (floatp y)
-                    (float-infinity-p y))
-               nil
-               (set-bound y (consp x)))))))
+       (handler-case
+         (with-float-traps-masked (:underflow :overflow :inexact :divide-by-zero)
+           ;; With these traps masked, we might get things like infinity
+           ;; or negative infinity returned. Check for this and return
+           ;; NIL to indicate unbounded.
+           (let ((y (funcall f (type-bound-number x))))
+             (if (and (floatp y)
+                      (float-infinity-p y))
+                 nil
+                 (set-bound y (consp x)))))
+         ;; Some numerical operations will signal SIMPLE-TYPE-ERROR, e.g.
+         ;; in the course of converting a bignum to a float.  Default to
+         ;; NIL in that case.
+         (simple-type-error ()))))
 
 (defun safe-double-coercion-p (x)
   (or (typep x 'double-float)
@@ -366,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
@@ -848,9 +860,6 @@
                  ((zerop (type-bound-number y))
                   ;; Divide by zero means result is infinity
                   nil)
-                 ((and (numberp x) (zerop x))
-                  ;; Zero divided by anything is zero.
-                  x)
                  (t
                   (bound-binop / x y)))))
     (let ((top-range (interval-range-info top))