static void
test_feupdateenv (void)
{
#if defined FE_NOMASK_ENV && defined FE_ALL_EXCEPT
int res;
fedisableexcept (FE_ALL_EXCEPT);
res = feupdateenv (FE_NOMASK_ENV);
if (!EXCEPTION_ENABLE_SUPPORTED (FE_ALL_EXCEPT) && (res != 0))
{
puts ("feupdateenv (FE_NOMASK_ENV)) not supported, cannot test.");
return;
}
else if (res != 0)
{
puts ("feupdateenv (FE_NOMASK_ENV) failed");
count_errors++;
}
if (fegetexcept () != FE_ALL_EXCEPT)
{
puts ("feupdateenv did not set all exceptions");
count_errors++;
}
#endif
}
double log_zerook (double x)
{
fenv_t fe;
feholdexcept(&fe);
x = log(x);
feclearexcept(FE_OVERFLOW | FE_DIVBYZERO);
feupdateenv(&fe);
return x;
}
/*
* C99 says we should not raise a spurious inexact exception when an
* invalid exception is raised. Unfortunately, the set of inputs
* that overflows depends on the rounding mode when 'dtype' has more
* significant bits than 'type'. Hence, we bend over backwards for the
* sake of correctness; an MD implementation could be more efficient.
*/
dtype
fn(type x)
{
fenv_t env;
dtype d;
feholdexcept(&env);
d = (dtype)roundit(x);
if (fetestexcept(FE_INVALID))
feclearexcept(FE_INEXACT);
feupdateenv(&env);
return (d);
}
void BM_math_sin_feupdateenv::Run(int iters) {
StartBenchmarkTiming();
d = 1.0;
for (int i = 0; i < iters; ++i) {
fenv_t __libc_save_rm;
feholdexcept(&__libc_save_rm);
fesetround(FE_TONEAREST);
d += sin(d);
feupdateenv(&__libc_save_rm);
}
StopBenchmarkTiming();
}
/*
* Compute the hypotenuse of a right triangle, avoiding intermediate
* overflow or underflow.
*
* (This example ignores the case of one argument having
* great magnitude and the other small, causing both overflow
* and underflow!)
*/
double hypotenuse(double sidea, double sideb)
{
#pragma STDC FENV_ACCESS ON
double sum, scale, ascaled, bscaled, invscale;
fenv_t fpenv;
int fpeflags;
if ( signbit(sidea)) sidea = fabs(sidea);
if ( signbit(sideb)) sideb = fabs(sideb);
feholdexcept(&fpenv); // Save previous environment,
// clear exceptions,
// switch to nonstop processing.
invscale = 1.0;
sum = sidea * sidea + sideb * sideb; // First try whether a^2 + b^2
// causes any exceptions.
fpeflags = fetestexcept(FE_UNDERFLOW | FE_OVERFLOW); // Did it?
if (fpeflags & FE_OVERFLOW && sidea > 1.0 && sideb > 1.0)
{
/* a^2 + b^2 caused an overflow. Scale the triangle down. */
feclearexcept(FE_OVERFLOW);
scale = scalbn( 1.0, (DBL_MIN_EXP / 2));
invscale = 1.0 / scale;
ascaled = scale * sidea;
bscaled = scale * sideb;
sum = ascaled * ascaled + bscaled * bscaled;
}
else if (fpeflags & FE_UNDERFLOW && sidea < 1.0 && sideb < 1.0)
{
/* a^2 + b^2 caused an underflow. Scale the triangle up. */
feclearexcept(FE_UNDERFLOW);
scale = scalbn( 1.0, (DBL_MAX_EXP / 2));
invscale = 1.0 / scale;
ascaled = scale * sidea;
bscaled = scale * sideb;
sum = ascaled * ascaled + bscaled * bscaled;
}
feupdateenv(&fpenv); // restore the caller's environment, and
// raise any new exceptions
/* c = (1/scale) * sqrt((a * scale)^2 + (b * scale)^2): */
return invscale * sqrt(sum);
}
double
__fma (double x, double y, double z)
{
if (__builtin_expect (isinf (z), 0))
{
/* If z is Inf, but x and y are finite, the result should be
z rather than NaN. */
if (finite (x) && finite (y))
return (z + x) + y;
return (x * y) + z;
}
/* Multiplication m1 + m2 = x * y using Dekker's algorithm. */
#define C ((1ULL << (LDBL_MANT_DIG + 1) / 2) + 1)
long double x1 = (long double) x * C;
long double y1 = (long double) y * C;
long double m1 = (long double) x * y;
x1 = (x - x1) + x1;
y1 = (y - y1) + y1;
long double x2 = x - x1;
long double y2 = y - y1;
long double m2 = (((x1 * y1 - m1) + x1 * y2) + x2 * y1) + x2 * y2;
/* Addition a1 + a2 = z + m1 using Knuth's algorithm. */
long double a1 = z + m1;
long double t1 = a1 - z;
long double t2 = a1 - t1;
t1 = m1 - t1;
t2 = z - t2;
long double a2 = t1 + t2;
fenv_t env;
feholdexcept (&env);
fesetround (FE_TOWARDZERO);
/* Perform m2 + a2 addition with round to odd. */
a2 = a2 + m2;
/* Add that to a1 again using rounding to odd. */
union ieee854_long_double u;
u.d = a1 + a2;
if ((u.ieee.mantissa1 & 1) == 0 && u.ieee.exponent != 0x7fff)
u.ieee.mantissa1 |= fetestexcept (FE_INEXACT) != 0;
feupdateenv (&env);
/* Add finally round to double precision. */
return u.d;
}
double
__fma (double x, double y, double z)
{
fenv_t env;
/* Multiplication is always exact. */
long double temp = (long double) x * (long double) y;
union ieee854_long_double u;
feholdexcept (&env);
fesetround (FE_TOWARDZERO);
/* Perform addition with round to odd. */
u.d = temp + (long double) z;
if ((u.ieee.mantissa3 & 1) == 0 && u.ieee.exponent != 0x7fff)
u.ieee.mantissa3 |= fetestexcept (FE_INEXACT) != 0;
feupdateenv (&env);
/* And finally truncation with round to nearest. */
return (double) u.d;
}
float
__fmaf (float x, float y, float z)
{
fenv_t env;
/* Multiplication is always exact. */
double temp = (double) x * (double) y;
union ieee754_double u;
feholdexcept (&env);
fesetround (FE_TOWARDZERO);
/* Perform addition with round to odd. */
u.d = temp + (double) z;
if ((u.ieee.mantissa1 & 1) == 0 && u.ieee.exponent != 0x7ff)
u.ieee.mantissa1 |= fetestexcept (FE_INEXACT) != 0;
feupdateenv (&env);
/* And finally truncation with round to nearest. */
return (float) u.d;
}
TEST(fenv, feholdexcept_feupdateenv) {
// Set FE_OVERFLOW only.
feclearexcept(FE_ALL_EXCEPT);
ASSERT_EQ(0, fetestexcept(FE_ALL_EXCEPT));
ASSERT_EQ(0, feraiseexcept(FE_OVERFLOW));
// feholdexcept (unlike fegetenv) clears everything...
fenv_t state;
ASSERT_EQ(0, feholdexcept(&state));
ASSERT_EQ(0, fetestexcept(FE_ALL_EXCEPT));
// Dividing by zero sets the appropriate flag...
DivideByZero();
ASSERT_EQ(FE_DIVBYZERO, fetestexcept(FE_ALL_EXCEPT));
// And feupdateenv (unlike fesetenv) merges what we started with
// (FE_OVERFLOW) with what we now have (FE_DIVBYZERO).
ASSERT_EQ(0, feupdateenv(&state));
ASSERT_EQ(FE_DIVBYZERO | FE_OVERFLOW, fetestexcept(FE_ALL_EXCEPT));
}
double
__fma (double x, double y, double z)
{
fenv_t env;
/* Multiplication is always exact. */
long double temp = (long double) x * (long double) y;
/* Ensure correct sign of an exact zero result by performing the
addition in the original rounding mode in that case. */
if (temp == -z)
return (double) temp + z;
union ieee854_long_double u;
feholdexcept (&env);
fesetround (FE_TOWARDZERO);
/* Perform addition with round to odd. */
u.d = temp + (long double) z;
if ((u.ieee.mantissa3 & 1) == 0 && u.ieee.exponent != 0x7fff)
u.ieee.mantissa3 |= fetestexcept (FE_INEXACT) != 0;
feupdateenv (&env);
/* And finally truncation with round to nearest. */
return (double) u.d;
}
EXPORT_C double
fma(double x, double y, double z)
{
#ifndef __SYMBIAN32__
static const double split = 0x1p27 + 1.0;
#else
static const double split = 134217729;
#endif //__SYMBIAN32__
double xs, ys, zs;
double c, cc, hx, hy, p, q, tx, ty;
double r, rr, s;
int oround;
int ex, ey, ez;
int spread;
if (z == 0.0)
return (x * y);
if (x == 0.0 || y == 0.0)
return (x * y + z);
/* Results of frexp() are undefined for these cases. */
if (!isfinite(x) || !isfinite(y) || !isfinite(z))
return (x * y + z);
xs = frexp(x, &ex);
ys = frexp(y, &ey);
zs = frexp(z, &ez);
oround = fegetround();
spread = ex + ey - ez;
/*
* If x * y and z are many orders of magnitude apart, the scaling
* will overflow, so we handle these cases specially. Rounding
* modes other than FE_TONEAREST are painful.
*/
if (spread > DBL_MANT_DIG * 2) {
fenv_t env;
feraiseexcept(FE_INEXACT);
switch(oround) {
case FE_TONEAREST:
return (x * y);
case FE_TOWARDZERO:
if (x > 0.0 ^ y < 0.0 ^ z < 0.0)
return (x * y);
feholdexcept(&env);
r = x * y;
if (!fetestexcept(FE_INEXACT))
r = nextafter(r, 0);
feupdateenv(&env);
return (r);
case FE_DOWNWARD:
if (z > 0.0)
return (x * y);
feholdexcept(&env);
r = x * y;
if (!fetestexcept(FE_INEXACT))
r = nextafter(r, -INFINITY);
feupdateenv(&env);
return (r);
default: /* FE_UPWARD */
if (z < 0.0)
return (x * y);
feholdexcept(&env);
r = x * y;
if (!fetestexcept(FE_INEXACT))
r = nextafter(r, INFINITY);
feupdateenv(&env);
return (r);
}
}
if (spread < -DBL_MANT_DIG) {
feraiseexcept(FE_INEXACT);
if (!isnormal(z))
feraiseexcept(FE_UNDERFLOW);
switch (oround) {
case FE_TONEAREST:
return (z);
case FE_TOWARDZERO:
if (x > 0.0 ^ y < 0.0 ^ z < 0.0)
return (z);
else
return (nextafter(z, 0));
case FE_DOWNWARD:
if (x > 0.0 ^ y < 0.0)
return (z);
else
return (nextafter(z, -INFINITY));
default: /* FE_UPWARD */
if (x > 0.0 ^ y < 0.0)
return (nextafter(z, INFINITY));
else
return (z);
}
}
/*
* Use Dekker's algorithm to perform the multiplication and
* subsequent addition in twice the machine precision.
* Arrange so that x * y = c + cc, and x * y + z = r + rr.
*/
fesetround(FE_TONEAREST);
p = xs * split;
hx = xs - p;
hx += p;
tx = xs - hx;
p = ys * split;
hy = ys - p;
hy += p;
ty = ys - hy;
p = hx * hy;
q = hx * ty + tx * hy;
c = p + q;
cc = p - c + q + tx * ty;
zs = ldexp(zs, -spread);
r = c + zs;
s = r - c;
rr = (c - (r - s)) + (zs - s) + cc;
spread = ex + ey;
if (spread + ilogb(r) > -1023) {
fesetround(oround);
r = r + rr;
} else {
/*
* The result is subnormal, so we round before scaling to
* avoid double rounding.
*/
#ifndef __SYMBIAN32__
p = ldexp(copysign(0x1p-1022, r), -spread);
#else
p = ldexp(copysign(0, r), -spread);
#endif //__SYMBIAN32__
c = r + p;
s = c - r;
cc = (r - (c - s)) + (p - s) + rr;
fesetround(oround);
r = (c + cc) - p;
}
return (ldexp(r, spread));
}
/*
* Test feholdexcept() and feupdateenv().
*
* Prerequisites: fetestexcept(), fegetround(), fesetround(),
* fedisableexcept(), feenableexcept()
*/
static void
test_feholdupdate(void)
{
fenv_t env;
struct sigaction act;
int except, i, pass, status, raise;
sigemptyset(&act.sa_mask);
act.sa_flags = 0;
act.sa_handler = trap_handler;
for (pass = 0; pass < 2; pass++) {
for (i = 0; i < NEXCEPTS; i++) {
except = std_excepts[i];
/* over/underflow may also raise inexact */
if (except == FE_INEXACT)
raise = FE_DIVBYZERO | FE_INVALID;
else
raise = ALL_STD_EXCEPT ^ except;
/*
* We need to fork a child process because
* there isn't a portable way to recover from
* a floating-point exception.
*/
switch(fork()) {
case 0: /* child */
/*
* We don't want to cause a fatal exception in
* the child until the second pass, so we can
* check other properties of feupdateenv().
*/
if (pass == 1)
assert((feenableexcept(except) &
ALL_STD_EXCEPT) == 0);
raiseexcept(raise);
assert(fesetround(FE_DOWNWARD) == 0);
assert(feholdexcept(&env) == 0);
assert(fetestexcept(FE_ALL_EXCEPT) == 0);
raiseexcept(except);
assert(fesetround(FE_UPWARD) == 0);
if (pass == 1)
assert(sigaction(SIGFPE, &act, NULL) ==
0);
assert(feupdateenv(&env) == 0);
assert(fegetround() == FE_DOWNWARD);
assert(fetestexcept(ALL_STD_EXCEPT) ==
(except | raise));
assert(pass == 0);
_exit(0);
default: /* parent */
assert(wait(&status) > 0);
/*
* Avoid assert() here so that it's possible
* to examine a failed child's core dump.
*/
if (!WIFEXITED(status))
errx(1, "child aborted\n");
assert(WEXITSTATUS(status) == 0);
break;
case -1: /* error */
assert(0);
}
}
}
assert(fetestexcept(FE_ALL_EXCEPT) == 0);
}
static void
feholdexcept_tests (void)
{
fenv_t saved, saved2;
int res;
feclearexcept (FE_ALL_EXCEPT);
fedisableexcept (FE_ALL_EXCEPT);
#ifdef FE_DIVBYZERO
feraiseexcept (FE_DIVBYZERO);
#endif
test_exceptions ("feholdexcept_tests FE_DIVBYZERO test",
DIVBYZERO_EXC, 0);
res = feholdexcept (&saved);
if (res != 0)
{
printf ("feholdexcept failed: %d\n", res);
++count_errors;
}
#if defined FE_TONEAREST && defined FE_TOWARDZERO
res = fesetround (FE_TOWARDZERO);
if (res != 0)
{
printf ("fesetround failed: %d\n", res);
++count_errors;
}
#endif
test_exceptions ("feholdexcept_tests 0 test", NO_EXC, 0);
#ifdef FE_INVALID
feraiseexcept (FE_INVALID);
test_exceptions ("feholdexcept_tests FE_INVALID test",
INVALID_EXC, 0);
#endif
res = feupdateenv (&saved);
if (res != 0)
{
printf ("feupdateenv failed: %d\n", res);
++count_errors;
}
#if defined FE_TONEAREST && defined FE_TOWARDZERO
res = fegetround ();
if (res != FE_TONEAREST)
{
printf ("feupdateenv didn't restore rounding mode: %d\n", res);
++count_errors;
}
#endif
test_exceptions ("feholdexcept_tests FE_DIVBYZERO|FE_INVALID test",
DIVBYZERO_EXC | INVALID_EXC, 0);
feclearexcept (FE_ALL_EXCEPT);
#ifdef FE_INVALID
feraiseexcept (FE_INVALID);
#endif
#if defined FE_TONEAREST && defined FE_UPWARD
res = fesetround (FE_UPWARD);
if (res != 0)
{
printf ("fesetround failed: %d\n", res);
++count_errors;
}
#endif
res = feholdexcept (&saved2);
if (res != 0)
{
printf ("feholdexcept failed: %d\n", res);
++count_errors;
}
#if defined FE_TONEAREST && defined FE_UPWARD
res = fesetround (FE_TONEAREST);
if (res != 0)
{
printf ("fesetround failed: %d\n", res);
++count_errors;
}
#endif
test_exceptions ("feholdexcept_tests 0 2nd test", NO_EXC, 0);
#ifdef FE_INEXACT
feraiseexcept (FE_INEXACT);
test_exceptions ("feholdexcept_tests FE_INEXACT test",
INEXACT_EXC, 0);
#endif
res = feupdateenv (&saved2);
if (res != 0)
{
printf ("feupdateenv failed: %d\n", res);
++count_errors;
}
#if defined FE_TONEAREST && defined FE_UPWARD
res = fegetround ();
if (res != FE_UPWARD)
{
printf ("feupdateenv didn't restore rounding mode: %d\n", res);
++count_errors;
}
fesetround (FE_TONEAREST);
#endif
test_exceptions ("feholdexcept_tests FE_INEXACT|FE_INVALID test",
INVALID_EXC | INEXACT_EXC, 0);
feclearexcept (FE_ALL_EXCEPT);
}
DLLEXPORT long double
sqrtl(long double x)
{
union IEEEl2bits u;
int k, r;
long double lo, xn;
fenv_t env;
u.e = x;
/* If x = NaN, then sqrt(x) = NaN. */
/* If x = Inf, then sqrt(x) = Inf. */
/* If x = -Inf, then sqrt(x) = NaN. */
if (u.bits.exp == LDBL_MAX_EXP * 2 - 1)
return (x * x + x);
/* If x = +-0, then sqrt(x) = +-0. */
if ((u.bits.manh | u.bits.manl | u.bits.exp) == 0)
return (x);
/* If x < 0, then raise invalid and return NaN */
if (u.bits.sign)
return ((x - x) / (x - x));
feholdexcept(&env);
if (u.bits.exp == 0) {
/* Adjust subnormal numbers. */
u.e *= 0x1.0p514;
k = -514;
} else {
k = 0;
}
/*
* u.e is a normal number, so break it into u.e = e*2^n where
* u.e = (2*e)*2^2k for odd n and u.e = (4*e)*2^2k for even n.
*/
if ((u.bits.exp - 0x3ffe) & 1) { /* n is odd. */
k += u.bits.exp - 0x3fff; /* 2k = n - 1. */
u.bits.exp = 0x3fff; /* u.e in [1,2). */
} else {
k += u.bits.exp - 0x4000; /* 2k = n - 2. */
u.bits.exp = 0x4000; /* u.e in [2,4). */
}
/*
* Newton's iteration.
* Split u.e into a high and low part to achieve additional precision.
*/
xn = sqrt(u.e); /* 53-bit estimate of sqrtl(x). */
#if LDBL_MANT_DIG > 100
xn = (xn + (u.e / xn)) * 0.5; /* 106-bit estimate. */
#endif
lo = u.e;
u.bits.manl = 0; /* Zero out lower bits. */
lo = (lo - u.e) / xn; /* Low bits divided by xn. */
xn = xn + (u.e / xn); /* High portion of estimate. */
u.e = xn + lo; /* Combine everything. */
u.bits.exp += (k >> 1) - 1;
feclearexcept(FE_INEXACT);
r = fegetround();
fesetround(FE_TOWARDZERO); /* Set to round-toward-zero. */
xn = x / u.e; /* Chopped quotient (inexact?). */
if (!fetestexcept(FE_INEXACT)) { /* Quotient is exact. */
if (xn == u.e) {
fesetenv(&env);
return (u.e);
}
/* Round correctly for inputs like x = y**2 - ulp. */
xn = dec(xn); /* xn = xn - ulp. */
}
if (r == FE_TONEAREST) {
xn = inc(xn); /* xn = xn + ulp. */
} else if (r == FE_UPWARD) {
u.e = inc(u.e); /* u.e = u.e + ulp. */
xn = inc(xn); /* xn = xn + ulp. */
}
u.e = u.e + xn; /* Chopped sum. */
feupdateenv(&env); /* Restore env and raise inexact */
u.bits.exp--;
return (u.e);
}
static __attribute__ ((noinline)) int
sse_tests (void)
{
int ret = 0;
fenv_t base_env;
if (fegetenv (&base_env) != 0)
{
puts ("fegetenv (&base_env) failed");
return 1;
}
if (fesetround (FE_UPWARD) != 0)
{
puts ("fesetround (FE_UPWARD) failed");
return 1;
}
if (fesetenv (&base_env) != 0)
{
puts ("fesetenv (&base_env) failed");
return 1;
}
volatile float a = 1.0f, b = FLT_MIN, c;
c = a + b;
if (c != 1.0f)
{
puts ("fesetenv did not restore rounding mode");
ret = 1;
}
if (fesetround (FE_DOWNWARD) != 0)
{
puts ("fesetround (FE_DOWNWARD) failed");
return 1;
}
if (feupdateenv (&base_env) != 0)
{
puts ("feupdateenv (&base_env) failed");
return 1;
}
volatile float d = -FLT_MIN, e;
e = a + d;
if (e != 1.0f)
{
puts ("feupdateenv did not restore rounding mode");
ret = 1;
}
if (fesetround (FE_UPWARD) != 0)
{
puts ("fesetround (FE_UPWARD) failed");
return 1;
}
fenv_t upward_env;
if (feholdexcept (&upward_env) != 0)
{
puts ("feholdexcept (&upward_env) failed");
return 1;
}
if (fesetround (FE_DOWNWARD) != 0)
{
puts ("fesetround (FE_DOWNWARD) failed");
return 1;
}
if (fesetenv (&upward_env) != 0)
{
puts ("fesetenv (&upward_env) failed");
return 1;
}
e = a + d;
if (e != 1.0f)
{
puts ("fesetenv did not restore rounding mode from feholdexcept");
ret = 1;
}
if (fesetround (FE_UPWARD) != 0)
{
puts ("fesetround (FE_UPWARD) failed");
return 1;
}
if (fesetenv (FE_DFL_ENV) != 0)
{
puts ("fesetenv (FE_DFL_ENV) failed");
return 1;
}
c = a + b;
if (c != 1.0f)
{
puts ("fesetenv (FE_DFL_ENV) did not restore rounding mode");
ret = 1;
}
return ret;
}
/*
* Fused multiply-add: Compute x * y + z with a single rounding error.
*
* We use scaling to avoid overflow/underflow, along with the
* canonical precision-doubling technique adapted from:
*
* Dekker, T. A Floating-Point Technique for Extending the
* Available Precision. Numer. Math. 18, 224-242 (1971).
*/
long double
fmal(long double x, long double y, long double z)
{
#if LDBL_MANT_DIG == 64
static const long double split = 0x1p32L + 1.0;
#elif LDBL_MANT_DIG == 113
static const long double split = 0x1p57L + 1.0;
#endif
long double xs, ys, zs;
long double c, cc, hx, hy, p, q, tx, ty;
long double r, rr, s;
int oround;
int ex, ey, ez;
int spread;
/*
* Handle special cases. The order of operations and the particular
* return values here are crucial in handling special cases involving
* infinities, NaNs, overflows, and signed zeroes correctly.
*/
if (x == 0.0 || y == 0.0)
return (x * y + z);
if (z == 0.0)
return (x * y);
if (!isfinite(x) || !isfinite(y))
return (x * y + z);
if (!isfinite(z))
return (z);
xs = frexpl(x, &ex);
ys = frexpl(y, &ey);
zs = frexpl(z, &ez);
oround = fegetround();
spread = ex + ey - ez;
/*
* If x * y and z are many orders of magnitude apart, the scaling
* will overflow, so we handle these cases specially. Rounding
* modes other than FE_TONEAREST are painful.
*/
if (spread > LDBL_MANT_DIG * 2) {
fenv_t env;
feraiseexcept(FE_INEXACT);
switch(oround) {
case FE_TONEAREST:
return (x * y);
case FE_TOWARDZERO:
if (x > 0.0 ^ y < 0.0 ^ z < 0.0)
return (x * y);
feholdexcept(&env);
r = x * y;
if (!fetestexcept(FE_INEXACT))
r = nextafterl(r, 0);
feupdateenv(&env);
return (r);
case FE_DOWNWARD:
if (z > 0.0)
return (x * y);
feholdexcept(&env);
r = x * y;
if (!fetestexcept(FE_INEXACT))
r = nextafterl(r, -INFINITY);
feupdateenv(&env);
return (r);
default: /* FE_UPWARD */
if (z < 0.0)
return (x * y);
feholdexcept(&env);
r = x * y;
if (!fetestexcept(FE_INEXACT))
r = nextafterl(r, INFINITY);
feupdateenv(&env);
return (r);
}
}
if (spread < -LDBL_MANT_DIG) {
feraiseexcept(FE_INEXACT);
if (!isnormal(z))
feraiseexcept(FE_UNDERFLOW);
switch (oround) {
case FE_TONEAREST:
return (z);
case FE_TOWARDZERO:
if (x > 0.0 ^ y < 0.0 ^ z < 0.0)
return (z);
else
return (nextafterl(z, 0));
case FE_DOWNWARD:
if (x > 0.0 ^ y < 0.0)
return (z);
else
return (nextafterl(z, -INFINITY));
default: /* FE_UPWARD */
if (x > 0.0 ^ y < 0.0)
return (nextafterl(z, INFINITY));
else
return (z);
}
}
/*
* Use Dekker's algorithm to perform the multiplication and
* subsequent addition in twice the machine precision.
* Arrange so that x * y = c + cc, and x * y + z = r + rr.
*/
fesetround(FE_TONEAREST);
p = xs * split;
hx = xs - p;
hx += p;
tx = xs - hx;
p = ys * split;
hy = ys - p;
hy += p;
ty = ys - hy;
p = hx * hy;
q = hx * ty + tx * hy;
c = p + q;
cc = p - c + q + tx * ty;
zs = ldexpl(zs, -spread);
r = c + zs;
s = r - c;
rr = (c - (r - s)) + (zs - s) + cc;
spread = ex + ey;
if (spread + ilogbl(r) > -16383) {
fesetround(oround);
r = r + rr;
} else {
/*
* The result is subnormal, so we round before scaling to
* avoid double rounding.
*/
p = ldexpl(copysignl(0x1p-16382L, r), -spread);
c = r + p;
s = c - r;
cc = (r - (c - s)) + (p - s) + rr;
fesetround(oround);
r = (c + cc) - p;
}
return (ldexpl(r, spread));
}
