X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Firrat.lisp;h=f2947a7e0be502925d77addc8ce319a6c7fbe75e;hb=01044af1b8d69fc3899dc0417064c1512223223d;hp=fe1362035d61e32344b06b5a8bbc572f9ed2b23b;hpb=22b819c0cd0ca0ea5be52ba280b9e9e0b8e86210;p=sbcl.git

diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index fe13620..f2947a7 100644
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -25,7 +25,7 @@
 (sb!xc:defmacro def-math-rtn (name num-args)
   (let ((function (symbolicate "%" (string-upcase name))))
     `(progn
-       (proclaim '(inline ,function))
+       (declaim (inline ,function))
        (sb!alien:define-alien-routine (,name ,function) double-float
          ,@(let ((results nil))
              (dotimes (i num-args (nreverse results))
@@ -83,10 +83,8 @@
 
 ;;; INTEXP -- Handle the rational base, integer power case.
 
-;;; FIXME: As long as the system dies on stack overflow or memory
-;;; exhaustion, it seems reasonable to have this, but its default
-;;; should be NIL, and when it's NIL, anything should be accepted.
-(defparameter *intexp-maximum-exponent* 10000)
+(declaim (type (or integer null) *intexp-maximum-exponent*))
+(defparameter *intexp-maximum-exponent* nil)
 
 ;;; This function precisely calculates base raised to an integral
 ;;; power. It separates the cases by the sign of power, for efficiency
@@ -94,13 +92,10 @@
 ;;; a positive integer. Values of power are calculated as positive
 ;;; integers, and inverted if negative.
 (defun intexp (base power)
-  (when (> (abs power) *intexp-maximum-exponent*)
-    ;; FIXME: should be ordinary error, not CERROR. (Once we set the
-    ;; default for the variable to NIL, the un-continuable error will
-    ;; be less obnoxious.)
-    (cerror "Continue with calculation."
-	    "The absolute value of ~S exceeds ~S."
-	    power '*intexp-maximum-exponent* base power))
+  (when (and *intexp-maximum-exponent*
+	     (> (abs power) *intexp-maximum-exponent*))
+    (error "The absolute value of ~S exceeds ~S."
+	    power '*intexp-maximum-exponent*))
   (cond ((minusp power)
 	 (/ (intexp base (- power))))
 	((eql base 2)
@@ -296,7 +291,7 @@
   "Return the logarithm of NUMBER in the base BASE, which defaults to e."
   (if base-p
       (cond
-	((zerop base) base) ; ANSI spec
+	((zerop base) 0f0) ; FIXME: type
 	((and (typep number '(integer (0) *))
 	      (typep base '(integer (0) *)))
 	 (coerce (/ (log2 number) (log2 base)) 'single-float))
@@ -642,7 +637,9 @@
 ;;; they're effectively implemented as special variable references,
 ;;; and the code below which uses them might be unnecessarily
 ;;; inefficient. Perhaps some sort of MAKE-LOAD-TIME-VALUE hackery
-;;; should be used instead?
+;;; should be used instead?  (KLUDGED 2004-03-08 CSR, by replacing the
+;;; special variable references with (probably equally slow)
+;;; constructors)
 
 (declaim (inline square))
 (defun square (x)
@@ -686,7 +683,8 @@
   (cond ((float-nan-p x)
 	 x)
 	((float-infinity-p x)
-	 sb!ext:double-float-positive-infinity)
+	 ;; DOUBLE-FLOAT-POSITIVE-INFINITY
+	 (double-from-bits 0 (1+ sb!vm:double-float-normal-exponent-max) 0))
 	((zerop x)
 	 ;; The answer is negative infinity, but we are supposed to
           ;; signal divide-by-zero, so do the actual division
@@ -706,9 +704,11 @@
 (defun coerce-to-complex-type (x y z)
   (declare (double-float x y)
 	   (number z))
-  (if (subtypep (type-of (realpart z)) 'double-float)
+  (if (typep (realpart z) 'double-float)
       (complex x y)
-      ;; Convert anything that's not a DOUBLE-FLOAT to a SINGLE-FLOAT.
+      ;; Convert anything that's not already a DOUBLE-FLOAT (because
+      ;; the initial argument was a (COMPLEX DOUBLE-FLOAT) and we
+      ;; haven't done anything to lose precision) to a SINGLE-FLOAT.
       (complex (float x 1f0)
 	       (float y 1f0))))
 
@@ -730,7 +730,10 @@
 		      (float-infinity-p rho))
 		  (or (float-infinity-p (abs x))
 		      (float-infinity-p (abs y))))
-              (values sb!ext:double-float-positive-infinity 0))
+	     ;; DOUBLE-FLOAT-POSITIVE-INFINITY
+	     (values
+	      (double-from-bits 0 (1+ sb!vm:double-float-normal-exponent-max) 0)
+	      0))
 	    ((let ((threshold #.(/ least-positive-double-float
 				   double-float-epsilon))
 		   (traps (ldb sb!vm::float-sticky-bits