Exemplo n.º 1
0
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
}
Exemplo n.º 2
0
double log_zerook (double x) 
{
	fenv_t fe;
	feholdexcept(&fe);
	x = log(x);
	feclearexcept(FE_OVERFLOW | FE_DIVBYZERO);
	feupdateenv(&fe);
	return x;
}
Exemplo n.º 3
0
/*
 * 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();
}
Exemplo n.º 5
0
/*
 * 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);
}
Exemplo n.º 6
0
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;
}
Exemplo n.º 7
0
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;
}
Exemplo n.º 8
0
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;
}
Exemplo n.º 9
0
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));
}
Exemplo n.º 10
0
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;
}
Exemplo n.º 11
0
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));
}
Exemplo n.º 12
0
/*
 * 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);
}
Exemplo n.º 13
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);
}
Exemplo n.º 14
0
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);
}
Exemplo n.º 15
0
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;
}
Exemplo n.º 16
0
/*
 * 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));
}