From 1ec73dec7406b04433b3bad7c40996a327b5c243 Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Thu, 24 Jun 2004 07:48:48 +0000
Subject: [PATCH] Hand-code several transcendental functions which are missing
 on Windows

---
 src/c/num_sfun.d   | 23 +++++++++++++++++++++++
 src/lsp/numlib.lsp | 15 +++++++++------
 2 files changed, 32 insertions(+), 6 deletions(-)

diff --git a/src/c/num_sfun.d b/src/c/num_sfun.d
index 366c79fb8..bfe58b830 100644
--- a/src/c/num_sfun.d
+++ b/src/c/num_sfun.d
@@ -36,6 +36,29 @@
 # endif
 #endif
 
+#ifdef mingw32
+/*
+ * Mingw32 does not implement asinh, acosh and atanh.
+ */
+double
+asinh(double x)
+{
+	return log(x + sqrt(1.0 + x*x));
+}
+
+double
+acosh(double x)
+{
+	return log(x + sqrt((x-1)*(x+1)));
+}
+
+double
+atanh(double x)
+{
+	return (log(x+1) - log(x-1))/2;
+}
+#endif /* mingw32 */
+
 cl_fixnum
 fixnum_expt(cl_fixnum x, cl_fixnum y)
 {
diff --git a/src/lsp/numlib.lsp b/src/lsp/numlib.lsp
index 87efd7258..1cbbd6c51 100644
--- a/src/lsp/numlib.lsp
+++ b/src/lsp/numlib.lsp
@@ -158,12 +158,13 @@ Returns the arc cosine of NUMBER."
 (defun asinh (x)
   "Args: (number)
 Returns the hyperbolic arc sine of NUMBER."
-  (if #+(or ecl-min mingw32) t #-(or ecl-min mingw32) (complexp x)
+  ;(log (+ x (sqrt (+ 1.0 (* x x)))))
+  (if #+(or ecl-min) t #-(or ecl-min) (complexp x)
       (let* ((iz (complex (- (imagpart x)) (realpart x)))
 	     (result (complex-asin iz)))
 	(complex (imagpart result)
 		 (- (realpart result))))
-      #-(or ecl-min mingw32)
+      #-(or ecl-min)
       (float (ffi:c-inline (x) (:double) :double "asinh(#0)" :one-liner t)
 	     (float x))))
 
@@ -171,9 +172,10 @@ Returns the hyperbolic arc sine of NUMBER."
 (defun acosh (x)
   "Args: (number)
 Returns the hyperbolic arc cosine of NUMBER."
-  (if #+(or ecl-min mingw32) t #-(or ecl-min mingw32) (complexp x)
+  ;(log (+ x (sqrt (* (1- x) (1+ x)))))
+  (if #+(or ecl-min) t #-(or ecl-min) (complexp x)
       (complex-acos x)
-      #-(or ecl-min mingw32)
+      #-(or ecl-min)
       (let* ((x (float x))
 	     (xr (float x 1d0)))
 	(declare (double-float xr))
@@ -193,9 +195,10 @@ Returns the hyperbolic arc cosine of NUMBER."
 (defun atanh (x)
   "Args: (number)
 Returns the hyperbolic arc tangent of NUMBER."
-  (if #+(or ecl-min mingw32) t #-(or ecl-min mingw32) (complexp x)
+  ;(/ (- (log (1+ x)) (log (- 1 x))) 2)
+  (if #+(or ecl-min) t #-(or ecl-min) (complexp x)
       (complex-atanh x)
-      #-(or ecl-min mingw32)
+      #-(or ecl-min)
       (let* ((x (float x))
 	     (xr (float x 1d0)))
 	(declare (double-float xr))