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