int
main (void)
{
long double x;
int y;
for (y = 0; y < 29; y++)
printf ("%5d %.16Lg %.16Lg\n", y, ldexpl (0.8L, y), ldexpl (0.8L, -y) * ldexpl (0.8L, y));
}
long double
hypotl (long double x, long double y)
{
if (isfinite (x) && isfinite (y))
{
/* Determine absolute values. */
x = fabsl (x);
y = fabsl (y);
{
/* Find the bigger and the smaller one. */
long double a;
long double b;
if (x >= y)
{
a = x;
b = y;
}
else
{
a = y;
b = x;
}
/* Now 0 <= b <= a. */
{
int e;
long double an;
long double bn;
/* Write a = an * 2^e, b = bn * 2^e with 0 <= bn <= an < 1. */
an = frexpl (a, &e);
bn = ldexpl (b, - e);
{
long double cn;
/* Through the normalization, no unneeded overflow or underflow
will occur here. */
cn = sqrtl (an * an + bn * bn);
return ldexpl (cn, e);
}
}
}
}
else
{
if (isinf (x) || isinf (y))
/* x or y is infinite. Return +Infinity. */
return HUGE_VALL;
else
/* x or y is NaN. Return NaN. */
return x + y;
}
}
/*
* Test whether csqrt(a + bi) works for inputs that are large enough to
* cause overflow in hypot(a, b) + a. In this case we are using
* csqrt(115 + 252*I) == 14 + 9*I
* scaled up to near MAX_EXP.
*/
static void
test_overflow(int maxexp)
{
long double a, b;
long double complex result;
a = ldexpl(115 * 0x1p-8, maxexp);
b = ldexpl(252 * 0x1p-8, maxexp);
result = t_csqrt(CMPLXL(a, b));
assert(creall(result) == ldexpl(14 * 0x1p-4, maxexp / 2));
assert(cimagl(result) == ldexpl(9 * 0x1p-4, maxexp / 2));
}
/*
* Test inputs very close to 0.
*/
static void
test_tiny(void)
{
float tiny = 0x1.23456p-120f;
testall(asin, tiny, tiny, FE_INEXACT);
testall(acos, tiny, pi / 2, FE_INEXACT);
testall(atan, tiny, tiny, FE_INEXACT);
testall(asin, -tiny, -tiny, FE_INEXACT);
testall(acos, -tiny, pi / 2, FE_INEXACT);
testall(atan, -tiny, -tiny, FE_INEXACT);
/* Test inputs to atan2() that would cause y/x to underflow. */
test2(atan2f, 0x1.0p-100, 0x1.0p100, 0.0, FE_INEXACT | FE_UNDERFLOW);
test2(atan2, 0x1.0p-1000, 0x1.0p1000, 0.0, FE_INEXACT | FE_UNDERFLOW);
test2(atan2l, ldexpl(1.0, 100 - LDBL_MAX_EXP),
ldexpl(1.0, LDBL_MAX_EXP - 100), 0.0, FE_INEXACT | FE_UNDERFLOW);
test2(atan2f, -0x1.0p-100, 0x1.0p100, -0.0, FE_INEXACT | FE_UNDERFLOW);
test2(atan2, -0x1.0p-1000, 0x1.0p1000, -0.0, FE_INEXACT | FE_UNDERFLOW);
test2(atan2l, -ldexpl(1.0, 100 - LDBL_MAX_EXP),
ldexpl(1.0, LDBL_MAX_EXP - 100), -0.0, FE_INEXACT | FE_UNDERFLOW);
test2(atan2f, 0x1.0p-100, -0x1.0p100, (float)pi, FE_INEXACT);
test2(atan2, 0x1.0p-1000, -0x1.0p1000, (double)pi, FE_INEXACT);
test2(atan2l, ldexpl(1.0, 100 - LDBL_MAX_EXP),
-ldexpl(1.0, LDBL_MAX_EXP - 100), pi, FE_INEXACT);
test2(atan2f, -0x1.0p-100, -0x1.0p100, (float)-pi, FE_INEXACT);
test2(atan2, -0x1.0p-1000, -0x1.0p1000, (double)-pi, FE_INEXACT);
test2(atan2l, -ldexpl(1.0, 100 - LDBL_MAX_EXP),
-ldexpl(1.0, LDBL_MAX_EXP - 100), -pi, FE_INEXACT);
}
/*
* Test very large inputs to atan().
*/
static void
test_atan_huge(void)
{
float huge = 0x1.23456p120;
testall(atan, huge, pi / 2, FE_INEXACT);
testall(atan, -huge, -pi / 2, FE_INEXACT);
/* Test inputs to atan2() that would cause y/x to overflow. */
test2(atan2f, 0x1.0p100, 0x1.0p-100, (float)pi / 2, FE_INEXACT);
test2(atan2, 0x1.0p1000, 0x1.0p-1000, (double)pi / 2, FE_INEXACT);
test2(atan2l, ldexpl(1.0, LDBL_MAX_EXP - 100),
ldexpl(1.0, 100 - LDBL_MAX_EXP), pi / 2, FE_INEXACT);
test2(atan2f, -0x1.0p100, 0x1.0p-100, (float)-pi / 2, FE_INEXACT);
test2(atan2, -0x1.0p1000, 0x1.0p-1000, (double)-pi / 2, FE_INEXACT);
test2(atan2l, -ldexpl(1.0, LDBL_MAX_EXP - 100),
ldexpl(1.0, 100 - LDBL_MAX_EXP), -pi / 2, FE_INEXACT);
test2(atan2f, 0x1.0p100, -0x1.0p-100, (float)pi / 2, FE_INEXACT);
test2(atan2, 0x1.0p1000, -0x1.0p-1000, (double)pi / 2, FE_INEXACT);
test2(atan2l, ldexpl(1.0, LDBL_MAX_EXP - 100),
-ldexpl(1.0, 100 - LDBL_MAX_EXP), pi / 2, FE_INEXACT);
test2(atan2f, -0x1.0p100, -0x1.0p-100, (float)-pi / 2, FE_INEXACT);
test2(atan2, -0x1.0p1000, -0x1.0p-1000, (double)-pi / 2, FE_INEXACT);
test2(atan2l, -ldexpl(1.0, LDBL_MAX_EXP - 100),
-ldexpl(1.0, 100 - LDBL_MAX_EXP), -pi / 2, FE_INEXACT);
}
void
run_log2_tests(void)
{
int i;
/*
* We should insist that log2() return exactly the correct
* result and not raise an inexact exception for powers of 2.
*/
feclearexcept(FE_ALL_EXCEPT);
for (i = FLT_MIN_EXP - FLT_MANT_DIG; i < FLT_MAX_EXP; i++) {
assert(log2f(ldexpf(1.0, i)) == i);
assert(fetestexcept(ALL_STD_EXCEPT) == 0);
}
for (i = DBL_MIN_EXP - DBL_MANT_DIG; i < DBL_MAX_EXP; i++) {
assert(log2(ldexp(1.0, i)) == i);
assert(fetestexcept(ALL_STD_EXCEPT) == 0);
}
for (i = LDBL_MIN_EXP - LDBL_MANT_DIG; i < LDBL_MAX_EXP; i++) {
assert(log2l(ldexpl(1.0, i)) == i);
#if 0
/* XXX This test does not pass yet. */
assert(fetestexcept(ALL_STD_EXCEPT) == 0);
#endif
}
}
cl_object
cl_scale_float(cl_object x, cl_object y)
{
const cl_env_ptr the_env = ecl_process_env();
cl_fixnum k;
if (ECL_FIXNUMP(y)) {
k = ecl_fixnum(y);
} else {
FEwrong_type_nth_arg(ecl_make_fixnum(/*SCALE-FLOAT*/737),2,y,ecl_make_fixnum(/*FIXNUM*/372));
}
switch (ecl_t_of(x)) {
case t_singlefloat:
x = ecl_make_single_float(ldexpf(ecl_single_float(x), k));
break;
case t_doublefloat:
x = ecl_make_double_float(ldexp(ecl_double_float(x), k));
break;
#ifdef ECL_LONG_FLOAT
case t_longfloat:
x = ecl_make_long_float(ldexpl(ecl_long_float(x), k));
break;
#endif
default:
FEwrong_type_nth_arg(ecl_make_fixnum(/*SCALE-FLOAT*/737),1,x,ecl_make_fixnum(/*FLOAT*/374));
}
ecl_return1(the_env, x);
}
/* A simple Newton-Raphson method. */
long double
sqrtl (long double x)
{
long double delta, y;
int exponent;
/* Check for NaN */
if (isnanl (x))
return x;
/* Check for negative numbers */
if (x < 0.0L)
return (long double) sqrt (-1);
/* Check for zero and infinites */
if (x + x == x)
return x;
frexpl (x, &exponent);
y = ldexpl (x, -exponent / 2);
do
{
delta = y;
y = (y + x / y) * 0.5L;
delta -= y;
}
while (delta != 0.0L);
return y;
}
long double
expl(long double x)
{
long double px, xx;
int n;
if( x > MAXLOGL)
return (huge*huge); /* overflow */
if( x < MINLOGL )
return (twom10000*twom10000); /* underflow */
/* Express e**x = e**g 2**n
* = e**g e**( n loge(2) )
* = e**( g + n loge(2) )
*/
px = floorl( LOG2EL * x + 0.5L ); /* floor() truncates toward -infinity. */
n = px;
x += px * C1;
x += px * C2;
/* rational approximation for exponential
* of the fractional part:
* e**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
*/
xx = x * x;
px = x * __polevll( xx, P, 4 );
xx = __polevll( xx, Q, 5 );
x = px/( xx - px );
x = 1.0L + x + x;
x = ldexpl( x, n );
return(x);
}
TEST(math, nexttowardl) {
ASSERT_DOUBLE_EQ(0.0L, nexttowardl(0.0L, 0.0L));
// Use a runtime value to accomodate the case when
// sizeof(double) == sizeof(long double)
long double smallest_positive = ldexpl(1.0L, LDBL_MIN_EXP - LDBL_MANT_DIG);
ASSERT_DOUBLE_EQ(smallest_positive, nexttowardl(0.0L, 1.0L));
ASSERT_DOUBLE_EQ(-smallest_positive, nexttowardl(0.0L, -1.0L));
}
void test_ldexp()
{
int ip = 1;
static_assert((std::is_same<decltype(ldexp((double)0, ip)), double>::value), "");
static_assert((std::is_same<decltype(ldexpf(0, ip)), float>::value), "");
static_assert((std::is_same<decltype(ldexpl(0, ip)), long double>::value), "");
assert(ldexp(1, ip) == 2);
}
cl_object
_ecl_long_double_to_integer(long double d0)
{
const int fb = FIXNUM_BITS - 3;
int e;
long double d = frexpl(d0, &e);
if (e <= fb) {
return ecl_make_fixnum((cl_fixnum)d0);
} else if (e > LDBL_MANT_DIG) {
return ecl_ash(_ecl_long_double_to_integer(ldexp(d, LDBL_MANT_DIG)),
e - LDBL_MANT_DIG);
} else {
long double d1 = floorl(d = ldexpl(d, fb));
int newe = e - fb;
cl_object o = ecl_ash(_ecl_long_double_to_integer(d1), newe);
long double d2 = ldexpl(d - d1, newe);
if (d2) o = ecl_plus(o, _ecl_long_double_to_integer(d2));
return o;
}
}
long double
_ecl_big_to_long_double(cl_object o)
{
long double output = 0;
int i, l = mpz_size(o->big.big_num), exp = 0;
for (i = 0; i < l; i++) {
output += ldexpl(mpz_getlimbn(o->big.big_num, i), exp);
exp += GMP_LIMB_BITS;
}
return (mpz_sgn(o->big.big_num) < 0)? -output : output;
}
/* use ldexpl routine in libc prototyped in math.h */
_f_real16
_SET_EXPONENT_16(_f_real16 a, _f_int4 i)
{
_f_int4 dummy;
_f_real16 aa;
if (a == 0.0) {
aa = 0.0;
} else {
aa = ldexpl(_get_frac_and_exp(a,&dummy),i);
}
return (aa);
}
static float_approx *
setup(cl_object number, float_approx *approx)
{
cl_object f = cl_integer_decode_float(number);
cl_fixnum e = ecl_fixnum(VALUES(1)), min_e;
bool limit_f = 0;
switch (ecl_t_of(number)) {
case t_singlefloat:
min_e = FLT_MIN_EXP;
limit_f = (number->SF.SFVAL ==
ldexpf(FLT_RADIX, FLT_MANT_DIG-1));
break;
case t_doublefloat:
min_e = DBL_MIN_EXP;
limit_f = (number->DF.DFVAL ==
ldexp(FLT_RADIX, DBL_MANT_DIG-1));
break;
#ifdef ECL_LONG_FLOAT
case t_longfloat:
min_e = LDBL_MIN_EXP;
limit_f = (number->longfloat.value ==
ldexpl(FLT_RADIX, LDBL_MANT_DIG-1));
#endif
}
approx->low_ok = approx->high_ok = ecl_evenp(f);
if (e > 0) {
cl_object be = EXPT_RADIX(e);
if (limit_f) {
cl_object be1 = ecl_times(be, ecl_make_fixnum(FLT_RADIX));
approx->r = times2(ecl_times(f, be1));
approx->s = ecl_make_fixnum(FLT_RADIX*2);
approx->mm = be;
approx->mp = be1;
} else {
approx->r = times2(ecl_times(f, be));
approx->s = ecl_make_fixnum(2);
approx->mm = be;
approx->mp = be;
}
} else if (!limit_f || (e == min_e)) {
approx->r = times2(f);
approx->s = times2(EXPT_RADIX(-e));
approx->mp = ecl_make_fixnum(1);
approx->mm = ecl_make_fixnum(1);
} else {
approx->r = times2(ecl_make_fixnum(FLT_RADIX));
approx->s = times2(EXPT_RADIX(1-e));
approx->mp = ecl_make_fixnum(FLT_RADIX);
approx->mm = ecl_make_fixnum(1);
}
return approx;
}
long double
expm1l(long double x)
{
long double px, qx, xx;
int k;
/* Overflow. */
if (x > MAXLOGL)
return (huge*huge); /* overflow */
if (x == 0.0)
return x;
/* Minimum value. */
if (x < minarg)
return -1.0L;
xx = C1 + C2;
/* Express x = ln 2 (k + remainder), remainder not exceeding 1/2. */
px = floorl (0.5 + x / xx);
k = px;
/* remainder times ln 2 */
x -= px * C1;
x -= px * C2;
/* Approximate exp(remainder ln 2). */
px = (((( P4 * x
+ P3) * x
+ P2) * x
+ P1) * x
+ P0) * x;
qx = (((( x
+ Q4) * x
+ Q3) * x
+ Q2) * x
+ Q1) * x
+ Q0;
xx = x * x;
qx = x + (0.5 * xx + xx * px / qx);
/* exp(x) = exp(k ln 2) exp(remainder ln 2) = 2^k exp(remainder ln 2).
We have qx = exp(remainder ln 2) - 1, so
exp(x) - 1 = 2^k (qx + 1) - 1 = 2^k qx + 2^k - 1. */
px = ldexpl(1.0L, k);
x = px * qx + (px - 1.0);
return x;
}
static long double
ratio_to_long_double(cl_object num, cl_object den)
{
cl_fixnum scale;
cl_object bits = prepare_ratio_to_float(num, den, LDBL_MANT_DIG, &scale);
#if (FIXNUM_BITS-ECL_TAG_BITS) >= LDBL_MANT_DIG
/* The output of prepare_ratio_to_float will always fit an integer */
long double output = ecl_fixnum(bits);
#else
long double output = ECL_FIXNUMP(bits)?
(long double)ecl_fixnum(bits) :
_ecl_big_to_long_double(bits);
#endif
return ldexpl(output, scale);
}
GFC_REAL_10
spacing_r10 (GFC_REAL_10 s, int p, int emin, GFC_REAL_10 tiny)
{
int e;
if (s == 0.)
return tiny;
frexpl (s, &e);
e = e - p;
e = e > emin ? e : emin;
#if defined (HAVE_LDEXPL)
return ldexpl (1., e);
#else
return scalbnl (1., e);
#endif
}
long double
expl(long double x)
{
long double px, xx;
int n;
if( isnan(x) )
return(x);
if( x > MAXLOGL)
return( INFINITY );
if( x < MINLOGL )
return(0.0L);
/* Express e**x = e**g 2**n
* = e**g e**( n loge(2) )
* = e**( g + n loge(2) )
*/
px = floorl( LOG2EL * x + 0.5L ); /* floor() truncates toward -infinity. */
n = px;
x -= px * C1;
x -= px * C2;
/* rational approximation for exponential
* of the fractional part:
* e**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
*/
xx = x * x;
px = x * __polevll( xx, P, 2 );
x = px/( __polevll( xx, Q, 3 ) - px );
x = 1.0L + ldexpl( x, 1 );
x = ldexpl( x, n );
return(x);
}
////////////////////////////////////////////////////////////////////////////////
// static long double Duplication_Formula(long double two_x) //
// //
// Description: //
// This function returns the Gamma(two_x) using the duplication formula //
// Gamma(2x) = (2^(2x-1) / sqrt(pi)) Gamma(x) Gamma(x+1/2). //
// //
// Arguments: //
// none //
// //
// Return Values: //
// Gamma(two_x) //
// //
// Example: //
// long double two_x, g; //
// //
// g = Duplication_Formula(two_x); //
////////////////////////////////////////////////////////////////////////////////
static long double Duplication_Formula( long double two_x )
{
long double x = 0.5L * two_x;
long double g;
double two_n = 1.0;
int n = (int) two_x - 1;
g = powl(2.0L, two_x - 1.0L - (long double) n);
g = ldexpl(g,n);
g /= sqrt(pi);
g *= xGamma_Function(x);
g *= xGamma_Function(x + 0.5L);
return g;
}
GFC_REAL_10
rrspacing_r10 (GFC_REAL_10 s, int p)
{
int e;
GFC_REAL_10 x;
x = fabsl (s);
if (x == 0.)
return 0.;
frexpl (s, &e);
#if defined (HAVE_LDEXPL)
return ldexpl (x, p - e);
#else
return scalbnl (x, p - e);
#endif
}
/*
* Return a real with the same type parameter as X whose value is the
* absolute spacing of the model number near X, that is, b**(e-p).
*/
_f_real16
_SPACING_16(_f_real16 a)
{
_f_int4 e;
_f_real16 f;
if (a == 0) {
e = -916;
} else {
(void) _get_frac_and_exp(a,&e);
}
e = e - DBL_DBL_MANT_BITS;
/* Unfortunately, (in Fortran) -1021 is too small. The
* constant -916 is hard-wired to maintain full precision.
*/
if (e < -916)
e = -916;
/* use ldexpl routine in libc prototyped in math.h */
f = ldexpl(1.0L,e);
return(f);
}
int
main()
{
#if N & 1
long double value = 0;
#else
double value = 0;
#endif
#if N < 5
int exp = 0;
#endif
#if N == 1
return ldexpl(value, exp) != 0;
#endif
#if N == 2
return ldexp(value, exp) != 0;
#endif
#if N == 3
return frexpl(value, &exp) != 0;
#endif
#if N == 4
return frexp(value, &exp) != 0;
#endif
#if N == 5
return isnan(value);
#endif
#if N == 6
return isnan(value);
#endif
#if N == 7
return copysign(1.0, value) < 0;
#endif
#if N == 8
return signbit(value);
#endif
}
void
run_exp2_tests(void)
{
int i;
/*
* We should insist that exp2() return exactly the correct
* result and not raise an inexact exception for integer
* arguments.
*/
feclearexcept(FE_ALL_EXCEPT);
for (i = FLT_MIN_EXP - FLT_MANT_DIG; i < FLT_MAX_EXP; i++) {
assert(exp2f(i) == ldexpf(1.0, i));
assert(fetestexcept(ALL_STD_EXCEPT) == 0);
}
for (i = DBL_MIN_EXP - DBL_MANT_DIG; i < DBL_MAX_EXP; i++) {
assert(exp2(i) == ldexp(1.0, i));
assert(fetestexcept(ALL_STD_EXCEPT) == 0);
}
for (i = LDBL_MIN_EXP - LDBL_MANT_DIG; i < LDBL_MAX_EXP; i++) {
assert(exp2l(i) == ldexpl(1.0, i));
assert(fetestexcept(ALL_STD_EXCEPT) == 0);
}
}
ATF_TC_BODY(fpclassify_long_double, tc)
{
long double d0, d1, d2, f, ip;
int e, i;
d0 = LDBL_MIN;
ATF_REQUIRE_EQ(fpclassify(d0), FP_NORMAL);
f = frexpl(d0, &e);
ATF_REQUIRE_EQ(e, LDBL_MIN_EXP);
ATF_REQUIRE_EQ(f, 0.5);
d1 = d0;
/* shift a "1" bit through the mantissa (skip the implicit bit) */
for (i = 1; i < LDBL_MANT_DIG; i++) {
d1 /= 2;
ATF_REQUIRE_EQ(fpclassify(d1), FP_SUBNORMAL);
ATF_REQUIRE(d1 > 0 && d1 < d0);
d2 = ldexpl(d0, -i);
ATF_REQUIRE_EQ(d2, d1);
d2 = modfl(d1, &ip);
ATF_REQUIRE_EQ(d2, d1);
ATF_REQUIRE_EQ(ip, 0);
f = frexpl(d1, &e);
ATF_REQUIRE_EQ(e, LDBL_MIN_EXP - i);
ATF_REQUIRE_EQ(f, 0.5);
}
d1 /= 2;
ATF_REQUIRE_EQ(fpclassify(d1), FP_ZERO);
f = frexpl(d1, &e);
ATF_REQUIRE_EQ(e, 0);
ATF_REQUIRE_EQ(f, 0);
}
longdouble strtold_dm(const char *p,char **endp)
{
longdouble ldval;
int exp;
long long msdec,lsdec;
unsigned long msscale;
char dot,sign;
int pow;
int ndigits;
const char *pinit = p;
static char infinity[] = "infinity";
static char nans[] = "nans";
unsigned int old_cw;
unsigned int old_status;
#if _WIN32 && __DMC__
fenv_t flagp;
fegetenv(&flagp); /* Store all exceptions, and current status word */
if (_8087)
{
// disable exceptions from occurring, set max precision, and round to nearest
#if __DMC__
__asm
{
fstcw word ptr old_cw
mov EAX,old_cw
mov ECX,EAX
and EAX,0xf0c0
or EAX,033fh
mov old_cw,EAX
fldcw word ptr old_cw
mov old_cw,ECX
}
#else
old_cw = _control87(_MCW_EM | _PC_64 | _RC_NEAR,
_MCW_EM | _MCW_PC | _MCW_RC);
#endif
}
#endif
while (isspace(*p))
p++;
sign = 0; /* indicating + */
switch (*p)
{ case '-':
sign++;
/* FALL-THROUGH */
case '+':
p++;
}
ldval = 0.0;
dot = 0; /* if decimal point has been seen */
exp = 0;
msdec = lsdec = 0;
msscale = 1;
ndigits = 0;
#if __DMC__
switch (*p)
{ case 'i':
case 'I':
if (memicmp(p,infinity,8) == 0)
{ p += 8;
goto L4;
}
if (memicmp(p,infinity,3) == 0) /* is it "inf"? */
{ p += 3;
L4:
ldval = HUGE_VAL;
goto L3;
}
break;
case 'n':
case 'N':
if (memicmp(p,nans,4) == 0) /* "nans"? */
{ p += 4;
ldval = NANS;
goto L5;
}
if (memicmp(p,nans,3) == 0) /* "nan"? */
{ p += 3;
ldval = NAN;
L5:
if (*p == '(') /* if (n-char-sequence) */
goto Lerr; /* invalid input */
goto L3;
}
}
#endif
if (*p == '0' && (p[1] == 'x' || p[1] == 'X'))
{ int guard = 0;
int anydigits = 0;
p += 2;
while (1)
{ int i = *p;
while (isxdigit(i))
{
anydigits = 1;
i = isalpha(i) ? ((i & ~0x20) - ('A' - 10)) : i - '0';
if (ndigits < 16)
{
msdec = msdec * 16 + i;
if (msdec)
ndigits++;
}
else if (ndigits == 16)
{
while (msdec >= 0)
{
exp--;
msdec <<= 1;
i <<= 1;
if (i & 0x10)
msdec |= 1;
}
guard = i << 4;
ndigits++;
exp += 4;
}
else
{
guard |= i;
exp += 4;
}
exp -= dot;
i = *++p;
}
#if _WIN32 && __DMC__
if (i == *__locale_decpoint && !dot)
#else
if (i == '.' && !dot)
#endif
{ p++;
dot = 4;
}
else
break;
}
// Round up if (guard && (sticky || odd))
if (guard & 0x80 && (guard & 0x7F || msdec & 1))
{
msdec++;
if (msdec == 0) // overflow
{ msdec = 0x8000000000000000LL;
exp++;
}
}
if (anydigits == 0) // if error (no digits seen)
goto Lerr;
if (*p == 'p' || *p == 'P')
{
char sexp;
int e;
sexp = 0;
switch (*++p)
{ case '-': sexp++;
case '+': p++;
}
ndigits = 0;
e = 0;
while (isdigit(*p))
{
if (e < 0x7FFFFFFF / 10 - 10) // prevent integer overflow
{
e = e * 10 + *p - '0';
}
p++;
ndigits = 1;
}
exp += (sexp) ? -e : e;
if (!ndigits) // if no digits in exponent
goto Lerr;
if (msdec)
{
#if __DMC__
// The 8087 has no instruction to load an
// unsigned long long
if (msdec < 0)
{
*(long long *)&ldval = msdec;
((unsigned short *)&ldval)[4] = 0x3FFF + 63;
}
else
{ // But does for a signed one
__asm
{
fild qword ptr msdec
fstp tbyte ptr ldval
}
}
#else
int e2 = 0x3FFF + 63;
// left justify mantissa
while (msdec >= 0)
{ msdec <<= 1;
e2--;
}
// Stuff mantissa directly into long double
*(long long *)&ldval = msdec;
((unsigned short *)&ldval)[4] = e2;
#endif
#if 0
if (0)
{ int i;
printf("msdec = x%llx, ldval = %Lg\n", msdec, ldval);
for (i = 0; i < 5; i++)
printf("%04x ",((unsigned short *)&ldval)[i]);
printf("\n");
printf("%llx\n",ldval);
}
#endif
// Exponent is power of 2, not power of 10
#if _WIN32 && __DMC__
__asm
{
fild dword ptr exp
fld tbyte ptr ldval
fscale // ST(0) = ST(0) * (2**ST(1))
fstp ST(1)
fstp tbyte ptr ldval
}
#else
ldval = ldexpl(ldval,exp);
#endif
}
goto L6;
}
long double
log10l(long double x)
{
long double y;
volatile long double z;
int e;
if( isnan(x) )
return(x);
/* Test for domain */
if( x <= 0.0L )
{
if( x == 0.0L )
return (-1.0L / (x - x));
else
return (x - x) / (x - x);
}
if( x == INFINITY )
return(INFINITY);
/* separate mantissa from exponent */
/* Note, frexp is used so that denormal numbers
* will be handled properly.
*/
x = frexpl( x, &e );
/* logarithm using log(x) = z + z**3 P(z)/Q(z),
* where z = 2(x-1)/x+1)
*/
if( (e > 2) || (e < -2) )
{
if( x < SQRTH )
{ /* 2( 2x-1 )/( 2x+1 ) */
e -= 1;
z = x - 0.5L;
y = 0.5L * z + 0.5L;
}
else
{ /* 2 (x-1)/(x+1) */
z = x - 0.5L;
z -= 0.5L;
y = 0.5L * x + 0.5L;
}
x = z / y;
z = x*x;
y = x * ( z * __polevll( z, R, 3 ) / __p1evll( z, S, 3 ) );
goto done;
}
/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
if( x < SQRTH )
{
e -= 1;
x = ldexpl( x, 1 ) - 1.0L; /* 2x - 1 */
}
else
{
x = x - 1.0L;
}
z = x*x;
y = x * ( z * __polevll( x, P, 6 ) / __p1evll( x, Q, 7 ) );
y = y - ldexpl( z, -1 ); /* -0.5x^2 + ... */
done:
/* Multiply log of fraction by log10(e)
* and base 2 exponent by log10(2).
*
* ***CAUTION***
*
* This sequence of operations is critical and it may
* be horribly defeated by some compiler optimizers.
*/
z = y * (L10EB);
z += x * (L10EB);
z += e * (L102B);
z += y * (L10EA);
z += x * (L10EA);
z += e * (L102A);
return( z );
}
long double frexpl(long double x, int *exponent)
{
*exponent = (int)ceill(log2(x));
return x / ldexpl(1.0, *exponent);
}
void
domathl (void)
{
#ifndef NO_LONG_DOUBLE
long double f1;
long double f2;
int i1;
f1 = acosl(0.0);
fprintf( stdout, "acosl : %Lf\n", f1);
f1 = acoshl(0.0);
fprintf( stdout, "acoshl : %Lf\n", f1);
f1 = asinl(1.0);
fprintf( stdout, "asinl : %Lf\n", f1);
f1 = asinhl(1.0);
fprintf( stdout, "asinhl : %Lf\n", f1);
f1 = atanl(M_PI_4);
fprintf( stdout, "atanl : %Lf\n", f1);
f1 = atan2l(2.3, 2.3);
fprintf( stdout, "atan2l : %Lf\n", f1);
f1 = atanhl(1.0);
fprintf( stdout, "atanhl : %Lf\n", f1);
f1 = cbrtl(27.0);
fprintf( stdout, "cbrtl : %Lf\n", f1);
f1 = ceill(3.5);
fprintf( stdout, "ceill : %Lf\n", f1);
f1 = copysignl(3.5, -2.5);
fprintf( stdout, "copysignl : %Lf\n", f1);
f1 = cosl(M_PI_2);
fprintf( stdout, "cosl : %Lf\n", f1);
f1 = coshl(M_PI_2);
fprintf( stdout, "coshl : %Lf\n", f1);
f1 = erfl(42.0);
fprintf( stdout, "erfl : %Lf\n", f1);
f1 = erfcl(42.0);
fprintf( stdout, "erfcl : %Lf\n", f1);
f1 = expl(0.42);
fprintf( stdout, "expl : %Lf\n", f1);
f1 = exp2l(0.42);
fprintf( stdout, "exp2l : %Lf\n", f1);
f1 = expm1l(0.00042);
fprintf( stdout, "expm1l : %Lf\n", f1);
f1 = fabsl(-1.123);
fprintf( stdout, "fabsl : %Lf\n", f1);
f1 = fdiml(1.123, 2.123);
fprintf( stdout, "fdiml : %Lf\n", f1);
f1 = floorl(0.5);
fprintf( stdout, "floorl : %Lf\n", f1);
f1 = floorl(-0.5);
fprintf( stdout, "floorl : %Lf\n", f1);
f1 = fmal(2.1, 2.2, 3.01);
fprintf( stdout, "fmal : %Lf\n", f1);
f1 = fmaxl(-0.42, 0.42);
fprintf( stdout, "fmaxl : %Lf\n", f1);
f1 = fminl(-0.42, 0.42);
fprintf( stdout, "fminl : %Lf\n", f1);
f1 = fmodl(42.0, 3.0);
fprintf( stdout, "fmodl : %Lf\n", f1);
/* no type-specific variant */
i1 = fpclassify(1.0);
fprintf( stdout, "fpclassify : %d\n", i1);
f1 = frexpl(42.0, &i1);
fprintf( stdout, "frexpl : %Lf\n", f1);
f1 = hypotl(42.0, 42.0);
fprintf( stdout, "hypotl : %Lf\n", f1);
i1 = ilogbl(42.0);
fprintf( stdout, "ilogbl : %d\n", i1);
/* no type-specific variant */
i1 = isfinite(3.0);
fprintf( stdout, "isfinite : %d\n", i1);
/* no type-specific variant */
i1 = isgreater(3.0, 3.1);
fprintf( stdout, "isgreater : %d\n", i1);
/* no type-specific variant */
i1 = isgreaterequal(3.0, 3.1);
fprintf( stdout, "isgreaterequal : %d\n", i1);
/* no type-specific variant */
i1 = isinf(3.0);
fprintf( stdout, "isinf : %d\n", i1);
/* no type-specific variant */
i1 = isless(3.0, 3.1);
fprintf( stdout, "isless : %d\n", i1);
/* no type-specific variant */
i1 = islessequal(3.0, 3.1);
fprintf( stdout, "islessequal : %d\n", i1);
/* no type-specific variant */
i1 = islessgreater(3.0, 3.1);
fprintf( stdout, "islessgreater : %d\n", i1);
/* no type-specific variant */
i1 = isnan(0.0);
fprintf( stdout, "isnan : %d\n", i1);
/* no type-specific variant */
i1 = isnormal(3.0);
fprintf( stdout, "isnormal : %d\n", i1);
/* no type-specific variant */
f1 = isunordered(1.0, 2.0);
fprintf( stdout, "isunordered : %d\n", i1);
f1 = j0l(1.2);
fprintf( stdout, "j0l : %Lf\n", f1);
f1 = j1l(1.2);
fprintf( stdout, "j1l : %Lf\n", f1);
f1 = jnl(2,1.2);
fprintf( stdout, "jnl : %Lf\n", f1);
f1 = ldexpl(1.2,3);
fprintf( stdout, "ldexpl : %Lf\n", f1);
f1 = lgammal(42.0);
fprintf( stdout, "lgammal : %Lf\n", f1);
f1 = llrintl(-0.5);
fprintf( stdout, "llrintl : %Lf\n", f1);
f1 = llrintl(0.5);
fprintf( stdout, "llrintl : %Lf\n", f1);
f1 = llroundl(-0.5);
fprintf( stdout, "lroundl : %Lf\n", f1);
f1 = llroundl(0.5);
fprintf( stdout, "lroundl : %Lf\n", f1);
f1 = logl(42.0);
fprintf( stdout, "logl : %Lf\n", f1);
f1 = log10l(42.0);
fprintf( stdout, "log10l : %Lf\n", f1);
f1 = log1pl(42.0);
fprintf( stdout, "log1pl : %Lf\n", f1);
f1 = log2l(42.0);
fprintf( stdout, "log2l : %Lf\n", f1);
f1 = logbl(42.0);
fprintf( stdout, "logbl : %Lf\n", f1);
f1 = lrintl(-0.5);
fprintf( stdout, "lrintl : %Lf\n", f1);
f1 = lrintl(0.5);
fprintf( stdout, "lrintl : %Lf\n", f1);
f1 = lroundl(-0.5);
fprintf( stdout, "lroundl : %Lf\n", f1);
f1 = lroundl(0.5);
fprintf( stdout, "lroundl : %Lf\n", f1);
f1 = modfl(42.0,&f2);
fprintf( stdout, "lmodfl : %Lf\n", f1);
f1 = nanl("");
fprintf( stdout, "nanl : %Lf\n", f1);
f1 = nearbyintl(1.5);
fprintf( stdout, "nearbyintl : %Lf\n", f1);
f1 = nextafterl(1.5,2.0);
fprintf( stdout, "nextafterl : %Lf\n", f1);
f1 = powl(3.01, 2.0);
fprintf( stdout, "powl : %Lf\n", f1);
f1 = remainderl(3.01,2.0);
fprintf( stdout, "remainderl : %Lf\n", f1);
f1 = remquol(29.0,3.0,&i1);
fprintf( stdout, "remquol : %Lf\n", f1);
f1 = rintl(0.5);
fprintf( stdout, "rintl : %Lf\n", f1);
f1 = rintl(-0.5);
fprintf( stdout, "rintl : %Lf\n", f1);
f1 = roundl(0.5);
fprintf( stdout, "roundl : %Lf\n", f1);
f1 = roundl(-0.5);
fprintf( stdout, "roundl : %Lf\n", f1);
f1 = scalblnl(1.2,3);
fprintf( stdout, "scalblnl : %Lf\n", f1);
f1 = scalbnl(1.2,3);
fprintf( stdout, "scalbnl : %Lf\n", f1);
/* no type-specific variant */
i1 = signbit(1.0);
fprintf( stdout, "signbit : %i\n", i1);
f1 = sinl(M_PI_4);
fprintf( stdout, "sinl : %Lf\n", f1);
f1 = sinhl(M_PI_4);
fprintf( stdout, "sinhl : %Lf\n", f1);
f1 = sqrtl(9.0);
fprintf( stdout, "sqrtl : %Lf\n", f1);
f1 = tanl(M_PI_4);
fprintf( stdout, "tanl : %Lf\n", f1);
f1 = tanhl(M_PI_4);
fprintf( stdout, "tanhl : %Lf\n", f1);
f1 = tgammal(2.1);
fprintf( stdout, "tgammal : %Lf\n", f1);
f1 = truncl(3.5);
fprintf( stdout, "truncl : %Lf\n", f1);
f1 = y0l(1.2);
fprintf( stdout, "y0l : %Lf\n", f1);
f1 = y1l(1.2);
fprintf( stdout, "y1l : %Lf\n", f1);
f1 = ynl(3,1.2);
fprintf( stdout, "ynl : %Lf\n", f1);
#endif
}
int
main(int argc, char *argv[])
{
static const int ex_under = FE_UNDERFLOW | FE_INEXACT; /* shorthand */
static const int ex_over = FE_OVERFLOW | FE_INEXACT;
long double ldbl_small, ldbl_eps, ldbl_max;
printf("1..5\n");
#ifdef __i386__
fpsetprec(FP_PE);
#endif
/*
* We can't use a compile-time constant here because gcc on
* FreeBSD/i386 assumes long doubles are truncated to the
* double format.
*/
ldbl_small = ldexpl(1.0, LDBL_MIN_EXP - LDBL_MANT_DIG);
ldbl_eps = LDBL_EPSILON;
ldbl_max = ldexpl(1.0 - ldbl_eps / 2, LDBL_MAX_EXP);
/*
* Special cases involving zeroes.
*/
#define ztest(prec) \
test##prec(copysign##prec(1.0, nextafter##prec(0.0, -0.0)), -1.0, 0); \
test##prec(copysign##prec(1.0, nextafter##prec(-0.0, 0.0)), 1.0, 0); \
test##prec(copysign##prec(1.0, nexttoward##prec(0.0, -0.0)), -1.0, 0);\
test##prec(copysign##prec(1.0, nexttoward##prec(-0.0, 0.0)), 1.0, 0)
ztest();
ztest(f);
ztest(l);
#undef ztest
#define stest(next, eps, prec) \
test##prec(next(-0.0, 42.0), eps, ex_under); \
test##prec(next(0.0, -42.0), -eps, ex_under); \
test##prec(next(0.0, INFINITY), eps, ex_under); \
test##prec(next(-0.0, -INFINITY), -eps, ex_under)
stest(nextafter, 0x1p-1074, );
stest(nextafterf, 0x1p-149f, f);
stest(nextafterl, ldbl_small, l);
stest(nexttoward, 0x1p-1074, );
stest(nexttowardf, 0x1p-149f, f);
stest(nexttowardl, ldbl_small, l);
#undef stest
printf("ok 1 - next\n");
/*
* `x == y' and NaN tests
*/
testall(42.0, 42.0, 42.0, 0);
testall(-42.0, -42.0, -42.0, 0);
testall(INFINITY, INFINITY, INFINITY, 0);
testall(-INFINITY, -INFINITY, -INFINITY, 0);
testall(NAN, 42.0, NAN, 0);
testall(42.0, NAN, NAN, 0);
testall(NAN, NAN, NAN, 0);
printf("ok 2 - next\n");
/*
* Tests where x is an ordinary normalized number
*/
testboth(1.0, 2.0, 1.0 + DBL_EPSILON, 0, );
testboth(1.0, -INFINITY, 1.0 - DBL_EPSILON/2, 0, );
testboth(1.0, 2.0, 1.0 + FLT_EPSILON, 0, f);
testboth(1.0, -INFINITY, 1.0 - FLT_EPSILON/2, 0, f);
testboth(1.0, 2.0, 1.0 + ldbl_eps, 0, l);
testboth(1.0, -INFINITY, 1.0 - ldbl_eps/2, 0, l);
testboth(-1.0, 2.0, -1.0 + DBL_EPSILON/2, 0, );
testboth(-1.0, -INFINITY, -1.0 - DBL_EPSILON, 0, );
testboth(-1.0, 2.0, -1.0 + FLT_EPSILON/2, 0, f);
testboth(-1.0, -INFINITY, -1.0 - FLT_EPSILON, 0, f);
testboth(-1.0, 2.0, -1.0 + ldbl_eps/2, 0, l);
testboth(-1.0, -INFINITY, -1.0 - ldbl_eps, 0, l);
/* Cases where nextafter(...) != nexttoward(...) */
test(nexttoward(1.0, 1.0 + ldbl_eps), 1.0 + DBL_EPSILON, 0);
testf(nexttowardf(1.0, 1.0 + ldbl_eps), 1.0 + FLT_EPSILON, 0);
testl(nexttowardl(1.0, 1.0 + ldbl_eps), 1.0 + ldbl_eps, 0);
printf("ok 3 - next\n");
/*
* Tests at word boundaries, normalization boundaries, etc.
*/
testboth(0x1.87654ffffffffp+0, INFINITY, 0x1.87655p+0, 0, );
testboth(0x1.87655p+0, -INFINITY, 0x1.87654ffffffffp+0, 0, );
testboth(0x1.fffffffffffffp+0, INFINITY, 0x1p1, 0, );
testboth(0x1p1, -INFINITY, 0x1.fffffffffffffp+0, 0, );
testboth(0x0.fffffffffffffp-1022, INFINITY, 0x1p-1022, 0, );
testboth(0x1p-1022, -INFINITY, 0x0.fffffffffffffp-1022, ex_under, );
testboth(0x1.fffffep0f, INFINITY, 0x1p1, 0, f);
testboth(0x1p1, -INFINITY, 0x1.fffffep0f, 0, f);
testboth(0x0.fffffep-126f, INFINITY, 0x1p-126f, 0, f);
testboth(0x1p-126f, -INFINITY, 0x0.fffffep-126f, ex_under, f);
#if LDBL_MANT_DIG == 53
testboth(0x1.87654ffffffffp+0L, INFINITY, 0x1.87655p+0L, 0, l);
testboth(0x1.87655p+0L, -INFINITY, 0x1.87654ffffffffp+0L, 0, l);
testboth(0x1.fffffffffffffp+0L, INFINITY, 0x1p1L, 0, l);
testboth(0x1p1L, -INFINITY, 0x1.fffffffffffffp+0L, 0, l);
testboth(0x0.fffffffffffffp-1022L, INFINITY, 0x1p-1022L, 0, l);
testboth(0x1p-1022L, -INFINITY, 0x0.fffffffffffffp-1022L, ex_under, l);
#elif LDBL_MANT_DIG == 64 && !defined(__i386)
testboth(0x1.87654321fffffffep+0L, INFINITY, 0x1.87654322p+0L, 0, l);
testboth(0x1.87654322p+0L, -INFINITY, 0x1.87654321fffffffep+0L, 0, l);
testboth(0x1.fffffffffffffffep0L, INFINITY, 0x1p1L, 0, l);
testboth(0x1p1L, -INFINITY, 0x1.fffffffffffffffep0L, 0, l);
testboth(0x0.fffffffffffffffep-16382L, INFINITY, 0x1p-16382L, 0, l);
testboth(0x1p-16382L, -INFINITY,
0x0.fffffffffffffffep-16382L, ex_under, l);
#elif LDBL_MANT_DIG == 113
testboth(0x1.876543210987ffffffffffffffffp+0L, INFINITY,
0x1.876543210988p+0, 0, l);
testboth(0x1.876543210988p+0L, -INFINITY,
0x1.876543210987ffffffffffffffffp+0L, 0, l);
testboth(0x1.ffffffffffffffffffffffffffffp0L, INFINITY, 0x1p1L, 0, l);
testboth(0x1p1L, -INFINITY, 0x1.ffffffffffffffffffffffffffffp0L, 0, l);
testboth(0x0.ffffffffffffffffffffffffffffp-16382L, INFINITY,
0x1p-16382L, 0, l);
testboth(0x1p-16382L, -INFINITY,
0x0.ffffffffffffffffffffffffffffp-16382L, ex_under, l);
#endif
printf("ok 4 - next\n");
/*
* Overflow tests
*/
test(idd(nextafter(DBL_MAX, INFINITY)), INFINITY, ex_over);
test(idd(nextafter(INFINITY, 0.0)), DBL_MAX, 0);
test(idd(nexttoward(DBL_MAX, DBL_MAX * 2.0L)), INFINITY, ex_over);
#if LDBL_MANT_DIG > 53
test(idd(nexttoward(INFINITY, DBL_MAX * 2.0L)), DBL_MAX, 0);
#endif
testf(idf(nextafterf(FLT_MAX, INFINITY)), INFINITY, ex_over);
testf(idf(nextafterf(INFINITY, 0.0)), FLT_MAX, 0);
testf(idf(nexttowardf(FLT_MAX, FLT_MAX * 2.0)), INFINITY, ex_over);
testf(idf(nexttowardf(INFINITY, FLT_MAX * 2.0)), FLT_MAX, 0);
testboth(ldbl_max, INFINITY, INFINITY, ex_over, l);
testboth(INFINITY, 0.0, ldbl_max, 0, l);
printf("ok 5 - next\n");
return (0);
}
