mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-11 03:33:11 -08:00
Code Issues Projects Releases Packages Wiki Activity

Hand-code several transcendental functions which are missing on Windows

Browse source
This commit is contained in:
jjgarcia 2004-06-24 07:48:48 +00:00
parent 491b23b433
commit 1ec73dec74
2 changed files with 32 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

23
src/c/num_sfun.d
View file

@ -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)
{

15
src/lsp/numlib.lsp
View file

@ -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))