NPTL is no longer an add-on!
[platform/upstream/glibc.git] / math / s_ctanhl.c
1 /* Complex hyperbole tangent for long double.
2    Copyright (C) 1997-2014 Free Software Foundation, Inc.
3    This file is part of the GNU C Library.
4    Contributed by Ulrich Drepper <drepper@cygnus.com>, 1997.
5
6    The GNU C Library is free software; you can redistribute it and/or
7    modify it under the terms of the GNU Lesser General Public
8    License as published by the Free Software Foundation; either
9    version 2.1 of the License, or (at your option) any later version.
10
11    The GNU C Library is distributed in the hope that it will be useful,
12    but WITHOUT ANY WARRANTY; without even the implied warranty of
13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14    Lesser General Public License for more details.
15
16    You should have received a copy of the GNU Lesser General Public
17    License along with the GNU C Library; if not, see
18    <http://www.gnu.org/licenses/>.  */
19
20 #include <complex.h>
21 #include <fenv.h>
22 #include <math.h>
23 #include <math_private.h>
24 #include <float.h>
25
26 __complex__ long double
27 __ctanhl (__complex__ long double x)
28 {
29   __complex__ long double res;
30
31   if (__glibc_unlikely (!isfinite (__real__ x) || !isfinite (__imag__ x)))
32     {
33       if (__isinf_nsl (__real__ x))
34         {
35           __real__ res = __copysignl (1.0, __real__ x);
36           __imag__ res = __copysignl (0.0, __imag__ x);
37         }
38       else if (__imag__ x == 0.0)
39         {
40           res = x;
41         }
42       else
43         {
44           __real__ res = __nanl ("");
45           __imag__ res = __nanl ("");
46
47           if (__isinf_nsl (__imag__ x))
48             feraiseexcept (FE_INVALID);
49         }
50     }
51   else
52     {
53       long double sinix, cosix;
54       long double den;
55       const int t = (int) ((LDBL_MAX_EXP - 1) * M_LN2l / 2);
56       int icls = fpclassify (__imag__ x);
57
58       /* tanh(x+iy) = (sinh(2x) + i*sin(2y))/(cosh(2x) + cos(2y))
59          = (sinh(x)*cosh(x) + i*sin(y)*cos(y))/(sinh(x)^2 + cos(y)^2).  */
60
61       if (__glibc_likely (icls != FP_SUBNORMAL))
62         {
63           __sincosl (__imag__ x, &sinix, &cosix);
64         }
65       else
66         {
67           sinix = __imag__ x;
68           cosix = 1.0;
69         }
70
71       if (fabsl (__real__ x) > t)
72         {
73           /* Avoid intermediate overflow when the imaginary part of
74              the result may be subnormal.  Ignoring negligible terms,
75              the real part is +/- 1, the imaginary part is
76              sin(y)*cos(y)/sinh(x)^2 = 4*sin(y)*cos(y)/exp(2x).  */
77           long double exp_2t = __ieee754_expl (2 * t);
78
79           __real__ res = __copysignl (1.0, __real__ x);
80           __imag__ res = 4 * sinix * cosix;
81           __real__ x = fabsl (__real__ x);
82           __real__ x -= t;
83           __imag__ res /= exp_2t;
84           if (__real__ x > t)
85             {
86               /* Underflow (original real part of x has absolute value
87                  > 2t).  */
88               __imag__ res /= exp_2t;
89             }
90           else
91             __imag__ res /= __ieee754_expl (2 * __real__ x);
92         }
93       else
94         {
95           long double sinhrx, coshrx;
96           if (fabsl (__real__ x) > LDBL_MIN)
97             {
98               sinhrx = __ieee754_sinhl (__real__ x);
99               coshrx = __ieee754_coshl (__real__ x);
100             }
101           else
102             {
103               sinhrx = __real__ x;
104               coshrx = 1.0L;
105             }
106
107           if (fabsl (sinhrx) > fabsl (cosix) * LDBL_EPSILON)
108             den = sinhrx * sinhrx + cosix * cosix;
109           else
110             den = cosix * cosix;
111           __real__ res = sinhrx * coshrx / den;
112           __imag__ res = sinix * cosix / den;
113         }
114     }
115
116   return res;
117 }
118 weak_alias (__ctanhl, ctanhl)