1.0.6.22: fix occasional UNBOUND-VARIABLE errors in MAP-REFERENCING-OBJECTS

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

diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index 9b901e8..5f901c9 100644 (file)
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -46,13 +46,21 @@
              `(defun ,name ,ll (,name ,@ll))))
   (def %atan2 (x y))
   (def %atan (x))
+  (def %tan (x))
   (def %tan-quick (x))
+  (def %cos (x))
   (def %cos-quick (x))
+  (def %sin (x))
   (def %sin-quick (x))
   (def %sqrt (x))
   (def %log (x))
   (def %exp (x)))
 
+#!+x86-64 ;; for constant folding
+(macrolet ((def (name ll)
+             `(defun ,name ,ll (,name ,@ll))))
+  (def %sqrt (x)))
+
 ;;;; stubs for the Unix math library
 ;;;;
 ;;;; Many of these are unnecessary on the X86 because they're built
@@ -68,17 +76,37 @@
 #!-x86 (def-math-rtn "atan2" 2)
 (def-math-rtn "sinh" 1)
 (def-math-rtn "cosh" 1)
-(def-math-rtn "tanh" 1)
-(def-math-rtn "asinh" 1)
-(def-math-rtn "acosh" 1)
-(def-math-rtn "atanh" 1)
+#!-win32
+(progn
+  (def-math-rtn "tanh" 1)
+  (def-math-rtn "asinh" 1)
+  (def-math-rtn "acosh" 1)
+  (def-math-rtn "atanh" 1))
+#!+win32
+(progn
+  (declaim (inline %tanh))
+  (defun %tanh (number)
+    (/ (%sinh number) (%cosh number)))
+  (declaim (inline %asinh))
+  (defun %asinh (number)
+    (log (+ number (sqrt (+ (* number number) 1.0d0))) #.(exp 1.0d0)))
+  (declaim (inline %acosh))
+  (defun %acosh (number)
+    (log (+ number (sqrt (- (* number number) 1.0d0))) #.(exp 1.0d0)))
+  (declaim (inline %atanh))
+  (defun %atanh (number)
+    (let ((ratio (/ (+ 1 number) (- 1 number))))
+      ;; Were we effectively zero?
+      (if (= ratio -1.0d0)
+          0.0d0
+          (/ (log ratio #.(exp 1.0d0)) 2.0d0)))))
 
 ;;; exponential and logarithmic
 #!-x86 (def-math-rtn "exp" 1)
 #!-x86 (def-math-rtn "log" 1)
 #!-x86 (def-math-rtn "log10" 1)
-(def-math-rtn "pow" 2)
-#!-x86 (def-math-rtn "sqrt" 1)
+#!-win32(def-math-rtn "pow" 2)
+#!-(or x86 x86-64) (def-math-rtn "sqrt" 1)
 (def-math-rtn "hypot" 2)
 #!-(or hpux x86) (def-math-rtn "log1p" 1)
 \f