1 /*
2  * ====================================================
3  * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
4  *
5  * Developed at SunPro, a Sun Microsystems, Inc. business.
6  * Permission to use, copy, modify, and distribute this
7  * software is freely granted, provided that this notice
8  * is preserved.
9  * ====================================================
10  */
11 
12 /*
13  * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
14  *
15  * Permission to use, copy, modify, and distribute this software for any
16  * purpose with or without fee is hereby granted, provided that the above
17  * copyright notice and this permission notice appear in all copies.
18  *
19  * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
20  * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
21  * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
22  * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
23  * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
24  * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
25  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
26  */
27 
28 /* coshl(x)
29  * Method :
30  * mathematically coshl(x) if defined to be (exp(x)+exp(-x))/2
31  *      1. Replace x by |x| (coshl(x) = coshl(-x)).
32  *      2.
33  *                                                      [ exp(x) - 1 ]^2
34  *          0        <= x <= ln2/2  :  coshl(x) := 1 + -------------------
35  *                                                         2*exp(x)
36  *
37  *                                                 exp(x) +  1/exp(x)
38  *          ln2/2    <= x <= 22     :  coshl(x) := -------------------
39  *                                                         2
40  *          22       <= x <= lnovft :  coshl(x) := expl(x)/2
41  *          lnovft   <= x <= ln2ovft:  coshl(x) := expl(x/2)/2 * expl(x/2)
42  *          ln2ovft  <  x           :  coshl(x) := huge*huge (overflow)
43  *
44  * Special cases:
45  *      coshl(x) is |x| if x is +INF, -INF, or NaN.
46  *      only coshl(0)=1 is exact for finite x.
47  */
48 
49 static const long double one = 1.0L, half = 0.5L, huge = 1.0e4900L,
50 ovf_thresh = 1.1357216553474703894801348310092223067821E4L;
51 
52 long double
coshl(long double x)53 coshl(long double x)
54 {
55   long double t, w;
56   int32_t ex;
57   ieee_quad_shape_type u;
58 
59   u.value = x;
60   ex = u.parts32.mswhi & 0x7fffffff;
61 
62   /* Absolute value of x.  */
63   u.parts32.mswhi = ex;
64 
65   /* x is INF or NaN */
66   if (ex >= 0x7fff0000)
67     return x * x;
68 
69   /* |x| in [0,0.5*ln2], return 1+expm1l(|x|)^2/(2*expl(|x|)) */
70   if (ex < 0x3ffd62e4) /* 0.3465728759765625 */
71     {
72       if (ex < 0x3fb80000) /* |x| < 2^-116 */
73 	return one;		/* cosh(tiny) = 1 */
74       t = expm1l (u.value);
75       w = one + t;
76 
77       return one + (t * t) / (w + w);
78     }
79 
80   /* |x| in [0.5*ln2,40], return (exp(|x|)+1/exp(|x|)/2; */
81   if (ex < 0x40044000)
82     {
83       t = expl (u.value);
84       return half * t + half / t;
85     }
86 
87   /* |x| in [22, ln(maxdouble)] return half*exp(|x|) */
88   if (ex <= 0x400c62e3) /* 11356.375 */
89     return half * expl (u.value);
90 
91   /* |x| in [log(maxdouble), overflowthresold] */
92   if (u.value <= ovf_thresh)
93     {
94       w = expl (half * u.value);
95       t = half * w;
96       return t * w;
97     }
98 
99   /* |x| > overflowthresold, cosh(x) overflow */
100   return __math_oflowl(0);
101 }
102