static void
check_get_d_2exp_inf_nan (void)
{
double var_d;
long exp;
mpfr_t var;
mpfr_init2 (var, MPFR_PREC_MIN);
mpfr_set_nan (var);
var_d = mpfr_get_d_2exp (&exp, var, MPFR_RNDN);
if (!DOUBLE_ISNAN (var_d))
{
printf ("mpfr_get_d_2exp with a NAN mpfr value returned a wrong value :\n"
" waiting for %g got %g\n", MPFR_DBL_NAN, var_d);
exit (1);
}
mpfr_set_zero (var, 1);
var_d = mpfr_get_d_2exp (&exp, var, MPFR_RNDN);
if ((exp != 0) || (var_d != 0.0))
{
printf ("mpfr_get_d_2exp with a +0.0 mpfr value returned a wrong value :\n"
" double waiting for 0.0 got %g\n exp waiting for 0 got %ld\n",
var_d, exp);
exit (1);
}
mpfr_set_zero (var, -1);
var_d = mpfr_get_d_2exp (&exp, var, MPFR_RNDN);
if ((exp != 0) || (var_d != DBL_NEG_ZERO))
{
printf ("mpfr_get_d_2exp with a +0.0 mpfr value returned a wrong value :\n"
" double waiting for %g got %g\n exp waiting for 0 got %ld\n",
DBL_NEG_ZERO, var_d, exp);
exit (1);
}
mpfr_set_inf (var, 1);
var_d = mpfr_get_d_2exp (&exp, var, MPFR_RNDN);
if (var_d != MPFR_DBL_INFP)
{
printf ("mpfr_get_d_2exp with a +Inf mpfr value returned a wrong value :\n"
" waiting for %g got %g\n", MPFR_DBL_INFP, var_d);
exit (1);
}
mpfr_set_inf (var, -1);
var_d = mpfr_get_d_2exp (&exp, var, MPFR_RNDN);
if (var_d != MPFR_DBL_INFM)
{
printf ("mpfr_get_d_2exp with a -Inf mpfr value returned a wrong value :\n"
" waiting for %g got %g\n", MPFR_DBL_INFM, var_d);
exit (1);
}
mpfr_clear (var);
}
static void
check_special (void)
{
mpfr_t x, y;
int inexact;
mpfr_init (x);
mpfr_init (y);
mpfr_set_inf (x, 1);
PRINT_ERROR_IF (!mpfr_inf_p (x) || mpfr_sgn (x) < 0,
"ERROR: mpfr_set_inf failed to set variable to +infinity.\n");
inexact = mpfr_set (y, x, MPFR_RNDN);
PRINT_ERROR_IF (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || inexact != 0,
"ERROR: mpfr_set failed to set variable to +infinity.\n");
inexact = mpfr_set_ui (y, 0, MPFR_RNDN);
PRINT_ERROR_IF (!mpfr_zero_p (y) || mpfr_sgn (y) < 0 || inexact != 0,
"ERROR: mpfr_set_ui failed to set variable to +0.\n");
mpfr_set_inf (x, -1);
PRINT_ERROR_IF (!mpfr_inf_p (x) || mpfr_sgn (x) > 0,
"ERROR: mpfr_set_inf failed to set variable to -infinity.\n");
inexact = mpfr_set (y, x, MPFR_RNDN);
PRINT_ERROR_IF (!mpfr_inf_p (y) || mpfr_sgn (y) > 0 || inexact != 0,
"ERROR: mpfr_set failed to set variable to -infinity.\n");
mpfr_set_zero (x, 1);
PRINT_ERROR_IF (!mpfr_zero_p (x) || mpfr_sgn (x) < 0,
"ERROR: mpfr_set_zero failed to set variable to +0.\n");
inexact = mpfr_set (y, x, MPFR_RNDN);
PRINT_ERROR_IF (!mpfr_zero_p (y) || mpfr_sgn (y) < 0 || inexact != 0,
"ERROR: mpfr_set failed to set variable to +0.\n");
mpfr_set_zero (x, -1);
PRINT_ERROR_IF (!mpfr_zero_p (x) || mpfr_sgn (x) > 0,
"ERROR: mpfr_set_zero failed to set variable to -0.\n");
inexact = mpfr_set (y, x, MPFR_RNDN);
PRINT_ERROR_IF (!mpfr_zero_p (y) || mpfr_sgn (y) > 0 || inexact != 0,
"ERROR: mpfr_set failed to set variable to -0.\n");
mpfr_set_nan (x);
PRINT_ERROR_IF (!mpfr_nan_p (x),
"ERROR: mpfr_set_nan failed to set variable to NaN.\n");
inexact = mpfr_set (y, x, MPFR_RNDN);
PRINT_ERROR_IF (!mpfr_nan_p (y) || inexact != 0,
"ERROR: mpfr_set failed to set variable to NaN.\n");
mpfr_clear (x);
mpfr_clear (y);
}
static int
mpc_sin_cos_real (mpc_ptr rop_sin, mpc_ptr rop_cos, mpc_srcptr op,
mpc_rnd_t rnd_sin, mpc_rnd_t rnd_cos)
/* assumes that op is real */
{
int inex_sin_re = 0, inex_cos_re = 0;
/* Until further notice, assume computations exact; in particular,
by definition, for not computed values. */
mpfr_t s, c;
int inex_s, inex_c;
int sign_im = mpfr_signbit (mpc_imagref (op));
/* sin(x +-0*i) = sin(x) +-0*i*sign(cos(x)) */
/* cos(x +-i*0) = cos(x) -+i*0*sign(sin(x)) */
if (rop_sin != 0)
mpfr_init2 (s, MPC_PREC_RE (rop_sin));
else
mpfr_init2 (s, 2); /* We need only the sign. */
if (rop_cos != NULL)
mpfr_init2 (c, MPC_PREC_RE (rop_cos));
else
mpfr_init2 (c, 2);
inex_s = mpfr_sin (s, mpc_realref (op), MPC_RND_RE (rnd_sin));
inex_c = mpfr_cos (c, mpc_realref (op), MPC_RND_RE (rnd_cos));
/* We cannot use mpfr_sin_cos since we may need two distinct rounding
modes and the exact return values. If we need only the sign, an
arbitrary rounding mode will work. */
if (rop_sin != NULL) {
mpfr_set (mpc_realref (rop_sin), s, MPFR_RNDN); /* exact */
inex_sin_re = inex_s;
mpfr_set_zero (mpc_imagref (rop_sin),
( ( sign_im && !mpfr_signbit(c))
|| (!sign_im && mpfr_signbit(c)) ? -1 : 1));
}
if (rop_cos != NULL) {
mpfr_set (mpc_realref (rop_cos), c, MPFR_RNDN); /* exact */
inex_cos_re = inex_c;
mpfr_set_zero (mpc_imagref (rop_cos),
( ( sign_im && mpfr_signbit(s))
|| (!sign_im && !mpfr_signbit(s)) ? -1 : 1));
}
mpfr_clear (s);
mpfr_clear (c);
return MPC_INEX12 (MPC_INEX (inex_sin_re, 0), MPC_INEX (inex_cos_re, 0));
}
int
fmpr_get_mpfr(mpfr_t x, const fmpr_t y, mpfr_rnd_t rnd)
{
int r;
if (fmpr_is_special(y))
{
if (fmpr_is_zero(y)) mpfr_set_zero(x, 0);
else if (fmpr_is_pos_inf(y)) mpfr_set_inf(x, 1);
else if (fmpr_is_neg_inf(y)) mpfr_set_inf(x, -1);
else mpfr_set_nan(x);
r = 0;
}
else if (COEFF_IS_MPZ(*fmpr_expref(y)))
{
flint_printf("exception: exponent too large to convert to mpfr");
abort();
}
else
{
if (!COEFF_IS_MPZ(*fmpr_manref(y)))
#if defined(__MINGW64__)
r = mpfr_set_sj_2exp(x, *fmpr_manref(y), *fmpr_expref(y), rnd);
#else
r = mpfr_set_si_2exp(x, *fmpr_manref(y), *fmpr_expref(y), rnd);
#endif
else
r = mpfr_set_z_2exp(x, COEFF_TO_PTR(*fmpr_manref(y)), *fmpr_expref(y), rnd);
if (!mpfr_regular_p(x))
{
flint_printf("exception: exponent too large to convert to mpfr");
abort();
}
}
static void
test_nan_inf_zero (void)
{
mpfr_ptr val;
int sign;
int kind;
reset_stack ();
val = new_mpfr (MPFR_PREC_MIN);
mpfr_set_nan (val);
kind = (mpfr_custom_get_kind) (val);
if (kind != MPFR_NAN_KIND)
{
printf ("mpfr_custom_get_kind error: ");
mpfr_dump (val);
printf (" is kind %d instead of %d\n", kind, (int) MPFR_NAN_KIND);
exit (1);
}
val = new_nan (MPFR_PREC_MIN);
if (!mpfr_nan_p(val))
{
printf ("Error: mpfr_custom_init_set doesn't set NAN mpfr.\n");
exit (1);
}
val = new_inf (MPFR_PREC_MIN);
if (!mpfr_inf_p(val) || mpfr_sgn(val) >= 0)
{
printf ("Error: mpfr_custom_init_set doesn't set -INF mpfr.\n");
exit (1);
}
sign = 1;
mpfr_set_inf (val, sign);
kind = (mpfr_custom_get_kind) (val);
if ((ABS (kind) != MPFR_INF_KIND) || (SIGN (kind) != SIGN (sign)))
{
printf ("mpfr_custom_get_kind error: ");
mpfr_dump (val);
printf (" is kind %d instead of %d\n", kind, (int) MPFR_INF_KIND);
printf (" have sign %d instead of %d\n", SIGN (kind), SIGN (sign));
exit (1);
}
sign = -1;
mpfr_set_zero (val, sign);
kind = (mpfr_custom_get_kind) (val);
if ((ABS (kind) != MPFR_ZERO_KIND) || (SIGN (kind) != SIGN (sign)))
{
printf ("mpfr_custom_get_kind error: ");
mpfr_dump (val);
printf (" is kind %d instead of %d\n", kind, (int) MPFR_ZERO_KIND);
printf (" have sign %d instead of %d\n", SIGN (kind), SIGN (sign));
exit (1);
}
reset_stack ();
}
mpfr_t* compute_rho_to_z_matrix(unsigned long Lambda_arg, long prec){
/* To avoid writing lambda + 1 so many times...*/
unsigned long Lambda=Lambda_arg+1;
mpfr_t* temps=malloc(sizeof(mpfr_t)*(Lambda));
mpfr_init2(temps[0],prec);
mpfr_set_ui(temps[0],8,MPFR_RNDN);
mpfr_sqrt(temps[0],temps[0],MPFR_RNDN);
mpfr_neg(temps[0],temps[0],MPFR_RNDN);
for(unsigned long j=1;j<Lambda;j++){
mpfr_init2(temps[j],prec);
mpfr_mul_si(temps[j],temps[j-1],2*j-3,MPFR_RNDN);
mpfr_div_ui(temps[j],temps[j],j,MPFR_RNDN);
}
mpfr_sub_ui(temps[1],temps[1],2,MPFR_RNDN);
mpfr_add_ui(temps[0],temps[0],3,MPFR_RNDN);
mpfr_t temp;
mpfr_init2(temp,prec);
mpfr_t temp2;
mpfr_init2(temp2,prec);
mpfr_t* result=malloc(sizeof(mpfr_t)*(Lambda)*(Lambda));
mpfr_init2(result[0],prec);
mpfr_set_ui(result[0],1,MPFR_RNDN);
for(unsigned long j=1; j<(Lambda*Lambda); j++){
mpfr_init2(result[j],prec);
mpfr_set_zero(result[j],1);
}
for(unsigned long j=1;j<Lambda;j++){
mpfr_set_ui(temp,1,MPFR_RNDN);
for(unsigned long k=0;k<=j;k++){
mpfr_mul(temp2,temps[j-k],temp,MPFR_RNDN);
mpfr_add(result[j+Lambda],result[j+Lambda],temp2,MPFR_RNDN);
mpfr_mul_si(temp,temp,-2,MPFR_RNDN);
}
}
for(unsigned long i=2;i<Lambda;i++){
for(unsigned long j=1;j<Lambda;j++){
for(unsigned long k=i-1;k<Lambda-j;k++){
mpfr_mul(temp,result[Lambda*(i-1)+k],result[j+Lambda],MPFR_RNDN);
mpfr_add(result[Lambda*i+k+j],result[Lambda*i+k+j],temp,MPFR_RNDN);
}
}
}
/* transposition */
for(unsigned long i=0;i<Lambda;i++){
for(unsigned long j=0;j<i;j++){
mpfr_swap(result[i+Lambda*j],result[j+Lambda*i]);
}
}
for(unsigned long j=0;j<Lambda;j++){
mpfr_clear(temps[j]);
}
free(temps);
mpfr_clear(temp);
mpfr_clear(temp2);
return result;
}
Floating*
Floating_set_positive_zero (Floating* self)
{
mpfr_set_zero(*self->value, 1);
invalidate_cache(self);
return self;
}
static void
test_nan_inf_zero (void)
{
mpfr_ptr val;
int sign;
int kind;
char *org = stack;
val = new_mpfr (MPFR_PREC_MIN);
mpfr_set_nan (val);
kind = (mpfr_custom_get_kind) (val);
if (kind != MPFR_NAN_KIND)
{
printf ("mpfr_custom_get_kind error : ");
mpfr_dump (val);
printf (" is kind %d instead of %d\n", kind, MPFR_NAN_KIND);
exit (1);
}
sign = 1;
mpfr_set_inf (val, sign);
kind = (mpfr_custom_get_kind) (val);
if ((ABS (kind) != MPFR_INF_KIND) || (SIGN (kind) != SIGN (sign)))
{
printf ("mpfr_custom_get_kind error : ");
mpfr_dump (val);
printf (" is kind %d instead of %d\n", kind, MPFR_INF_KIND);
printf (" have sign %d instead of %d\n", SIGN (kind), SIGN (sign));
exit (1);
}
sign = -1;
mpfr_set_zero (val, sign);
kind = (mpfr_custom_get_kind) (val);
if ((ABS (kind) != MPFR_ZERO_KIND) || (SIGN (kind) != SIGN (sign)))
{
printf ("mpfr_custom_get_kind error : ");
mpfr_dump (val);
printf (" is kind %d instead of %d\n", kind, MPFR_ZERO_KIND);
printf (" have sign %d instead of %d\n", SIGN (kind), SIGN (sign));
exit (1);
}
stack = org;
}
int
mpc_div (mpc_ptr a, mpc_srcptr b, mpc_srcptr c, mpc_rnd_t rnd)
{
int ok_re = 0, ok_im = 0;
mpc_t res, c_conj;
mpfr_t q;
mpfr_prec_t prec;
int inex, inexact_prod, inexact_norm, inexact_re, inexact_im, loops = 0;
int underflow_norm, overflow_norm, underflow_prod, overflow_prod;
int underflow_re = 0, overflow_re = 0, underflow_im = 0, overflow_im = 0;
mpfr_rnd_t rnd_re = MPC_RND_RE (rnd), rnd_im = MPC_RND_IM (rnd);
int saved_underflow, saved_overflow;
int tmpsgn;
mpfr_exp_t e, emin, emax, emid; /* for scaling of exponents */
mpc_t b_scaled, c_scaled;
mpfr_t b_re, b_im, c_re, c_im;
/* According to the C standard G.3, there are three types of numbers: */
/* finite (both parts are usual real numbers; contains 0), infinite */
/* (at least one part is a real infinity) and all others; the latter */
/* are numbers containing a nan, but no infinity, and could reasonably */
/* be called nan. */
/* By G.5.1.4, infinite/finite=infinite; finite/infinite=0; */
/* all other divisions that are not finite/finite return nan+i*nan. */
/* Division by 0 could be handled by the following case of division by */
/* a real; we handle it separately instead. */
if (mpc_zero_p (c)) /* both Re(c) and Im(c) are zero */
return mpc_div_zero (a, b, c, rnd);
else if (mpc_inf_p (b) && mpc_fin_p (c)) /* either Re(b) or Im(b) is infinite
and both Re(c) and Im(c) are ordinary */
return mpc_div_inf_fin (a, b, c);
else if (mpc_fin_p (b) && mpc_inf_p (c))
return mpc_div_fin_inf (a, b, c);
else if (!mpc_fin_p (b) || !mpc_fin_p (c)) {
mpc_set_nan (a);
return MPC_INEX (0, 0);
}
else if (mpfr_zero_p(mpc_imagref(c)))
return mpc_div_real (a, b, c, rnd);
else if (mpfr_zero_p(mpc_realref(c)))
return mpc_div_imag (a, b, c, rnd);
prec = MPC_MAX_PREC(a);
mpc_init2 (res, 2);
mpfr_init (q);
/* compute scaling of exponents: none of Re(c) and Im(c) can be zero,
but one of Re(b) or Im(b) could be zero */
e = mpfr_get_exp (mpc_realref (c));
emin = emax = e;
e = mpfr_get_exp (mpc_imagref (c));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
if (!mpfr_zero_p (mpc_realref (b)))
{
e = mpfr_get_exp (mpc_realref (b));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
}
if (!mpfr_zero_p (mpc_imagref (b)))
{
e = mpfr_get_exp (mpc_imagref (b));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
}
/* all input exponents are in [emin, emax] */
emid = emin / 2 + emax / 2;
/* scale the inputs */
b_re[0] = mpc_realref (b)[0];
if (!mpfr_zero_p (mpc_realref (b)))
MPFR_EXP(b_re) = MPFR_EXP(mpc_realref (b)) - emid;
b_im[0] = mpc_imagref (b)[0];
if (!mpfr_zero_p (mpc_imagref (b)))
MPFR_EXP(b_im) = MPFR_EXP(mpc_imagref (b)) - emid;
c_re[0] = mpc_realref (c)[0];
MPFR_EXP(c_re) = MPFR_EXP(mpc_realref (c)) - emid;
c_im[0] = mpc_imagref (c)[0];
MPFR_EXP(c_im) = MPFR_EXP(mpc_imagref (c)) - emid;
/* create the scaled inputs without allocating new memory */
mpc_realref (b_scaled)[0] = b_re[0];
mpc_imagref (b_scaled)[0] = b_im[0];
mpc_realref (c_scaled)[0] = c_re[0];
mpc_imagref (c_scaled)[0] = c_im[0];
/* create the conjugate of c in c_conj without allocating new memory */
mpc_realref (c_conj)[0] = mpc_realref (c_scaled)[0];
mpc_imagref (c_conj)[0] = mpc_imagref (c_scaled)[0];
MPFR_CHANGE_SIGN (mpc_imagref (c_conj));
/* save the underflow or overflow flags from MPFR */
saved_underflow = mpfr_underflow_p ();
saved_overflow = mpfr_overflow_p ();
do {
loops ++;
prec += loops <= 2 ? mpc_ceil_log2 (prec) + 5 : prec / 2;
mpc_set_prec (res, prec);
mpfr_set_prec (q, prec);
/* first compute norm(c_scaled) */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_norm = mpc_norm (q, c_scaled, MPFR_RNDU);
underflow_norm = mpfr_underflow_p ();
overflow_norm = mpfr_overflow_p ();
if (underflow_norm)
mpfr_set_ui (q, 0ul, MPFR_RNDN);
/* to obtain divisions by 0 later on */
/* now compute b_scaled*conjugate(c_scaled) */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_prod = mpc_mul (res, b_scaled, c_conj, MPC_RNDZZ);
inexact_re = MPC_INEX_RE (inexact_prod);
inexact_im = MPC_INEX_IM (inexact_prod);
underflow_prod = mpfr_underflow_p ();
overflow_prod = mpfr_overflow_p ();
/* unfortunately, does not distinguish between under-/overflow
in real or imaginary parts
hopefully, the side-effects of mpc_mul do indeed raise the
mpfr exceptions */
if (overflow_prod) {
/* FIXME: in case overflow_norm is also true, the code below is wrong,
since the after division by the norm, we might end up with finite
real and/or imaginary parts. A workaround would be to scale the
inputs (in case the exponents are within the same range). */
int isinf = 0;
/* determine if the real part of res is the maximum or the minimum
representable number */
tmpsgn = mpfr_sgn (mpc_realref(res));
if (tmpsgn > 0)
{
mpfr_nextabove (mpc_realref(res));
isinf = mpfr_inf_p (mpc_realref(res));
mpfr_nextbelow (mpc_realref(res));
}
else if (tmpsgn < 0)
{
mpfr_nextbelow (mpc_realref(res));
isinf = mpfr_inf_p (mpc_realref(res));
mpfr_nextabove (mpc_realref(res));
}
if (isinf)
{
mpfr_set_inf (mpc_realref(res), tmpsgn);
overflow_re = 1;
}
/* same for the imaginary part */
tmpsgn = mpfr_sgn (mpc_imagref(res));
isinf = 0;
if (tmpsgn > 0)
{
mpfr_nextabove (mpc_imagref(res));
isinf = mpfr_inf_p (mpc_imagref(res));
mpfr_nextbelow (mpc_imagref(res));
}
else if (tmpsgn < 0)
{
mpfr_nextbelow (mpc_imagref(res));
isinf = mpfr_inf_p (mpc_imagref(res));
mpfr_nextabove (mpc_imagref(res));
}
if (isinf)
{
mpfr_set_inf (mpc_imagref(res), tmpsgn);
overflow_im = 1;
}
mpc_set (a, res, rnd);
goto end;
}
/* divide the product by the norm */
if (inexact_norm == 0 && (inexact_re == 0 || inexact_im == 0)) {
/* The division has good chances to be exact in at least one part. */
/* Since this can cause problems when not rounding to the nearest, */
/* we use the division code of mpfr, which handles the situation. */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_re |= mpfr_div (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
underflow_re = mpfr_underflow_p ();
overflow_re = mpfr_overflow_p ();
ok_re = !inexact_re || underflow_re || overflow_re
|| mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));
if (ok_re) /* compute imaginary part */ {
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_im |= mpfr_div (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
underflow_im = mpfr_underflow_p ();
overflow_im = mpfr_overflow_p ();
ok_im = !inexact_im || underflow_im || overflow_im
|| mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
}
}
else {
/* The division is inexact, so for efficiency reasons we invert q */
/* only once and multiply by the inverse. */
if (mpfr_ui_div (q, 1ul, q, MPFR_RNDZ) || inexact_norm) {
/* if 1/q is inexact, the approximations of the real and
imaginary part below will be inexact, unless RE(res)
or IM(res) is zero */
inexact_re |= !mpfr_zero_p (mpc_realref (res));
inexact_im |= !mpfr_zero_p (mpc_imagref (res));
}
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_re |= mpfr_mul (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
underflow_re = mpfr_underflow_p ();
overflow_re = mpfr_overflow_p ();
ok_re = !inexact_re || underflow_re || overflow_re
|| mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));
if (ok_re) /* compute imaginary part */ {
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_im |= mpfr_mul (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
underflow_im = mpfr_underflow_p ();
overflow_im = mpfr_overflow_p ();
ok_im = !inexact_im || underflow_im || overflow_im
|| mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
}
}
} while ((!ok_re || !ok_im) && !underflow_norm && !overflow_norm
&& !underflow_prod && !overflow_prod);
inex = mpc_set (a, res, rnd);
inexact_re = MPC_INEX_RE (inex);
inexact_im = MPC_INEX_IM (inex);
end:
/* fix values and inexact flags in case of overflow/underflow */
/* FIXME: heuristic, certainly does not cover all cases */
if (overflow_re || (underflow_norm && !underflow_prod)) {
mpfr_set_inf (mpc_realref (a), mpfr_sgn (mpc_realref (res)));
inexact_re = mpfr_sgn (mpc_realref (res));
}
else if (underflow_re || (overflow_norm && !overflow_prod)) {
inexact_re = mpfr_signbit (mpc_realref (res)) ? 1 : -1;
mpfr_set_zero (mpc_realref (a), -inexact_re);
}
if (overflow_im || (underflow_norm && !underflow_prod)) {
mpfr_set_inf (mpc_imagref (a), mpfr_sgn (mpc_imagref (res)));
inexact_im = mpfr_sgn (mpc_imagref (res));
}
else if (underflow_im || (overflow_norm && !overflow_prod)) {
inexact_im = mpfr_signbit (mpc_imagref (res)) ? 1 : -1;
mpfr_set_zero (mpc_imagref (a), -inexact_im);
}
mpc_clear (res);
mpfr_clear (q);
/* restore underflow and overflow flags from MPFR */
if (saved_underflow)
mpfr_set_underflow ();
if (saved_overflow)
mpfr_set_overflow ();
return MPC_INEX (inexact_re, inexact_im);
}
static MPC_Object *
GMPy_MPC_From_PyStr(PyObject *s, int base, mpfr_prec_t rprec, mpfr_prec_t iprec,
CTXT_Object *context)
{
MPC_Object *result;
PyObject *ascii_str = NULL;
Py_ssize_t len;
char *cp, *unwind, *tempchar, *lastchar;
int firstp = 0, lastp = 0, real_rc = 0, imag_rc = 0;
CHECK_CONTEXT(context);
if (PyBytes_Check(s)) {
len = PyBytes_Size(s);
cp = (char*)PyBytes_AsString(s);
}
else if (PyUnicode_Check(s)) {
ascii_str = PyUnicode_AsASCIIString(s);
if (!ascii_str) {
VALUE_ERROR("string contains non-ASCII characters");
return NULL;
}
len = PyBytes_Size(ascii_str);
cp = (char*)PyBytes_AsString(ascii_str);
}
else {
TYPE_ERROR("string required");
return NULL;
}
/* Don't allow NULL characters */
if (strlen(cp) != len) {
VALUE_ERROR("string without NULL characters expected");
Py_XDECREF(ascii_str);
return NULL;
}
if (!(result = GMPy_MPC_New(rprec, iprec, context))) {
Py_XDECREF(ascii_str);
return NULL;
}
/* Get a pointer to the last valid character (ignoring trailing
* whitespace.) */
lastchar = cp + len - 1;
while (isspace(*lastchar))
lastchar--;
/* Skip trailing ). */
if (*lastchar == ')') {
lastp = 1;
lastchar--;
}
/* Skip trailing j. */
if (*lastchar == 'j')
lastchar--;
/* Skip leading whitespace. */
while (isspace(*cp))
cp++;
/* Skip a leading (. */
if (*cp == '(') {
firstp = 1;
cp++;
}
if (firstp != lastp) goto invalid_string;
/* Read the real component first. */
unwind = cp;
real_rc = mpfr_strtofr(mpc_realref(result->c), cp, &tempchar, base,
GET_REAL_ROUND(context));
/* Verify that at least one valid character was read. */
if (cp == tempchar) goto invalid_string;
/* If the next character is a j, then the real component is 0 and
* we just read the imaginary componenet.
*/
if (*tempchar == 'j') {
mpfr_set_zero(mpc_realref(result->c), MPFR_RNDN);
cp = unwind;
}
else {
/* Read the imaginary component next. */
cp = tempchar;
}
imag_rc = mpfr_strtofr(mpc_imagref(result->c), cp, &tempchar, base,
GET_IMAG_ROUND(context));
if (cp == tempchar && tempchar > lastchar)
goto valid_string;
if (*tempchar != 'j' && *cp != ' ')
goto invalid_string;
if (tempchar <= lastchar)
goto invalid_string;
valid_string:
Py_XDECREF(ascii_str);
result->rc = MPC_INEX(real_rc, imag_rc);
if (rprec != 1 || iprec != 1) {
GMPY_MPC_CHECK_RANGE(result, context);
}
GMPY_MPC_SUBNORMALIZE(result, context);
GMPY_MPC_EXCEPTIONS(result, context);
return result;
invalid_string:
VALUE_ERROR("invalid string in mpc()");
Py_DECREF((PyObject*)result);
Py_XDECREF(ascii_str);
return NULL;
}
static PyObject *
GMPy_Real_DivMod_2(PyObject *x, PyObject *y, CTXT_Object *context)
{
MPFR_Object *tempx = NULL, *tempy = NULL, *quo = NULL, *rem = NULL;
PyObject *result = NULL;
CHECK_CONTEXT(context);
if (!(result = PyTuple_New(2)) ||
!(rem = GMPy_MPFR_New(0, context)) ||
!(quo = GMPy_MPFR_New(0, context))) {
/* LCOV_EXCL_START */
goto error;
/* LCOV_EXCL_STOP */
}
if (IS_REAL(x) && IS_REAL(y)) {
if (!(tempx = GMPy_MPFR_From_Real(x, 1, context)) ||
!(tempy = GMPy_MPFR_From_Real(y, 1, context))) {
/* LCOV_EXCL_START */
goto error;
/* LCOV_EXCL_STOP */
}
if (mpfr_zero_p(tempy->f)) {
context->ctx.divzero = 1;
if (context->ctx.traps & TRAP_DIVZERO) {
GMPY_DIVZERO("divmod() division by zero");
goto error;
}
}
if (mpfr_nan_p(tempx->f) || mpfr_nan_p(tempy->f) || mpfr_inf_p(tempx->f)) {
context->ctx.invalid = 1;
if (context->ctx.traps & TRAP_INVALID) {
GMPY_INVALID("divmod() invalid operation");
goto error;
}
else {
mpfr_set_nan(quo->f);
mpfr_set_nan(rem->f);
}
}
else if (mpfr_inf_p(tempy->f)) {
context->ctx.invalid = 1;
if (context->ctx.traps & TRAP_INVALID) {
GMPY_INVALID("divmod() invalid operation");
goto error;
}
if (mpfr_zero_p(tempx->f)) {
mpfr_set_zero(quo->f, mpfr_sgn(tempy->f));
mpfr_set_zero(rem->f, mpfr_sgn(tempy->f));
}
else if ((mpfr_signbit(tempx->f)) != (mpfr_signbit(tempy->f))) {
mpfr_set_si(quo->f, -1, MPFR_RNDN);
mpfr_set_inf(rem->f, mpfr_sgn(tempy->f));
}
else {
mpfr_set_si(quo->f, 0, MPFR_RNDN);
rem->rc = mpfr_set(rem->f, tempx->f, MPFR_RNDN);
}
}
else {
MPQ_Object *mpqx = NULL, *mpqy = NULL, *temp_rem = NULL;
MPZ_Object *temp_quo = NULL;
if (!(mpqx = GMPy_MPQ_From_MPFR(tempx, context)) ||
!(mpqy = GMPy_MPQ_From_MPFR(tempy, context))) {
/* LCOV_EXCL_START */
Py_XDECREF((PyObject*)mpqx);
Py_XDECREF((PyObject*)mpqy);
goto error;
/* LCOV_EXCL_STOP */
}
if (!(temp_rem = GMPy_MPQ_New(context)) ||
!(temp_quo = GMPy_MPZ_New(context))) {
/* LCOV_EXCL_START */
Py_XDECREF((PyObject*)temp_rem);
Py_XDECREF((PyObject*)temp_quo);
Py_XDECREF((PyObject*)mpqx);
Py_XDECREF((PyObject*)mpqy);
goto error;
/* LCOV_EXCL_STOP */
}
Py_DECREF((PyObject*)tempx);
Py_DECREF((PyObject*)tempy);
mpq_div(temp_rem->q, mpqx->q, mpqy->q);
mpz_fdiv_q(temp_quo->z, mpq_numref(temp_rem->q), mpq_denref(temp_rem->q));
/* Need to calculate x - quo * y. */
mpq_set_z(temp_rem->q, temp_quo->z);
mpq_mul(temp_rem->q, temp_rem->q, mpqy->q);
mpq_sub(temp_rem->q, mpqx->q, temp_rem->q);
Py_DECREF((PyObject*)mpqx);
Py_DECREF((PyObject*)mpqy);
quo->rc = mpfr_set_z(quo->f, temp_quo->z, MPFR_RNDD);
rem->rc = mpfr_set_q(rem->f, temp_rem->q, MPFR_RNDN);
Py_DECREF((PyObject*)temp_rem);
Py_DECREF((PyObject*)temp_quo);
GMPY_MPFR_CHECK_RANGE(quo, context);
GMPY_MPFR_CHECK_RANGE(rem, context);
GMPY_MPFR_SUBNORMALIZE(quo, context);
GMPY_MPFR_SUBNORMALIZE(rem, context);
PyTuple_SET_ITEM(result, 0, (PyObject*)quo);
PyTuple_SET_ITEM(result, 1, (PyObject*)rem);
return result;
}
}
/* LCOV_EXCL_START */
SYSTEM_ERROR("Internal error in GMPy_Real_DivMod_2().");
error:
Py_XDECREF((PyObject*)tempx);
Py_XDECREF((PyObject*)tempy);
Py_XDECREF((PyObject*)rem);
Py_XDECREF((PyObject*)quo);
Py_XDECREF(result);
return NULL;
/* LCOV_EXCL_STOP */
}
static PyObject *
GMPy_Real_DivMod_1(PyObject *x, PyObject *y, CTXT_Object *context)
{
MPFR_Object *tempx = NULL, *tempy = NULL, *quo = NULL, *rem = NULL;
PyObject *result = NULL;
CHECK_CONTEXT(context);
if (!(result = PyTuple_New(2)) ||
!(rem = GMPy_MPFR_New(0, context)) ||
!(quo = GMPy_MPFR_New(0, context))) {
/* LCOV_EXCL_START */
goto error;
/* LCOV_EXCL_STOP */
}
if (IS_REAL(x) && IS_REAL(y)) {
if (!(tempx = GMPy_MPFR_From_Real(x, 1, context)) ||
!(tempy = GMPy_MPFR_From_Real(y, 1, context))) {
/* LCOV_EXCL_START */
goto error;
/* LCOV_EXCL_STOP */
}
if (mpfr_zero_p(tempy->f)) {
context->ctx.divzero = 1;
if (context->ctx.traps & TRAP_DIVZERO) {
GMPY_DIVZERO("divmod() division by zero");
goto error;
}
}
if (mpfr_nan_p(tempx->f) || mpfr_nan_p(tempy->f) || mpfr_inf_p(tempx->f)) {
context->ctx.invalid = 1;
if (context->ctx.traps & TRAP_INVALID) {
GMPY_INVALID("divmod() invalid operation");
goto error;
}
else {
mpfr_set_nan(quo->f);
mpfr_set_nan(rem->f);
}
}
else if (mpfr_inf_p(tempy->f)) {
context->ctx.invalid = 1;
if (context->ctx.traps & TRAP_INVALID) {
GMPY_INVALID("divmod() invalid operation");
goto error;
}
if (mpfr_zero_p(tempx->f)) {
mpfr_set_zero(quo->f, mpfr_sgn(tempy->f));
mpfr_set_zero(rem->f, mpfr_sgn(tempy->f));
}
else if ((mpfr_signbit(tempx->f)) != (mpfr_signbit(tempy->f))) {
mpfr_set_si(quo->f, -1, MPFR_RNDN);
mpfr_set_inf(rem->f, mpfr_sgn(tempy->f));
}
else {
mpfr_set_si(quo->f, 0, MPFR_RNDN);
rem->rc = mpfr_set(rem->f, tempx->f, MPFR_RNDN);
}
}
else {
MPFR_Object *temp;
if (!(temp = GMPy_MPFR_New(0, context))) {
/* LCOV_EXCL_START */
goto error;
/* LCOV_EXCL_STOP */
}
mpfr_fmod(rem->f, tempx->f, tempy->f, MPFR_RNDN);
mpfr_sub(temp->f, tempx->f, rem->f, MPFR_RNDN);
mpfr_div(quo->f, temp->f, tempy->f, MPFR_RNDN);
if (!mpfr_zero_p(rem->f)) {
if ((mpfr_sgn(tempy->f) < 0) != (mpfr_sgn(rem->f) < 0)) {
mpfr_add(rem->f, rem->f, tempy->f, MPFR_RNDN);
mpfr_sub_ui(quo->f, quo->f, 1, MPFR_RNDN);
}
}
else {
mpfr_copysign(rem->f, rem->f, tempy->f, MPFR_RNDN);
}
if (!mpfr_zero_p(quo->f)) {
mpfr_round(quo->f, quo->f);
}
else {
mpfr_setsign(quo->f, quo->f, mpfr_sgn(tempx->f) * mpfr_sgn(tempy->f) - 1, MPFR_RNDN);
}
Py_DECREF((PyObject*)temp);
}
GMPY_MPFR_CHECK_RANGE(quo, context);
GMPY_MPFR_CHECK_RANGE(rem, context);
GMPY_MPFR_SUBNORMALIZE(quo, context);
GMPY_MPFR_SUBNORMALIZE(rem, context);
Py_DECREF((PyObject*)tempx);
Py_DECREF((PyObject*)tempy);
PyTuple_SET_ITEM(result, 0, (PyObject*)quo);
PyTuple_SET_ITEM(result, 1, (PyObject*)rem);
return (PyObject*)result;
}
/* LCOV_EXCL_START */
SYSTEM_ERROR("Internal error in GMPy_Real_DivMod_1().");
error:
Py_XDECREF((PyObject*)tempx);
Py_XDECREF((PyObject*)tempy);
Py_XDECREF((PyObject*)rem);
Py_XDECREF((PyObject*)quo);
Py_XDECREF(result);
return NULL;
/* LCOV_EXCL_STOP */
}
static void
check_underflow (void)
{
mpfr_t sum1, sum2, t[NUNFL];
mpfr_ptr p[NUNFL];
mpfr_prec_t precmax = 444;
mpfr_exp_t emin, emax;
unsigned int ex_flags, flags;
int c, i;
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
set_emin (MPFR_EMIN_MIN);
set_emax (MPFR_EMAX_MAX);
ex_flags = MPFR_FLAGS_UNDERFLOW | MPFR_FLAGS_INEXACT;
mpfr_init2 (sum1, MPFR_PREC_MIN);
mpfr_init2 (sum2, precmax);
for (i = 0; i < NUNFL; i++)
{
mpfr_init2 (t[i], precmax);
p[i] = t[i];
}
for (c = 0; c < 8; c++)
{
mpfr_prec_t fprec;
int n, neg, r;
fprec = MPFR_PREC_MIN + (randlimb () % (precmax - MPFR_PREC_MIN + 1));
n = 3 + (randlimb () % (NUNFL - 2));
MPFR_ASSERTN (n <= NUNFL);
mpfr_set_prec (sum2, (randlimb () & 1) ? MPFR_PREC_MIN : precmax);
mpfr_set_prec (t[0], fprec + 64);
mpfr_set_zero (t[0], 1);
for (i = 1; i < n; i++)
{
int inex;
mpfr_set_prec (t[i], MPFR_PREC_MIN +
(randlimb () % (fprec - MPFR_PREC_MIN + 1)));
do
mpfr_urandomb (t[i], RANDS);
while (MPFR_IS_ZERO (t[i]));
mpfr_set_exp (t[i], MPFR_EMIN_MIN);
inex = mpfr_sub (t[0], t[0], t[i], MPFR_RNDN);
MPFR_ASSERTN (inex == 0);
}
neg = randlimb () & 1;
if (neg)
mpfr_nextbelow (t[0]);
else
mpfr_nextabove (t[0]);
RND_LOOP(r)
{
int inex1, inex2;
mpfr_set_zero (sum1, 1);
if (neg)
mpfr_nextbelow (sum1);
else
mpfr_nextabove (sum1);
inex1 = mpfr_div_2ui (sum1, sum1, 2, (mpfr_rnd_t) r);
mpfr_clear_flags ();
inex2 = mpfr_sum (sum2, p, n, (mpfr_rnd_t) r);
flags = __gmpfr_flags;
MPFR_ASSERTN (mpfr_check (sum1));
MPFR_ASSERTN (mpfr_check (sum2));
if (flags != ex_flags)
{
printf ("Bad flags in check_underflow on %s, c = %d\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r), c);
printf ("Expected flags:");
flags_out (ex_flags);
printf ("Got flags: ");
flags_out (flags);
printf ("sum = ");
mpfr_dump (sum2);
exit (1);
}
if (!(mpfr_equal_p (sum1, sum2) && SAME_SIGN (inex1, inex2)))
{
printf ("Error in check_underflow on %s, c = %d\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r), c);
printf ("Expected ");
mpfr_dump (sum1);
printf ("with inex = %d\n", inex1);
printf ("Got ");
mpfr_dump (sum2);
printf ("with inex = %d\n", inex2);
exit (1);
}
}
}
for (i = 0; i < NUNFL; i++)
mpfr_clear (t[i]);
mpfr_clears (sum1, sum2, (mpfr_ptr) 0);
set_emin (emin);
set_emax (emax);
}
/*------------------------------------------------------------------------*/
int my_mpfr_beta (mpfr_t R, mpfr_t a, mpfr_t b, mpfr_rnd_t RND)
{
mpfr_prec_t p_a = mpfr_get_prec(a), p_b = mpfr_get_prec(b);
if(p_a < p_b) p_a = p_b;// p_a := max(p_a, p_b)
if(mpfr_get_prec(R) < p_a)
mpfr_prec_round(R, p_a, RND);// so prec(R) = max( prec(a), prec(b) )
int ans;
mpfr_t s; mpfr_init2(s, p_a);
#ifdef DEBUG_Rmpfr
R_CheckUserInterrupt();
int cc = 0;
#endif
/* "FIXME": check each 'ans' below, and return when not ok ... */
ans = mpfr_add(s, a, b, RND);
if(mpfr_integer_p(s) && mpfr_sgn(s) <= 0) { // (a + b) is integer <= 0
if(!mpfr_integer_p(a) && !mpfr_integer_p(b)) {
// but a,b not integer ==> R = finite / +-Inf = 0 :
mpfr_set_zero (R, +1);
mpfr_clear (s);
return ans;
}// else: sum is integer; at least one {a,b} integer ==> both integer
int sX = mpfr_sgn(a), sY = mpfr_sgn(b);
if(sX * sY < 0) { // one negative, one positive integer
// ==> special treatment here :
if(sY < 0) // ==> sX > 0; swap the two
mpfr_swap(a, b);
// now have --- a < 0 < b <= |a| integer ------------------
/* ================ and in this case:
B(a,b) = (-1)^b B(1-a-b, b) = (-1)^b B(1-s, b)
= (1*2*..*b) / (-s-1)*(-s-2)*...*(-s-b)
*/
/* where in the 2nd form, both numerator and denominator have exactly
* b integer factors. This is attractive {numerically & speed wise}
* for 'small' b */
#define b_large 100
#ifdef DEBUG_Rmpfr
Rprintf(" my_mpfr_beta(<neg int>): s = a+b= "); R_PRT(s);
Rprintf("\n a = "); R_PRT(a);
Rprintf("\n b = "); R_PRT(b); Rprintf("\n");
if(cc++ > 999) { mpfr_set_zero (R, +1); mpfr_clear (s); return ans; }
#endif
unsigned long b_ = 0;// -Wall
Rboolean
b_fits_ulong = mpfr_fits_ulong_p(b, RND),
small_b = b_fits_ulong && (b_ = mpfr_get_ui(b, RND)) < b_large;
if(small_b) {
#ifdef DEBUG_Rmpfr
Rprintf(" b <= b_large = %d...\n", b_large);
#endif
//----------------- small b ------------------
// use GMP big integer arithmetic:
mpz_t S; mpz_init(S); mpfr_get_z(S, s, RND); // S := s
mpz_sub_ui (S, S, (unsigned long) 1); // S = s - 1 = (a+b-1)
/* binomial coefficient choose(N, k) requires k a 'long int';
* here, b must fit into a long: */
mpz_bin_ui (S, S, b_); // S = choose(S, b) = choose(a+b-1, b)
mpz_mul_ui (S, S, b_); // S = S*b = b * choose(a+b-1, b)
// back to mpfr: R = 1 / S = 1 / (b * choose(a+b-1, b))
mpfr_set_ui(s, (unsigned long) 1, RND);
mpfr_div_z(R, s, S, RND);
mpz_clear(S);
}
else { // b is "large", use direct B(.,.) formula
#ifdef DEBUG_Rmpfr
Rprintf(" b > b_large = %d...\n", b_large);
#endif
// a := (-1)^b :
// there is no mpfr_si_pow(a, -1, b, RND);
int neg; // := 1 ("TRUE") if (-1)^b = -1, i.e. iff b is odd
if(b_fits_ulong) { // (i.e. not very large)
neg = (b_ % 2); // 1 iff b_ is odd, 0 otherwise
} else { // really large b; as we know it is integer, can still..
// b2 := b / 2
mpfr_t b2; mpfr_init2(b2, p_a);
mpfr_div_2ui(b2, b, 1, RND);
neg = !mpfr_integer_p(b2); // b is odd, if b/2 is *not* integer
#ifdef DEBUG_Rmpfr
Rprintf(" really large b; neg = ('b is odd') = %d\n", neg);
#endif
}
// s' := 1-s = 1-a-b
mpfr_ui_sub(s, 1, s, RND);
#ifdef DEBUG_Rmpfr
Rprintf(" neg = %d\n", neg);
Rprintf(" s' = 1-a-b = "); R_PRT(s);
Rprintf("\n -> calling B(s',b)\n");
#endif
// R := B(1-a-b, b) = B(s', b)
if(small_b) {
my_mpfr_beta (R, s, b, RND);
} else {
my_mpfr_lbeta (R, s, b, RND);
mpfr_exp(R, R, RND); // correct *if* beta() >= 0
}
#ifdef DEBUG_Rmpfr
Rprintf(" R' = beta(s',b) = "); R_PRT(R); Rprintf("\n");
#endif
// Result = (-1)^b B(1-a-b, b) = +/- s'
if(neg) mpfr_neg(R, R, RND);
}
mpfr_clear(s);
return ans;
}
}
ans = mpfr_gamma(s, s, RND); /* s = gamma(a + b) */
#ifdef DEBUG_Rmpfr
Rprintf("my_mpfr_beta(): s = gamma(a+b)= "); R_PRT(s);
Rprintf("\n a = "); R_PRT(a);
Rprintf("\n b = "); R_PRT(b);
#endif
ans = mpfr_gamma(a, a, RND);
ans = mpfr_gamma(b, b, RND);
ans = mpfr_mul(b, b, a, RND); /* b' = gamma(a) * gamma(b) */
#ifdef DEBUG_Rmpfr
Rprintf("\n G(a) * G(b) = "); R_PRT(b); Rprintf("\n");
#endif
ans = mpfr_div(R, b, s, RND);
mpfr_clear (s);
/* mpfr_free_cache() must be called in the caller !*/
return ans;
}
/* TODO
* exponents that use more than 16 bytes are not managed
*/
static int
mpfr_fpif_read_exponent_from_file (mpfr_t x, FILE * fh)
{
mpfr_exp_t exponent;
mpfr_uexp_t uexp;
size_t exponent_size;
int sign;
unsigned char buffer[sizeof(mpfr_exp_t)];
if (fh == NULL)
return 1;
if (fread (buffer, 1, 1, fh) != 1)
return 1;
sign = (buffer[0] & 0x80) ? -1 : 1;
exponent = buffer[0] & 0x7F;
exponent_size = 1;
if (exponent > MPFR_EXTERNAL_EXPONENT && exponent < MPFR_KIND_ZERO)
{
mpfr_uexp_t exponent_sign;
exponent_size = exponent - MPFR_EXTERNAL_EXPONENT;
if (exponent_size > sizeof(mpfr_exp_t))
return 1;
if (fread (buffer, exponent_size, 1, fh) != 1)
return 1;
uexp = 0;
getLittleEndianData ((unsigned char *) &uexp, buffer,
sizeof(mpfr_exp_t), exponent_size);
exponent_sign = uexp & ((mpfr_uexp_t) 1 << (8 * exponent_size - 1));
uexp &= ~exponent_sign;
uexp += MPFR_MAX_EMBEDDED_EXPONENT;
exponent = exponent_sign ? - (mpfr_exp_t) uexp : (mpfr_exp_t) uexp;
if (! MPFR_EXP_IN_RANGE (exponent))
return 1;
MPFR_EXP (x) = exponent;
MPFR_SET_SIGN (x, sign);
exponent_size++;
}
else if (exponent == MPFR_KIND_ZERO)
mpfr_set_zero (x, sign);
else if (exponent == MPFR_KIND_INF)
mpfr_set_inf (x, sign);
else if (exponent == MPFR_KIND_NAN)
mpfr_set_nan (x);
else if (exponent < 95)
{
/* FIXME: no sign set. Is this normal? Check with a testcase. */
exponent -= MPFR_MAX_EMBEDDED_EXPONENT;
if (! MPFR_EXP_IN_RANGE (exponent))
return 1;
MPFR_EXP (x) = exponent;
}
else
return 1;
return 0;
}
int
main (int argc, char *argv[])
{
char *filenameCompressed = FILE_NAME_RW;
char *data = FILE_NAME_R;
int status;
FILE *fh;
mpfr_t x[9];
mpfr_t y;
unsigned char badData[6][2] =
{ { 7, 0 }, { 16, 0 }, { 23, 118 }, { 23, 95 }, { 23, 127 }, { 23, 47 } };
int badDataSize[6] = { 1, 1, 2, 2, 2, 2 };
int i;
if (argc != 1)
{
printf ("Usage: %s\n", argv[0]);
exit (1);
}
tests_start_mpfr ();
mpfr_init2 (x[0], 130);
mpfr_init2 (x[8], 130);
mpfr_inits2 (2048, x[1], x[2], x[3], x[4], x[5], x[6], x[7], (mpfr_ptr) 0);
mpfr_set_str1 (x[0], "45.2564215000000018562786863185465335845947265625");
mpfr_set_str1 (x[1], "45.2564215000000018562786863185465335845947265625");
mpfr_set_str1 (x[2], "45.2564215000000018562786863185465335845947265625");
mpfr_set_exp (x[2], -48000);
mpfr_set_inf (x[3], -1);
mpfr_set_zero (x[4], 0);
mpfr_set_nan (x[5]);
mpfr_set_ui (x[6], 104348, MPFR_RNDN);
mpfr_set_ui (x[7], 33215, MPFR_RNDN);
mpfr_div (x[8], x[6], x[7], MPFR_RNDN);
mpfr_div (x[6], x[6], x[7], MPFR_RNDN);
/* we first write to file FILE_NAME_RW the numbers x[i] */
fh = fopen (filenameCompressed, "w");
if (fh == NULL)
{
printf ("Failed to open for writing %s, exiting...\n",
filenameCompressed);
exit (1);
}
for (i = 0; i < 9; i++)
{
status = mpfr_fpif_export (fh, x[i]);
if (status != 0)
{
fclose (fh);
printf ("Failed to export number %d, exiting...\n", i);
exit (1);
}
}
fclose (fh);
/* we then read back FILE_NAME_RW and check we get the same numbers x[i] */
fh = fopen (filenameCompressed, "r");
if (fh == NULL)
{
printf ("Failed to open for reading %s, exiting...\n",
filenameCompressed);
exit (1);
}
for (i = 0; i < 9; i++)
{
mpfr_init2 (y, 2);
mpfr_fpif_import (y, fh);
if (mpfr_cmp(x[i], y) != 0)
{
printf ("mpfr_cmp failed on written number %d, exiting...\n", i);
printf ("expected "); mpfr_dump (x[i]);
printf ("got "); mpfr_dump (y);
exit (1);
}
mpfr_clear (y);
}
fclose (fh);
/* we do the same for the fixed file FILE_NAME_R, this ensures
we get same results with different word size or endianness */
fh = src_fopen (data, "r");
if (fh == NULL)
{
printf ("Failed to open for reading %s in srcdir, exiting...\n", data);
exit (1);
}
for (i = 0; i < 9; i++)
{
mpfr_init2 (y, 2);
mpfr_fpif_import (y, fh);
if (mpfr_cmp (x[i], y) != 0)
{
printf ("mpfr_cmp failed on data number %d, exiting...\n", i);
printf ("expected "); mpfr_dump (x[i]);
printf ("got "); mpfr_dump (y);
exit (1);
}
mpfr_clear (y);
}
fclose (fh);
for (i = 0; i < 9; i++)
mpfr_clear (x[i]);
remove (filenameCompressed);
mpfr_init2 (y, 2);
status = mpfr_fpif_export (NULL, y);
if (status == 0)
{
printf ("mpfr_fpif_export did not fail with a NULL file\n");
exit(1);
}
status = mpfr_fpif_import (y, NULL);
if (status == 0)
{
printf ("mpfr_fpif_import did not fail with a NULL file\n");
exit(1);
}
fh = fopen (filenameCompressed, "w+");
if (fh == NULL)
{
printf ("Failed to open for reading/writing %s, exiting...\n",
filenameCompressed);
fclose (fh);
remove (filenameCompressed);
exit (1);
}
status = mpfr_fpif_import (y, fh);
if (status == 0)
{
printf ("mpfr_fpif_import did not fail on a empty file\n");
fclose (fh);
remove (filenameCompressed);
exit(1);
}
for (i = 0; i < 6; i++)
{
rewind (fh);
status = fwrite (&badData[i][0], badDataSize[i], 1, fh);
if (status != 1)
{
printf ("Write error on the test file\n");
fclose (fh);
remove (filenameCompressed);
exit(1);
}
rewind (fh);
status = mpfr_fpif_import (y, fh);
if (status == 0)
{
printf ("mpfr_fpif_import did not fail on a bad imported data\n");
switch (i)
{
case 0:
printf (" not enough precision data\n");
break;
case 1:
printf (" no exponent data\n");
break;
case 2:
printf (" too big exponent\n");
break;
case 3:
printf (" not enough exponent data\n");
break;
case 4:
printf (" exponent data wrong\n");
break;
case 5:
printf (" no limb data\n");
break;
default:
printf ("Test fatal error, unknown case\n");
break;
}
fclose (fh);
remove (filenameCompressed);
exit(1);
}
}
fclose (fh);
mpfr_clear (y);
fh = fopen (filenameCompressed, "r");
if (fh == NULL)
{
printf ("Failed to open for reading %s, exiting...\n",
filenameCompressed);
exit (1);
}
mpfr_init2 (y, 2);
status = mpfr_fpif_export (fh, y);
if (status == 0)
{
printf ("mpfr_fpif_export did not fail on a read only stream\n");
exit(1);
}
fclose (fh);
remove (filenameCompressed);
mpfr_clear (y);
tests_end_mpfr ();
return 0;
}
int
mpc_asin (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
mpfr_prec_t p, p_re, p_im, incr_p = 0;
mpfr_rnd_t rnd_re, rnd_im;
mpc_t z1;
int inex;
/* special values */
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
{
if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_inf (mpc_imagref (rop), mpfr_signbit (mpc_imagref (op)) ? -1 : +1);
}
else if (mpfr_zero_p (mpc_realref (op)))
{
mpfr_set (mpc_realref (rop), mpc_realref (op), GMP_RNDN);
mpfr_set_nan (mpc_imagref (rop));
}
else
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
return 0;
}
if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
int inex_re;
if (mpfr_inf_p (mpc_realref (op)))
{
int inf_im = mpfr_inf_p (mpc_imagref (op));
inex_re = set_pi_over_2 (mpc_realref (rop),
(mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd));
mpfr_set_inf (mpc_imagref (rop), (mpfr_signbit (mpc_imagref (op)) ? -1 : 1));
if (inf_im)
mpfr_div_2ui (mpc_realref (rop), mpc_realref (rop), 1, GMP_RNDN);
}
else
{
mpfr_set_zero (mpc_realref (rop), (mpfr_signbit (mpc_realref (op)) ? -1 : 1));
inex_re = 0;
mpfr_set_inf (mpc_imagref (rop), (mpfr_signbit (mpc_imagref (op)) ? -1 : 1));
}
return MPC_INEX (inex_re, 0);
}
/* pure real argument */
if (mpfr_zero_p (mpc_imagref (op)))
{
int inex_re;
int inex_im;
int s_im;
s_im = mpfr_signbit (mpc_imagref (op));
if (mpfr_cmp_ui (mpc_realref (op), 1) > 0)
{
if (s_im)
inex_im = -mpfr_acosh (mpc_imagref (rop), mpc_realref (op),
INV_RND (MPC_RND_IM (rnd)));
else
inex_im = mpfr_acosh (mpc_imagref (rop), mpc_realref (op),
MPC_RND_IM (rnd));
inex_re = set_pi_over_2 (mpc_realref (rop),
(mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd));
if (s_im)
mpc_conj (rop, rop, MPC_RNDNN);
}
else if (mpfr_cmp_si (mpc_realref (op), -1) < 0)
{
mpfr_t minus_op_re;
minus_op_re[0] = mpc_realref (op)[0];
MPFR_CHANGE_SIGN (minus_op_re);
if (s_im)
inex_im = -mpfr_acosh (mpc_imagref (rop), minus_op_re,
INV_RND (MPC_RND_IM (rnd)));
else
inex_im = mpfr_acosh (mpc_imagref (rop), minus_op_re,
MPC_RND_IM (rnd));
inex_re = set_pi_over_2 (mpc_realref (rop),
(mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd));
if (s_im)
mpc_conj (rop, rop, MPC_RNDNN);
}
else
{
inex_im = mpfr_set_ui (mpc_imagref (rop), 0, MPC_RND_IM (rnd));
if (s_im)
mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), GMP_RNDN);
inex_re = mpfr_asin (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
}
return MPC_INEX (inex_re, inex_im);
}
/* pure imaginary argument */
if (mpfr_zero_p (mpc_realref (op)))
{
int inex_im;
int s;
s = mpfr_signbit (mpc_realref (op));
mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
if (s)
mpfr_neg (mpc_realref (rop), mpc_realref (rop), GMP_RNDN);
inex_im = mpfr_asinh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
return MPC_INEX (0, inex_im);
}
/* regular complex: asin(z) = -i*log(i*z+sqrt(1-z^2)) */
p_re = mpfr_get_prec (mpc_realref(rop));
p_im = mpfr_get_prec (mpc_imagref(rop));
rnd_re = MPC_RND_RE(rnd);
rnd_im = MPC_RND_IM(rnd);
p = p_re >= p_im ? p_re : p_im;
mpc_init2 (z1, p);
while (1)
{
mpfr_exp_t ex, ey, err;
p += mpc_ceil_log2 (p) + 3 + incr_p; /* incr_p is zero initially */
incr_p = p / 2;
mpfr_set_prec (mpc_realref(z1), p);
mpfr_set_prec (mpc_imagref(z1), p);
/* z1 <- z^2 */
mpc_sqr (z1, op, MPC_RNDNN);
/* err(x) <= 1/2 ulp(x), err(y) <= 1/2 ulp(y) */
/* z1 <- 1-z1 */
ex = mpfr_get_exp (mpc_realref(z1));
mpfr_ui_sub (mpc_realref(z1), 1, mpc_realref(z1), GMP_RNDN);
mpfr_neg (mpc_imagref(z1), mpc_imagref(z1), GMP_RNDN);
ex = ex - mpfr_get_exp (mpc_realref(z1));
ex = (ex <= 0) ? 0 : ex;
/* err(x) <= 2^ex * ulp(x) */
ex = ex + mpfr_get_exp (mpc_realref(z1)) - p;
/* err(x) <= 2^ex */
ey = mpfr_get_exp (mpc_imagref(z1)) - p - 1;
/* err(y) <= 2^ey */
ex = (ex >= ey) ? ex : ey; /* err(x), err(y) <= 2^ex, i.e., the norm
of the error is bounded by |h|<=2^(ex+1/2) */
/* z1 <- sqrt(z1): if z1 = z + h, then sqrt(z1) = sqrt(z) + h/2/sqrt(t) */
ey = mpfr_get_exp (mpc_realref(z1)) >= mpfr_get_exp (mpc_imagref(z1))
? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1));
/* we have |z1| >= 2^(ey-1) thus 1/|z1| <= 2^(1-ey) */
mpc_sqrt (z1, z1, MPC_RNDNN);
ex = (2 * ex + 1) - 2 - (ey - 1); /* |h^2/4/|t| <= 2^ex */
ex = (ex + 1) / 2; /* ceil(ex/2) */
/* express ex in terms of ulp(z1) */
ey = mpfr_get_exp (mpc_realref(z1)) <= mpfr_get_exp (mpc_imagref(z1))
? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1));
ex = ex - ey + p;
/* take into account the rounding error in the mpc_sqrt call */
err = (ex <= 0) ? 1 : ex + 1;
/* err(x) <= 2^err * ulp(x), err(y) <= 2^err * ulp(y) */
/* z1 <- i*z + z1 */
ex = mpfr_get_exp (mpc_realref(z1));
ey = mpfr_get_exp (mpc_imagref(z1));
mpfr_sub (mpc_realref(z1), mpc_realref(z1), mpc_imagref(op), GMP_RNDN);
mpfr_add (mpc_imagref(z1), mpc_imagref(z1), mpc_realref(op), GMP_RNDN);
if (mpfr_cmp_ui (mpc_realref(z1), 0) == 0 || mpfr_cmp_ui (mpc_imagref(z1), 0) == 0)
continue;
ex -= mpfr_get_exp (mpc_realref(z1)); /* cancellation in x */
ey -= mpfr_get_exp (mpc_imagref(z1)); /* cancellation in y */
ex = (ex >= ey) ? ex : ey; /* maximum cancellation */
err += ex;
err = (err <= 0) ? 1 : err + 1; /* rounding error in sub/add */
/* z1 <- log(z1): if z1 = z + h, then log(z1) = log(z) + h/t with
|t| >= min(|z1|,|z|) */
ex = mpfr_get_exp (mpc_realref(z1));
ey = mpfr_get_exp (mpc_imagref(z1));
ex = (ex >= ey) ? ex : ey;
err += ex - p; /* revert to absolute error <= 2^err */
mpc_log (z1, z1, GMP_RNDN);
err -= ex - 1; /* 1/|t| <= 1/|z| <= 2^(1-ex) */
/* express err in terms of ulp(z1) */
ey = mpfr_get_exp (mpc_realref(z1)) <= mpfr_get_exp (mpc_imagref(z1))
? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1));
err = err - ey + p;
/* take into account the rounding error in the mpc_log call */
err = (err <= 0) ? 1 : err + 1;
/* z1 <- -i*z1 */
mpfr_swap (mpc_realref(z1), mpc_imagref(z1));
mpfr_neg (mpc_imagref(z1), mpc_imagref(z1), GMP_RNDN);
if (mpfr_can_round (mpc_realref(z1), p - err, GMP_RNDN, GMP_RNDZ,
p_re + (rnd_re == GMP_RNDN)) &&
mpfr_can_round (mpc_imagref(z1), p - err, GMP_RNDN, GMP_RNDZ,
p_im + (rnd_im == GMP_RNDN)))
break;
}
inex = mpc_set (rop, z1, rnd);
mpc_clear (z1);
return inex;
}
int
main (int argc, char *argv[])
{
unsigned int prec, yprec;
int rnd;
mpfr_t x, y, z, t;
unsigned long n;
int inex;
mpfr_exp_t emin, emax;
mpfr_flags_t flags, ex_flags;
int i;
tests_start_mpfr ();
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
if (argc >= 3) /* tzeta_ui n prec [rnd] */
{
mpfr_set_prec (x, atoi (argv[2]));
mpfr_zeta_ui (x, atoi (argv[1]),
argc > 3 ? (mpfr_rnd_t) atoi (argv[3]) : MPFR_RNDN);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf ("\n");
goto clear_and_exit;
}
mpfr_set_prec (x, 33);
mpfr_set_prec (y, 33);
mpfr_zeta_ui (x, 3, MPFR_RNDZ);
mpfr_set_str_binary (y, "0.100110011101110100000000001001111E1");
if (mpfr_cmp (x, y))
{
printf ("Error for zeta(3), prec=33, MPFR_RNDZ\n");
printf ("expected "); mpfr_dump (y);
printf ("got "); mpfr_dump (x);
exit (1);
}
mpfr_clear_flags ();
inex = mpfr_zeta_ui (x, 0, MPFR_RNDN);
flags = __gmpfr_flags;
MPFR_ASSERTN (inex == 0 && mpfr_cmp_si_2exp (x, -1, -1) == 0 && flags == 0);
for (i = -2; i <= 2; i += 2)
RND_LOOP (rnd)
{
int ex_inex;
set_emin (i);
set_emax (i);
mpfr_clear_flags ();
inex = mpfr_zeta_ui (x, 0, (mpfr_rnd_t) rnd);
flags = __gmpfr_flags;
if (i < 0)
{
mpfr_set_inf (y, -1);
if (rnd == MPFR_RNDU || rnd == MPFR_RNDZ)
{
mpfr_nextabove (y);
ex_inex = 1;
}
else
{
ex_inex = -1;
}
ex_flags = MPFR_FLAGS_OVERFLOW | MPFR_FLAGS_INEXACT;
}
else if (i > 0)
{
mpfr_set_zero (y, -1);
if (rnd == MPFR_RNDD || rnd == MPFR_RNDA)
{
mpfr_nextbelow (y);
ex_inex = -1;
}
else
{
ex_inex = 1;
}
ex_flags = MPFR_FLAGS_UNDERFLOW | MPFR_FLAGS_INEXACT;
}
else
{
mpfr_set_str_binary (y, "-1e-1");
ex_inex = 0;
ex_flags = 0;
}
set_emin (emin);
set_emax (emax);
if (! (mpfr_equal_p (x, y) && MPFR_IS_NEG (x) &&
SAME_SIGN (inex, ex_inex) && flags == ex_flags))
{
printf ("Failure for zeta(0) in %s, exponent range [%d,%d]\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) rnd), i, i);
printf ("Expected ");
mpfr_dump (y);
printf (" with inex ~ %d, flags =", ex_inex);
flags_out (ex_flags);
printf ("Got ");
mpfr_dump (x);
printf (" with inex = %d, flags =", inex);
flags_out (flags);
exit (1);
}
}
mpfr_clear_divby0 ();
inex = mpfr_zeta_ui (x, 1, MPFR_RNDN);
MPFR_ASSERTN (inex == 0 && MPFR_IS_INF (x) && MPFR_IS_POS (x)
&& mpfr_divby0_p ());
for (prec = MPFR_PREC_MIN; prec <= 100; prec++)
{
mpfr_set_prec (x, prec);
mpfr_set_prec (z, prec);
mpfr_set_prec (t, prec);
yprec = prec + 10;
mpfr_set_prec (y, yprec);
for (n = 0; n < 50; n++)
RND_LOOP (rnd)
{
mpfr_zeta_ui (y, n, MPFR_RNDN);
if (mpfr_can_round (y, yprec, MPFR_RNDN, MPFR_RNDZ, prec
+ (rnd == MPFR_RNDN)))
{
mpfr_set (t, y, (mpfr_rnd_t) rnd);
for (i = 0; i <= 1; i++)
{
if (i)
{
mpfr_exp_t e;
if (MPFR_IS_SINGULAR (t))
break;
e = mpfr_get_exp (t);
set_emin (e);
set_emax (e);
}
mpfr_zeta_ui (z, n, (mpfr_rnd_t) rnd);
if (i)
{
set_emin (emin);
set_emax (emax);
}
if (mpfr_cmp (t, z))
{
printf ("results differ for n = %lu, prec = %u,"
" %s%s\n", n, prec,
mpfr_print_rnd_mode ((mpfr_rnd_t) rnd),
i ? ", reduced exponent range" : "");
printf (" got ");
mpfr_dump (z);
printf (" expected ");
mpfr_dump (t);
printf (" approx ");
mpfr_dump (y);
exit (1);
}
}
}
}
}
clear_and_exit:
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (t);
tests_end_mpfr ();
return 0;
}
