Improve tgamma accuracy (bugs 2546, 2560, 5159, 15426).

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 9873551757..5b17f7b5ad 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 0000000000..2a3fc1aff8
--- /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 0000000000..46072f16ea
--- /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 a312957b0a..f58f4c8056 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 cd3123046b..150921f90b 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 b6da31c13e..e8d49e9872 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 0000000000..157dbab9fb
--- /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 52ade9e4a1..90d8e3f0d2 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 0000000000..7c6186d230
--- /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 0974351a10..7cb3e8563a 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 0000000000..d464e70842
--- /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 0000000000..157dbab9fb
--- /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;
+}