From cf42b486323a8c50ee1d937ba3eee33777575905 Mon Sep 17 00:00:00 2001
From: Alexey Dejneka <adejneka@comail.ru>
Date: Thu, 21 Aug 2003 09:18:59 +0000
Subject: [PATCH] 0.8.2.51:         * Fixed new bug shown by CLOCC: EXPT type
 deriver tried to           work with arbitrarily large
 exponents;         * stylistic change: eliminate (case ...
 ('+ ...));         * test case for the bug 45b;         *
 stylistic change: stream tests should remove temporary
 files.

---
 BUGS                           |   13 +++++++++----
 src/compiler/float-tran.lisp   |   23 ++++++++++++-----------
 tests/float.pure.lisp          |    9 +++++++++
 tests/stream.impure-cload.lisp |    1 +
 version.lisp-expr              |    2 +-
 5 files changed, 32 insertions(+), 16 deletions(-)

diff --git a/BUGS b/BUGS
index 7e1433e..ed452a7 100644
--- a/BUGS
+++ b/BUGS
@@ -1051,10 +1051,6 @@ WORKAROUND:
         (bignum "hip")
         (t "zuz")))
 
-271:
-  Cross-compiler cannot perform constant folding of some internal
-  functions, such as %NEGATE.
-
 272:
   All forms of GC hooks (including notifiers and finalisers) are currently
   (since 0.8.0) broken for gencgc (i.e. x86) users 
@@ -1076,6 +1072,15 @@ WORKAROUND:
   CLHS says that type declaration of a symbol macro should not affect
   its expansion, but in SBCL it does.
 
+275:
+  The following code (taken from CLOCC) takes a lot of time to compile:
+
+    (defun foo (n)
+      (declare (type (integer 0 #.large-constant) n))
+      (expt 1/10 n))
+
+  (fixed in 0.8.2.51)
+
 
 DEFUNCT CATEGORIES OF BUGS
   IR1-#:
diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index 972a954..f2880de 100644
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -693,14 +693,15 @@
 ;;; have too much roundoff. Thus we have to do it the hard way.
 (defun safe-expt (x y)
   (handler-case
-      (expt x y)
+      (when (< (abs y) 10000)
+        (expt x y))
     (error ()
       nil)))
 
 ;;; Handle the case when x >= 1.
 (defun interval-expt-> (x y)
   (case (sb!c::interval-range-info y 0d0)
-    ('+
+    (+
      ;; Y is positive and log X >= 0. The range of exp(y * log(x)) is
      ;; obviously non-negative. We just have to be careful for
      ;; infinite bounds (given by nil).
@@ -709,7 +710,7 @@
 	   (hi (safe-expt (type-bound-number (sb!c::interval-high x))
 			  (type-bound-number (sb!c::interval-high y)))))
        (list (sb!c::make-interval :low (or lo 1) :high hi))))
-    ('-
+    (-
      ;; Y is negative and log x >= 0. The range of exp(y * log(x)) is
      ;; obviously [0, 1]. However, underflow (nil) means 0 is the
      ;; result.
@@ -728,10 +729,10 @@
 ;;; Handle the case when x <= 1
 (defun interval-expt-< (x y)
   (case (sb!c::interval-range-info x 0d0)
-    ('+
+    (+
      ;; The case of 0 <= x <= 1 is easy
      (case (sb!c::interval-range-info y)
-       ('+
+       (+
 	;; Y is positive and log X <= 0. The range of exp(y * log(x)) is
 	;; obviously [0, 1]. We just have to be careful for infinite bounds
 	;; (given by nil).
@@ -740,7 +741,7 @@
 	      (hi (safe-expt (type-bound-number (sb!c::interval-high x))
 			     (type-bound-number (sb!c::interval-low y)))))
 	  (list (sb!c::make-interval :low (or lo 0) :high (or hi 1)))))
-       ('-
+       (-
 	;; Y is negative and log x <= 0. The range of exp(y * log(x)) is
 	;; obviously [1, inf].
 	(let ((hi (safe-expt (type-bound-number (sb!c::interval-low x))
@@ -754,7 +755,7 @@
 	    (sb!c::interval-split 0 y t)
 	  (list (interval-expt-< x y-)
 		(interval-expt-< x y+))))))
-    ('-
+    (-
      ;; The case where x <= 0. Y MUST be an INTEGER for this to work!
      ;; The calling function must insure this! For now we'll just
      ;; return the appropriate unbounded float type.
@@ -768,10 +769,10 @@
 ;;; Compute bounds for (expt x y).
 (defun interval-expt (x y)
   (case (interval-range-info x 1)
-    ('+
+    (+
      ;; X >= 1
 	 (interval-expt-> x y))
-    ('-
+    (-
      ;; X <= 1
      (interval-expt-< x y))
     (t
@@ -983,14 +984,14 @@
 	 (bound-type (or format 'float)))
     (cond ((numeric-type-real-p arg)
 	   (case (interval-range-info (numeric-type->interval arg) 0.0)
-	     ('+
+	     (+
 	      ;; The number is positive, so the phase is 0.
 	      (make-numeric-type :class 'float
 				 :format format
 				 :complexp :real
 				 :low (coerce 0 bound-type)
 				 :high (coerce 0 bound-type)))
-	     ('-
+	     (-
 	      ;; The number is always negative, so the phase is pi.
 	      (make-numeric-type :class 'float
 				 :format format
diff --git a/tests/float.pure.lisp b/tests/float.pure.lisp
index 5195bbb..8ccc63d 100644
--- a/tests/float.pure.lisp
+++ b/tests/float.pure.lisp
@@ -73,3 +73,12 @@
   (loop for (exp res) in tests
         for real-res = (multiple-value-list (eval exp))
         do (assert (equal real-res res))))
+
+;;; bug 45b reported by PVE
+(dolist (type '(short single double long))
+  (dolist (sign '(positive negative))
+    (let* ((name (find-symbol (format nil "LEAST-~A-~A-FLOAT"
+                                      sign type)
+                              :cl))
+           (value (symbol-value name)))
+      (assert (zerop (/ value 2))))))
diff --git a/tests/stream.impure-cload.lisp b/tests/stream.impure-cload.lisp
index 374f466..323881c 100644
--- a/tests/stream.impure-cload.lisp
+++ b/tests/stream.impure-cload.lisp
@@ -72,3 +72,4 @@
       b))
   (format nil "1234")
   :end1 4))
+(delete-file *scratch-file-name*)
diff --git a/version.lisp-expr b/version.lisp-expr
index e1c7f51..bdaa751 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".)
-"0.8.2.50"
+"0.8.2.51"
-- 
1.7.10.4