long double expl(long double x) { long double px, xx; int k; if (isnan(x)) return x; if (x > 11356.5234062941439488L) /* x > ln(2^16384 - 0.5) */ return x * 0x1p16383L; if (x < -11399.4985314888605581L) /* x < ln(2^-16446) */ return -0x1p-16445L/x; /* Express e**x = e**f 2**k * = e**(f + k ln(2)) */ px = floorl(LOG2E * x + 0.5); k = px; x -= px * LN2HI; x -= px * LN2LO; /* rational approximation of the fractional part: * e**x = 1 + 2x P(x**2)/(Q(x**2) - x P(x**2)) */ xx = x * x; px = x * __polevll(xx, P, 2); x = px/(__polevll(xx, Q, 3) - px); x = 1.0 + 2.0 * x; return scalbnl(x, k); }
long double expl(long double x) { long double px, xx; int n; if( x > MAXLOGL) return (huge*huge); /* overflow */ if( x < MINLOGL ) return (twom10000*twom10000); /* underflow */ /* Express e**x = e**g 2**n * = e**g e**( n loge(2) ) * = e**( g + n loge(2) ) */ px = floorl( LOG2EL * x + 0.5L ); /* floor() truncates toward -infinity. */ n = px; x += px * C1; x += px * C2; /* rational approximation for exponential * of the fractional part: * e**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) */ xx = x * x; px = x * __polevll( xx, P, 4 ); xx = __polevll( xx, Q, 5 ); x = px/( xx - px ); x = 1.0L + x + x; x = ldexpl( x, n ); return(x); }
/* Gamma function computed by Stirling's formula. */ static long double stirf(long double x) { long double y, w, v; w = 1.0L/x; /* For large x, use rational coefficients from the analytical expansion. */ if( x > 1024.0L ) w = (((((6.97281375836585777429E-5L * w + 7.84039221720066627474E-4L) * w - 2.29472093621399176955E-4L) * w - 2.68132716049382716049E-3L) * w + 3.47222222222222222222E-3L) * w + 8.33333333333333333333E-2L) * w + 1.0L; else w = 1.0L + w * __polevll( w, STIR, 8 ); y = expl(x); if( x > MAXSTIR ) { /* Avoid overflow in pow() */ v = powl( x, 0.5L * x - 0.25L ); y = v * (v / y); } else { y = powl( x, x - 0.5L ) / y; } y = SQTPI * y * w; return( y ); }
long double expl(long double x) { long double px, xx; int n; if( isnan(x) ) return(x); if( x > MAXLOGL) return( INFINITY ); if( x < MINLOGL ) return(0.0L); /* Express e**x = e**g 2**n * = e**g e**( n loge(2) ) * = e**( g + n loge(2) ) */ px = floorl( LOG2EL * x + 0.5L ); /* floor() truncates toward -infinity. */ n = px; x -= px * C1; x -= px * C2; /* rational approximation for exponential * of the fractional part: * e**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) */ xx = x * x; px = x * __polevll( xx, P, 2 ); x = px/( __polevll( xx, Q, 3 ) - px ); x = 1.0L + ldexpl( x, 1 ); x = ldexpl( x, n ); return(x); }
long double log10l(long double x) { long double y, z; int e; if (isnan(x)) return x; if(x <= 0.0) { if(x == 0.0) return -1.0 / (x*x); return (x - x) / 0.0; } if (x == INFINITY) return INFINITY; /* separate mantissa from exponent */ /* Note, frexp is used so that denormal numbers * will be handled properly. */ x = frexpl(x, &e); /* logarithm using log(x) = z + z**3 P(z)/Q(z), * where z = 2(x-1)/x+1) */ if (e > 2 || e < -2) { if (x < SQRTH) { /* 2(2x-1)/(2x+1) */ e -= 1; z = x - 0.5; y = 0.5 * z + 0.5; } else { /* 2 (x-1)/(x+1) */ z = x - 0.5; z -= 0.5; y = 0.5 * x + 0.5; } x = z / y; z = x*x; y = x * (z * __polevll(z, R, 3) / __p1evll(z, S, 3)); goto done; } /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ if (x < SQRTH) { e -= 1; x = 2.0*x - 1.0; } else { x = x - 1.0; } z = x*x; y = x * (z * __polevll(x, P, 6) / __p1evll(x, Q, 7)); y = y - 0.5*z; done: /* Multiply log of fraction by log10(e) * and base 2 exponent by log10(2). * * ***CAUTION*** * * This sequence of operations is critical and it may * be horribly defeated by some compiler optimizers. */ z = y * (L10EB); z += x * (L10EB); z += e * (L102B); z += y * (L10EA); z += x * (L10EA); z += e * (L102A); return z; }
long double log10l(long double x) { long double y; volatile long double z; int e; if( isnan(x) ) return(x); /* Test for domain */ if( x <= 0.0L ) { if( x == 0.0L ) return (-1.0L / (x - x)); else return (x - x) / (x - x); } if( x == INFINITY ) return(INFINITY); /* separate mantissa from exponent */ /* Note, frexp is used so that denormal numbers * will be handled properly. */ x = frexpl( x, &e ); /* logarithm using log(x) = z + z**3 P(z)/Q(z), * where z = 2(x-1)/x+1) */ if( (e > 2) || (e < -2) ) { if( x < SQRTH ) { /* 2( 2x-1 )/( 2x+1 ) */ e -= 1; z = x - 0.5L; y = 0.5L * z + 0.5L; } else { /* 2 (x-1)/(x+1) */ z = x - 0.5L; z -= 0.5L; y = 0.5L * x + 0.5L; } x = z / y; z = x*x; y = x * ( z * __polevll( z, R, 3 ) / __p1evll( z, S, 3 ) ); goto done; } /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ if( x < SQRTH ) { e -= 1; x = ldexpl( x, 1 ) - 1.0L; /* 2x - 1 */ } else { x = x - 1.0L; } z = x*x; y = x * ( z * __polevll( x, P, 6 ) / __p1evll( x, Q, 7 ) ); y = y - ldexpl( z, -1 ); /* -0.5x^2 + ... */ done: /* Multiply log of fraction by log10(e) * and base 2 exponent by log10(2). * * ***CAUTION*** * * This sequence of operations is critical and it may * be horribly defeated by some compiler optimizers. */ z = y * (L10EB); z += x * (L10EB); z += e * (L102B); z += y * (L10EA); z += x * (L10EA); z += e * (L102A); return( z ); }
long double powl(long double x, long double y) { /* double F, Fa, Fb, G, Ga, Gb, H, Ha, Hb */ int i, nflg, iyflg, yoddint; long e; volatile long double z=0; long double w=0, W=0, Wa=0, Wb=0, ya=0, yb=0, u=0; /* make sure no invalid exception is raised by nan comparision */ if (isnan(x)) { if (!isnan(y) && y == 0.0) return 1.0; return x; } if (isnan(y)) { if (x == 1.0) return 1.0; return y; } if (x == 1.0) return 1.0; /* 1**y = 1, even if y is nan */ if (x == -1.0 && !isfinite(y)) return 1.0; /* -1**inf = 1 */ if (y == 0.0) return 1.0; /* x**0 = 1, even if x is nan */ if (y == 1.0) return x; if (y >= LDBL_MAX) { if (x > 1.0 || x < -1.0) return INFINITY; if (x != 0.0) return 0.0; } if (y <= -LDBL_MAX) { if (x > 1.0 || x < -1.0) return 0.0; if (x != 0.0 || y == -INFINITY) return INFINITY; } if (x >= LDBL_MAX) { if (y > 0.0) return INFINITY; return 0.0; } w = floorl(y); /* Set iyflg to 1 if y is an integer. */ iyflg = 0; if (w == y) iyflg = 1; /* Test for odd integer y. */ yoddint = 0; if (iyflg) { ya = fabsl(y); ya = floorl(0.5 * ya); yb = 0.5 * fabsl(w); if( ya != yb ) yoddint = 1; } if (x <= -LDBL_MAX) { if (y > 0.0) { if (yoddint) return -INFINITY; return INFINITY; } if (y < 0.0) { if (yoddint) return -0.0; return 0.0; } } nflg = 0; /* (x<0)**(odd int) */ if (x <= 0.0) { if (x == 0.0) { if (y < 0.0) { if (signbit(x) && yoddint) /* (-0.0)**(-odd int) = -inf, divbyzero */ return -1.0/0.0; /* (+-0.0)**(negative) = inf, divbyzero */ return 1.0/0.0; } if (signbit(x) && yoddint) return -0.0; return 0.0; } if (iyflg == 0) return (x - x) / (x - x); /* (x<0)**(non-int) is NaN */ /* (x<0)**(integer) */ if (yoddint) nflg = 1; /* negate result */ x = -x; } /* (+integer)**(integer) */ if (iyflg && floorl(x) == x && fabsl(y) < 32768.0) { w = powil(x, (int)y); return nflg ? -w : w; } /* separate significand from exponent */ x = frexpl(x, &i); e = i; /* find significand in antilog table A[] */ i = 1; if (x <= A[17]) i = 17; if (x <= A[i+8]) i += 8; if (x <= A[i+4]) i += 4; if (x <= A[i+2]) i += 2; if (x >= A[1]) i = -1; i += 1; /* Find (x - A[i])/A[i] * in order to compute log(x/A[i]): * * log(x) = log( a x/a ) = log(a) + log(x/a) * * log(x/a) = log(1+v), v = x/a - 1 = (x-a)/a */ x -= A[i]; x -= B[i/2]; x /= A[i]; /* rational approximation for log(1+v): * * log(1+v) = v - v**2/2 + v**3 P(v) / Q(v) */ z = x*x; w = x * (z * __polevll(x, P, 3) / __p1evll(x, Q, 3)); w = w - 0.5*z; /* Convert to base 2 logarithm: * multiply by log2(e) = 1 + LOG2EA */ z = LOG2EA * w; z += w; z += LOG2EA * x; z += x; /* Compute exponent term of the base 2 logarithm. */ w = -i; w /= NXT; w += e; /* Now base 2 log of x is w + z. */ /* Multiply base 2 log by y, in extended precision. */ /* separate y into large part ya * and small part yb less than 1/NXT */ ya = reducl(y); yb = y - ya; /* (w+z)(ya+yb) * = w*ya + w*yb + z*y */ F = z * y + w * yb; Fa = reducl(F); Fb = F - Fa; G = Fa + w * ya; Ga = reducl(G); Gb = G - Ga; H = Fb + Gb; Ha = reducl(H); w = (Ga + Ha) * NXT; /* Test the power of 2 for overflow */ if (w > MEXP) return huge * huge; /* overflow */ if (w < MNEXP) return twom10000 * twom10000; /* underflow */ e = w; Hb = H - Ha; if (Hb > 0.0) { e += 1; Hb -= 1.0/NXT; /*0.0625L;*/ } /* Now the product y * log2(x) = Hb + e/NXT. * * Compute base 2 exponential of Hb, * where -0.0625 <= Hb <= 0. */ z = Hb * __polevll(Hb, R, 6); /* z = 2**Hb - 1 */ /* Express e/NXT as an integer plus a negative number of (1/NXT)ths. * Find lookup table entry for the fractional power of 2. */ if (e < 0) i = 0; else i = 1; i = e/NXT + i; e = NXT*i - e; w = A[e]; z = w * z; /* 2**-e * ( 1 + (2**Hb-1) ) */ z = z + w; z = scalbnl(z, i); /* multiply by integer power of 2 */ if (nflg) z = -z; return z; }
long double log1pl(long double xm1) { long double x, y, z; int e; if (isnan(xm1)) return xm1; if (xm1 == INFINITY) return xm1; if (xm1 == 0.0) return xm1; x = xm1 + 1.0; /* Test for domain errors. */ if (x <= 0.0) { if (x == 0.0) return -1/x; /* -inf with divbyzero */ return 0/0.0f; /* nan with invalid */ } /* Separate mantissa from exponent. Use frexp so that denormal numbers will be handled properly. */ x = frexpl(x, &e); /* logarithm using log(x) = z + z^3 P(z)/Q(z), where z = 2(x-1)/x+1) */ if (e > 2 || e < -2) { if (x < SQRTH) { /* 2(2x-1)/(2x+1) */ e -= 1; z = x - 0.5; y = 0.5 * z + 0.5; } else { /* 2 (x-1)/(x+1) */ z = x - 0.5; z -= 0.5; y = 0.5 * x + 0.5; } x = z / y; z = x*x; z = x * (z * __polevll(z, R, 3) / __p1evll(z, S, 3)); z = z + e * C2; z = z + x; z = z + e * C1; return z; } /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ if (x < SQRTH) { e -= 1; if (e != 0) x = 2.0 * x - 1.0; else x = xm1; } else { if (e != 0) x = x - 1.0; else x = xm1; } z = x*x; y = x * (z * __polevll(x, P, 6) / __p1evll(x, Q, 6)); y = y + e * C2; z = y - 0.5 * z; z = z + x; z = z + e * C1; return z; }
long double logl(long double x) { long double y, z; int e; if (isnan(x)) return x; if (x == INFINITY) return x; if (x <= 0.0) { if (x == 0.0) return -INFINITY; return NAN; } /* separate mantissa from exponent */ /* Note, frexp is used so that denormal numbers * will be handled properly. */ x = frexpl(x, &e); /* logarithm using log(x) = z + z**3 P(z)/Q(z), * where z = 2(x-1)/x+1) */ if (e > 2 || e < -2) { if (x < SQRTH) { /* 2(2x-1)/(2x+1) */ e -= 1; z = x - 0.5; y = 0.5 * z + 0.5; } else { /* 2 (x-1)/(x+1) */ z = x - 0.5; z -= 0.5; y = 0.5 * x + 0.5; } x = z / y; z = x*x; z = x * (z * __polevll(z, R, 3) / __p1evll(z, S, 3)); z = z + e * C2; z = z + x; z = z + e * C1; return z; } /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ if (x < SQRTH) { e -= 1; x = 2.0*x - 1.0; } else { x = x - 1.0; } z = x*x; y = x * (z * __polevll(x, P, 6) / __p1evll(x, Q, 6)); y = y + e * C2; z = y - 0.5*z; /* Note, the sum of above terms does not exceed x/4, * so it contributes at most about 1/4 lsb to the error. */ z = z + x; z = z + e * C1; /* This sum has an error of 1/2 lsb. */ return z; }
long double logl(long double x) { long double y, z; int e; if( isnan(x) ) return(x); if( x == INFINITY ) return(x); /* Test for domain */ if( x <= 0.0L ) { if( x == 0.0L ) return( -INFINITY ); else return( NAN ); } /* separate mantissa from exponent */ /* Note, frexp is used so that denormal numbers * will be handled properly. */ x = frexpl( x, &e ); /* logarithm using log(x) = z + z**3 P(z)/Q(z), * where z = 2(x-1)/x+1) */ if( (e > 2) || (e < -2) ) { if( x < SQRTH ) { /* 2( 2x-1 )/( 2x+1 ) */ e -= 1; z = x - 0.5L; y = 0.5L * z + 0.5L; } else { /* 2 (x-1)/(x+1) */ z = x - 0.5L; z -= 0.5L; y = 0.5L * x + 0.5L; } x = z / y; z = x*x; z = x * ( z * __polevll( z, (void *)R, 3 ) / __p1evll( z, (void *)S, 3 ) ); z = z + e * C2; z = z + x; z = z + e * C1; return( z ); } /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ if( x < SQRTH ) { e -= 1; x = ldexpl( x, 1 ) - 1.0L; /* 2x - 1 */ } else { x = x - 1.0L; } z = x*x; y = x * ( z * __polevll( x, (void *)P, 6 ) / __p1evll( x, (void *)Q, 6 ) ); y = y + e * C2; z = y - ldexpl( z, -1 ); /* y - 0.5 * z */ /* Note, the sum of above terms does not exceed x/4, * so it contributes at most about 1/4 lsb to the error. */ z = z + x; z = z + e * C1; /* This sum has an error of 1/2 lsb. */ return( z ); }
long double tgammal(long double x) { long double p, q, z; int i; signgam = 1; if( isnan(x) ) return(NAN); if(x == INFINITY) return(INFINITY); if(x == -INFINITY) return(x - x); q = fabsl(x); if( q > 13.0L ) { if( q > MAXGAML ) goto goverf; if( x < 0.0L ) { p = floorl(q); if( p == q ) return (x - x) / (x - x); i = p; if( (i & 1) == 0 ) signgam = -1; z = q - p; if( z > 0.5L ) { p += 1.0L; z = q - p; } z = q * sinl( PIL * z ); z = fabsl(z) * stirf(q); if( z <= PIL/LDBL_MAX ) { goverf: return( signgam * INFINITY); } z = PIL/z; } else { z = stirf(x); } return( signgam * z ); } z = 1.0L; while( x >= 3.0L ) { x -= 1.0L; z *= x; } while( x < -0.03125L ) { z /= x; x += 1.0L; } if( x <= 0.03125L ) goto small; while( x < 2.0L ) { z /= x; x += 1.0L; } if( x == 2.0L ) return(z); x -= 2.0L; p = __polevll( x, P, 7 ); q = __polevll( x, Q, 8 ); z = z * p / q; if( z < 0 ) signgam = -1; return z; small: if( x == 0.0L ) return (x - x) / (x - x); else { if( x < 0.0L ) { x = -x; q = z / (x * __polevll( x, SN, 8 )); signgam = -1; } else q = z / (x * __polevll( x, S, 8 )); } return q; }
long double tgammal(long double x) { long double p, q, z; if (!isfinite(x)) return x + INFINITY; q = fabsl(x); if (q > 13.0) { if (x < 0.0) { p = floorl(q); z = q - p; if (z == 0) return 0 / z; if (q > MAXGAML) { z = 0; } else { if (z > 0.5) { p += 1.0; z = q - p; } z = q * sinl(PIL * z); z = fabsl(z) * stirf(q); z = PIL/z; } if (0.5 * p == floorl(q * 0.5)) z = -z; } else if (x > MAXGAML) { z = x * 0x1p16383L; } else { z = stirf(x); } return z; } z = 1.0; while (x >= 3.0) { x -= 1.0; z *= x; } while (x < -0.03125L) { z /= x; x += 1.0; } if (x <= 0.03125L) goto small; while (x < 2.0) { z /= x; x += 1.0; } if (x == 2.0) return z; x -= 2.0; p = __polevll(x, P, 7); q = __polevll(x, Q, 8); z = z * p / q; return z; small: /* z==1 if x was originally +-0 */ if (x == 0 && z != 1) return x / x; if (x < 0.0) { x = -x; q = z / (x * __polevll(x, SN, 8)); } else q = z / (x * __polevll(x, S, 8)); return q; }