b_expl.c revision 1.1 1 1.1 christos /*-
2 1.1 christos * SPDX-License-Identifier: BSD-3-Clause
3 1.1 christos *
4 1.1 christos * Copyright (c) 1985, 1993
5 1.1 christos * The Regents of the University of California. All rights reserved.
6 1.1 christos *
7 1.1 christos * Redistribution and use in source and binary forms, with or without
8 1.1 christos * modification, are permitted provided that the following conditions
9 1.1 christos * are met:
10 1.1 christos * 1. Redistributions of source code must retain the above copyright
11 1.1 christos * notice, this list of conditions and the following disclaimer.
12 1.1 christos * 2. Redistributions in binary form must reproduce the above copyright
13 1.1 christos * notice, this list of conditions and the following disclaimer in the
14 1.1 christos * documentation and/or other materials provided with the distribution.
15 1.1 christos * 3. Neither the name of the University nor the names of its contributors
16 1.1 christos * may be used to endorse or promote products derived from this software
17 1.1 christos * without specific prior written permission.
18 1.1 christos *
19 1.1 christos * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
20 1.1 christos * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
21 1.1 christos * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
22 1.1 christos * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
23 1.1 christos * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
24 1.1 christos * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
25 1.1 christos * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
26 1.1 christos * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
27 1.1 christos * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
28 1.1 christos * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
29 1.1 christos * SUCH DAMAGE.
30 1.1 christos */
31 1.1 christos
32 1.1 christos /*
33 1.1 christos * See bsdsrc/b_exp.c for implementation details.
34 1.1 christos *
35 1.1 christos * bsdrc/b_exp.c converted to long double by Steven G. Kargl.
36 1.1 christos */
37 1.1 christos
38 1.1 christos #include "math_private.h"
39 1.1 christos
40 1.1 christos static const union ieee_ext_u
41 1.1 christos p0u = LD80C(0xaaaaaaaaaaaaaaab, -3, 1.66666666666666666671e-01L),
42 1.1 christos p1u = LD80C(0xb60b60b60b60b59a, -9, -2.77777777777777775377e-03L),
43 1.1 christos p2u = LD80C(0x8ab355e008a3cfce, -14, 6.61375661375629297465e-05L),
44 1.1 christos p3u = LD80C(0xddebbc994b0c1376, -20, -1.65343915327882529784e-06L),
45 1.1 christos p4u = LD80C(0xb354784cb4ef4c41, -25, 4.17535101591534118469e-08L),
46 1.1 christos p5u = LD80C(0x913e8a718382ce75, -30, -1.05679137034774806475e-09L),
47 1.1 christos p6u = LD80C(0xe8f0042aa134502e, -36, 2.64819349895429516863e-11L);
48 1.1 christos #define p1 (p0u.extu_ld)
49 1.1 christos #define p2 (p1u.extu_ld)
50 1.1 christos #define p3 (p2u.extu_ld)
51 1.1 christos #define p4 (p3u.extu_ld)
52 1.1 christos #define p5 (p4u.extu_ld)
53 1.1 christos #define p6 (p5u.extu_ld)
54 1.1 christos #define p7 (p6u.extu_ld)
55 1.1 christos
56 1.1 christos /*
57 1.1 christos * lnhuge = (LDBL_MAX_EXP + 9) * log(2.)
58 1.1 christos * lntiny = (LDBL_MIN_EXP - 64 - 10) * log(2.)
59 1.1 christos * invln2 = 1 / log(2.)
60 1.1 christos */
61 1.1 christos static const union ieee_ext_u
62 1.1 christos ln2hiu = LD80C(0xb17217f700000000, -1, 6.93147180369123816490e-01L),
63 1.1 christos ln2lou = LD80C(0xd1cf79abc9e3b398, -33, 1.90821492927058781614e-10L),
64 1.1 christos lnhugeu = LD80C(0xb18b0c0330a8fad9, 13, 1.13627617309191834574e+04L),
65 1.1 christos lntinyu = LD80C(0xb236f28a68bc3bd7, 13, -1.14057368561139000667e+04L),
66 1.1 christos invln2u = LD80C(0xb8aa3b295c17f0bc, 0, 1.44269504088896340739e+00L);
67 1.1 christos #define ln2hi (ln2hiu.extu_ld)
68 1.1 christos #define ln2lo (ln2lou.extu_ld)
69 1.1 christos #define lnhuge (lnhugeu.extu_ld)
70 1.1 christos #define lntiny (lntinyu.extu_ld)
71 1.1 christos #define invln2 (invln2u.extu_ld)
72 1.1 christos
73 1.1 christos /* returns exp(r = x + c) for |c| < |x| with no overlap. */
74 1.1 christos
75 1.1 christos static long double
76 1.1 christos __exp__LD(long double x, long double c)
77 1.1 christos {
78 1.1 christos long double hi, lo, z;
79 1.1 christos int k;
80 1.1 christos
81 1.1 christos if (x != x) /* x is NaN. */
82 1.1 christos return(x);
83 1.1 christos
84 1.1 christos if (x <= lnhuge) {
85 1.1 christos if (x >= lntiny) {
86 1.1 christos /* argument reduction: x --> x - k*ln2 */
87 1.1 christos z = invln2 * x;
88 1.1 christos k = z + copysignl(0.5L, x);
89 1.1 christos
90 1.1 christos /*
91 1.1 christos * Express (x + c) - k * ln2 as hi - lo.
92 1.1 christos * Let x = hi - lo rounded.
93 1.1 christos */
94 1.1 christos hi = x - k * ln2hi; /* Exact. */
95 1.1 christos lo = k * ln2lo - c;
96 1.1 christos x = hi - lo;
97 1.1 christos
98 1.1 christos /* Return 2^k*[1+x+x*c/(2+c)] */
99 1.1 christos z = x * x;
100 1.1 christos c = x - z * (p1 + z * (p2 + z * (p3 + z * (p4 +
101 1.1 christos z * (p5 + z * (p6 + z * p7))))));
102 1.1 christos c = (x * c) / (2 - c);
103 1.1 christos
104 1.1 christos return (ldexpl(1 + (hi - (lo - c)), k));
105 1.1 christos } else {
106 1.1 christos /* exp(-INF) is 0. exp(-big) underflows to 0. */
107 1.1 christos return (isfinite(x) ? ldexpl(1., -5000) : 0);
108 1.1 christos }
109 1.1 christos } else
110 1.1 christos /* exp(INF) is INF, exp(+big#) overflows to INF */
111 1.1 christos return (isfinite(x) ? ldexpl(1., 5000) : x);
112 1.1 christos }
113