0.8.3.82: Make the runtime compile (not necessarily run) on x86/bsd again

[sbcl.git] / src / code / irrat.lisp

diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index b221854..c22fd93 100644 (file)
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -14,8 +14,9 @@
 \f
 ;;;; miscellaneous constants, utility functions, and macros
 
-(defconstant pi 3.14159265358979323846264338327950288419716939937511L0)
-;(defconstant e 2.71828182845904523536028747135266249775724709369996L0)
+(defconstant pi
+  #!+long-float 3.14159265358979323846264338327950288419716939937511l0
+  #!-long-float 3.14159265358979323846264338327950288419716939937511d0)
 
 ;;; Make these INLINE, since the call to C is at least as compact as a
 ;;; Lisp call, and saves number consing to boot.
@@ -24,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))
@@ -82,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
@@ -93,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)
@@ -295,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))
@@ -314,8 +310,9 @@
                      (integer-length denominator))
                   (coerce (%log1p (coerce (- number 1) 'double-float))
                           'single-float)
-                  (coerce (- (log numerator) (log denominator))
-                             'single-float)))))
+                  (coerce (/ (- (log2 numerator) (log2 denominator))
+                             (log (exp 1.0d0) 2.0d0))
+                          'single-float)))))
        (((foreach single-float double-float))
         ;; Is (log -0) -infinity (libm.a) or -infinity + i*pi (Kahan)?
         ;; Since this doesn't seem to be an implementation issue
@@ -704,9 +701,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))))
 
@@ -902,13 +901,18 @@
       ;; space 0 to get maybe-inline functions inlined
       (declare (optimize (speed 3) (space 0)))
     (cond ((> (abs x)
-             #-(or linux hpux) #.(/ (asinh most-positive-double-float) 4d0)
-             ;; This is more accurate under linux.
-             #+(or linux hpux) #.(/ (+ (log 2.0d0)
-                                       (log most-positive-double-float))
-                                    4d0))
-              (coerce-to-complex-type (float-sign x)
-                                      (float-sign y) z))
+             ;; FIXME: this form is hideously broken wrt
+             ;; cross-compilation portability.  Much else in this
+             ;; file is too, of course, sometimes hidden by
+             ;; constant-folding, but this one in particular clearly
+             ;; depends on host and target
+             ;; MOST-POSITIVE-DOUBLE-FLOATs being equal.  -- CSR,
+             ;; 2003-04-20
+             #.(/ (+ (log 2.0d0)
+                     (log most-positive-double-float))
+                  4d0))
+          (coerce-to-complex-type (float-sign x)
+                                  (float-sign y) z))
          (t
           (let* ((tv (%tan y))
                  (beta (+ 1.0d0 (* tv tv)))