Home | History | Annotate | Line # | Download | only in ld80
      1 /*-
      2  * SPDX-License-Identifier: BSD-2-Clause
      3  *
      4  * Copyright (c) 2009-2013 Steven G. Kargl
      5  * All rights reserved.
      6  *
      7  * Redistribution and use in source and binary forms, with or without
      8  * modification, are permitted provided that the following conditions
      9  * are met:
     10  * 1. Redistributions of source code must retain the above copyright
     11  *    notice unmodified, this list of conditions, and the following
     12  *    disclaimer.
     13  * 2. Redistributions in binary form must reproduce the above copyright
     14  *    notice, this list of conditions and the following disclaimer in the
     15  *    documentation and/or other materials provided with the distribution.
     16  *
     17  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
     18  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
     19  * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
     20  * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
     21  * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
     22  * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
     23  * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
     24  * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
     25  * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
     26  * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
     27  *
     28  * Optimized by Bruce D. Evans.
     29  */
     30 
     31 #include <sys/cdefs.h>
     32 /**
     33  * Compute the exponential of x for Intel 80-bit format.  This is based on:
     34  *
     35  *   PTP Tang, "Table-driven implementation of the exponential function
     36  *   in IEEE floating-point arithmetic," ACM Trans. Math. Soft., 15,
     37  *   144-157 (1989).
     38  *
     39  * where the 32 table entries have been expanded to INTERVALS (see below).
     40  */
     41 
     42 #include <float.h>
     43 
     44 #ifdef __FreeBSD__
     45 #include "fpmath.h"
     46 #endif
     47 #include "math.h"
     48 #include "math_private.h"
     49 #include "k_expl.h"
     50 
     51 /* XXX Prevent compilers from erroneously constant folding these: */
     52 static const volatile long double
     53 huge = 0x1p10000L,
     54 tiny = 0x1p-10000L;
     55 
     56 static const long double
     57 twom10000 = 0x1p-10000L;
     58 
     59 static const union ieee_ext_u
     60 /* log(2**16384 - 0.5) rounded towards zero: */
     61 /* log(2**16384 - 0.5 + 1) rounded towards zero for expm1l() is the same: */
     62 o_thresholdu = LD80C(0xb17217f7d1cf79ab, 13,  11356.5234062941439488L),
     63 #define o_threshold	 (o_thresholdu.extu_ld)
     64 /* log(2**(-16381-64-1)) rounded towards zero: */
     65 u_thresholdu = LD80C(0xb21dfe7f09e2baa9, 13, -11399.4985314888605581L);
     66 #define u_threshold	 (u_thresholdu.extu_ld)
     67 
     68 long double
     69 expl(long double x)
     70 {
     71 	union ieee_ext_u u;
     72 	long double hi, lo, t, twopk;
     73 	int k;
     74 	uint16_t hx, ix;
     75 
     76 	/* Filter out exceptional cases. */
     77 	u.extu_ld = x;
     78 	hx = GET_EXPSIGN(&u);
     79 	ix = hx & 0x7fff;
     80 	if (ix >= BIAS + 13) {		/* |x| >= 8192 or x is NaN */
     81 		if (ix == BIAS + LDBL_MAX_EXP) {
     82 			if (hx & 0x8000)  /* x is -Inf, -NaN or unsupported */
     83 				RETURNF(-1 / x);
     84 			RETURNF(x + x);	/* x is +Inf, +NaN or unsupported */
     85 		}
     86 		if (x > o_threshold)
     87 			RETURNF(huge * huge);
     88 		if (x < u_threshold)
     89 			RETURNF(tiny * tiny);
     90 	} else if (ix < BIAS - 75) {	/* |x| < 0x1p-75 (includes pseudos) */
     91 		RETURNF(1 + x);		/* 1 with inexact iff x != 0 */
     92 	}
     93 
     94 	ENTERI();
     95 
     96 	twopk = 1;
     97 	__k_expl(x, &hi, &lo, &k);
     98 	t = SUM2P(hi, lo);
     99 
    100 	/* Scale by 2**k. */
    101 	if (k >= LDBL_MIN_EXP) {
    102 		if (k == LDBL_MAX_EXP)
    103 			RETURNI(t * 2 * 0x1p16383L);
    104 		SET_LDBL_EXPSIGN(twopk, BIAS + k);
    105 		RETURNI(t * twopk);
    106 	} else {
    107 		SET_LDBL_EXPSIGN(twopk, BIAS + k + 10000);
    108 		RETURNI(t * twopk * twom10000);
    109 	}
    110 }
    111 
    112 /**
    113  * Compute expm1l(x) for Intel 80-bit format.  This is based on:
    114  *
    115  *   PTP Tang, "Table-driven implementation of the Expm1 function
    116  *   in IEEE floating-point arithmetic," ACM Trans. Math. Soft., 18,
    117  *   211-222 (1992).
    118  */
    119 
    120 /*
    121  * Our T1 and T2 are chosen to be approximately the points where method
    122  * A and method B have the same accuracy.  Tang's T1 and T2 are the
    123  * points where method A's accuracy changes by a full bit.  For Tang,
    124  * this drop in accuracy makes method A immediately less accurate than
    125  * method B, but our larger INTERVALS makes method A 2 bits more
    126  * accurate so it remains the most accurate method significantly
    127  * closer to the origin despite losing the full bit in our extended
    128  * range for it.
    129  */
    130 static const double
    131 T1 = -0.1659,				/* ~-30.625/128 * log(2) */
    132 T2 =  0.1659;				/* ~30.625/128 * log(2) */
    133 
    134 /*
    135  * Domain [-0.1659, 0.1659], range ~[-2.6155e-22, 2.5507e-23]:
    136  * |(exp(x)-1-x-x**2/2)/x - p(x)| < 2**-71.6
    137  *
    138  * XXX the coeffs aren't very carefully rounded, and I get 2.8 more bits,
    139  * but unlike for ld128 we can't drop any terms.
    140  */
    141 static const union ieee_ext_u
    142 B3 = LD80C(0xaaaaaaaaaaaaaaab, -3,  1.66666666666666666671e-1L),
    143 B4 = LD80C(0xaaaaaaaaaaaaaaac, -5,  4.16666666666666666712e-2L);
    144 
    145 static const double
    146 B5  =  8.3333333333333245e-3,		/*  0x1.111111111110cp-7 */
    147 B6  =  1.3888888888888861e-3,		/*  0x1.6c16c16c16c0ap-10 */
    148 B7  =  1.9841269841532042e-4,		/*  0x1.a01a01a0319f9p-13 */
    149 B8  =  2.4801587302069236e-5,		/*  0x1.a01a01a03cbbcp-16 */
    150 B9  =  2.7557316558468562e-6,		/*  0x1.71de37fd33d67p-19 */
    151 B10 =  2.7557315829785151e-7,		/*  0x1.27e4f91418144p-22 */
    152 B11 =  2.5063168199779829e-8,		/*  0x1.ae94fabdc6b27p-26 */
    153 B12 =  2.0887164654459567e-9;		/*  0x1.1f122d6413fe1p-29 */
    154 
    155 long double
    156 expm1l(long double x)
    157 {
    158 	union ieee_ext_u u, v;
    159 	long double fn, hx2_hi, hx2_lo, q, r, r1, r2, t, twomk, twopk, x_hi;
    160 	long double x_lo, x2, z;
    161 	long double x4;
    162 	int k, n, n2;
    163 	uint16_t hx, ix;
    164 
    165 	/* Filter out exceptional cases. */
    166 	u.extu_ld = x;
    167 	hx = GET_EXPSIGN(&u);
    168 	ix = hx & 0x7fff;
    169 	if (ix >= BIAS + 6) {		/* |x| >= 64 or x is NaN */
    170 		if (ix == BIAS + LDBL_MAX_EXP) {
    171 			if (hx & 0x8000)  /* x is -Inf, -NaN or unsupported */
    172 				RETURNF(-1 / x - 1);
    173 			RETURNF(x + x);	/* x is +Inf, +NaN or unsupported */
    174 		}
    175 		if (x > o_threshold)
    176 			RETURNF(huge * huge);
    177 		/*
    178 		 * expm1l() never underflows, but it must avoid
    179 		 * unrepresentable large negative exponents.  We used a
    180 		 * much smaller threshold for large |x| above than in
    181 		 * expl() so as to handle not so large negative exponents
    182 		 * in the same way as large ones here.
    183 		 */
    184 		if (hx & 0x8000)	/* x <= -64 */
    185 			RETURNF(tiny - 1);	/* good for x < -65ln2 - eps */
    186 	}
    187 
    188 	ENTERI();
    189 
    190 	if (T1 < x && x < T2) {
    191 		if (ix < BIAS - 74) {	/* |x| < 0x1p-74 (includes pseudos) */
    192 			/* x (rounded) with inexact if x != 0: */
    193 			RETURNI(x == 0 ? x :
    194 			    (0x1p100 * x + fabsl(x)) * 0x1p-100);
    195 		}
    196 
    197 		x2 = x * x;
    198 		x4 = x2 * x2;
    199 		q = x4 * (x2 * (x4 *
    200 		    /*
    201 		     * XXX the number of terms is no longer good for
    202 		     * pairwise grouping of all except B3, and the
    203 		     * grouping is no longer from highest down.
    204 		     */
    205 		    (x2 *            B12  + (x * B11 + B10)) +
    206 		    (x2 * (x * B9 +  B8) +  (x * B7 +  B6))) +
    207 			  (x * B5 +  B4.extu_ld)) + x2 * x * B3.extu_ld;
    208 
    209 		x_hi = (float)x;
    210 		x_lo = x - x_hi;
    211 		hx2_hi = x_hi * x_hi / 2;
    212 		hx2_lo = x_lo * (x + x_hi) / 2;
    213 		if (ix >= BIAS - 7)
    214 			RETURNI((hx2_hi + x_hi) + (hx2_lo + x_lo + q));
    215 		else
    216 			RETURNI(x + (hx2_lo + q + hx2_hi));
    217 	}
    218 
    219 	/* Reduce x to (k*ln2 + endpoint[n2] + r1 + r2). */
    220 	fn = rnintl(x * INV_L);
    221 	n = irint(fn);
    222 	n2 = (unsigned)n % INTERVALS;
    223 	k = n >> LOG2_INTERVALS;
    224 	r1 = x - fn * L1;
    225 	r2 = fn * -L2;
    226 	r = r1 + r2;
    227 
    228 	/* Prepare scale factor. */
    229 	v.extu_ld = 1;
    230 	SET_EXPSIGN(&v, BIAS + k);
    231 	twopk = v.extu_ld;
    232 
    233 	/*
    234 	 * Evaluate lower terms of
    235 	 * expl(endpoint[n2] + r1 + r2) = tbl[n2] * expl(r1 + r2).
    236 	 */
    237 	z = r * r;
    238 	q = r2 + z * (A2 + r * A3) + z * z * (A4 + r * A5) + z * z * z * A6;
    239 
    240 	t = (long double)tbl[n2].lo + tbl[n2].hi;
    241 
    242 	if (k == 0) {
    243 		t = SUM2P(tbl[n2].hi - 1, tbl[n2].lo * (r1 + 1) + t * q +
    244 		    tbl[n2].hi * r1);
    245 		RETURNI(t);
    246 	}
    247 	if (k == -1) {
    248 		t = SUM2P(tbl[n2].hi - 2, tbl[n2].lo * (r1 + 1) + t * q +
    249 		    tbl[n2].hi * r1);
    250 		RETURNI(t / 2);
    251 	}
    252 	if (k < -7) {
    253 		t = SUM2P(tbl[n2].hi, tbl[n2].lo + t * (q + r1));
    254 		RETURNI(t * twopk - 1);
    255 	}
    256 	if (k > 2 * LDBL_MANT_DIG - 1) {
    257 		t = SUM2P(tbl[n2].hi, tbl[n2].lo + t * (q + r1));
    258 		if (k == LDBL_MAX_EXP)
    259 			RETURNI(t * 2 * 0x1p16383L - 1);
    260 		RETURNI(t * twopk - 1);
    261 	}
    262 
    263 	SET_EXPSIGN(&v, BIAS - k);
    264 	twomk = v.extu_ld;
    265 
    266 	if (k > LDBL_MANT_DIG - 1)
    267 		t = SUM2P(tbl[n2].hi, tbl[n2].lo - twomk + t * (q + r1));
    268 	else
    269 		t = SUM2P(tbl[n2].hi - twomk, tbl[n2].lo + t * (q + r1));
    270 	RETURNI(t * twopk);
    271 }
    272