double
__lgamma_product (double t, double x, double x_eps, int n)
{
double ret = 0, ret_eps = 0;
for (int i = 0; i < n; i++)
{
double xi = x + i;
double quot = t / xi;
double mhi, mlo;
mul_split (&mhi, &mlo, quot, xi);
double quot_lo = (t - mhi - mlo) / xi - t * x_eps / (xi * xi);
/* We want (1 + RET + RET_EPS) * (1 + QUOT + QUOT_LO) - 1. */
double rhi, rlo;
mul_split (&rhi, &rlo, ret, quot);
double rpq = ret + quot;
double rpq_eps = (ret - rpq) + quot;
double nret = rpq + rhi;
double nret_eps = (rpq - nret) + rhi;
ret_eps += (rpq_eps + nret_eps + rlo + ret_eps * quot
+ quot_lo + quot_lo * (ret + ret_eps));
ret = nret;
}
return ret + ret_eps;
}
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;
}
long double
__x2y2m1l (long double x, long double y)
{
double vals[12];
SET_RESTORE_ROUND (FE_TONEAREST);
union ibm_extended_long_double xu, yu;
xu.d = x;
yu.d = y;
if (fabs (xu.dd[1]) < 0x1p-500)
xu.dd[1] = 0.0;
if (fabs (yu.dd[1]) < 0x1p-500)
yu.dd[1] = 0.0;
mul_split (&vals[1], &vals[0], xu.dd[0], xu.dd[0]);
mul_split (&vals[3], &vals[2], xu.dd[0], xu.dd[1]);
vals[2] *= 2.0;
vals[3] *= 2.0;
mul_split (&vals[5], &vals[4], xu.dd[1], xu.dd[1]);
mul_split (&vals[7], &vals[6], yu.dd[0], yu.dd[0]);
mul_split (&vals[9], &vals[8], yu.dd[0], yu.dd[1]);
vals[8] *= 2.0;
vals[9] *= 2.0;
mul_split (&vals[11], &vals[10], yu.dd[1], yu.dd[1]);
if (xu.dd[0] >= 0.75)
vals[1] -= 1.0;
else
{
vals[1] -= 0.5;
vals[7] -= 0.5;
}
qsort (vals, 12, sizeof (double), compare);
/* Add up the values so that each element of VALS has absolute value
at most equal to the last set bit of the next nonzero
element. */
for (size_t i = 0; i <= 10; i++)
{
add_split (&vals[i + 1], &vals[i], vals[i + 1], vals[i]);
qsort (vals + i + 1, 11 - i, sizeof (double), compare);
}
/* Now any error from this addition will be small. */
long double retval = (long double) vals[11];
for (size_t i = 10; i != (size_t) -1; i--)
retval += (long double) vals[i];
return retval;
}
