aboutsummaryrefslogtreecommitdiff
path: root/sysdeps/ieee754
diff options
context:
space:
mode:
authorJoseph Myers <joseph@codesourcery.com>2013-05-08 11:58:18 +0000
committerJoseph Myers <joseph@codesourcery.com>2013-05-08 11:58:18 +0000
commitd8cd06db62d92f86cc8cc3c0d6a489bd207bb834 (patch)
tree3906235135ce8e0b4ea11d5dadc076699be07738 /sysdeps/ieee754
parentbb7cf681e90d5aa2d867aeff4948ac605447de7d (diff)
downloadglibc-d8cd06db62d92f86cc8cc3c0d6a489bd207bb834.zip
glibc-d8cd06db62d92f86cc8cc3c0d6a489bd207bb834.tar.gz
glibc-d8cd06db62d92f86cc8cc3c0d6a489bd207bb834.tar.bz2
Improve tgamma accuracy (bugs 2546, 2560, 5159, 15426).
Diffstat (limited to 'sysdeps/ieee754')
-rw-r--r--sysdeps/ieee754/dbl-64/e_gamma_r.c140
-rw-r--r--sysdeps/ieee754/dbl-64/gamma_product.c75
-rw-r--r--sysdeps/ieee754/dbl-64/gamma_productf.c46
-rw-r--r--sysdeps/ieee754/flt-32/e_gammaf_r.c134
-rw-r--r--sysdeps/ieee754/k_standard.c2
-rw-r--r--sysdeps/ieee754/ldbl-128/e_gammal_r.c145
-rw-r--r--sysdeps/ieee754/ldbl-128/gamma_productl.c75
-rw-r--r--sysdeps/ieee754/ldbl-128ibm/e_gammal_r.c144
-rw-r--r--sysdeps/ieee754/ldbl-128ibm/gamma_productl.c42
-rw-r--r--sysdeps/ieee754/ldbl-96/e_gammal_r.c143
-rw-r--r--sysdeps/ieee754/ldbl-96/gamma_product.c46
-rw-r--r--sysdeps/ieee754/ldbl-96/gamma_productl.c75
12 files changed, 1035 insertions, 32 deletions
diff --git a/sysdeps/ieee754/dbl-64/e_gamma_r.c b/sysdeps/ieee754/dbl-64/e_gamma_r.c
index 9873551..5b17f7b 100644
--- a/sysdeps/ieee754/dbl-64/e_gamma_r.c
+++ b/sysdeps/ieee754/dbl-64/e_gamma_r.c
@@ -19,14 +19,104 @@
#include <math.h>
#include <math_private.h>
+#include <float.h>
+/* Coefficients B_2k / 2k(2k-1) of x^-(2k-1) inside exp in Stirling's
+ approximation to gamma function. */
+
+static const double gamma_coeff[] =
+ {
+ 0x1.5555555555555p-4,
+ -0xb.60b60b60b60b8p-12,
+ 0x3.4034034034034p-12,
+ -0x2.7027027027028p-12,
+ 0x3.72a3c5631fe46p-12,
+ -0x7.daac36664f1f4p-12,
+ };
+
+#define NCOEFF (sizeof (gamma_coeff) / sizeof (gamma_coeff[0]))
+
+/* Return gamma (X), for positive X less than 184, in the form R *
+ 2^(*EXP2_ADJ), where R is the return value and *EXP2_ADJ is set to
+ avoid overflow or underflow in intermediate calculations. */
+
+static double
+gamma_positive (double x, int *exp2_adj)
+{
+ int local_signgam;
+ if (x < 0.5)
+ {
+ *exp2_adj = 0;
+ return __ieee754_exp (__ieee754_lgamma_r (x + 1, &local_signgam)) / x;
+ }
+ else if (x <= 1.5)
+ {
+ *exp2_adj = 0;
+ return __ieee754_exp (__ieee754_lgamma_r (x, &local_signgam));
+ }
+ else if (x < 6.5)
+ {
+ /* Adjust into the range for using exp (lgamma). */
+ *exp2_adj = 0;
+ double n = __ceil (x - 1.5);
+ double x_adj = x - n;
+ double eps;
+ double prod = __gamma_product (x_adj, 0, n, &eps);
+ return (__ieee754_exp (__ieee754_lgamma_r (x_adj, &local_signgam))
+ * prod * (1.0 + eps));
+ }
+ else
+ {
+ double eps = 0;
+ double x_eps = 0;
+ double x_adj = x;
+ double prod = 1;
+ if (x < 12.0)
+ {
+ /* Adjust into the range for applying Stirling's
+ approximation. */
+ double n = __ceil (12.0 - x);
+#if FLT_EVAL_METHOD != 0
+ volatile
+#endif
+ double x_tmp = x + n;
+ x_adj = x_tmp;
+ x_eps = (x - (x_adj - n));
+ prod = __gamma_product (x_adj - n, x_eps, n, &eps);
+ }
+ /* The result is now gamma (X_ADJ + X_EPS) / (PROD * (1 + EPS)).
+ Compute gamma (X_ADJ + X_EPS) using Stirling's approximation,
+ starting by computing pow (X_ADJ, X_ADJ) with a power of 2
+ factored out. */
+ double exp_adj = -eps;
+ double x_adj_int = __round (x_adj);
+ double x_adj_frac = x_adj - x_adj_int;
+ int x_adj_log2;
+ double x_adj_mant = __frexp (x_adj, &x_adj_log2);
+ if (x_adj_mant < M_SQRT1_2)
+ {
+ x_adj_log2--;
+ x_adj_mant *= 2.0;
+ }
+ *exp2_adj = x_adj_log2 * (int) x_adj_int;
+ double ret = (__ieee754_pow (x_adj_mant, x_adj)
+ * __ieee754_exp2 (x_adj_log2 * x_adj_frac)
+ * __ieee754_exp (-x_adj)
+ * __ieee754_sqrt (2 * M_PI / x_adj)
+ / prod);
+ exp_adj += x_eps * __ieee754_log (x);
+ double bsum = gamma_coeff[NCOEFF - 1];
+ double x_adj2 = x_adj * x_adj;
+ for (size_t i = 1; i <= NCOEFF - 1; i++)
+ bsum = bsum / x_adj2 + gamma_coeff[NCOEFF - 1 - i];
+ exp_adj += bsum / x_adj;
+ return ret + ret * __expm1 (exp_adj);
+ }
+}
double
__ieee754_gamma_r (double x, int *signgamp)
{
- /* We don't have a real gamma implementation now. We'll use lgamma
- and the exp function. But due to the required boundary
- conditions we must check some values separately. */
int32_t hx;
u_int32_t lx;
@@ -51,8 +141,48 @@ __ieee754_gamma_r (double x, int *signgamp)
*signgamp = 0;
return x - x;
}
+ if (__builtin_expect ((hx & 0x7ff00000) == 0x7ff00000, 0))
+ {
+ /* Positive infinity (return positive infinity) or NaN (return
+ NaN). */
+ *signgamp = 0;
+ return x + x;
+ }
- /* XXX FIXME. */
- return __ieee754_exp (__ieee754_lgamma_r (x, signgamp));
+ if (x >= 172.0)
+ {
+ /* Overflow. */
+ *signgamp = 0;
+ return DBL_MAX * DBL_MAX;
+ }
+ else if (x > 0.0)
+ {
+ *signgamp = 0;
+ int exp2_adj;
+ double ret = gamma_positive (x, &exp2_adj);
+ return __scalbn (ret, exp2_adj);
+ }
+ else if (x >= -DBL_EPSILON / 4.0)
+ {
+ *signgamp = 0;
+ return 1.0 / x;
+ }
+ else
+ {
+ double tx = __trunc (x);
+ *signgamp = (tx == 2.0 * __trunc (tx / 2.0)) ? -1 : 1;
+ if (x <= -184.0)
+ /* Underflow. */
+ return DBL_MIN * DBL_MIN;
+ double frac = tx - x;
+ if (frac > 0.5)
+ frac = 1.0 - frac;
+ double sinpix = (frac <= 0.25
+ ? __sin (M_PI * frac)
+ : __cos (M_PI * (0.5 - frac)));
+ int exp2_adj;
+ double ret = M_PI / (-x * sinpix * gamma_positive (-x, &exp2_adj));
+ return __scalbn (ret, -exp2_adj);
+ }
}
strong_alias (__ieee754_gamma_r, __gamma_r_finite)
diff --git a/sysdeps/ieee754/dbl-64/gamma_product.c b/sysdeps/ieee754/dbl-64/gamma_product.c
new file mode 100644
index 0000000..2a3fc1a
--- /dev/null
+++ b/sysdeps/ieee754/dbl-64/gamma_product.c
@@ -0,0 +1,75 @@
+/* Compute a product of X, X+1, ..., with an error estimate.
+ Copyright (C) 2013 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, see
+ <http://www.gnu.org/licenses/>. */
+
+#include <math.h>
+#include <math_private.h>
+#include <float.h>
+
+/* Calculate X * Y exactly and store the result in *HI + *LO. It is
+ given that the values are small enough that no overflow occurs and
+ large enough (or zero) that no underflow occurs. */
+
+static void
+mul_split (double *hi, double *lo, double x, double y)
+{
+#ifdef __FP_FAST_FMA
+ /* Fast built-in fused multiply-add. */
+ *hi = x * y;
+ *lo = __builtin_fma (x, y, -*hi);
+#elif defined FP_FAST_FMA
+ /* Fast library fused multiply-add, compiler before GCC 4.6. */
+ *hi = x * y;
+ *lo = __fma (x, y, -*hi);
+#else
+ /* Apply Dekker's algorithm. */
+ *hi = x * y;
+# define C ((1 << (DBL_MANT_DIG + 1) / 2) + 1)
+ double x1 = x * C;
+ double y1 = y * C;
+# undef C
+ x1 = (x - x1) + x1;
+ y1 = (y - y1) + y1;
+ double x2 = x - x1;
+ double y2 = y - y1;
+ *lo = (((x1 * y1 - *hi) + x1 * y2) + x2 * y1) + x2 * y2;
+#endif
+}
+
+/* Compute the product of X + X_EPS, X + X_EPS + 1, ..., X + X_EPS + N
+ - 1, in the form R * (1 + *EPS) where the return value R is an
+ approximation to the product and *EPS is set to indicate the
+ approximate error in the return value. X is such that all the
+ values X + 1, ..., X + N - 1 are exactly representable, and X_EPS /
+ X is small enough that factors quadratic in it can be
+ neglected. */
+
+double
+__gamma_product (double x, double x_eps, int n, double *eps)
+{
+ SET_RESTORE_ROUND (FE_TONEAREST);
+ double ret = x;
+ *eps = x_eps / x;
+ for (int i = 1; i < n; i++)
+ {
+ *eps += x_eps / (x + i);
+ double lo;
+ mul_split (&ret, &lo, ret, x + i);
+ *eps += lo / ret;
+ }
+ return ret;
+}
diff --git a/sysdeps/ieee754/dbl-64/gamma_productf.c b/sysdeps/ieee754/dbl-64/gamma_productf.c
new file mode 100644
index 0000000..46072f1
--- /dev/null
+++ b/sysdeps/ieee754/dbl-64/gamma_productf.c
@@ -0,0 +1,46 @@
+/* Compute a product of X, X+1, ..., with an error estimate.
+ Copyright (C) 2013 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, see
+ <http://www.gnu.org/licenses/>. */
+
+#include <math.h>
+#include <math_private.h>
+#include <float.h>
+
+/* Compute the product of X + X_EPS, X + X_EPS + 1, ..., X + X_EPS + N
+ - 1, in the form R * (1 + *EPS) where the return value R is an
+ approximation to the product and *EPS is set to indicate the
+ approximate error in the return value. X is such that all the
+ values X + 1, ..., X + N - 1 are exactly representable, and X_EPS /
+ X is small enough that factors quadratic in it can be
+ neglected. */
+
+float
+__gamma_productf (float x, float x_eps, int n, float *eps)
+{
+ double x_full = (double) x + (double) x_eps;
+ double ret = x_full;
+ for (int i = 1; i < n; i++)
+ ret *= x_full + i;
+
+#if FLT_EVAL_METHOD != 0
+ volatile
+#endif
+ float fret = ret;
+ *eps = (ret - fret) / fret;
+
+ return fret;
+}
diff --git a/sysdeps/ieee754/flt-32/e_gammaf_r.c b/sysdeps/ieee754/flt-32/e_gammaf_r.c
index a312957..f58f4c8 100644
--- a/sysdeps/ieee754/flt-32/e_gammaf_r.c
+++ b/sysdeps/ieee754/flt-32/e_gammaf_r.c
@@ -19,14 +19,97 @@
#include <math.h>
#include <math_private.h>
+#include <float.h>
+/* Coefficients B_2k / 2k(2k-1) of x^-(2k-1) inside exp in Stirling's
+ approximation to gamma function. */
+
+static const float gamma_coeff[] =
+ {
+ 0x1.555556p-4f,
+ -0xb.60b61p-12f,
+ 0x3.403404p-12f,
+ };
+
+#define NCOEFF (sizeof (gamma_coeff) / sizeof (gamma_coeff[0]))
+
+/* Return gamma (X), for positive X less than 42, in the form R *
+ 2^(*EXP2_ADJ), where R is the return value and *EXP2_ADJ is set to
+ avoid overflow or underflow in intermediate calculations. */
+
+static float
+gammaf_positive (float x, int *exp2_adj)
+{
+ int local_signgam;
+ if (x < 0.5f)
+ {
+ *exp2_adj = 0;
+ return __ieee754_expf (__ieee754_lgammaf_r (x + 1, &local_signgam)) / x;
+ }
+ else if (x <= 1.5f)
+ {
+ *exp2_adj = 0;
+ return __ieee754_expf (__ieee754_lgammaf_r (x, &local_signgam));
+ }
+ else if (x < 2.5f)
+ {
+ *exp2_adj = 0;
+ float x_adj = x - 1;
+ return (__ieee754_expf (__ieee754_lgammaf_r (x_adj, &local_signgam))
+ * x_adj);
+ }
+ else
+ {
+ float eps = 0;
+ float x_eps = 0;
+ float x_adj = x;
+ float prod = 1;
+ if (x < 4.0f)
+ {
+ /* Adjust into the range for applying Stirling's
+ approximation. */
+ float n = __ceilf (4.0f - x);
+#if FLT_EVAL_METHOD != 0
+ volatile
+#endif
+ float x_tmp = x + n;
+ x_adj = x_tmp;
+ x_eps = (x - (x_adj - n));
+ prod = __gamma_productf (x_adj - n, x_eps, n, &eps);
+ }
+ /* The result is now gamma (X_ADJ + X_EPS) / (PROD * (1 + EPS)).
+ Compute gamma (X_ADJ + X_EPS) using Stirling's approximation,
+ starting by computing pow (X_ADJ, X_ADJ) with a power of 2
+ factored out. */
+ float exp_adj = -eps;
+ float x_adj_int = __roundf (x_adj);
+ float x_adj_frac = x_adj - x_adj_int;
+ int x_adj_log2;
+ float x_adj_mant = __frexpf (x_adj, &x_adj_log2);
+ if (x_adj_mant < (float) M_SQRT1_2)
+ {
+ x_adj_log2--;
+ x_adj_mant *= 2.0f;
+ }
+ *exp2_adj = x_adj_log2 * (int) x_adj_int;
+ float ret = (__ieee754_powf (x_adj_mant, x_adj)
+ * __ieee754_exp2f (x_adj_log2 * x_adj_frac)
+ * __ieee754_expf (-x_adj)
+ * __ieee754_sqrtf (2 * (float) M_PI / x_adj)
+ / prod);
+ exp_adj += x_eps * __ieee754_logf (x);
+ float bsum = gamma_coeff[NCOEFF - 1];
+ float x_adj2 = x_adj * x_adj;
+ for (size_t i = 1; i <= NCOEFF - 1; i++)
+ bsum = bsum / x_adj2 + gamma_coeff[NCOEFF - 1 - i];
+ exp_adj += bsum / x_adj;
+ return ret + ret * __expm1f (exp_adj);
+ }
+}
float
__ieee754_gammaf_r (float x, int *signgamp)
{
- /* We don't have a real gamma implementation now. We'll use lgamma
- and the exp function. But due to the required boundary
- conditions we must check some values separately. */
int32_t hx;
GET_FLOAT_WORD (hx, x);
@@ -50,8 +133,49 @@ __ieee754_gammaf_r (float x, int *signgamp)
*signgamp = 0;
return x - x;
}
+ if (__builtin_expect ((hx & 0x7f800000) == 0x7f800000, 0))
+ {
+ /* Positive infinity (return positive infinity) or NaN (return
+ NaN). */
+ *signgamp = 0;
+ return x + x;
+ }
- /* XXX FIXME. */
- return __ieee754_expf (__ieee754_lgammaf_r (x, signgamp));
+ if (x >= 36.0f)
+ {
+ /* Overflow. */
+ *signgamp = 0;
+ return FLT_MAX * FLT_MAX;
+ }
+ else if (x > 0.0f)
+ {
+ *signgamp = 0;
+ int exp2_adj;
+ float ret = gammaf_positive (x, &exp2_adj);
+ return __scalbnf (ret, exp2_adj);
+ }
+ else if (x >= -FLT_EPSILON / 4.0f)
+ {
+ *signgamp = 0;
+ return 1.0f / x;
+ }
+ else
+ {
+ float tx = __truncf (x);
+ *signgamp = (tx == 2.0f * __truncf (tx / 2.0f)) ? -1 : 1;
+ if (x <= -42.0f)
+ /* Underflow. */
+ return FLT_MIN * FLT_MIN;
+ float frac = tx - x;
+ if (frac > 0.5f)
+ frac = 1.0f - frac;
+ float sinpix = (frac <= 0.25f
+ ? __sinf ((float) M_PI * frac)
+ : __cosf ((float) M_PI * (0.5f - frac)));
+ int exp2_adj;
+ float ret = (float) M_PI / (-x * sinpix
+ * gammaf_positive (-x, &exp2_adj));
+ return __scalbnf (ret, -exp2_adj);
+ }
}
strong_alias (__ieee754_gammaf_r, __gammaf_r_finite)
diff --git a/sysdeps/ieee754/k_standard.c b/sysdeps/ieee754/k_standard.c
index cd31230..150921f 100644
--- a/sysdeps/ieee754/k_standard.c
+++ b/sysdeps/ieee754/k_standard.c
@@ -837,7 +837,7 @@ __kernel_standard(double x, double y, int type)
exc.type = OVERFLOW;
exc.name = type < 100 ? "tgamma" : (type < 200
? "tgammaf" : "tgammal");
- exc.retval = HUGE_VAL;
+ exc.retval = __copysign (HUGE_VAL, x);
if (_LIB_VERSION == _POSIX_)
__set_errno (ERANGE);
else if (!matherr(&exc)) {
diff --git a/sysdeps/ieee754/ldbl-128/e_gammal_r.c b/sysdeps/ieee754/ldbl-128/e_gammal_r.c
index b6da31c..e8d49e9 100644
--- a/sysdeps/ieee754/ldbl-128/e_gammal_r.c
+++ b/sysdeps/ieee754/ldbl-128/e_gammal_r.c
@@ -20,14 +20,108 @@
#include <math.h>
#include <math_private.h>
+#include <float.h>
+/* Coefficients B_2k / 2k(2k-1) of x^-(2k-1) inside exp in Stirling's
+ approximation to gamma function. */
+
+static const long double gamma_coeff[] =
+ {
+ 0x1.5555555555555555555555555555p-4L,
+ -0xb.60b60b60b60b60b60b60b60b60b8p-12L,
+ 0x3.4034034034034034034034034034p-12L,
+ -0x2.7027027027027027027027027028p-12L,
+ 0x3.72a3c5631fe46ae1d4e700dca8f2p-12L,
+ -0x7.daac36664f1f207daac36664f1f4p-12L,
+ 0x1.a41a41a41a41a41a41a41a41a41ap-8L,
+ -0x7.90a1b2c3d4e5f708192a3b4c5d7p-8L,
+ 0x2.dfd2c703c0cfff430edfd2c703cp-4L,
+ -0x1.6476701181f39edbdb9ce625987dp+0L,
+ 0xd.672219167002d3a7a9c886459cp+0L,
+ -0x9.cd9292e6660d55b3f712eb9e07c8p+4L,
+ 0x8.911a740da740da740da740da741p+8L,
+ -0x8.d0cc570e255bf59ff6eec24b49p+12L,
+ };
+
+#define NCOEFF (sizeof (gamma_coeff) / sizeof (gamma_coeff[0]))
+
+/* Return gamma (X), for positive X less than 1775, in the form R *
+ 2^(*EXP2_ADJ), where R is the return value and *EXP2_ADJ is set to
+ avoid overflow or underflow in intermediate calculations. */
+
+static long double
+gammal_positive (long double x, int *exp2_adj)
+{
+ int local_signgam;
+ if (x < 0.5L)
+ {
+ *exp2_adj = 0;
+ return __ieee754_expl (__ieee754_lgammal_r (x + 1, &local_signgam)) / x;
+ }
+ else if (x <= 1.5L)
+ {
+ *exp2_adj = 0;
+ return __ieee754_expl (__ieee754_lgammal_r (x, &local_signgam));
+ }
+ else if (x < 12.5L)
+ {
+ /* Adjust into the range for using exp (lgamma). */
+ *exp2_adj = 0;
+ long double n = __ceill (x - 1.5L);
+ long double x_adj = x - n;
+ long double eps;
+ long double prod = __gamma_productl (x_adj, 0, n, &eps);
+ return (__ieee754_expl (__ieee754_lgammal_r (x_adj, &local_signgam))
+ * prod * (1.0L + eps));
+ }
+ else
+ {
+ long double eps = 0;
+ long double x_eps = 0;
+ long double x_adj = x;
+ long double prod = 1;
+ if (x < 24.0L)
+ {
+ /* Adjust into the range for applying Stirling's
+ approximation. */
+ long double n = __ceill (24.0L - x);
+ x_adj = x + n;
+ x_eps = (x - (x_adj - n));
+ prod = __gamma_productl (x_adj - n, x_eps, n, &eps);
+ }
+ /* The result is now gamma (X_ADJ + X_EPS) / (PROD * (1 + EPS)).
+ Compute gamma (X_ADJ + X_EPS) using Stirling's approximation,
+ starting by computing pow (X_ADJ, X_ADJ) with a power of 2
+ factored out. */
+ long double exp_adj = -eps;
+ long double x_adj_int = __roundl (x_adj);
+ long double x_adj_frac = x_adj - x_adj_int;
+ int x_adj_log2;
+ long double x_adj_mant = __frexpl (x_adj, &x_adj_log2);
+ if (x_adj_mant < M_SQRT1_2l)
+ {
+ x_adj_log2--;
+ x_adj_mant *= 2.0L;
+ }
+ *exp2_adj = x_adj_log2 * (int) x_adj_int;
+ long double ret = (__ieee754_powl (x_adj_mant, x_adj)
+ * __ieee754_exp2l (x_adj_log2 * x_adj_frac)
+ * __ieee754_expl (-x_adj)
+ * __ieee754_sqrtl (2 * M_PIl / x_adj)
+ / prod);
+ exp_adj += x_eps * __ieee754_logl (x);
+ long double bsum = gamma_coeff[NCOEFF - 1];
+ long double x_adj2 = x_adj * x_adj;
+ for (size_t i = 1; i <= NCOEFF - 1; i++)
+ bsum = bsum / x_adj2 + gamma_coeff[NCOEFF - 1 - i];
+ exp_adj += bsum / x_adj;
+ return ret + ret * __expm1l (exp_adj);
+ }
+}
long double
__ieee754_gammal_r (long double x, int *signgamp)
{
- /* We don't have a real gamma implementation now. We'll use lgamma
- and the exp function. But due to the required boundary
- conditions we must check some values separately. */
int64_t hx;
u_int64_t lx;
@@ -51,8 +145,49 @@ __ieee754_gammal_r (long double x, int *signgamp)
*signgamp = 0;
return x - x;
}
+ if ((hx & 0x7fff000000000000ULL) == 0x7fff000000000000ULL)
+ {
+ /* Positive infinity (return positive infinity) or NaN (return
+ NaN). */
+ *signgamp = 0;
+ return x + x;
+ }
- /* XXX FIXME. */
- return __ieee754_expl (__ieee754_lgammal_r (x, signgamp));
+ if (x >= 1756.0L)
+ {
+ /* Overflow. */
+ *signgamp = 0;
+ return LDBL_MAX * LDBL_MAX;
+ }
+ else if (x > 0.0L)
+ {
+ *signgamp = 0;
+ int exp2_adj;
+ long double ret = gammal_positive (x, &exp2_adj);
+ return __scalbnl (ret, exp2_adj);
+ }
+ else if (x >= -LDBL_EPSILON / 4.0L)
+ {
+ *signgamp = 0;
+ return 1.0f / x;
+ }
+ else
+ {
+ long double tx = __truncl (x);
+ *signgamp = (tx == 2.0L * __truncl (tx / 2.0L)) ? -1 : 1;
+ if (x <= -1775.0L)
+ /* Underflow. */
+ return LDBL_MIN * LDBL_MIN;
+ long double frac = tx - x;
+ if (frac > 0.5L)
+ frac = 1.0L - frac;
+ long double sinpix = (frac <= 0.25L
+ ? __sinl (M_PIl * frac)
+ : __cosl (M_PIl * (0.5L - frac)));
+ int exp2_adj;
+ long double ret = M_PIl / (-x * sinpix
+ * gammal_positive (-x, &exp2_adj));
+ return __scalbnl (ret, -exp2_adj);
+ }
}
strong_alias (__ieee754_gammal_r, __gammal_r_finite)
diff --git a/sysdeps/ieee754/ldbl-128/gamma_productl.c b/sysdeps/ieee754/ldbl-128/gamma_productl.c
new file mode 100644
index 0000000..157dbab
--- /dev/null
+++ b/sysdeps/ieee754/ldbl-128/gamma_productl.c
@@ -0,0 +1,75 @@
+/* Compute a product of X, X+1, ..., with an error estimate.
+ Copyright (C) 2013 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, see
+ <http://www.gnu.org/licenses/>. */
+
+#include <math.h>
+#include <math_private.h>
+#include <float.h>
+
+/* Calculate X * Y exactly and store the result in *HI + *LO. It is
+ given that the values are small enough that no overflow occurs and
+ large enough (or zero) that no underflow occurs. */
+
+static inline void
+mul_split (long double *hi, long double *lo, long double x, long double y)
+{
+#ifdef __FP_FAST_FMAL
+ /* Fast built-in fused multiply-add. */
+ *hi = x * y;
+ *lo = __builtin_fmal (x, y, -*hi);
+#elif defined FP_FAST_FMAL
+ /* Fast library fused multiply-add, compiler before GCC 4.6. */
+ *hi = x * y;
+ *lo = __fmal (x, y, -*hi);
+#else
+ /* Apply Dekker's algorithm. */
+ *hi = x * y;
+# define C ((1LL << (LDBL_MANT_DIG + 1) / 2) + 1)
+ long double x1 = x * C;
+ long double y1 = y * C;
+# undef C
+ x1 = (x - x1) + x1;
+ y1 = (y - y1) + y1;
+ long double x2 = x - x1;
+ long double y2 = y - y1;
+ *lo = (((x1 * y1 - *hi) + x1 * y2) + x2 * y1) + x2 * y2;
+#endif
+}
+
+/* Compute the product of X + X_EPS, X + X_EPS + 1, ..., X + X_EPS + N
+ - 1, in the form R * (1 + *EPS) where the return value R is an
+ approximation to the product and *EPS is set to indicate the
+ approximate error in the return value. X is such that all the
+ values X + 1, ..., X + N - 1 are exactly representable, and X_EPS /
+ X is small enough that factors quadratic in it can be
+ neglected. */
+
+long double
+__gamma_productl (long double x, long double x_eps, int n, long double *eps)
+{
+ SET_RESTORE_ROUNDL (FE_TONEAREST);
+ long double ret = x;
+ *eps = x_eps / x;
+ for (int i = 1; i < n; i++)
+ {
+ *eps += x_eps / (x + i);
+ long double lo;
+ mul_split (&ret, &lo, ret, x + i);
+ *eps += lo / ret;
+ }
+ return ret;
+}
diff --git a/sysdeps/ieee754/ldbl-128ibm/e_gammal_r.c b/sysdeps/ieee754/ldbl-128ibm/e_gammal_r.c
index 52ade9e..90d8e3f 100644
--- a/sysdeps/ieee754/ldbl-128ibm/e_gammal_r.c
+++ b/sysdeps/ieee754/ldbl-128ibm/e_gammal_r.c
@@ -20,14 +20,107 @@
#include <math.h>
#include <math_private.h>
+#include <float.h>
+/* Coefficients B_2k / 2k(2k-1) of x^-(2k-1) inside exp in Stirling's
+ approximation to gamma function. */
+
+static const long double gamma_coeff[] =
+ {
+ 0x1.555555555555555555555555558p-4L,
+ -0xb.60b60b60b60b60b60b60b60b6p-12L,
+ 0x3.4034034034034034034034034p-12L,
+ -0x2.7027027027027027027027027p-12L,
+ 0x3.72a3c5631fe46ae1d4e700dca9p-12L,
+ -0x7.daac36664f1f207daac36664f2p-12L,
+ 0x1.a41a41a41a41a41a41a41a41a4p-8L,
+ -0x7.90a1b2c3d4e5f708192a3b4c5ep-8L,
+ 0x2.dfd2c703c0cfff430edfd2c704p-4L,
+ -0x1.6476701181f39edbdb9ce625988p+0L,
+ 0xd.672219167002d3a7a9c886459cp+0L,
+ -0x9.cd9292e6660d55b3f712eb9e08p+4L,
+ 0x8.911a740da740da740da740da74p+8L,
+ };
+
+#define NCOEFF (sizeof (gamma_coeff) / sizeof (gamma_coeff[0]))
+
+/* Return gamma (X), for positive X less than 191, in the form R *
+ 2^(*EXP2_ADJ), where R is the return value and *EXP2_ADJ is set to
+ avoid overflow or underflow in intermediate calculations. */
+
+static long double
+gammal_positive (long double x, int *exp2_adj)
+{
+ int local_signgam;
+ if (x < 0.5L)
+ {
+ *exp2_adj = 0;
+ return __ieee754_expl (__ieee754_lgammal_r (x + 1, &local_signgam)) / x;
+ }
+ else if (x <= 1.5L)
+ {
+ *exp2_adj = 0;
+ return __ieee754_expl (__ieee754_lgammal_r (x, &local_signgam));
+ }
+ else if (x < 11.5L)
+ {
+ /* Adjust into the range for using exp (lgamma). */
+ *exp2_adj = 0;
+ long double n = __ceill (x - 1.5L);
+ long double x_adj = x - n;
+ long double eps;
+ long double prod = __gamma_productl (x_adj, 0, n, &eps);
+ return (__ieee754_expl (__ieee754_lgammal_r (x_adj, &local_signgam))
+ * prod * (1.0L + eps));
+ }
+ else
+ {
+ long double eps = 0;
+ long double x_eps = 0;
+ long double x_adj = x;
+ long double prod = 1;
+ if (x < 23.0L)
+ {
+ /* Adjust into the range for applying Stirling's
+ approximation. */
+ long double n = __ceill (23.0L - x);
+ x_adj = x + n;
+ x_eps = (x - (x_adj - n));
+ prod = __gamma_productl (x_adj - n, x_eps, n, &eps);
+ }
+ /* The result is now gamma (X_ADJ + X_EPS) / (PROD * (1 + EPS)).
+ Compute gamma (X_ADJ + X_EPS) using Stirling's approximation,
+ starting by computing pow (X_ADJ, X_ADJ) with a power of 2
+ factored out. */
+ long double exp_adj = -eps;
+ long double x_adj_int = __roundl (x_adj);
+ long double x_adj_frac = x_adj - x_adj_int;
+ int x_adj_log2;
+ long double x_adj_mant = __frexpl (x_adj, &x_adj_log2);
+ if (x_adj_mant < M_SQRT1_2l)
+ {
+ x_adj_log2--;
+ x_adj_mant *= 2.0L;
+ }
+ *exp2_adj = x_adj_log2 * (int) x_adj_int;
+ long double ret = (__ieee754_powl (x_adj_mant, x_adj)
+ * __ieee754_exp2l (x_adj_log2 * x_adj_frac)
+ * __ieee754_expl (-x_adj)
+ * __ieee754_sqrtl (2 * M_PIl / x_adj)
+ / prod);
+ exp_adj += x_eps * __ieee754_logl (x);
+ long double bsum = gamma_coeff[NCOEFF - 1];
+ long double x_adj2 = x_adj * x_adj;
+ for (size_t i = 1; i <= NCOEFF - 1; i++)
+ bsum = bsum / x_adj2 + gamma_coeff[NCOEFF - 1 - i];
+ exp_adj += bsum / x_adj;
+ return ret + ret * __expm1l (exp_adj);
+ }
+}
long double
__ieee754_gammal_r (long double x, int *signgamp)
{
- /* We don't have a real gamma implementation now. We'll use lgamma
- and the exp function. But due to the required boundary
- conditions we must check some values separately. */
int64_t hx;
u_int64_t lx;
@@ -51,8 +144,49 @@ __ieee754_gammal_r (long double x, int *signgamp)
*signgamp = 0;
return x - x;
}
+ if ((hx & 0x7ff0000000000000ULL) == 0x7ff0000000000000ULL)
+ {
+ /* Positive infinity (return positive infinity) or NaN (return
+ NaN). */
+ *signgamp = 0;
+ return x + x;
+ }
- /* XXX FIXME. */
- return __ieee754_expl (__ieee754_lgammal_r (x, signgamp));
+ if (x >= 172.0L)
+ {
+ /* Overflow. */
+ *signgamp = 0;
+ return LDBL_MAX * LDBL_MAX;
+ }
+ else if (x > 0.0L)
+ {
+ *signgamp = 0;
+ int exp2_adj;
+ long double ret = gammal_positive (x, &exp2_adj);
+ return __scalbnl (ret, exp2_adj);
+ }
+ else if (x >= -0x1p-110L)
+ {
+ *signgamp = 0;
+ return 1.0f / x;
+ }
+ else
+ {
+ long double tx = __truncl (x);
+ *signgamp = (tx == 2.0L * __truncl (tx / 2.0L)) ? -1 : 1;
+ if (x <= -191.0L)
+ /* Underflow. */
+ return LDBL_MIN * LDBL_MIN;
+ long double frac = tx - x;
+ if (frac > 0.5L)
+ frac = 1.0L - frac;
+ long double sinpix = (frac <= 0.25L
+ ? __sinl (M_PIl * frac)
+ : __cosl (M_PIl * (0.5L - frac)));
+ int exp2_adj;
+ long double ret = M_PIl / (-x * sinpix
+ * gammal_positive (-x, &exp2_adj));
+ return __scalbnl (ret, -exp2_adj);
+ }
}
strong_alias (__ieee754_gammal_r, __gammal_r_finite)
diff --git a/sysdeps/ieee754/ldbl-128ibm/gamma_productl.c b/sysdeps/ieee754/ldbl-128ibm/gamma_productl.c
new file mode 100644
index 0000000..7c6186d
--- /dev/null
+++ b/sysdeps/ieee754/ldbl-128ibm/gamma_productl.c
@@ -0,0 +1,42 @@
+/* Compute a product of X, X+1, ..., with an error estimate.
+ Copyright (C) 2013 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, see
+ <http://www.gnu.org/licenses/>. */
+
+#include <math.h>
+#include <math_private.h>
+
+/* Compute the product of X + X_EPS, X + X_EPS + 1, ..., X + X_EPS + N
+ - 1, in the form R * (1 + *EPS) where the return value R is an
+ approximation to the product and *EPS is set to indicate the
+ approximate error in the return value. X is such that all the
+ values X + 1, ..., X + N - 1 are exactly representable, and X_EPS /
+ X is small enough that factors quadratic in it can be
+ neglected. */
+
+long double
+__gamma_productl (long double x, long double x_eps, int n, long double *eps)
+{
+ long double ret = x;
+ *eps = x_eps / x;
+ for (int i = 1; i < n; i++)
+ {
+ *eps += x_eps / (x + i);
+ ret *= x + i;
+ /* FIXME: no error estimates for the multiplication. */
+ }
+ return ret;
+}
diff --git a/sysdeps/ieee754/ldbl-96/e_gammal_r.c b/sysdeps/ieee754/ldbl-96/e_gammal_r.c
index 0974351..7cb3e85 100644
--- a/sysdeps/ieee754/ldbl-96/e_gammal_r.c
+++ b/sysdeps/ieee754/ldbl-96/e_gammal_r.c
@@ -19,14 +19,102 @@
#include <math.h>
#include <math_private.h>
+#include <float.h>
+/* Coefficients B_2k / 2k(2k-1) of x^-(2k-1) inside exp in Stirling's
+ approximation to gamma function. */
+
+static const long double gamma_coeff[] =
+ {
+ 0x1.5555555555555556p-4L,
+ -0xb.60b60b60b60b60bp-12L,
+ 0x3.4034034034034034p-12L,
+ -0x2.7027027027027028p-12L,
+ 0x3.72a3c5631fe46aep-12L,
+ -0x7.daac36664f1f208p-12L,
+ 0x1.a41a41a41a41a41ap-8L,
+ -0x7.90a1b2c3d4e5f708p-8L,
+ };
+
+#define NCOEFF (sizeof (gamma_coeff) / sizeof (gamma_coeff[0]))
+
+/* Return gamma (X), for positive X less than 1766, in the form R *
+ 2^(*EXP2_ADJ), where R is the return value and *EXP2_ADJ is set to
+ avoid overflow or underflow in intermediate calculations. */
+
+static long double
+gammal_positive (long double x, int *exp2_adj)
+{
+ int local_signgam;
+ if (x < 0.5L)
+ {
+ *exp2_adj = 0;
+ return __ieee754_expl (__ieee754_lgammal_r (x + 1, &local_signgam)) / x;
+ }
+ else if (x <= 1.5L)
+ {
+ *exp2_adj = 0;
+ return __ieee754_expl (__ieee754_lgammal_r (x, &local_signgam));
+ }
+ else if (x < 7.5L)
+ {
+ /* Adjust into the range for using exp (lgamma). */
+ *exp2_adj = 0;
+ long double n = __ceill (x - 1.5L);
+ long double x_adj = x - n;
+ long double eps;
+ long double prod = __gamma_productl (x_adj, 0, n, &eps);
+ return (__ieee754_expl (__ieee754_lgammal_r (x_adj, &local_signgam))
+ * prod * (1.0L + eps));
+ }
+ else
+ {
+ long double eps = 0;
+ long double x_eps = 0;
+ long double x_adj = x;
+ long double prod = 1;
+ if (x < 13.0L)
+ {
+ /* Adjust into the range for applying Stirling's
+ approximation. */
+ long double n = __ceill (13.0L - x);
+ x_adj = x + n;
+ x_eps = (x - (x_adj - n));
+ prod = __gamma_productl (x_adj - n, x_eps, n, &eps);
+ }
+ /* The result is now gamma (X_ADJ + X_EPS) / (PROD * (1 + EPS)).
+ Compute gamma (X_ADJ + X_EPS) using Stirling's approximation,
+ starting by computing pow (X_ADJ, X_ADJ) with a power of 2
+ factored out. */
+ long double exp_adj = -eps;
+ long double x_adj_int = __roundl (x_adj);
+ long double x_adj_frac = x_adj - x_adj_int;
+ int x_adj_log2;
+ long double x_adj_mant = __frexpl (x_adj, &x_adj_log2);
+ if (x_adj_mant < M_SQRT1_2l)
+ {
+ x_adj_log2--;
+ x_adj_mant *= 2.0L;
+ }
+ *exp2_adj = x_adj_log2 * (int) x_adj_int;
+ long double ret = (__ieee754_powl (x_adj_mant, x_adj)
+ * __ieee754_exp2l (x_adj_log2 * x_adj_frac)
+ * __ieee754_expl (-x_adj)
+ * __ieee754_sqrtl (2 * M_PIl / x_adj)
+ / prod);
+ exp_adj += x_eps * __ieee754_logl (x);
+ long double bsum = gamma_coeff[NCOEFF - 1];
+ long double x_adj2 = x_adj * x_adj;
+ for (size_t i = 1; i <= NCOEFF - 1; i++)
+ bsum = bsum / x_adj2 + gamma_coeff[NCOEFF - 1 - i];
+ exp_adj += bsum / x_adj;
+ return ret + ret * __expm1l (exp_adj);
+ }
+}
long double
__ieee754_gammal_r (long double x, int *signgamp)
{
- /* We don't have a real gamma implementation now. We'll use lgamma
- and the exp function. But due to the required boundary
- conditions we must check some values separately. */
u_int32_t es, hx, lx;
GET_LDOUBLE_WORDS (es, hx, lx, x);
@@ -43,22 +131,55 @@ __ieee754_gammal_r (long double x, int *signgamp)
*signgamp = 0;
return x - x;
}
- if (__builtin_expect ((es & 0x7fff) == 0x7fff, 0)
- && ((hx & 0x7fffffff) | lx) != 0)
+ if (__builtin_expect ((es & 0x7fff) == 0x7fff, 0))
{
- /* NaN, return it. */
+ /* Positive infinity (return positive infinity) or NaN (return
+ NaN). */
*signgamp = 0;
- return x;
+ return x + x;
}
- if (__builtin_expect ((es & 0x8000) != 0, 0)
- && x < 0xffffffff && __rintl (x) == x)
+ if (__builtin_expect ((es & 0x8000) != 0, 0) && __rintl (x) == x)
{
/* Return value for integer x < 0 is NaN with invalid exception. */
*signgamp = 0;
return (x - x) / (x - x);
}
- /* XXX FIXME. */
- return __ieee754_expl (__ieee754_lgammal_r (x, signgamp));
+ if (x >= 1756.0L)
+ {
+ /* Overflow. */
+ *signgamp = 0;
+ return LDBL_MAX * LDBL_MAX;
+ }
+ else if (x > 0.0L)
+ {
+ *signgamp = 0;
+ int exp2_adj;
+ long double ret = gammal_positive (x, &exp2_adj);
+ return __scalbnl (ret, exp2_adj);
+ }
+ else if (x >= -LDBL_EPSILON / 4.0L)
+ {
+ *signgamp = 0;
+ return 1.0f / x;
+ }
+ else
+ {
+ long double tx = __truncl (x);
+ *signgamp = (tx == 2.0L * __truncl (tx / 2.0L)) ? -1 : 1;
+ if (x <= -1766.0L)
+ /* Underflow. */
+ return LDBL_MIN * LDBL_MIN;
+ long double frac = tx - x;
+ if (frac > 0.5L)
+ frac = 1.0L - frac;
+ long double sinpix = (frac <= 0.25L
+ ? __sinl (M_PIl * frac)
+ : __cosl (M_PIl * (0.5L - frac)));
+ int exp2_adj;
+ long double ret = M_PIl / (-x * sinpix
+ * gammal_positive (-x, &exp2_adj));
+ return __scalbnl (ret, -exp2_adj);
+ }
}
strong_alias (__ieee754_gammal_r, __gammal_r_finite)
diff --git a/sysdeps/ieee754/ldbl-96/gamma_product.c b/sysdeps/ieee754/ldbl-96/gamma_product.c
new file mode 100644
index 0000000..d464e70
--- /dev/null
+++ b/sysdeps/ieee754/ldbl-96/gamma_product.c
@@ -0,0 +1,46 @@
+/* Compute a product of X, X+1, ..., with an error estimate.
+ Copyright (C) 2013 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, see
+ <http://www.gnu.org/licenses/>. */
+
+#include <math.h>
+#include <math_private.h>
+#include <float.h>
+
+/* Compute the product of X + X_EPS, X + X_EPS + 1, ..., X + X_EPS + N
+ - 1, in the form R * (1 + *EPS) where the return value R is an
+ approximation to the product and *EPS is set to indicate the
+ approximate error in the return value. X is such that all the
+ values X + 1, ..., X + N - 1 are exactly representable, and X_EPS /
+ X is small enough that factors quadratic in it can be
+ neglected. */
+
+double
+__gamma_product (double x, double x_eps, int n, double *eps)
+{
+ long double x_full = (long double) x + (long double) x_eps;
+ long double ret = x_full;
+ for (int i = 1; i < n; i++)
+ ret *= x_full + i;
+
+#if FLT_EVAL_METHOD != 0
+ volatile
+#endif
+ double fret = ret;
+ *eps = (ret - fret) / fret;
+
+ return fret;
+}
diff --git a/sysdeps/ieee754/ldbl-96/gamma_productl.c b/sysdeps/ieee754/ldbl-96/gamma_productl.c
new file mode 100644
index 0000000..157dbab
--- /dev/null
+++ b/sysdeps/ieee754/ldbl-96/gamma_productl.c
@@ -0,0 +1,75 @@
+/* Compute a product of X, X+1, ..., with an error estimate.
+ Copyright (C) 2013 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, see
+ <http://www.gnu.org/licenses/>. */
+
+#include <math.h>
+#include <math_private.h>
+#include <float.h>
+
+/* Calculate X * Y exactly and store the result in *HI + *LO. It is
+ given that the values are small enough that no overflow occurs and
+ large enough (or zero) that no underflow occurs. */
+
+static inline void
+mul_split (long double *hi, long double *lo, long double x, long double y)
+{
+#ifdef __FP_FAST_FMAL
+ /* Fast built-in fused multiply-add. */
+ *hi = x * y;
+ *lo = __builtin_fmal (x, y, -*hi);
+#elif defined FP_FAST_FMAL
+ /* Fast library fused multiply-add, compiler before GCC 4.6. */
+ *hi = x * y;
+ *lo = __fmal (x, y, -*hi);
+#else
+ /* Apply Dekker's algorithm. */
+ *hi = x * y;
+# define C ((1LL << (LDBL_MANT_DIG + 1) / 2) + 1)
+ long double x1 = x * C;
+ long double y1 = y * C;
+# undef C
+ x1 = (x - x1) + x1;
+ y1 = (y - y1) + y1;
+ long double x2 = x - x1;
+ long double y2 = y - y1;
+ *lo = (((x1 * y1 - *hi) + x1 * y2) + x2 * y1) + x2 * y2;
+#endif
+}
+
+/* Compute the product of X + X_EPS, X + X_EPS + 1, ..., X + X_EPS + N
+ - 1, in the form R * (1 + *EPS) where the return value R is an
+ approximation to the product and *EPS is set to indicate the
+ approximate error in the return value. X is such that all the
+ values X + 1, ..., X + N - 1 are exactly representable, and X_EPS /
+ X is small enough that factors quadratic in it can be
+ neglected. */
+
+long double
+__gamma_productl (long double x, long double x_eps, int n, long double *eps)
+{
+ SET_RESTORE_ROUNDL (FE_TONEAREST);
+ long double ret = x;
+ *eps = x_eps / x;
+ for (int i = 1; i < n; i++)
+ {
+ *eps += x_eps / (x + i);
+ long double lo;
+ mul_split (&ret, &lo, ret, x + i);
+ *eps += lo / ret;
+ }
+ return ret;
+}