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; }