1 /* @(#)s_tanh.c 5.1 93/09/24 */
3 * ====================================================
4 * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
6 * Developed at SunPro, a Sun Microsystems, Inc. business.
7 * Permission to use, copy, modify, and distribute this
8 * software is freely granted, provided that this notice
10 * ====================================================
13 #if defined(LIBM_SCCS) && !defined(lint)
14 static char rcsid
[] = "$NetBSD: s_tanh.c,v 1.7 1995/05/10 20:48:22 jtc Exp $";
18 * Return the Hyperbolic Tangent of x
23 * 0. tanh(x) is defined to be -----------
26 * 1. reduce x to non-negative by tanh(-x) = -tanh(x).
27 * 2. 0 <= x <= 2**-57 : tanh(x) := x*(one+x)
29 * 2**-57 < x <= 1 : tanh(x) := -----; t = expm1(-2x)
32 * 1 <= x <= 40.0 : tanh(x) := 1- ----- ; t=expm1(2x)
34 * 40.0 < x <= INF : tanh(x) := 1.
38 * only tanh(0)=0 is exact for finite argument.
43 #include <math_private.h>
44 #include <math-underflow.h>
45 #include <math_ldbl_opt.h>
47 static const long double one
=1.0L, two
=2.0L, tiny
= 1.0e-300L;
49 long double __tanhl(long double x
)
55 /* High word of |x|. */
57 EXTRACT_WORDS64 (jx
, xhi
);
58 ix
= jx
&0x7fffffffffffffffLL
;
61 if(ix
>=0x7ff0000000000000LL
) {
62 if (jx
>=0) return one
/x
+one
; /* tanh(+-inf)=+-1 */
63 else return one
/x
-one
; /* tanh(NaN) = NaN */
67 if (ix
< 0x4044000000000000LL
) { /* |x|<40 */
69 return x
; /* x == +-0 */
70 if (ix
<0x3c60000000000000LL
) /* |x|<2**-57 */
72 math_check_force_underflow (x
);
73 return x
; /* tanh(small) = small */
75 if (ix
>=0x3ff0000000000000LL
) { /* |x|>=1 */
76 t
= __expm1l(two
*fabsl(x
));
77 z
= one
- two
/(t
+two
);
79 t
= __expm1l(-two
*fabsl(x
));
82 /* |x| > 40, return +-1 */
84 z
= one
- tiny
; /* raised inexact flag */
86 return (jx
>=0)? z
: -z
;
88 long_double_symbol (libm
, __tanhl
, tanhl
);