/* compute remainder as in definition:
r = x - n * y, where n = trunc(x/y).
warning: may change flags. */
static int
slow_fmod (mpfr_ptr r, mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd)
{
mpfr_t q;
int inexact;
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x) || MPFR_IS_SINGULAR (y)))
{
if (MPFR_IS_NAN (x) || MPFR_IS_NAN (y) || MPFR_IS_INF (x)
|| MPFR_IS_ZERO (y))
{
MPFR_SET_NAN (r);
MPFR_RET_NAN;
}
else /* either y is Inf and x is 0 or non-special,
or x is 0 and y is non-special,
in both cases the quotient is zero. */
return mpfr_set (r, x, rnd);
}
/* regular cases */
/* if 2^(ex-1) <= |x| < 2^ex, and 2^(ey-1) <= |y| < 2^ey,
then |x/y| < 2^(ex-ey+1) */
mpfr_init2 (q,
MAX (MPFR_PREC_MIN, mpfr_get_exp (x) - mpfr_get_exp (y) + 1));
mpfr_div (q, x, y, MPFR_RNDZ);
mpfr_trunc (q, q); /* may change inexact flag */
mpfr_prec_round (q, mpfr_get_prec (q) + mpfr_get_prec (y), MPFR_RNDZ);
inexact = mpfr_mul (q, q, y, MPFR_RNDZ); /* exact */
inexact = mpfr_sub (r, x, q, rnd);
mpfr_clear (q);
return inexact;
}
inline mpfr_class frexp(const mpfr_class& v, int* expon)
{
int e = mpfr_get_exp(v.__get_mp());
mpfr_class result(v);
mpfr_set_exp(result.__get_mp(), 0);
*expon = e;
return result;
}
int main (int argc, char *argv[])
{
int dmax, n, p;
mpfr_t VARS;
if (argc != 3 && argc != 4)
{
fprintf (stderr, "Usage: divworst <dmax> <n> [ <p> ]\n");
exit (EXIT_FAILURE);
}
dmax = atoi (argv[1]);
n = atoi (argv[2]);
p = argc == 3 ? n : atoi (argv[3]);
if (p < n)
{
fprintf (stderr, "divworst: p must be greater or equal to n\n");
exit (EXIT_FAILURE);
}
mpfr_inits2 (n, PRECN, (mpfr_ptr) 0);
mpfr_init2 (t, p);
for (mpfr_set_ui_2exp (x, 1, -1, MPFR_RNDN);
mpfr_get_exp (x) <= dmax;
mpfr_nextabove (x))
for (mpfr_set_ui_2exp (y, 1, -1, MPFR_RNDN);
mpfr_get_exp (y) == 0;
mpfr_nextabove (y))
{
unsigned long rz, rn;
if (mpfr_sub (z, x, y, MPFR_RNDZ) != 0)
continue; /* x - y is not representable in precision n */
rz = eval (x, y, z, t, MPFR_RNDZ);
rn = eval (x, y, z, t, MPFR_RNDN);
if (rz == rn)
continue;
mpfr_printf ("x = %.*Rb ; y = %.*Rb ; Z: %lu ; N: %lu\n",
n - 1, x, n - 1, y, rz, rn);
}
mpfr_clears (VARS, (mpfr_ptr) 0);
return 0;
}
/* return add = 1 + floor(log(c^3*(13+m1))/log(2))
where c = (1+eps)*(1+eps*max(8,m1)),
m1 = 1 + max(1/eps,2*sd)*(1+eps),
eps = 2^(-precz-14)
sd = abs(s-1)
*/
static long
compute_add (mpfr_srcptr s, mpfr_prec_t precz)
{
mpfr_t t, u, m1;
long add;
mpfr_inits2 (64, t, u, m1, (mpfr_ptr) 0);
if (mpfr_cmp_ui (s, 1) >= 0)
mpfr_sub_ui (t, s, 1, MPFR_RNDU);
else
mpfr_ui_sub (t, 1, s, MPFR_RNDU);
/* now t = sd = abs(s-1), rounded up */
mpfr_set_ui_2exp (u, 1, - precz - 14, MPFR_RNDU);
/* u = eps */
/* since 1/eps = 2^(precz+14), if EXP(sd) >= precz+14, then
sd >= 1/2*2^(precz+14) thus 2*sd >= 2^(precz+14) >= 1/eps */
if (mpfr_get_exp (t) >= precz + 14)
mpfr_mul_2exp (t, t, 1, MPFR_RNDU);
else
mpfr_set_ui_2exp (t, 1, precz + 14, MPFR_RNDU);
/* now t = max(1/eps,2*sd) */
mpfr_add_ui (u, u, 1, MPFR_RNDU); /* u = 1+eps, rounded up */
mpfr_mul (t, t, u, MPFR_RNDU); /* t = max(1/eps,2*sd)*(1+eps) */
mpfr_add_ui (m1, t, 1, MPFR_RNDU);
if (mpfr_get_exp (m1) <= 3)
mpfr_set_ui (t, 8, MPFR_RNDU);
else
mpfr_set (t, m1, MPFR_RNDU);
/* now t = max(8,m1) */
mpfr_div_2exp (t, t, precz + 14, MPFR_RNDU); /* eps*max(8,m1) */
mpfr_add_ui (t, t, 1, MPFR_RNDU); /* 1+eps*max(8,m1) */
mpfr_mul (t, t, u, MPFR_RNDU); /* t = c */
mpfr_add_ui (u, m1, 13, MPFR_RNDU); /* 13+m1 */
mpfr_mul (u, u, t, MPFR_RNDU); /* c*(13+m1) */
mpfr_sqr (t, t, MPFR_RNDU); /* c^2 */
mpfr_mul (u, u, t, MPFR_RNDU); /* c^3*(13+m1) */
add = mpfr_get_exp (u);
mpfr_clears (t, u, m1, (mpfr_ptr) 0);
return add;
}
static int
is_odd (mpfr_srcptr y, mpfr_exp_t k)
{
mpfr_exp_t expo;
mpfr_prec_t prec;
mp_size_t yn;
mp_limb_t *yp;
expo = mpfr_get_exp (y) + k;
if (expo <= 0)
return 0; /* |y| < 1 and not 0 */
prec = mpfr_get_prec (y);
if ((mpfr_prec_t) expo > prec)
return 0; /* y is a multiple of 2^(expo-prec), thus not odd */
/* 0 < expo <= prec:
y = 1xxxxxxxxxt.zzzzzzzzzzzzzzzzzz[000]
expo bits (prec-expo) bits
We have to check that:
(a) the bit 't' is set
(b) all the 'z' bits are zero
*/
prec = ((prec - 1) / BITS_PER_MP_LIMB + 1) * BITS_PER_MP_LIMB - expo;
/* number of z+0 bits */
yn = prec / BITS_PER_MP_LIMB;
/* yn is the index of limb containing the 't' bit */
yp = y->_mpfr_d;
/* if expo is a multiple of BITS_PER_MP_LIMB, t is bit 0 */
if (expo % BITS_PER_MP_LIMB == 0 ? (yp[yn] & 1) == 0
: yp[yn] << ((expo % BITS_PER_MP_LIMB) - 1) != MPFR_LIMB_HIGHBIT)
return 0;
while (--yn >= 0)
if (yp[yn] != 0)
return 0;
return 1;
}
/* TODO
* exponents that use more than 16 bytes are not managed
*/
static unsigned char*
mpfr_fpif_store_exponent (unsigned char *buffer, size_t *buffer_size, mpfr_t x)
{
unsigned char *result;
mpfr_exp_t exponent;
mpfr_uexp_t uexp;
size_t exponent_size;
exponent = mpfr_get_exp (x);
exponent_size = 0;
if (mpfr_regular_p (x))
{
if (exponent > MPFR_MAX_EMBEDDED_EXPONENT ||
exponent < -MPFR_MAX_EMBEDDED_EXPONENT)
{
mpfr_exp_t copy_exponent;
uexp = SAFE_ABS (mpfr_uexp_t, exponent)
- MPFR_MAX_EMBEDDED_EXPONENT;
copy_exponent = uexp << 1;
COUNT_NB_BYTE(copy_exponent, exponent_size);
if (exponent < 0)
uexp |= (mpfr_uexp_t) 1 << (8 * exponent_size - 1);
}
else
uexp = exponent + MPFR_MAX_EMBEDDED_EXPONENT;
}
result = buffer;
ALLOC_RESULT(result, buffer_size, exponent_size + 1);
if (mpfr_regular_p (x))
{
if (exponent_size == 0)
result[0] = uexp;
else
{
result[0] = MPFR_EXTERNAL_EXPONENT + exponent_size;
putLittleEndianData (result + 1, (unsigned char *) &uexp,
sizeof(mpfr_exp_t), exponent_size);
}
}
else if (mpfr_zero_p (x))
result[0] = MPFR_KIND_ZERO;
else if (mpfr_inf_p (x))
result[0] = MPFR_KIND_INF;
else
{
MPFR_ASSERTD (mpfr_nan_p (x));
result[0] = MPFR_KIND_NAN;
}
if (MPFR_IS_NEG (x))
result[0] |= 0x80;
return result;
}
/* Don't need to save/restore exponent range: the cache does it */
int
mpfr_const_pi_internal (mpfr_ptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t a, A, B, D, S;
mpfr_prec_t px, p, cancel, k, kmax;
MPFR_ZIV_DECL (loop);
int inex;
MPFR_LOG_FUNC
(("rnd_mode=%d", rnd_mode),
("x[%Pu]=%.*Rg inexact=%d", mpfr_get_prec(x), mpfr_log_prec, x, inex));
px = MPFR_PREC (x);
/* we need 9*2^kmax - 4 >= px+2*kmax+8 */
for (kmax = 2; ((px + 2 * kmax + 12) / 9) >> kmax; kmax ++);
p = px + 3 * kmax + 14; /* guarantees no recomputation for px <= 10000 */
mpfr_init2 (a, p);
mpfr_init2 (A, p);
mpfr_init2 (B, p);
mpfr_init2 (D, p);
mpfr_init2 (S, p);
MPFR_ZIV_INIT (loop, p);
for (;;) {
mpfr_set_ui (a, 1, MPFR_RNDN); /* a = 1 */
mpfr_set_ui (A, 1, MPFR_RNDN); /* A = a^2 = 1 */
mpfr_set_ui_2exp (B, 1, -1, MPFR_RNDN); /* B = b^2 = 1/2 */
mpfr_set_ui_2exp (D, 1, -2, MPFR_RNDN); /* D = 1/4 */
#define b B
#define ap a
#define Ap A
#define Bp B
for (k = 0; ; k++)
{
/* invariant: 1/2 <= B <= A <= a < 1 */
mpfr_add (S, A, B, MPFR_RNDN); /* 1 <= S <= 2 */
mpfr_div_2ui (S, S, 2, MPFR_RNDN); /* exact, 1/4 <= S <= 1/2 */
mpfr_sqrt (b, B, MPFR_RNDN); /* 1/2 <= b <= 1 */
mpfr_add (ap, a, b, MPFR_RNDN); /* 1 <= ap <= 2 */
mpfr_div_2ui (ap, ap, 1, MPFR_RNDN); /* exact, 1/2 <= ap <= 1 */
mpfr_mul (Ap, ap, ap, MPFR_RNDN); /* 1/4 <= Ap <= 1 */
mpfr_sub (Bp, Ap, S, MPFR_RNDN); /* -1/4 <= Bp <= 3/4 */
mpfr_mul_2ui (Bp, Bp, 1, MPFR_RNDN); /* -1/2 <= Bp <= 3/2 */
mpfr_sub (S, Ap, Bp, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (S, 1) < 0);
cancel = mpfr_cmp_ui (S, 0) ? (mpfr_uexp_t) -mpfr_get_exp(S) : p;
/* MPFR_ASSERTN (cancel >= px || cancel >= 9 * (1 << k) - 4); */
mpfr_mul_2ui (S, S, k, MPFR_RNDN);
mpfr_sub (D, D, S, MPFR_RNDN);
/* stop when |A_k - B_k| <= 2^(k-p) i.e. cancel >= p-k */
if (cancel + k >= p)
break;
}
#undef b
#undef ap
#undef Ap
#undef Bp
mpfr_div (A, B, D, MPFR_RNDN);
/* MPFR_ASSERTN(p >= 2 * k + 8); */
if (MPFR_LIKELY (MPFR_CAN_ROUND (A, p - 2 * k - 8, px, rnd_mode)))
break;
p += kmax;
MPFR_ZIV_NEXT (loop, p);
mpfr_set_prec (a, p);
mpfr_set_prec (A, p);
mpfr_set_prec (B, p);
mpfr_set_prec (D, p);
mpfr_set_prec (S, p);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (x, A, rnd_mode);
mpfr_clear (a);
mpfr_clear (A);
mpfr_clear (B);
mpfr_clear (D);
mpfr_clear (S);
return inex;
}
void generate_2D_sample (FILE *output, struct speed_params2D param)
{
mpfr_t temp;
double incr_prec;
mpfr_t incr_x;
mpfr_t x, x2;
double prec;
struct speed_params s;
int i;
int test;
int nb_functions;
double *t; /* store the timing of each implementation */
/* We first determine how many implementations we have */
nb_functions = 0;
while (param.speed_funcs[nb_functions] != NULL)
nb_functions++;
t = malloc (nb_functions * sizeof (double));
if (t == NULL)
{
fprintf (stderr, "Can't allocate memory.\n");
abort ();
}
mpfr_init2 (temp, MPFR_SMALL_PRECISION);
/* The precision is sampled from min_prec to max_prec with */
/* approximately nb_points_prec points. If logarithmic_scale_prec */
/* is true, the precision is multiplied by incr_prec at each */
/* step. Otherwise, incr_prec is added at each step. */
if (param.logarithmic_scale_prec)
{
mpfr_set_ui (temp, (unsigned long int)param.max_prec, MPFR_RNDU);
mpfr_div_ui (temp, temp, (unsigned long int)param.min_prec, MPFR_RNDU);
mpfr_root (temp, temp,
(unsigned long int)param.nb_points_prec, MPFR_RNDU);
incr_prec = mpfr_get_d (temp, MPFR_RNDU);
}
else
{
incr_prec = (double)param.max_prec - (double)param.min_prec;
incr_prec = incr_prec/((double)param.nb_points_prec);
}
/* The points x are sampled according to the following rule: */
/* If logarithmic_scale_x = 0: */
/* nb_points_x points are equally distributed between min_x and max_x */
/* If logarithmic_scale_x = 1: */
/* nb_points_x points are sampled from 2^(min_x) to 2^(max_x). At */
/* each step, the current point is multiplied by incr_x. */
/* If logarithmic_scale_x = -1: */
/* nb_points_x/2 points are sampled from -2^(max_x) to -2^(min_x) */
/* (at each step, the current point is divided by incr_x); and */
/* nb_points_x/2 points are sampled from 2^(min_x) to 2^(max_x) */
/* (at each step, the current point is multiplied by incr_x). */
mpfr_init2 (incr_x, param.max_prec);
if (param.logarithmic_scale_x == 0)
{
mpfr_set_d (incr_x,
(param.max_x - param.min_x)/(double)param.nb_points_x,
MPFR_RNDU);
}
else if (param.logarithmic_scale_x == -1)
{
mpfr_set_d (incr_x,
2.*(param.max_x - param.min_x)/(double)param.nb_points_x,
MPFR_RNDU);
mpfr_exp2 (incr_x, incr_x, MPFR_RNDU);
}
else
{ /* other values of param.logarithmic_scale_x are considered as 1 */
mpfr_set_d (incr_x,
(param.max_x - param.min_x)/(double)param.nb_points_x,
MPFR_RNDU);
mpfr_exp2 (incr_x, incr_x, MPFR_RNDU);
}
/* Main loop */
mpfr_init2 (x, param.max_prec);
mpfr_init2 (x2, param.max_prec);
prec = (double)param.min_prec;
while (prec <= param.max_prec)
{
printf ("prec = %d\n", (int)prec);
if (param.logarithmic_scale_x == 0)
mpfr_set_d (temp, param.min_x, MPFR_RNDU);
else if (param.logarithmic_scale_x == -1)
{
mpfr_set_d (temp, param.max_x, MPFR_RNDD);
mpfr_exp2 (temp, temp, MPFR_RNDD);
mpfr_neg (temp, temp, MPFR_RNDU);
}
else
{
mpfr_set_d (temp, param.min_x, MPFR_RNDD);
mpfr_exp2 (temp, temp, MPFR_RNDD);
}
/* We perturb x a little bit, in order to avoid trailing zeros that */
/* might change the behavior of algorithms. */
mpfr_const_pi (x, MPFR_RNDN);
mpfr_div_2ui (x, x, 7, MPFR_RNDN);
mpfr_add_ui (x, x, 1, MPFR_RNDN);
mpfr_mul (x, x, temp, MPFR_RNDN);
test = 1;
while (test)
{
mpfr_fprintf (output, "%e\t", mpfr_get_d (x, MPFR_RNDN));
mpfr_fprintf (output, "%Pu\t", (mpfr_prec_t)prec);
s.r = (mp_limb_t)mpfr_get_exp (x);
s.size = (mpfr_prec_t)prec;
s.align_xp = (mpfr_sgn (x) > 0)?1:2;
mpfr_set_prec (x2, (mpfr_prec_t)prec);
mpfr_set (x2, x, MPFR_RNDU);
s.xp = x2->_mpfr_d;
for (i=0; i<nb_functions; i++)
{
t[i] = speed_measure (param.speed_funcs[i], &s);
mpfr_fprintf (output, "%e\t", t[i]);
}
fprintf (output, "%d\n", 1 + find_best (t, nb_functions));
if (param.logarithmic_scale_x == 0)
{
mpfr_add (x, x, incr_x, MPFR_RNDU);
if (mpfr_cmp_d (x, param.max_x) > 0)
test=0;
}
else
{
if (mpfr_sgn (x) < 0 )
{ /* if x<0, it means that logarithmic_scale_x=-1 */
mpfr_div (x, x, incr_x, MPFR_RNDU);
mpfr_abs (temp, x, MPFR_RNDD);
mpfr_log2 (temp, temp, MPFR_RNDD);
if (mpfr_cmp_d (temp, param.min_x) < 0)
mpfr_neg (x, x, MPFR_RNDN);
}
else
{
mpfr_mul (x, x, incr_x, MPFR_RNDU);
mpfr_set (temp, x, MPFR_RNDD);
mpfr_log2 (temp, temp, MPFR_RNDD);
if (mpfr_cmp_d (temp, param.max_x) > 0)
test=0;
}
}
}
prec = ( (param.logarithmic_scale_prec) ? (prec * incr_prec)
: (prec + incr_prec) );
fprintf (output, "\n");
}
free (t);
mpfr_clear (incr_x);
mpfr_clear (x);
mpfr_clear (x2);
mpfr_clear (temp);
return;
}
/* f <- 1 - r/2! + r^2/4! + ... + (-1)^l r^l/(2l)! + ...
Assumes |r| < 1/2, and f, r have the same precision.
Returns e such that the error on f is bounded by 2^e ulps.
*/
static int
mpfr_cos2_aux (mpfr_ptr f, mpfr_srcptr r)
{
mpz_t x, t, s;
mpfr_exp_t ex, l, m;
mpfr_prec_t p, q;
unsigned long i, maxi, imax;
MPFR_ASSERTD(mpfr_get_exp (r) <= -1);
/* compute minimal i such that i*(i+1) does not fit in an unsigned long,
assuming that there are no padding bits. */
maxi = 1UL << (CHAR_BIT * sizeof(unsigned long) / 2);
if (maxi * (maxi / 2) == 0) /* test checked at compile time */
{
/* can occur only when there are padding bits. */
/* maxi * (maxi-1) is representable iff maxi * (maxi / 2) != 0 */
do
maxi /= 2;
while (maxi * (maxi / 2) == 0);
}
mpz_init (x);
mpz_init (s);
mpz_init (t);
ex = mpfr_get_z_2exp (x, r); /* r = x*2^ex */
/* remove trailing zeroes */
l = mpz_scan1 (x, 0);
ex += l;
mpz_fdiv_q_2exp (x, x, l);
/* since |r| < 1, r = x*2^ex, and x is an integer, necessarily ex < 0 */
p = mpfr_get_prec (f); /* same than r */
/* bound for number of iterations */
imax = p / (-mpfr_get_exp (r));
imax += (imax == 0);
q = 2 * MPFR_INT_CEIL_LOG2(imax) + 4; /* bound for (3l)^2 */
mpz_set_ui (s, 1); /* initialize sum with 1 */
mpz_mul_2exp (s, s, p + q); /* scale all values by 2^(p+q) */
mpz_set (t, s); /* invariant: t is previous term */
for (i = 1; (m = mpz_sizeinbase (t, 2)) >= q; i += 2)
{
/* adjust precision of x to that of t */
l = mpz_sizeinbase (x, 2);
if (l > m)
{
l -= m;
mpz_fdiv_q_2exp (x, x, l);
ex += l;
}
/* multiply t by r */
mpz_mul (t, t, x);
mpz_fdiv_q_2exp (t, t, -ex);
/* divide t by i*(i+1) */
if (i < maxi)
mpz_fdiv_q_ui (t, t, i * (i + 1));
else
{
mpz_fdiv_q_ui (t, t, i);
mpz_fdiv_q_ui (t, t, i + 1);
}
/* if m is the (current) number of bits of t, we can consider that
all operations on t so far had precision >= m, so we can prove
by induction that the relative error on t is of the form
(1+u)^(3l)-1, where |u| <= 2^(-m), and l=(i+1)/2 is the # of loops.
Since |(1+x^2)^(1/x) - 1| <= 4x/3 for |x| <= 1/2,
for |u| <= 1/(3l)^2, the absolute error is bounded by
4/3*(3l)*2^(-m)*t <= 4*l since |t| < 2^m.
Therefore the error on s is bounded by 2*l*(l+1). */
/* add or subtract to s */
if (i % 4 == 1)
mpz_sub (s, s, t);
else
mpz_add (s, s, t);
}
mpfr_set_z (f, s, MPFR_RNDN);
mpfr_div_2ui (f, f, p + q, MPFR_RNDN);
mpz_clear (x);
mpz_clear (s);
mpz_clear (t);
l = (i - 1) / 2; /* number of iterations */
return 2 * MPFR_INT_CEIL_LOG2 (l + 1) + 1; /* bound is 2l(l+1) */
}
int
mpc_sqr (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int ok;
mpfr_t u, v;
mpfr_t x;
/* temporary variable to hold the real part of op,
needed in the case rop==op */
mpfr_prec_t prec;
int inex_re, inex_im, inexact;
mpfr_exp_t emin;
int saved_underflow;
/* special values: NaN and infinities */
if (!mpc_fin_p (op)) {
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op))) {
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
else if (mpfr_inf_p (mpc_realref (op))) {
if (mpfr_inf_p (mpc_imagref (op))) {
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_nan (mpc_realref (rop));
}
else {
if (mpfr_zero_p (mpc_imagref (op)))
mpfr_set_nan (mpc_imagref (rop));
else
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_inf (mpc_realref (rop), +1);
}
}
else /* IM(op) is infinity, RE(op) is not */ {
if (mpfr_zero_p (mpc_realref (op)))
mpfr_set_nan (mpc_imagref (rop));
else
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_inf (mpc_realref (rop), -1);
}
return MPC_INEX (0, 0); /* exact */
}
prec = MPC_MAX_PREC(rop);
/* Check for real resp. purely imaginary number */
if (mpfr_zero_p (mpc_imagref(op))) {
int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op));
inex_re = mpfr_sqr (mpc_realref(rop), mpc_realref(op), MPC_RND_RE(rnd));
inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN);
if (!same_sign)
mpc_conj (rop, rop, MPC_RNDNN);
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_zero_p (mpc_realref(op))) {
int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op));
inex_re = -mpfr_sqr (mpc_realref(rop), mpc_imagref(op), INV_RND (MPC_RND_RE(rnd)));
mpfr_neg (mpc_realref(rop), mpc_realref(rop), MPFR_RNDN);
inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN);
if (!same_sign)
mpc_conj (rop, rop, MPC_RNDNN);
return MPC_INEX(inex_re, inex_im);
}
if (rop == op)
{
mpfr_init2 (x, MPC_PREC_RE (op));
mpfr_set (x, op->re, MPFR_RNDN);
}
else
x [0] = op->re [0];
/* From here on, use x instead of op->re and safely overwrite rop->re. */
/* Compute real part of result. */
if (SAFE_ABS (mpfr_exp_t,
mpfr_get_exp (mpc_realref (op)) - mpfr_get_exp (mpc_imagref (op)))
> (mpfr_exp_t) MPC_MAX_PREC (op) / 2) {
/* If the real and imaginary parts of the argument have very different
exponents, it is not reasonable to use Karatsuba squaring; compute
exactly with the standard formulae instead, even if this means an
additional multiplication. Using the approach copied from mul, over-
and underflows are also handled correctly. */
inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd));
}
else {
/* Karatsuba squaring: we compute the real part as (x+y)*(x-y) and the
imaginary part as 2*x*y, with a total of 2M instead of 2S+1M for the
naive algorithm, which computes x^2-y^2 and 2*y*y */
mpfr_init (u);
mpfr_init (v);
emin = mpfr_get_emin ();
do
{
prec += mpc_ceil_log2 (prec) + 5;
mpfr_set_prec (u, prec);
mpfr_set_prec (v, prec);
/* Let op = x + iy. We need u = x+y and v = x-y, rounded away. */
/* The error is bounded above by 1 ulp. */
/* We first let inexact be 1 if the real part is not computed */
/* exactly and determine the sign later. */
inexact = mpfr_add (u, x, mpc_imagref (op), MPFR_RNDA)
| mpfr_sub (v, x, mpc_imagref (op), MPFR_RNDA);
/* compute the real part as u*v, rounded away */
/* determine also the sign of inex_re */
if (mpfr_sgn (u) == 0 || mpfr_sgn (v) == 0) {
/* as we have rounded away, the result is exact */
mpfr_set_ui (mpc_realref (rop), 0, MPFR_RNDN);
inex_re = 0;
ok = 1;
}
else {
inexact |= mpfr_mul (u, u, v, MPFR_RNDA); /* error 5 */
if (mpfr_get_exp (u) == emin || mpfr_inf_p (u)) {
/* under- or overflow */
inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd));
ok = 1;
}
else {
ok = (!inexact) | mpfr_can_round (u, prec - 3,
MPFR_RNDA, MPFR_RNDZ,
MPC_PREC_RE (rop) + (MPC_RND_RE (rnd) == MPFR_RNDN));
if (ok) {
inex_re = mpfr_set (mpc_realref (rop), u, MPC_RND_RE (rnd));
if (inex_re == 0)
/* remember that u was already rounded */
inex_re = inexact;
}
}
}
}
while (!ok);
mpfr_clear (u);
mpfr_clear (v);
}
saved_underflow = mpfr_underflow_p ();
mpfr_clear_underflow ();
inex_im = mpfr_mul (rop->im, x, op->im, MPC_RND_IM (rnd));
if (!mpfr_underflow_p ())
inex_im |= mpfr_mul_2ui (rop->im, rop->im, 1, MPC_RND_IM (rnd));
/* We must not multiply by 2 if rop->im has been set to the smallest
representable number. */
if (saved_underflow)
mpfr_set_underflow ();
if (rop == op)
mpfr_clear (x);
return MPC_INEX (inex_re, inex_im);
}
int
mpc_atan (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int s_re;
int s_im;
int inex_re;
int inex_im;
int inex;
inex_re = 0;
inex_im = 0;
s_re = mpfr_signbit (mpc_realref (op));
s_im = mpfr_signbit (mpc_imagref (op));
/* special values */
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
{
if (mpfr_nan_p (mpc_realref (op)))
{
mpfr_set_nan (mpc_realref (rop));
if (mpfr_zero_p (mpc_imagref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, MPC_RNDNN);
}
else
mpfr_set_nan (mpc_imagref (rop));
}
else
{
if (mpfr_inf_p (mpc_realref (op)))
{
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
}
else
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
}
return MPC_INEX (inex_re, 0);
}
if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, GMP_RNDN);
return MPC_INEX (inex_re, 0);
}
/* pure real argument */
if (mpfr_zero_p (mpc_imagref (op)))
{
inex_re = mpfr_atan (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, GMP_RNDN);
return MPC_INEX (inex_re, 0);
}
/* pure imaginary argument */
if (mpfr_zero_p (mpc_realref (op)))
{
int cmp_1;
if (s_im)
cmp_1 = -mpfr_cmp_si (mpc_imagref (op), -1);
else
cmp_1 = mpfr_cmp_ui (mpc_imagref (op), +1);
if (cmp_1 < 0)
{
/* atan(+0+iy) = +0 +i*atanh(y), if |y| < 1
atan(-0+iy) = -0 +i*atanh(y), if |y| < 1 */
mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
if (s_re)
mpfr_neg (mpc_realref (rop), mpc_realref (rop), GMP_RNDN);
inex_im = mpfr_atanh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
}
else if (cmp_1 == 0)
{
/* atan(+/-0+i) = NaN +i*inf
atan(+/-0-i) = NaN -i*inf */
mpfr_set_nan (mpc_realref (rop));
mpfr_set_inf (mpc_imagref (rop), s_im ? -1 : +1);
}
else
{
/* atan(+0+iy) = +pi/2 +i*atanh(1/y), if |y| > 1
atan(-0+iy) = -pi/2 +i*atanh(1/y), if |y| > 1 */
mpfr_rnd_t rnd_im, rnd_away;
mpfr_t y;
mpfr_prec_t p, p_im;
int ok;
rnd_im = MPC_RND_IM (rnd);
mpfr_init (y);
p_im = mpfr_get_prec (mpc_imagref (rop));
p = p_im;
/* a = o(1/y) with error(a) < 1 ulp(a)
b = o(atanh(a)) with error(b) < (1+2^{1+Exp(a)-Exp(b)}) ulp(b)
As |atanh (1/y)| > |1/y| we have Exp(a)-Exp(b) <=0 so, at most,
2 bits of precision are lost.
We round atanh(1/y) away from 0.
*/
do
{
p += mpc_ceil_log2 (p) + 2;
mpfr_set_prec (y, p);
rnd_away = s_im == 0 ? GMP_RNDU : GMP_RNDD;
inex_im = mpfr_ui_div (y, 1, mpc_imagref (op), rnd_away);
/* FIXME: should we consider the case with unreasonably huge
precision prec(y)>3*exp_min, where atanh(1/Im(op)) could be
representable while 1/Im(op) underflows ?
This corresponds to |y| = 0.5*2^emin, in which case the
result may be wrong. */
/* atanh cannot underflow: |atanh(x)| > |x| for |x| < 1 */
inex_im |= mpfr_atanh (y, y, rnd_away);
ok = inex_im == 0
|| mpfr_can_round (y, p - 2, rnd_away, GMP_RNDZ,
p_im + (rnd_im == GMP_RNDN));
} while (ok == 0);
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
inex_im = mpfr_set (mpc_imagref (rop), y, rnd_im);
mpfr_clear (y);
}
return MPC_INEX (inex_re, inex_im);
}
/* regular number argument */
{
mpfr_t a, b, x, y;
mpfr_prec_t prec, p;
mpfr_exp_t err, expo;
int ok = 0;
mpfr_t minus_op_re;
mpfr_exp_t op_re_exp, op_im_exp;
mpfr_rnd_t rnd1, rnd2;
mpfr_inits2 (MPFR_PREC_MIN, a, b, x, y, (mpfr_ptr) 0);
/* real part: Re(arctan(x+i*y)) = [arctan2(x,1-y) - arctan2(-x,1+y)]/2 */
minus_op_re[0] = mpc_realref (op)[0];
MPFR_CHANGE_SIGN (minus_op_re);
op_re_exp = mpfr_get_exp (mpc_realref (op));
op_im_exp = mpfr_get_exp (mpc_imagref (op));
prec = mpfr_get_prec (mpc_realref (rop)); /* result precision */
/* a = o(1-y) error(a) < 1 ulp(a)
b = o(atan2(x,a)) error(b) < [1+2^{3+Exp(x)-Exp(a)-Exp(b)}] ulp(b)
= kb ulp(b)
c = o(1+y) error(c) < 1 ulp(c)
d = o(atan2(-x,c)) error(d) < [1+2^{3+Exp(x)-Exp(c)-Exp(d)}] ulp(d)
= kd ulp(d)
e = o(b - d) error(e) < [1 + kb*2^{Exp(b}-Exp(e)}
+ kd*2^{Exp(d)-Exp(e)}] ulp(e)
error(e) < [1 + 2^{4+Exp(x)-Exp(a)-Exp(e)}
+ 2^{4+Exp(x)-Exp(c)-Exp(e)}] ulp(e)
because |atan(u)| < |u|
< [1 + 2^{5+Exp(x)-min(Exp(a),Exp(c))
-Exp(e)}] ulp(e)
f = e/2 exact
*/
/* p: working precision */
p = (op_im_exp > 0 || prec > SAFE_ABS (mpfr_prec_t, op_im_exp)) ? prec
: (prec - op_im_exp);
rnd1 = mpfr_sgn (mpc_realref (op)) > 0 ? GMP_RNDD : GMP_RNDU;
rnd2 = mpfr_sgn (mpc_realref (op)) < 0 ? GMP_RNDU : GMP_RNDD;
do
{
p += mpc_ceil_log2 (p) + 2;
mpfr_set_prec (a, p);
mpfr_set_prec (b, p);
mpfr_set_prec (x, p);
/* x = upper bound for atan (x/(1-y)). Since atan is increasing, we
need an upper bound on x/(1-y), i.e., a lower bound on 1-y for
x positive, and an upper bound on 1-y for x negative */
mpfr_ui_sub (a, 1, mpc_imagref (op), rnd1);
if (mpfr_sgn (a) == 0) /* y is near 1, thus 1+y is near 2, and
expo will be 1 or 2 below */
{
MPC_ASSERT (mpfr_cmp_ui (mpc_imagref(op), 1) == 0);
/* check for intermediate underflow */
err = 2; /* ensures err will be expo below */
}
else
err = mpfr_get_exp (a); /* err = Exp(a) with the notations above */
mpfr_atan2 (x, mpc_realref (op), a, GMP_RNDU);
/* b = lower bound for atan (-x/(1+y)): for x negative, we need a
lower bound on -x/(1+y), i.e., an upper bound on 1+y */
mpfr_add_ui (a, mpc_imagref(op), 1, rnd2);
/* if a is exactly zero, i.e., Im(op) = -1, then the error on a is 0,
and we can simply ignore the terms involving Exp(a) in the error */
if (mpfr_sgn (a) == 0)
{
MPC_ASSERT (mpfr_cmp_si (mpc_imagref(op), -1) == 0);
/* check for intermediate underflow */
expo = err; /* will leave err unchanged below */
}
else
expo = mpfr_get_exp (a); /* expo = Exp(c) with the notations above */
mpfr_atan2 (b, minus_op_re, a, GMP_RNDD);
err = err < expo ? err : expo; /* err = min(Exp(a),Exp(c)) */
mpfr_sub (x, x, b, GMP_RNDU);
err = 5 + op_re_exp - err - mpfr_get_exp (x);
/* error is bounded by [1 + 2^err] ulp(e) */
err = err < 0 ? 1 : err + 1;
mpfr_div_2ui (x, x, 1, GMP_RNDU);
/* Note: using RND2=RNDD guarantees that if x is exactly representable
on prec + ... bits, mpfr_can_round will return 0 */
ok = mpfr_can_round (x, p - err, GMP_RNDU, GMP_RNDD,
prec + (MPC_RND_RE (rnd) == GMP_RNDN));
} while (ok == 0);
/* Imaginary part
Im(atan(x+I*y)) = 1/4 * [log(x^2+(1+y)^2) - log (x^2 +(1-y)^2)] */
prec = mpfr_get_prec (mpc_imagref (rop)); /* result precision */
/* a = o(1+y) error(a) < 1 ulp(a)
b = o(a^2) error(b) < 5 ulp(b)
c = o(x^2) error(c) < 1 ulp(c)
d = o(b+c) error(d) < 7 ulp(d)
e = o(log(d)) error(e) < [1 + 7*2^{2-Exp(e)}] ulp(e) = ke ulp(e)
f = o(1-y) error(f) < 1 ulp(f)
g = o(f^2) error(g) < 5 ulp(g)
h = o(c+f) error(h) < 7 ulp(h)
i = o(log(h)) error(i) < [1 + 7*2^{2-Exp(i)}] ulp(i) = ki ulp(i)
j = o(e-i) error(j) < [1 + ke*2^{Exp(e)-Exp(j)}
+ ki*2^{Exp(i)-Exp(j)}] ulp(j)
error(j) < [1 + 2^{Exp(e)-Exp(j)} + 2^{Exp(i)-Exp(j)}
+ 7*2^{3-Exp(j)}] ulp(j)
< [1 + 2^{max(Exp(e),Exp(i))-Exp(j)+1}
+ 7*2^{3-Exp(j)}] ulp(j)
k = j/4 exact
*/
err = 2;
p = prec; /* working precision */
do
{
p += mpc_ceil_log2 (p) + err;
mpfr_set_prec (a, p);
mpfr_set_prec (b, p);
mpfr_set_prec (y, p);
/* a = upper bound for log(x^2 + (1+y)^2) */
ROUND_AWAY (mpfr_add_ui (a, mpc_imagref (op), 1, MPFR_RNDA), a);
mpfr_sqr (a, a, GMP_RNDU);
mpfr_sqr (y, mpc_realref (op), GMP_RNDU);
mpfr_add (a, a, y, GMP_RNDU);
mpfr_log (a, a, GMP_RNDU);
/* b = lower bound for log(x^2 + (1-y)^2) */
mpfr_ui_sub (b, 1, mpc_imagref (op), GMP_RNDZ); /* round to zero */
mpfr_sqr (b, b, GMP_RNDZ);
/* we could write mpfr_sqr (y, mpc_realref (op), GMP_RNDZ) but it is
more efficient to reuse the value of y (x^2) above and subtract
one ulp */
mpfr_nextbelow (y);
mpfr_add (b, b, y, GMP_RNDZ);
mpfr_log (b, b, GMP_RNDZ);
mpfr_sub (y, a, b, GMP_RNDU);
if (mpfr_zero_p (y))
/* FIXME: happens when x and y have very different magnitudes;
could be handled more efficiently */
ok = 0;
else
{
expo = MPC_MAX (mpfr_get_exp (a), mpfr_get_exp (b));
expo = expo - mpfr_get_exp (y) + 1;
err = 3 - mpfr_get_exp (y);
/* error(j) <= [1 + 2^expo + 7*2^err] ulp(j) */
if (expo <= err) /* error(j) <= [1 + 2^{err+1}] ulp(j) */
err = (err < 0) ? 1 : err + 2;
else
err = (expo < 0) ? 1 : expo + 2;
mpfr_div_2ui (y, y, 2, GMP_RNDN);
MPC_ASSERT (!mpfr_zero_p (y));
/* FIXME: underflow. Since the main term of the Taylor series
in y=0 is 1/(x^2+1) * y, this means that y is very small
and/or x very large; but then the mpfr_zero_p (y) above
should be true. This needs a proof, or better yet,
special code. */
ok = mpfr_can_round (y, p - err, GMP_RNDU, GMP_RNDD,
prec + (MPC_RND_IM (rnd) == GMP_RNDN));
}
} while (ok == 0);
inex = mpc_set_fr_fr (rop, x, y, rnd);
mpfr_clears (a, b, x, y, (mpfr_ptr) 0);
return inex;
}
}
/* Generic random tests with cancellations.
*
* In summary, we do 4000 tests of the following form:
* 1. We set the first MPFR_NCANCEL members of an array to random values,
* with a random exponent taken in 4 ranges, depending on the value of
* i % 4 (see code below).
* 2. For each of the next MPFR_NCANCEL iterations:
* A. we randomly permute some terms of the array (to make sure that a
* particular order doesn't have an influence on the result);
* B. we compute the sum in a random rounding mode;
* C. if this sum is zero, we end the current test (there is no longer
* anything interesting to test);
* D. we check that this sum is below some bound (chosen as infinite
* for the first iteration of (2), i.e. this test will be useful
* only for the next iterations, after cancellations);
* E. we put the opposite of this sum in the array, the goal being to
* introduce a chain of cancellations;
* F. we compute the bound for the next iteration, derived from (E).
* 3. We do another iteration like (2), but with reusing a random element
* of the array. This last test allows one to check the support of
* reused arguments. Before this support (r10467), it triggers an
* assertion failure with (almost?) all seeds, and if assertions are
* not checked, tsum fails in most cases but not all.
*/
static void
cancel (void)
{
mpfr_t x[2 * MPFR_NCANCEL], bound;
mpfr_ptr px[2 * MPFR_NCANCEL];
int i, j, k, n;
mpfr_init2 (bound, 2);
/* With 4000 tests, tsum will fail in most cases without support of
reused arguments (before r10467). */
for (i = 0; i < 4000; i++)
{
mpfr_set_inf (bound, 1);
for (n = 0; n <= numberof (x); n++)
{
mpfr_prec_t p;
mpfr_rnd_t rnd;
if (n < numberof (x))
{
px[n] = x[n];
p = MPFR_PREC_MIN + (randlimb () % 256);
mpfr_init2 (x[n], p);
k = n;
}
else
{
/* Reuse of a random member of the array. */
k = randlimb () % n;
}
if (n < MPFR_NCANCEL)
{
mpfr_exp_t e;
MPFR_ASSERTN (n < numberof (x));
e = (i & 1) ? 0 : mpfr_get_emin ();
tests_default_random (x[n], 256, e,
((i & 2) ? e + 2000 : mpfr_get_emax ()),
0);
}
else
{
/* random permutation with n random transpositions */
for (j = 0; j < n; j++)
{
int k1, k2;
k1 = randlimb () % (n-1);
k2 = randlimb () % (n-1);
mpfr_swap (x[k1], x[k2]);
}
rnd = RND_RAND ();
#if DEBUG
printf ("mpfr_sum cancellation test\n");
for (j = 0; j < n; j++)
{
printf (" x%d[%3ld] = ", j, mpfr_get_prec(x[j]));
mpfr_out_str (stdout, 16, 0, x[j], MPFR_RNDN);
printf ("\n");
}
printf (" rnd = %s, output prec = %ld\n",
mpfr_print_rnd_mode (rnd), mpfr_get_prec (x[n]));
#endif
mpfr_sum (x[k], px, n, rnd);
if (mpfr_zero_p (x[k]))
{
if (k == n)
n++;
break;
}
if (mpfr_cmpabs (x[k], bound) > 0)
{
printf ("Error in cancel on i = %d, n = %d\n", i, n);
printf ("Expected bound: ");
mpfr_dump (bound);
printf ("x[%d]: ", k);
mpfr_dump (x[k]);
exit (1);
}
if (k != n)
break;
/* For the bound, use MPFR_RNDU due to possible underflow.
It would be nice to add some specific underflow checks,
though there are already ones in check_underflow(). */
mpfr_set_ui_2exp (bound, 1,
mpfr_get_exp (x[n]) - p - (rnd == MPFR_RNDN),
MPFR_RNDU);
/* The next sum will be <= bound in absolute value
(the equality can be obtained in all rounding modes
since the sum will be rounded). */
mpfr_neg (x[n], x[n], MPFR_RNDN);
}
}
while (--n >= 0)
mpfr_clear (x[n]);
}
mpfr_clear (bound);
}
/* With N = 2 * GMP_NUMB_BITS:
i * 2^N + j + k * 2^(-1) + f1 * 2^(-N) + f2 * 2^(-N),
with i = -1 or 1, j = 0 or i, -1 <= k <= 1, -1 <= f1 <= 1, -1 <= f2 <= 1
ulp(exact sum) = 2^0. */
static void
check2 (void)
{
mpfr_t sum1, sum2, s1, s2, s3, s4, t[5];
mpfr_ptr p[5];
int i, j, k, f1, f2, prec, r, inex1, inex2;
#define N (2 * GMP_NUMB_BITS)
mpfr_init2 (sum1, N+1);
mpfr_init2 (sum2, N+1);
mpfr_init2 (s1, N+1);
mpfr_init2 (s2, N+2);
mpfr_init2 (s3, 2*N+1);
mpfr_init2 (s4, 2*N+1);
for (i = 0; i < 5; i++)
{
mpfr_init2 (t[i], 2);
p[i] = t[i];
}
for (i = -1; i <= 1; i += 2)
{
mpfr_set_si_2exp (t[0], i, N, MPFR_RNDN);
for (j = 0; j != 2*i; j += i)
{
mpfr_set_si (t[1], j, MPFR_RNDN);
inex1 = mpfr_add (s1, t[0], t[1], MPFR_RNDN);
MPFR_ASSERTN (inex1 == 0);
for (k = -1; k <= 1; k++)
{
mpfr_set_si_2exp (t[2], k, -1, MPFR_RNDN);
inex1 = mpfr_add (s2, s1, t[2], MPFR_RNDN);
MPFR_ASSERTN (inex1 == 0);
for (f1 = -1; f1 <= 1; f1++)
{
mpfr_set_si_2exp (t[3], f1, -N, MPFR_RNDN);
inex1 = mpfr_add (s3, s2, t[3], MPFR_RNDN);
MPFR_ASSERTN (inex1 == 0);
for (f2 = -1; f2 <= 1; f2++)
{
mpfr_set_si_2exp (t[4], f2, -N, MPFR_RNDN);
inex1 = mpfr_add (s4, s3, t[4], MPFR_RNDN);
MPFR_ASSERTN (inex1 == 0);
prec = mpfr_get_exp (s4);
mpfr_set_prec (sum1, prec);
mpfr_set_prec (sum2, prec);
RND_LOOP (r)
{
inex1 = mpfr_set (sum1, s4, (mpfr_rnd_t) r);
inex2 = mpfr_sum (sum2, p, 5, (mpfr_rnd_t) r);
MPFR_ASSERTN (mpfr_check (sum1));
MPFR_ASSERTN (mpfr_check (sum2));
if (!(mpfr_equal_p (sum1, sum2) &&
SAME_SIGN (inex1, inex2)))
{
printf ("Error in check2 on %s, prec = %d, "
"i = %d, j = %d, k = %d, f1 = %d, "
"f2 = %d\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r),
prec, i, j, k, f1, f2);
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 < 5; i++)
mpfr_clear (t[i]);
mpfr_clears (sum1, sum2, s1, s2, s3, s4, (mpfr_ptr) 0);
}
/* i * 2^(46+h) + j * 2^(45+h) + k * 2^(44+h) + f * 2^(-2),
with -1 <= i, j, k <= 1, i != 0, -3 <= f <= 3, and
* prec set up so that ulp(exact sum) = 2^0, then
* prec set up so that ulp(exact sum) = 2^(44+h) when possible,
i.e. when prec >= MPFR_PREC_MIN.
------
Some explanations:
ulp(exact sum) = 2^q means EXP(exact sum) - prec = q where prec is
the precision of the output. Thus ulp(exact sum) = 2^0 is achieved
by setting prec = EXP(s3), where s3 is the exact sum (computed with
mpfr_add's and sufficient precision). Then ulp(exact sum) = 2^(44+h)
is achieved by subtracting 44+h from prec. The loop on prec does
this. Since EXP(s3) <= 47+h, prec <= 3 at the second iteration,
thus there will be at most 2 iterations. Whether a second iteration
is done or not depends on EXP(s3), i.e. the values of the parameters,
and the value of MPFR_PREC_MIN. */
static void
check1 (int h)
{
mpfr_t sum1, sum2, s1, s2, s3, t[4];
mpfr_ptr p[4];
int i, j, k, f, prec, r, inex1, inex2;
mpfr_init2 (sum1, 47 + h);
mpfr_init2 (sum2, 47 + h);
mpfr_init2 (s1, 3);
mpfr_init2 (s2, 3);
mpfr_init2 (s3, 49 + h);
for (i = 0; i < 4; i++)
{
mpfr_init2 (t[i], 2);
p[i] = t[i];
}
for (i = -1; i <= 1; i += 2)
{
mpfr_set_si_2exp (t[0], i, 46 + h, MPFR_RNDN);
for (j = -1; j <= 1; j++)
{
mpfr_set_si_2exp (t[1], j, 45 + h, MPFR_RNDN);
inex1 = mpfr_add (s1, t[0], t[1], MPFR_RNDN);
MPFR_ASSERTN (inex1 == 0);
for (k = -1; k <= 1; k++)
{
mpfr_set_si_2exp (t[2], k, 44 + h, MPFR_RNDN);
inex1 = mpfr_add (s2, s1, t[2], MPFR_RNDN);
MPFR_ASSERTN (inex1 == 0);
for (f = -3; f <= 3; f++)
{
mpfr_set_si_2exp (t[3], f, -2, MPFR_RNDN);
inex1 = mpfr_add (s3, s2, t[3], MPFR_RNDN);
MPFR_ASSERTN (inex1 == 0);
for (prec = mpfr_get_exp (s3);
prec >= MPFR_PREC_MIN;
prec -= 44 + h)
{
mpfr_set_prec (sum1, prec);
mpfr_set_prec (sum2, prec);
RND_LOOP (r)
{
inex1 = mpfr_set (sum1, s3, (mpfr_rnd_t) r);
inex2 = mpfr_sum (sum2, p, 4, (mpfr_rnd_t) r);
MPFR_ASSERTN (mpfr_check (sum1));
MPFR_ASSERTN (mpfr_check (sum2));
if (!(mpfr_equal_p (sum1, sum2) &&
SAME_SIGN (inex1, inex2)))
{
printf ("Error in check1 on %s, prec = %d, "
"i = %d, j = %d, k = %d, f = %d, "
"h = %d\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r),
prec, i, j, k, f, h);
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 < 4; i++)
mpfr_clear (t[i]);
mpfr_clears (sum1, sum2, s1, s2, s3, (mpfr_ptr) 0);
}
int
mpc_acos (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int inex_re, inex_im, inex;
mpfr_prec_t p_re, p_im, p;
mpc_t z1;
mpfr_t pi_over_2;
mpfr_exp_t e1, e2;
mpfr_rnd_t rnd_im;
mpc_rnd_t rnd1;
inex_re = 0;
inex_im = 0;
/* 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_inf (mpc_imagref (rop), mpfr_signbit (mpc_imagref (op)) ? +1 : -1);
mpfr_set_nan (mpc_realref (rop));
}
else if (mpfr_zero_p (mpc_realref (op)))
{
inex_re = set_pi_over_2 (mpc_realref (rop), +1, MPC_RND_RE (rnd));
mpfr_set_nan (mpc_imagref (rop));
}
else
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
return MPC_INEX (inex_re, 0);
}
if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
if (mpfr_inf_p (mpc_realref (op)))
{
if (mpfr_inf_p (mpc_imagref (op)))
{
if (mpfr_sgn (mpc_realref (op)) > 0)
{
inex_re =
set_pi_over_2 (mpc_realref (rop), +1, MPC_RND_RE (rnd));
mpfr_div_2ui (mpc_realref (rop), mpc_realref (rop), 1, GMP_RNDN);
}
else
{
/* the real part of the result is 3*pi/4
a = o(pi) error(a) < 1 ulp(a)
b = o(3*a) error(b) < 2 ulp(b)
c = b/4 exact
thus 1 bit is lost */
mpfr_t x;
mpfr_prec_t prec;
int ok;
mpfr_init (x);
prec = mpfr_get_prec (mpc_realref (rop));
p = prec;
do
{
p += mpc_ceil_log2 (p);
mpfr_set_prec (x, p);
mpfr_const_pi (x, GMP_RNDD);
mpfr_mul_ui (x, x, 3, GMP_RNDD);
ok =
mpfr_can_round (x, p - 1, GMP_RNDD, MPC_RND_RE (rnd),
prec+(MPC_RND_RE (rnd) == GMP_RNDN));
} while (ok == 0);
inex_re =
mpfr_div_2ui (mpc_realref (rop), x, 2, MPC_RND_RE (rnd));
mpfr_clear (x);
}
}
else
{
if (mpfr_sgn (mpc_realref (op)) > 0)
mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
else
inex_re = mpfr_const_pi (mpc_realref (rop), MPC_RND_RE (rnd));
}
}
else
inex_re = set_pi_over_2 (mpc_realref (rop), +1, MPC_RND_RE (rnd));
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 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),
MPC_RND_IM (rnd));
else
inex_im = -mpfr_acosh (mpc_imagref (rop), mpc_realref (op),
INV_RND (MPC_RND_IM (rnd)));
mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
}
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,
MPC_RND_IM (rnd));
else
inex_im = -mpfr_acosh (mpc_imagref (rop), minus_op_re,
INV_RND (MPC_RND_IM (rnd)));
inex_re = mpfr_const_pi (mpc_realref (rop), MPC_RND_RE (rnd));
}
else
{
inex_re = mpfr_acos (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, MPC_RND_IM (rnd));
}
if (!s_im)
mpc_conj (rop, rop, MPC_RNDNN);
return MPC_INEX (inex_re, inex_im);
}
/* pure imaginary argument */
if (mpfr_zero_p (mpc_realref (op)))
{
inex_re = set_pi_over_2 (mpc_realref (rop), +1, MPC_RND_RE (rnd));
inex_im = -mpfr_asinh (mpc_imagref (rop), mpc_imagref (op),
INV_RND (MPC_RND_IM (rnd)));
mpc_conj (rop,rop, MPC_RNDNN);
return MPC_INEX (inex_re, inex_im);
}
/* regular complex argument: acos(z) = Pi/2 - asin(z) */
p_re = mpfr_get_prec (mpc_realref(rop));
p_im = mpfr_get_prec (mpc_imagref(rop));
p = p_re;
mpc_init3 (z1, p, p_im); /* we round directly the imaginary part to p_im,
with rounding mode opposite to rnd_im */
rnd_im = MPC_RND_IM(rnd);
/* the imaginary part of asin(z) has the same sign as Im(z), thus if
Im(z) > 0 and rnd_im = RNDZ, we want to round the Im(asin(z)) to -Inf
so that -Im(asin(z)) is rounded to zero */
if (rnd_im == GMP_RNDZ)
rnd_im = mpfr_sgn (mpc_imagref(op)) > 0 ? GMP_RNDD : GMP_RNDU;
else
rnd_im = rnd_im == GMP_RNDU ? GMP_RNDD
: rnd_im == GMP_RNDD ? GMP_RNDU
: rnd_im; /* both RNDZ and RNDA map to themselves for -asin(z) */
rnd1 = MPC_RND (GMP_RNDN, rnd_im);
mpfr_init2 (pi_over_2, p);
for (;;)
{
p += mpc_ceil_log2 (p) + 3;
mpfr_set_prec (mpc_realref(z1), p);
mpfr_set_prec (pi_over_2, p);
set_pi_over_2 (pi_over_2, +1, GMP_RNDN);
e1 = 1; /* Exp(pi_over_2) */
inex = mpc_asin (z1, op, rnd1); /* asin(z) */
MPC_ASSERT (mpfr_sgn (mpc_imagref(z1)) * mpfr_sgn (mpc_imagref(op)) > 0);
inex_im = MPC_INEX_IM(inex); /* inex_im is in {-1, 0, 1} */
e2 = mpfr_get_exp (mpc_realref(z1));
mpfr_sub (mpc_realref(z1), pi_over_2, mpc_realref(z1), GMP_RNDN);
if (!mpfr_zero_p (mpc_realref(z1)))
{
/* the error on x=Re(z1) is bounded by 1/2 ulp(x) + 2^(e1-p-1) +
2^(e2-p-1) */
e1 = e1 >= e2 ? e1 + 1 : e2 + 1;
/* the error on x is bounded by 1/2 ulp(x) + 2^(e1-p-1) */
e1 -= mpfr_get_exp (mpc_realref(z1));
/* the error on x is bounded by 1/2 ulp(x) [1 + 2^e1] */
e1 = e1 <= 0 ? 0 : e1;
/* the error on x is bounded by 2^e1 * ulp(x) */
mpfr_neg (mpc_imagref(z1), mpc_imagref(z1), GMP_RNDN); /* exact */
inex_im = -inex_im;
if (mpfr_can_round (mpc_realref(z1), p - e1, GMP_RNDN, GMP_RNDZ,
p_re + (MPC_RND_RE(rnd) == GMP_RNDN)))
break;
}
}
inex = mpc_set (rop, z1, rnd);
inex_re = MPC_INEX_RE(inex);
mpc_clear (z1);
mpfr_clear (pi_over_2);
return MPC_INEX(inex_re, inex_im);
}
int
mpc_log (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd){
int ok, underflow = 0;
mpfr_srcptr x, y;
mpfr_t v, w;
mpfr_prec_t prec;
int loops;
int re_cmp, im_cmp;
int inex_re, inex_im;
int err;
mpfr_exp_t expw;
int sgnw;
/* special values: NaN and infinities */
if (!mpc_fin_p (op)) {
if (mpfr_nan_p (mpc_realref (op))) {
if (mpfr_inf_p (mpc_imagref (op)))
mpfr_set_inf (mpc_realref (rop), +1);
else
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex_im = 0; /* Inf/NaN is exact */
}
else if (mpfr_nan_p (mpc_imagref (op))) {
if (mpfr_inf_p (mpc_realref (op)))
mpfr_set_inf (mpc_realref (rop), +1);
else
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex_im = 0; /* Inf/NaN is exact */
}
else /* We have an infinity in at least one part. */ {
inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
MPC_RND_IM (rnd));
mpfr_set_inf (mpc_realref (rop), +1);
}
return MPC_INEX(0, inex_im);
}
/* special cases: real and purely imaginary numbers */
re_cmp = mpfr_cmp_ui (mpc_realref (op), 0);
im_cmp = mpfr_cmp_ui (mpc_imagref (op), 0);
if (im_cmp == 0) {
if (re_cmp == 0) {
inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
MPC_RND_IM (rnd));
mpfr_set_inf (mpc_realref (rop), -1);
inex_re = 0; /* -Inf is exact */
}
else if (re_cmp > 0) {
inex_re = mpfr_log (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
inex_im = mpfr_set (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
}
else {
/* op = x + 0*y; let w = -x = |x| */
int negative_zero;
mpfr_rnd_t rnd_im;
negative_zero = mpfr_signbit (mpc_imagref (op));
if (negative_zero)
rnd_im = INV_RND (MPC_RND_IM (rnd));
else
rnd_im = MPC_RND_IM (rnd);
w [0] = *mpc_realref (op);
MPFR_CHANGE_SIGN (w);
inex_re = mpfr_log (mpc_realref (rop), w, MPC_RND_RE (rnd));
inex_im = mpfr_const_pi (mpc_imagref (rop), rnd_im);
if (negative_zero) {
mpc_conj (rop, rop, MPC_RNDNN);
inex_im = -inex_im;
}
}
return MPC_INEX(inex_re, inex_im);
}
else if (re_cmp == 0) {
if (im_cmp > 0) {
inex_re = mpfr_log (mpc_realref (rop), mpc_imagref (op), MPC_RND_RE (rnd));
inex_im = mpfr_const_pi (mpc_imagref (rop), MPC_RND_IM (rnd));
/* division by 2 does not change the ternary flag */
mpfr_div_2ui (mpc_imagref (rop), mpc_imagref (rop), 1, GMP_RNDN);
}
else {
w [0] = *mpc_imagref (op);
MPFR_CHANGE_SIGN (w);
inex_re = mpfr_log (mpc_realref (rop), w, MPC_RND_RE (rnd));
inex_im = mpfr_const_pi (mpc_imagref (rop), INV_RND (MPC_RND_IM (rnd)));
/* division by 2 does not change the ternary flag */
mpfr_div_2ui (mpc_imagref (rop), mpc_imagref (rop), 1, GMP_RNDN);
mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), GMP_RNDN);
inex_im = -inex_im; /* negate the ternary flag */
}
return MPC_INEX(inex_re, inex_im);
}
prec = MPC_PREC_RE(rop);
mpfr_init2 (w, 2);
/* let op = x + iy; log = 1/2 log (x^2 + y^2) + i atan2 (y, x) */
/* loop for the real part: 1/2 log (x^2 + y^2), fast, but unsafe */
/* implementation */
ok = 0;
for (loops = 1; !ok && loops <= 2; loops++) {
prec += mpc_ceil_log2 (prec) + 4;
mpfr_set_prec (w, prec);
mpc_abs (w, op, GMP_RNDN);
/* error 0.5 ulp */
if (mpfr_inf_p (w))
/* intermediate overflow; the logarithm may be representable.
Intermediate underflow is impossible. */
break;
mpfr_log (w, w, GMP_RNDN);
/* generic error of log: (2^(- exp(w)) + 0.5) ulp */
if (mpfr_zero_p (w))
/* impossible to round, switch to second algorithm */
break;
err = MPC_MAX (-mpfr_get_exp (w), 0) + 1;
/* number of lost digits */
ok = mpfr_can_round (w, prec - err, GMP_RNDN, GMP_RNDZ,
mpfr_get_prec (mpc_realref (rop)) + (MPC_RND_RE (rnd) == GMP_RNDN));
}
if (!ok) {
prec = MPC_PREC_RE(rop);
mpfr_init2 (v, 2);
/* compute 1/2 log (x^2 + y^2) = log |x| + 1/2 * log (1 + (y/x)^2)
if |x| >= |y|; otherwise, exchange x and y */
if (mpfr_cmpabs (mpc_realref (op), mpc_imagref (op)) >= 0) {
x = mpc_realref (op);
y = mpc_imagref (op);
}
else {
x = mpc_imagref (op);
y = mpc_realref (op);
}
do {
prec += mpc_ceil_log2 (prec) + 4;
mpfr_set_prec (v, prec);
mpfr_set_prec (w, prec);
mpfr_div (v, y, x, GMP_RNDD); /* error 1 ulp */
mpfr_sqr (v, v, GMP_RNDD);
/* generic error of multiplication:
1 + 2*1*(2+1*2^(1-prec)) <= 5.0625 since prec >= 6 */
mpfr_log1p (v, v, GMP_RNDD);
/* error 1 + 4*5.0625 = 21.25 , see algorithms.tex */
mpfr_div_2ui (v, v, 1, GMP_RNDD);
/* If the result is 0, then there has been an underflow somewhere. */
mpfr_abs (w, x, GMP_RNDN); /* exact */
mpfr_log (w, w, GMP_RNDN); /* error 0.5 ulp */
expw = mpfr_get_exp (w);
sgnw = mpfr_signbit (w);
mpfr_add (w, w, v, GMP_RNDN);
if (!sgnw) /* v is positive, so no cancellation;
error 22.25 ulp; error counts lost bits */
err = 5;
else
err = MPC_MAX (5 + mpfr_get_exp (v),
/* 21.25 ulp (v) rewritten in ulp (result, now in w) */
-1 + expw - mpfr_get_exp (w)
/* 0.5 ulp (previous w), rewritten in ulp (result) */
) + 2;
/* handle one special case: |x|=1, and (y/x)^2 underflows;
then 1/2*log(x^2+y^2) \approx 1/2*y^2 also underflows. */
if ( (mpfr_cmp_si (x, -1) == 0 || mpfr_cmp_ui (x, 1) == 0)
&& mpfr_zero_p (w))
underflow = 1;
} while (!underflow &&
!mpfr_can_round (w, prec - err, GMP_RNDN, GMP_RNDZ,
mpfr_get_prec (mpc_realref (rop)) + (MPC_RND_RE (rnd) == GMP_RNDN)));
mpfr_clear (v);
}
/* imaginary part */
inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
MPC_RND_IM (rnd));
/* set the real part; cannot be done before if rop==op */
if (underflow)
/* create underflow in result */
inex_re = mpfr_set_ui_2exp (mpc_realref (rop), 1,
mpfr_get_emin_min () - 2, MPC_RND_RE (rnd));
else
inex_re = mpfr_set (mpc_realref (rop), w, MPC_RND_RE (rnd));
mpfr_clear (w);
return MPC_INEX(inex_re, inex_im);
}
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);
}
void benchmark_optimize_exp()
{
int REPS;
int prec;
int i, k, r, J, best_r, best_J;
double best_time, best_here;
double t1, t2, elapsed;
double mpfr_time;
int accuracy, min_accuracy;
mpz_t x, y, dummy;
mpfr_t mx, my;
mpfr_init(mx);
mpfr_init(my);
mpz_init(x);
mpz_init(y);
mpz_init(dummy);
printf(" prec acc J r mpfr this faster\n");
for (prec=53; prec<30000; prec+=prec/4)
{
if (prec < 300)
REPS = 100;
else if (prec < 600)
REPS = 50;
else if (prec < 1200)
REPS = 10;
else
REPS = 2;
mpz_set_ui(x, 37);
mpz_mul_2exp(x, x, prec);
mpz_div_ui(x, x, 100);
min_accuracy = prec;
best_time = 1e100;
best_r = 0;
best_J = 0;
mpfr_set_prec(mx, prec);
mpfr_set_prec(my, prec);
mpfr_set_str(mx, "0.37", 10, GMP_RNDN);
mpfr_time = 1e100;
for (i=0; i<10; i++)
{
t1 = timing();
for (k=0; k<REPS; k++)
{
mpfr_exp(my, mx, GMP_RNDN);
}
t2 = timing();
elapsed = (t2-t1)/REPS;
if (elapsed < mpfr_time)
mpfr_time = elapsed;
}
for (J=1; J<MAX_SERIES_STEPS; J++)
{
for (r=0; r*r<prec+30; r++)
{
for (i=0; i<3; i++)
{
t1 = timing();
for (k=0; k<REPS; k++)
{
exp_series(y, dummy, x, prec, r, J, 2);
}
t2 = timing();
elapsed = (t2-t1) / REPS;
if (elapsed < best_time)
{
best_time = elapsed;
best_r = r;
best_J = J;
}
}
mpfr_set_z(mx, y, GMP_RNDN);
mpfr_div_2ui(mx, mx, prec, GMP_RNDN);
//mpfr_printf("Value: %Rf\n", mx);
mpfr_sub(mx, mx, my, GMP_RNDN);
mpfr_abs(mx, mx, GMP_RNDN);
if (!mpfr_zero_p(mx))
{
accuracy = -(int)mpfr_get_exp(mx)+1;
if (accuracy < min_accuracy)
{
min_accuracy = accuracy;
}
}
}
}
mpfr_time *= 1000;
best_time *= 1000;
printf("%5d %5d %3d %3d %8d %8d %.3f\n", prec, min_accuracy, best_J, best_r,
(int)mpfr_time, (int)best_time, mpfr_time/best_time);
}
mpfr_clear(mx);
mpfr_clear(my);
mpz_clear(x);
mpz_clear(y);
mpz_clear(dummy);
}
static int
mpfr_fsss (mpfr_ptr z, mpfr_srcptr a, mpfr_srcptr c, mpfr_rnd_t rnd)
{
/* Computes z = a^2 - c^2.
Assumes that a and c are finite and non-zero; so a squaring yielding
an infinity is an overflow, and a squaring yielding 0 is an underflow.
Assumes further that z is distinct from a and c. */
int inex;
mpfr_t u, v;
/* u=a^2, v=c^2 exactly */
mpfr_init2 (u, 2*mpfr_get_prec (a));
mpfr_init2 (v, 2*mpfr_get_prec (c));
mpfr_sqr (u, a, MPFR_RNDN);
mpfr_sqr (v, c, MPFR_RNDN);
/* tentatively compute z as u-v; here we need z to be distinct
from a and c to not lose the latter */
inex = mpfr_sub (z, u, v, rnd);
if (mpfr_inf_p (z)) {
/* replace by "correctly rounded overflow" */
mpfr_set_si (z, (mpfr_signbit (z) ? -1 : 1), MPFR_RNDN);
inex = mpfr_mul_2ui (z, z, mpfr_get_emax (), rnd);
}
else if (mpfr_zero_p (u) && !mpfr_zero_p (v)) {
/* exactly u underflowed, determine inexact flag */
inex = (mpfr_signbit (u) ? 1 : -1);
}
else if (mpfr_zero_p (v) && !mpfr_zero_p (u)) {
/* exactly v underflowed, determine inexact flag */
inex = (mpfr_signbit (v) ? -1 : 1);
}
else if (mpfr_nan_p (z) || (mpfr_zero_p (u) && mpfr_zero_p (v))) {
/* In the first case, u and v are +inf.
In the second case, u and v are zeroes; their difference may be 0
or the least representable number, with a sign to be determined.
Redo the computations with mpz_t exponents */
mpfr_exp_t ea, ec;
mpz_t eu, ev;
/* cheat to work around the const qualifiers */
/* Normalise the input by shifting and keep track of the shifts in
the exponents of u and v */
ea = mpfr_get_exp (a);
ec = mpfr_get_exp (c);
mpfr_set_exp ((mpfr_ptr) a, (mpfr_prec_t) 0);
mpfr_set_exp ((mpfr_ptr) c, (mpfr_prec_t) 0);
mpz_init (eu);
mpz_init (ev);
mpz_set_si (eu, (long int) ea);
mpz_mul_2exp (eu, eu, 1);
mpz_set_si (ev, (long int) ec);
mpz_mul_2exp (ev, ev, 1);
/* recompute u and v and move exponents to eu and ev */
mpfr_sqr (u, a, MPFR_RNDN);
/* exponent of u is non-positive */
mpz_sub_ui (eu, eu, (unsigned long int) (-mpfr_get_exp (u)));
mpfr_set_exp (u, (mpfr_prec_t) 0);
mpfr_sqr (v, c, MPFR_RNDN);
mpz_sub_ui (ev, ev, (unsigned long int) (-mpfr_get_exp (v)));
mpfr_set_exp (v, (mpfr_prec_t) 0);
if (mpfr_nan_p (z)) {
mpfr_exp_t emax = mpfr_get_emax ();
int overflow;
/* We have a = ma * 2^ea with 1/2 <= |ma| < 1 and ea <= emax.
So eu <= 2*emax, and eu > emax since we have
an overflow. The same holds for ev. Shift u and v by as much as
possible so that one of them has exponent emax and the
remaining exponents in eu and ev are the same. Then carry out
the addition. Shifting u and v prevents an underflow. */
if (mpz_cmp (eu, ev) >= 0) {
mpfr_set_exp (u, emax);
mpz_sub_ui (eu, eu, (long int) emax);
mpz_sub (ev, ev, eu);
mpfr_set_exp (v, (mpfr_exp_t) mpz_get_ui (ev));
/* remaining common exponent is now in eu */
}
else {
mpfr_set_exp (v, emax);
mpz_sub_ui (ev, ev, (long int) emax);
mpz_sub (eu, eu, ev);
mpfr_set_exp (u, (mpfr_exp_t) mpz_get_ui (eu));
mpz_set (eu, ev);
/* remaining common exponent is now also in eu */
}
inex = mpfr_sub (z, u, v, rnd);
/* Result is finite since u and v have the same sign. */
overflow = mpfr_mul_2ui (z, z, mpz_get_ui (eu), rnd);
if (overflow)
inex = overflow;
}
else {
int underflow;
/* Subtraction of two zeroes. We have a = ma * 2^ea
with 1/2 <= |ma| < 1 and ea >= emin and similarly for b.
So 2*emin < 2*emin+1 <= eu < emin < 0, and analogously for v. */
mpfr_exp_t emin = mpfr_get_emin ();
if (mpz_cmp (eu, ev) <= 0) {
mpfr_set_exp (u, emin);
mpz_add_ui (eu, eu, (unsigned long int) (-emin));
mpz_sub (ev, ev, eu);
mpfr_set_exp (v, (mpfr_exp_t) mpz_get_si (ev));
}
else {
mpfr_set_exp (v, emin);
mpz_add_ui (ev, ev, (unsigned long int) (-emin));
mpz_sub (eu, eu, ev);
mpfr_set_exp (u, (mpfr_exp_t) mpz_get_si (eu));
mpz_set (eu, ev);
}
inex = mpfr_sub (z, u, v, rnd);
mpz_neg (eu, eu);
underflow = mpfr_div_2ui (z, z, mpz_get_ui (eu), rnd);
if (underflow)
inex = underflow;
}
mpz_clear (eu);
mpz_clear (ev);
mpfr_set_exp ((mpfr_ptr) a, ea);
mpfr_set_exp ((mpfr_ptr) c, ec);
/* works also when a == c */
}
mpfr_clear (u);
mpfr_clear (v);
return inex;
}
int
mpc_exp (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
mpfr_t x, y, z;
mpfr_prec_t prec;
int ok = 0;
int inex_re, inex_im;
int saved_underflow, saved_overflow;
/* special values */
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
/* NaNs
exp(nan +i*y) = nan -i*0 if y = -0,
nan +i*0 if y = +0,
nan +i*nan otherwise
exp(x+i*nan) = +/-0 +/-i*0 if x=-inf,
+/-inf +i*nan if x=+inf,
nan +i*nan otherwise */
{
if (mpfr_zero_p (mpc_imagref (op)))
return mpc_set (rop, op, MPC_RNDNN);
if (mpfr_inf_p (mpc_realref (op)))
{
if (mpfr_signbit (mpc_realref (op)))
return mpc_set_ui_ui (rop, 0, 0, MPC_RNDNN);
else
{
mpfr_set_inf (mpc_realref (rop), +1);
mpfr_set_nan (mpc_imagref (rop));
return MPC_INEX(0, 0); /* Inf/NaN are exact */
}
}
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
return MPC_INEX(0, 0); /* NaN is exact */
}
if (mpfr_zero_p (mpc_imagref(op)))
/* special case when the input is real
exp(x-i*0) = exp(x) -i*0, even if x is NaN
exp(x+i*0) = exp(x) +i*0, even if x is NaN */
{
inex_re = mpfr_exp (mpc_realref(rop), mpc_realref(op), MPC_RND_RE(rnd));
inex_im = mpfr_set (mpc_imagref(rop), mpc_imagref(op), MPC_RND_IM(rnd));
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_zero_p (mpc_realref (op)))
/* special case when the input is imaginary */
{
inex_re = mpfr_cos (mpc_realref (rop), mpc_imagref (op), MPC_RND_RE(rnd));
inex_im = mpfr_sin (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM(rnd));
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_inf_p (mpc_realref (op)))
/* real part is an infinity,
exp(-inf +i*y) = 0*(cos y +i*sin y)
exp(+inf +i*y) = +/-inf +i*nan if y = +/-inf
+inf*(cos y +i*sin y) if 0 < |y| < inf */
{
mpfr_t n;
mpfr_init2 (n, 2);
if (mpfr_signbit (mpc_realref (op)))
mpfr_set_ui (n, 0, GMP_RNDN);
else
mpfr_set_inf (n, +1);
if (mpfr_inf_p (mpc_imagref (op)))
{
inex_re = mpfr_set (mpc_realref (rop), n, GMP_RNDN);
if (mpfr_signbit (mpc_realref (op)))
inex_im = mpfr_set (mpc_imagref (rop), n, GMP_RNDN);
else
{
mpfr_set_nan (mpc_imagref (rop));
inex_im = 0; /* NaN is exact */
}
}
else
{
mpfr_t c, s;
mpfr_init2 (c, 2);
mpfr_init2 (s, 2);
mpfr_sin_cos (s, c, mpc_imagref (op), GMP_RNDN);
inex_re = mpfr_copysign (mpc_realref (rop), n, c, GMP_RNDN);
inex_im = mpfr_copysign (mpc_imagref (rop), n, s, GMP_RNDN);
mpfr_clear (s);
mpfr_clear (c);
}
mpfr_clear (n);
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_inf_p (mpc_imagref (op)))
/* real part is finite non-zero number, imaginary part is an infinity */
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
return MPC_INEX(0, 0); /* NaN is exact */
}
/* from now on, both parts of op are regular numbers */
prec = MPC_MAX_PREC(rop)
+ MPC_MAX (MPC_MAX (-mpfr_get_exp (mpc_realref (op)), 0),
-mpfr_get_exp (mpc_imagref (op)));
/* When op is close to 0, then exp is close to 1+Re(op), while
cos is close to 1-Im(op); to decide on the ternary value of exp*cos,
we need a high enough precision so that none of exp or cos is
computed as 1. */
mpfr_init2 (x, 2);
mpfr_init2 (y, 2);
mpfr_init2 (z, 2);
/* save the underflow or overflow flags from MPFR */
saved_underflow = mpfr_underflow_p ();
saved_overflow = mpfr_overflow_p ();
do
{
prec += mpc_ceil_log2 (prec) + 5;
mpfr_set_prec (x, prec);
mpfr_set_prec (y, prec);
mpfr_set_prec (z, prec);
/* FIXME: x may overflow so x.y does overflow too, while Re(exp(op))
could be represented in the precision of rop. */
mpfr_clear_overflow ();
mpfr_clear_underflow ();
mpfr_exp (x, mpc_realref(op), GMP_RNDN); /* error <= 0.5ulp */
mpfr_sin_cos (z, y, mpc_imagref(op), GMP_RNDN); /* errors <= 0.5ulp */
mpfr_mul (y, y, x, GMP_RNDN); /* error <= 2ulp */
ok = mpfr_overflow_p () || mpfr_zero_p (x)
|| mpfr_can_round (y, prec - 2, GMP_RNDN, GMP_RNDZ,
MPC_PREC_RE(rop) + (MPC_RND_RE(rnd) == GMP_RNDN));
if (ok) /* compute imaginary part */
{
mpfr_mul (z, z, x, GMP_RNDN);
ok = mpfr_overflow_p () || mpfr_zero_p (x)
|| mpfr_can_round (z, prec - 2, GMP_RNDN, GMP_RNDZ,
MPC_PREC_IM(rop) + (MPC_RND_IM(rnd) == GMP_RNDN));
}
}
while (ok == 0);
inex_re = mpfr_set (mpc_realref(rop), y, MPC_RND_RE(rnd));
inex_im = mpfr_set (mpc_imagref(rop), z, MPC_RND_IM(rnd));
if (mpfr_overflow_p ()) {
/* overflow in real exponential, inex is sign of infinite result */
inex_re = mpfr_sgn (y);
inex_im = mpfr_sgn (z);
}
else if (mpfr_underflow_p ()) {
/* underflow in real exponential, inex is opposite of sign of 0 result */
inex_re = (mpfr_signbit (y) ? +1 : -1);
inex_im = (mpfr_signbit (z) ? +1 : -1);
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
/* restore underflow and overflow flags from MPFR */
if (saved_underflow)
mpfr_set_underflow ();
if (saved_overflow)
mpfr_set_overflow ();
return MPC_INEX(inex_re, inex_im);
}
static void
check_random (FILE *fout, int nb_tests)
{
int i;
mpfr_t x;
mp_rnd_t rnd;
char flag[] =
{
'-',
'+',
' ',
'#',
'0', /* no ambiguity: first zeros are flag zero*/
'\''
};
char specifier[] =
{
'a',
'b',
'e',
'f',
'g'
};
mp_exp_t old_emin, old_emax;
old_emin = mpfr_get_emin ();
old_emax = mpfr_get_emax ();
mpfr_init (x);
for (i = 0; i < nb_tests; ++i)
{
int ret;
int j, jmax;
int spec, prec;
#define FMT_SIZE 13
char fmt[FMT_SIZE]; /* at most something like "%-+ #0'.*R*f" */
char *ptr = fmt;
tests_default_random (x, 256, MPFR_EMIN_MIN, MPFR_EMAX_MAX);
rnd = RND_RAND ();
spec = (int) (randlimb () % 5);
jmax = (spec == 3 || spec == 4) ? 6 : 5; /* ' flag only with %f or %g */
/* advantage small precision */
prec = (int) (randlimb () % ((randlimb () % 2) ? 10 : prec_max_printf));
if (spec == 3
&& (mpfr_get_exp (x) > prec_max_printf
|| mpfr_get_exp (x) < -prec_max_printf))
/* change style 'f' to style 'e' when number x is large */
--spec;
*ptr++ = '%';
for (j = 0; j < jmax; j++)
{
if (randlimb () % 3 == 0)
*ptr++ = flag[j];
}
*ptr++ = '.';
*ptr++ = '*';
*ptr++ = 'R';
*ptr++ = '*';
*ptr++ = specifier[spec];
*ptr = '\0';
MPFR_ASSERTD (ptr - fmt < FMT_SIZE);
mpfr_fprintf (fout, "mpfr_fprintf(fout, \"%s\", %d, %s, %Re)\n",
fmt, prec, mpfr_print_rnd_mode (rnd), x);
ret = mpfr_fprintf (fout, fmt, prec, rnd, x);
if (ret == -1)
{
if (spec == 3
&& (MPFR_GET_EXP (x) > INT_MAX || MPFR_GET_EXP (x) < -INT_MAX))
/* normal failure: x is too large to be output with full precision */
{
mpfr_fprintf (fout, "too large !");
}
else
{
mpfr_printf ("Error in mpfr_fprintf(fout, \"%s\", %d, %s, %Re)\n",
fmt, prec, mpfr_print_rnd_mode (rnd), x);
exit (1);
}
}
mpfr_fprintf (fout, "\n");
}
mpfr_set_emin (old_emin);
mpfr_set_emax (old_emax);
mpfr_clear (x);
}
CRFPConstMult::CRFPConstMult(Target* target, int wE_in, int wF_in, int wE_out, int wF_out, string _constant):
FPConstMult(target, wE_in, wF_in, wE_out, wF_out),
constant (_constant)
{
#if 0
sollya_obj_t node;
mpfr_t mpR;
mpz_t zz;
srcFileName="CRFPConstMult";
/* Convert the input string into a sollya evaluation tree */
node = sollya_lib_parse_string(constant.c_str());
/* If parse error throw an exception */
if (sollya_lib_obj_is_error(node))
{
ostringstream error;
error << srcFileName << ": Unable to parse string "<< constant << " as a numeric constant" <<endl;
throw error.str();
}
mpfr_inits(mpR, NULL);
sollya_lib_get_constant(mpR, node);
if(verbose){
double r;
r = mpfr_get_d(mpR, GMP_RNDN);
cout << " Constant evaluates to " <<r <<endl;
}
// compute the precision -- TODO with NWB
cst_width = 2*wF_in+4;
REPORT(0, "***** WARNING Taking constant with 2*wF_in+4 bits. Correct rounding is not yet guaranteed. This is being implemented." );
REPORT(INFO, "Required significand precision to reach correct rounding is " << cst_width );
mpfr_set_prec(mpfrC, cst_width);
sollya_lib_get_constant(mpR, node);
// Now convert mpR into exponent + integral significand
// sign
cst_sgn = mpfr_sgn(mpR);
if(cst_sgn<0)
mpfr_neg(mpR, mpR, GMP_RNDN);
// compute exponent and mantissa
cst_exp_when_mantissa_1_2 = mpfr_get_exp(mpR) - 1; //mpfr_get_exp() assumes significand in [1/2,1)
cst_exp_when_mantissa_int = cst_exp_when_mantissa_1_2 - cst_width + 1;
mpfr_init2(mpfr_cst_sig, cst_width);
mpfr_div_2si(mpfr_cst_sig, mpR, cst_exp_when_mantissa_1_2, GMP_RNDN);
REPORT(INFO, "mpfr_cst_sig = " << mpfr_get_d(mpfr_cst_sig, GMP_RNDN));
// Build the corresponding FPConstMult.
// initialize mpfr_xcut_sig = 2/cst_sig, will be between 1 and 2
mpfr_init2(mpfr_xcut_sig, 32*(cst_width+wE_in+wE_out)); // should be accurate enough
mpfr_set_d(mpfr_xcut_sig, 2.0, GMP_RNDN); // exaxt op
mpfr_div(mpfr_xcut_sig, mpfr_xcut_sig, mpfr_cst_sig, GMP_RNDD);
// now round it down to wF_in+1 bits
mpfr_t xcut_wF;
mpfr_init2(xcut_wF, wF_in+1);
mpfr_set(xcut_wF, mpfr_xcut_sig, GMP_RNDD);
mpfr_mul_2si(xcut_wF, xcut_wF, wF_in, GMP_RNDN);
// It should now be an int; cast it into a mpz, then a mpz_class
mpz_init2(zz, wF_in+1);
mpfr_get_z(zz, xcut_wF, GMP_RNDN);
xcut_sig_rd = mpz_class(zz);
mpz_clear(zz);
REPORT(DETAILED, "mpfr_xcut_sig = " << mpfr_get_d(mpfr_xcut_sig, GMP_RNDN) );
// Now build the mpz significand
mpfr_mul_2si(mpfr_cst_sig, mpfr_cst_sig, cst_width, GMP_RNDN);
// It should now be an int; cast it into a mpz, then a mpz_class
mpz_init2(zz, cst_width);
mpfr_get_z(zz, mpfr_cst_sig, GMP_RNDN);
cst_sig = mpz_class(zz);
mpz_clear(zz);
REPORT(DETAILED, "mpzclass cst_sig = " << cst_sig);
// build the name
ostringstream name;
name <<"FPConstMult_"<<(cst_sgn==0?"":"M") <<cst_sig<<"b"
<<(cst_exp_when_mantissa_int<0?"M":"")<<abs(cst_exp_when_mantissa_int)
<<"_"<<wE_in<<"_"<<wF_in<<"_"<<wE_out<<"_"<<wF_out;
uniqueName_=name.str();
// cleaning up
mpfr_clears(mpR, mpfr_xcut_sig, xcut_wF, mpfr_cst_sig, NULL);
icm = new IntConstMult(target, wF_in+1, cst_sig);
oplist.push_back(icm);
buildVHDL();
#endif
}
/* Put in s an approximation of digamma(x).
Assumes x >= 2.
Assumes s does not overlap with x.
Returns an integer e such that the error is bounded by 2^e ulps
of the result s.
*/
static mpfr_exp_t
mpfr_digamma_approx (mpfr_ptr s, mpfr_srcptr x)
{
mpfr_prec_t p = MPFR_PREC (s);
mpfr_t t, u, invxx;
mpfr_exp_t e, exps, f, expu;
mpz_t *INITIALIZED(B); /* variable B declared as initialized */
unsigned long n0, n; /* number of allocated B[] */
MPFR_ASSERTN(MPFR_IS_POS(x) && (MPFR_EXP(x) >= 2));
mpfr_init2 (t, p);
mpfr_init2 (u, p);
mpfr_init2 (invxx, p);
mpfr_log (s, x, MPFR_RNDN); /* error <= 1/2 ulp */
mpfr_ui_div (t, 1, x, MPFR_RNDN); /* error <= 1/2 ulp */
mpfr_div_2exp (t, t, 1, MPFR_RNDN); /* exact */
mpfr_sub (s, s, t, MPFR_RNDN);
/* error <= 1/2 + 1/2*2^(EXP(olds)-EXP(s)) + 1/2*2^(EXP(t)-EXP(s)).
For x >= 2, log(x) >= 2*(1/(2x)), thus olds >= 2t, and olds - t >= olds/2,
thus 0 <= EXP(olds)-EXP(s) <= 1, and EXP(t)-EXP(s) <= 0, thus
error <= 1/2 + 1/2*2 + 1/2 <= 2 ulps. */
e = 2; /* initial error */
mpfr_mul (invxx, x, x, MPFR_RNDZ); /* invxx = x^2 * (1 + theta)
for |theta| <= 2^(-p) */
mpfr_ui_div (invxx, 1, invxx, MPFR_RNDU); /* invxx = 1/x^2 * (1 + theta)^2 */
/* in the following we note err=xxx when the ratio between the approximation
and the exact result can be written (1 + theta)^xxx for |theta| <= 2^(-p),
following Higham's method */
B = mpfr_bernoulli_internal ((mpz_t *) 0, 0);
mpfr_set_ui (t, 1, MPFR_RNDN); /* err = 0 */
for (n = 1;; n++)
{
/* compute next Bernoulli number */
B = mpfr_bernoulli_internal (B, n);
/* The main term is Bernoulli[2n]/(2n)/x^(2n) = B[n]/(2n+1)!(2n)/x^(2n)
= B[n]*t[n]/(2n) where t[n]/t[n-1] = 1/(2n)/(2n+1)/x^2. */
mpfr_mul (t, t, invxx, MPFR_RNDU); /* err = err + 3 */
mpfr_div_ui (t, t, 2 * n, MPFR_RNDU); /* err = err + 1 */
mpfr_div_ui (t, t, 2 * n + 1, MPFR_RNDU); /* err = err + 1 */
/* we thus have err = 5n here */
mpfr_div_ui (u, t, 2 * n, MPFR_RNDU); /* err = 5n+1 */
mpfr_mul_z (u, u, B[n], MPFR_RNDU); /* err = 5n+2, and the
absolute error is bounded
by 10n+4 ulp(u) [Rule 11] */
/* if the terms 'u' are decreasing by a factor two at least,
then the error coming from those is bounded by
sum((10n+4)/2^n, n=1..infinity) = 24 */
exps = mpfr_get_exp (s);
expu = mpfr_get_exp (u);
if (expu < exps - (mpfr_exp_t) p)
break;
mpfr_sub (s, s, u, MPFR_RNDN); /* error <= 24 + n/2 */
if (mpfr_get_exp (s) < exps)
e <<= exps - mpfr_get_exp (s);
e ++; /* error in mpfr_sub */
f = 10 * n + 4;
while (expu < exps)
{
f = (1 + f) / 2;
expu ++;
}
e += f; /* total rouding error coming from 'u' term */
}
n0 = ++n;
while (n--)
mpz_clear (B[n]);
(*__gmp_free_func) (B, n0 * sizeof (mpz_t));
mpfr_clear (t);
mpfr_clear (u);
mpfr_clear (invxx);
f = 0;
while (e > 1)
{
f++;
e = (e + 1) / 2;
/* Invariant: 2^f * e does not decrease */
}
return f;
}
int
mpc_tan (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
mpc_t x, y;
mpfr_prec_t prec;
mpfr_exp_t err;
int ok = 0;
int inex;
/* special values */
if (!mpc_fin_p (op))
{
if (mpfr_nan_p (mpc_realref (op)))
{
if (mpfr_inf_p (mpc_imagref (op)))
/* tan(NaN -i*Inf) = +/-0 -i */
/* tan(NaN +i*Inf) = +/-0 +i */
{
/* exact unless 1 is not in exponent range */
inex = mpc_set_si_si (rop, 0,
(MPFR_SIGN (mpc_imagref (op)) < 0) ? -1 : +1,
rnd);
}
else
/* tan(NaN +i*y) = NaN +i*NaN, when y is finite */
/* tan(NaN +i*NaN) = NaN +i*NaN */
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex = MPC_INEX (0, 0); /* always exact */
}
}
else if (mpfr_nan_p (mpc_imagref (op)))
{
if (mpfr_cmp_ui (mpc_realref (op), 0) == 0)
/* tan(-0 +i*NaN) = -0 +i*NaN */
/* tan(+0 +i*NaN) = +0 +i*NaN */
{
mpc_set (rop, op, rnd);
inex = MPC_INEX (0, 0); /* always exact */
}
else
/* tan(x +i*NaN) = NaN +i*NaN, when x != 0 */
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex = MPC_INEX (0, 0); /* always exact */
}
}
else if (mpfr_inf_p (mpc_realref (op)))
{
if (mpfr_inf_p (mpc_imagref (op)))
/* tan(-Inf -i*Inf) = -/+0 -i */
/* tan(-Inf +i*Inf) = -/+0 +i */
/* tan(+Inf -i*Inf) = +/-0 -i */
/* tan(+Inf +i*Inf) = +/-0 +i */
{
const int sign_re = mpfr_signbit (mpc_realref (op));
int inex_im;
mpfr_set_ui (mpc_realref (rop), 0, MPC_RND_RE (rnd));
mpfr_setsign (mpc_realref (rop), mpc_realref (rop), sign_re, MPFR_RNDN);
/* exact, unless 1 is not in exponent range */
inex_im = mpfr_set_si (mpc_imagref (rop),
mpfr_signbit (mpc_imagref (op)) ? -1 : +1,
MPC_RND_IM (rnd));
inex = MPC_INEX (0, inex_im);
}
else
/* tan(-Inf +i*y) = tan(+Inf +i*y) = NaN +i*NaN, when y is
finite */
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex = MPC_INEX (0, 0); /* always exact */
}
}
else
/* tan(x -i*Inf) = +0*sin(x)*cos(x) -i, when x is finite */
/* tan(x +i*Inf) = +0*sin(x)*cos(x) +i, when x is finite */
{
mpfr_t c;
mpfr_t s;
int inex_im;
mpfr_init (c);
mpfr_init (s);
mpfr_sin_cos (s, c, mpc_realref (op), MPFR_RNDN);
mpfr_set_ui (mpc_realref (rop), 0, MPC_RND_RE (rnd));
mpfr_setsign (mpc_realref (rop), mpc_realref (rop),
mpfr_signbit (c) != mpfr_signbit (s), MPFR_RNDN);
/* exact, unless 1 is not in exponent range */
inex_im = mpfr_set_si (mpc_imagref (rop),
(mpfr_signbit (mpc_imagref (op)) ? -1 : +1),
MPC_RND_IM (rnd));
inex = MPC_INEX (0, inex_im);
mpfr_clear (s);
mpfr_clear (c);
}
return inex;
}
if (mpfr_zero_p (mpc_realref (op)))
/* tan(-0 -i*y) = -0 +i*tanh(y), when y is finite. */
/* tan(+0 +i*y) = +0 +i*tanh(y), when y is finite. */
{
int inex_im;
mpfr_set (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
inex_im = mpfr_tanh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
return MPC_INEX (0, inex_im);
}
if (mpfr_zero_p (mpc_imagref (op)))
/* tan(x -i*0) = tan(x) -i*0, when x is finite. */
/* tan(x +i*0) = tan(x) +i*0, when x is finite. */
{
int inex_re;
inex_re = mpfr_tan (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
mpfr_set (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
return MPC_INEX (inex_re, 0);
}
/* ordinary (non-zero) numbers */
/* tan(op) = sin(op) / cos(op).
We use the following algorithm with rounding away from 0 for all
operations, and working precision w:
(1) x = A(sin(op))
(2) y = A(cos(op))
(3) z = A(x/y)
the error on Im(z) is at most 81 ulp,
the error on Re(z) is at most
7 ulp if k < 2,
8 ulp if k = 2,
else 5+k ulp, where
k = Exp(Re(x))+Exp(Re(y))-2min{Exp(Re(y)), Exp(Im(y))}-Exp(Re(x/y))
see proof in algorithms.tex.
*/
prec = MPC_MAX_PREC(rop);
mpc_init2 (x, 2);
mpc_init2 (y, 2);
err = 7;
do
{
mpfr_exp_t k, exr, eyr, eyi, ezr;
ok = 0;
/* FIXME: prevent addition overflow */
prec += mpc_ceil_log2 (prec) + err;
mpc_set_prec (x, prec);
mpc_set_prec (y, prec);
/* rounding away from zero: except in the cases x=0 or y=0 (processed
above), sin x and cos y are never exact, so rounding away from 0 is
rounding towards 0 and adding one ulp to the absolute value */
mpc_sin_cos (x, y, op, MPC_RNDZZ, MPC_RNDZZ);
MPFR_ADD_ONE_ULP (mpc_realref (x));
MPFR_ADD_ONE_ULP (mpc_imagref (x));
MPFR_ADD_ONE_ULP (mpc_realref (y));
MPFR_ADD_ONE_ULP (mpc_imagref (y));
MPC_ASSERT (mpfr_zero_p (mpc_realref (x)) == 0);
if ( mpfr_inf_p (mpc_realref (x)) || mpfr_inf_p (mpc_imagref (x))
|| mpfr_inf_p (mpc_realref (y)) || mpfr_inf_p (mpc_imagref (y))) {
/* If the real or imaginary part of x is infinite, it means that
Im(op) was large, in which case the result is
sign(tan(Re(op)))*0 + sign(Im(op))*I,
where sign(tan(Re(op))) = sign(Re(x))*sign(Re(y)). */
int inex_re, inex_im;
mpfr_set_ui (mpc_realref (rop), 0, MPFR_RNDN);
if (mpfr_sgn (mpc_realref (x)) * mpfr_sgn (mpc_realref (y)) < 0)
{
mpfr_neg (mpc_realref (rop), mpc_realref (rop), MPFR_RNDN);
inex_re = 1;
}
else
inex_re = -1; /* +0 is rounded down */
if (mpfr_sgn (mpc_imagref (op)) > 0)
{
mpfr_set_ui (mpc_imagref (rop), 1, MPFR_RNDN);
inex_im = 1;
}
else
{
mpfr_set_si (mpc_imagref (rop), -1, MPFR_RNDN);
inex_im = -1;
}
inex = MPC_INEX(inex_re, inex_im);
goto end;
}
exr = mpfr_get_exp (mpc_realref (x));
eyr = mpfr_get_exp (mpc_realref (y));
eyi = mpfr_get_exp (mpc_imagref (y));
/* some parts of the quotient may be exact */
inex = mpc_div (x, x, y, MPC_RNDZZ);
/* OP is no pure real nor pure imaginary, so in theory the real and
imaginary parts of its tangent cannot be null. However due to
rouding errors this might happen. Consider for example
tan(1+14*I) = 1.26e-10 + 1.00*I. For small precision sin(op) and
cos(op) differ only by a factor I, thus after mpc_div x = I and
its real part is zero. */
if (mpfr_zero_p (mpc_realref (x)) || mpfr_zero_p (mpc_imagref (x)))
{
err = prec; /* double precision */
continue;
}
if (MPC_INEX_RE (inex))
MPFR_ADD_ONE_ULP (mpc_realref (x));
if (MPC_INEX_IM (inex))
MPFR_ADD_ONE_ULP (mpc_imagref (x));
MPC_ASSERT (mpfr_zero_p (mpc_realref (x)) == 0);
ezr = mpfr_get_exp (mpc_realref (x));
/* FIXME: compute
k = Exp(Re(x))+Exp(Re(y))-2min{Exp(Re(y)), Exp(Im(y))}-Exp(Re(x/y))
avoiding overflow */
k = exr - ezr + MPC_MAX(-eyr, eyr - 2 * eyi);
err = k < 2 ? 7 : (k == 2 ? 8 : (5 + k));
/* Can the real part be rounded? */
ok = (!mpfr_number_p (mpc_realref (x)))
|| mpfr_can_round (mpc_realref(x), prec - err, MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_RE(rop) + (MPC_RND_RE(rnd) == MPFR_RNDN));
if (ok)
{
/* Can the imaginary part be rounded? */
ok = (!mpfr_number_p (mpc_imagref (x)))
|| mpfr_can_round (mpc_imagref(x), prec - 6, MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_IM(rop) + (MPC_RND_IM(rnd) == MPFR_RNDN));
}
}
while (ok == 0);
inex = mpc_set (rop, x, rnd);
end:
mpc_clear (x);
mpc_clear (y);
return inex;
}
/* Put in z the value of x^y, rounded according to 'rnd'.
Return the inexact flag in [0, 10]. */
int
mpc_pow (mpc_ptr z, mpc_srcptr x, mpc_srcptr y, mpc_rnd_t rnd)
{
int ret = -2, loop, x_real, x_imag, y_real, z_real = 0, z_imag = 0;
mpc_t t, u;
mpfr_prec_t p, pr, pi, maxprec;
int saved_underflow, saved_overflow;
/* save the underflow or overflow flags from MPFR */
saved_underflow = mpfr_underflow_p ();
saved_overflow = mpfr_overflow_p ();
x_real = mpfr_zero_p (mpc_imagref(x));
y_real = mpfr_zero_p (mpc_imagref(y));
if (y_real && mpfr_zero_p (mpc_realref(y))) /* case y zero */
{
if (x_real && mpfr_zero_p (mpc_realref(x)))
{
/* we define 0^0 to be (1, +0) since the real part is
coherent with MPFR where 0^0 gives 1, and the sign of the
imaginary part cannot be determined */
mpc_set_ui_ui (z, 1, 0, MPC_RNDNN);
return 0;
}
else /* x^0 = 1 +/- i*0 even for x=NaN see algorithms.tex for the
sign of zero */
{
mpfr_t n;
int inex, cx1;
int sign_zi;
/* cx1 < 0 if |x| < 1
cx1 = 0 if |x| = 1
cx1 > 0 if |x| > 1
*/
mpfr_init (n);
inex = mpc_norm (n, x, MPFR_RNDN);
cx1 = mpfr_cmp_ui (n, 1);
if (cx1 == 0 && inex != 0)
cx1 = -inex;
sign_zi = (cx1 < 0 && mpfr_signbit (mpc_imagref (y)) == 0)
|| (cx1 == 0
&& mpfr_signbit (mpc_imagref (x)) != mpfr_signbit (mpc_realref (y)))
|| (cx1 > 0 && mpfr_signbit (mpc_imagref (y)));
/* warning: mpc_set_ui_ui does not set Im(z) to -0 if Im(rnd)=RNDD */
ret = mpc_set_ui_ui (z, 1, 0, rnd);
if (MPC_RND_IM (rnd) == MPFR_RNDD || sign_zi)
mpc_conj (z, z, MPC_RNDNN);
mpfr_clear (n);
return ret;
}
}
if (!mpc_fin_p (x) || !mpc_fin_p (y))
{
/* special values: exp(y*log(x)) */
mpc_init2 (u, 2);
mpc_log (u, x, MPC_RNDNN);
mpc_mul (u, u, y, MPC_RNDNN);
ret = mpc_exp (z, u, rnd);
mpc_clear (u);
goto end;
}
if (x_real) /* case x real */
{
if (mpfr_zero_p (mpc_realref(x))) /* x is zero */
{
/* special values: exp(y*log(x)) */
mpc_init2 (u, 2);
mpc_log (u, x, MPC_RNDNN);
mpc_mul (u, u, y, MPC_RNDNN);
ret = mpc_exp (z, u, rnd);
mpc_clear (u);
goto end;
}
/* Special case 1^y = 1 */
if (mpfr_cmp_ui (mpc_realref(x), 1) == 0)
{
int s1, s2;
s1 = mpfr_signbit (mpc_realref (y));
s2 = mpfr_signbit (mpc_imagref (x));
ret = mpc_set_ui (z, +1, rnd);
/* the sign of the zero imaginary part is known in some cases (see
algorithm.tex). In such cases we have
(x +s*0i)^(y+/-0i) = x^y + s*sign(y)*0i
where s = +/-1. We extend here this rule to fix the sign of the
zero part.
Note that the sign must also be set explicitly when rnd=RNDD
because mpfr_set_ui(z_i, 0, rnd) always sets z_i to +0.
*/
if (MPC_RND_IM (rnd) == MPFR_RNDD || s1 != s2)
mpc_conj (z, z, MPC_RNDNN);
goto end;
}
/* x^y is real when:
(a) x is real and y is integer
(b) x is real non-negative and y is real */
if (y_real && (mpfr_integer_p (mpc_realref(y)) ||
mpfr_cmp_ui (mpc_realref(x), 0) >= 0))
{
int s1, s2;
s1 = mpfr_signbit (mpc_realref (y));
s2 = mpfr_signbit (mpc_imagref (x));
ret = mpfr_pow (mpc_realref(z), mpc_realref(x), mpc_realref(y), MPC_RND_RE(rnd));
ret = MPC_INEX(ret, mpfr_set_ui (mpc_imagref(z), 0, MPC_RND_IM(rnd)));
/* the sign of the zero imaginary part is known in some cases
(see algorithm.tex). In such cases we have (x +s*0i)^(y+/-0i)
= x^y + s*sign(y)*0i where s = +/-1.
We extend here this rule to fix the sign of the zero part.
Note that the sign must also be set explicitly when rnd=RNDD
because mpfr_set_ui(z_i, 0, rnd) always sets z_i to +0.
*/
if (MPC_RND_IM(rnd) == MPFR_RNDD || s1 != s2)
mpfr_neg (mpc_imagref(z), mpc_imagref(z), MPC_RND_IM(rnd));
goto end;
}
/* (-1)^(n+I*t) is real for n integer and t real */
if (mpfr_cmp_si (mpc_realref(x), -1) == 0 && mpfr_integer_p (mpc_realref(y)))
z_real = 1;
/* for x real, x^y is imaginary when:
(a) x is negative and y is half-an-integer
(b) x = -1 and Re(y) is half-an-integer
*/
if ((mpfr_cmp_ui (mpc_realref(x), 0) < 0) && is_odd (mpc_realref(y), 1)
&& (y_real || mpfr_cmp_si (mpc_realref(x), -1) == 0))
z_imag = 1;
}
else /* x non real */
/* I^(t*I) and (-I)^(t*I) are real for t real,
I^(n+t*I) and (-I)^(n+t*I) are real for n even and t real, and
I^(n+t*I) and (-I)^(n+t*I) are imaginary for n odd and t real
(s*I)^n is real for n even and imaginary for n odd */
if ((mpc_cmp_si_si (x, 0, 1) == 0 || mpc_cmp_si_si (x, 0, -1) == 0 ||
(mpfr_cmp_ui (mpc_realref(x), 0) == 0 && y_real)) &&
mpfr_integer_p (mpc_realref(y)))
{ /* x is I or -I, and Re(y) is an integer */
if (is_odd (mpc_realref(y), 0))
z_imag = 1; /* Re(y) odd: z is imaginary */
else
z_real = 1; /* Re(y) even: z is real */
}
else /* (t+/-t*I)^(2n) is imaginary for n odd and real for n even */
if (mpfr_cmpabs (mpc_realref(x), mpc_imagref(x)) == 0 && y_real &&
mpfr_integer_p (mpc_realref(y)) && is_odd (mpc_realref(y), 0) == 0)
{
if (is_odd (mpc_realref(y), -1)) /* y/2 is odd */
z_imag = 1;
else
z_real = 1;
}
pr = mpfr_get_prec (mpc_realref(z));
pi = mpfr_get_prec (mpc_imagref(z));
p = (pr > pi) ? pr : pi;
p += 12; /* experimentally, seems to give less than 10% of failures in
Ziv's strategy; probably wrong now since q is not computed */
if (p < 64)
p = 64;
mpc_init2 (u, p);
mpc_init2 (t, p);
pr += MPC_RND_RE(rnd) == MPFR_RNDN;
pi += MPC_RND_IM(rnd) == MPFR_RNDN;
maxprec = MPC_MAX_PREC (z);
x_imag = mpfr_zero_p (mpc_realref(x));
for (loop = 0;; loop++)
{
int ret_exp;
mpfr_exp_t dr, di;
mpfr_prec_t q;
mpc_log (t, x, MPC_RNDNN);
mpc_mul (t, t, y, MPC_RNDNN);
/* Compute q such that |Re (y log x)|, |Im (y log x)| < 2^q.
We recompute it at each loop since we might get different
bounds if the precision is not enough. */
q = mpfr_get_exp (mpc_realref(t)) > 0 ? mpfr_get_exp (mpc_realref(t)) : 0;
if (mpfr_get_exp (mpc_imagref(t)) > (mpfr_exp_t) q)
q = mpfr_get_exp (mpc_imagref(t));
mpfr_clear_overflow ();
mpfr_clear_underflow ();
ret_exp = mpc_exp (u, t, MPC_RNDNN);
if (mpfr_underflow_p () || mpfr_overflow_p ()) {
/* under- and overflow flags are set by mpc_exp */
mpc_set (z, u, MPC_RNDNN);
ret = ret_exp;
goto exact;
}
/* Since the error bound is global, we have to take into account the
exponent difference between the real and imaginary parts. We assume
either the real or the imaginary part of u is not zero.
*/
dr = mpfr_zero_p (mpc_realref(u)) ? mpfr_get_exp (mpc_imagref(u))
: mpfr_get_exp (mpc_realref(u));
di = mpfr_zero_p (mpc_imagref(u)) ? dr : mpfr_get_exp (mpc_imagref(u));
if (dr > di)
{
di = dr - di;
dr = 0;
}
else
{
dr = di - dr;
di = 0;
}
/* the term -3 takes into account the factor 4 in the complex error
(see algorithms.tex) plus one due to the exponent difference: if
z = a + I*b, where the relative error on z is at most 2^(-p), and
EXP(a) = EXP(b) + k, the relative error on b is at most 2^(k-p) */
if ((z_imag || (p > q + 3 + dr && mpfr_can_round (mpc_realref(u), p - q - 3 - dr, MPFR_RNDN, MPFR_RNDZ, pr))) &&
(z_real || (p > q + 3 + di && mpfr_can_round (mpc_imagref(u), p - q - 3 - di, MPFR_RNDN, MPFR_RNDZ, pi))))
break;
/* if Re(u) is not known to be zero, assume it is a normal number, i.e.,
neither zero, Inf or NaN, otherwise we might enter an infinite loop */
MPC_ASSERT (z_imag || mpfr_number_p (mpc_realref(u)));
/* idem for Im(u) */
MPC_ASSERT (z_real || mpfr_number_p (mpc_imagref(u)));
if (ret == -2) /* we did not yet call mpc_pow_exact, or it aborted
because intermediate computations had > maxprec bits */
{
/* check exact cases (see algorithms.tex) */
if (y_real)
{
maxprec *= 2;
ret = mpc_pow_exact (z, x, mpc_realref(y), rnd, maxprec);
if (ret != -1 && ret != -2)
goto exact;
}
p += dr + di + 64;
}
else
p += p / 2;
mpc_set_prec (t, p);
mpc_set_prec (u, p);
}
if (z_real)
{
/* When the result is real (see algorithm.tex for details),
Im(x^y) =
+ sign(imag(y))*0i, if |x| > 1
+ sign(imag(x))*sign(real(y))*0i, if |x| = 1
- sign(imag(y))*0i, if |x| < 1
*/
mpfr_t n;
int inex, cx1;
int sign_zi, sign_rex, sign_imx;
/* cx1 < 0 if |x| < 1
cx1 = 0 if |x| = 1
cx1 > 0 if |x| > 1
*/
sign_rex = mpfr_signbit (mpc_realref (x));
sign_imx = mpfr_signbit (mpc_imagref (x));
mpfr_init (n);
inex = mpc_norm (n, x, MPFR_RNDN);
cx1 = mpfr_cmp_ui (n, 1);
if (cx1 == 0 && inex != 0)
cx1 = -inex;
sign_zi = (cx1 < 0 && mpfr_signbit (mpc_imagref (y)) == 0)
|| (cx1 == 0 && sign_imx != mpfr_signbit (mpc_realref (y)))
|| (cx1 > 0 && mpfr_signbit (mpc_imagref (y)));
/* copy RE(y) to n since if z==y we will destroy Re(y) below */
mpfr_set_prec (n, mpfr_get_prec (mpc_realref (y)));
mpfr_set (n, mpc_realref (y), MPFR_RNDN);
ret = mpfr_set (mpc_realref(z), mpc_realref(u), MPC_RND_RE(rnd));
if (y_real && (x_real || x_imag))
{
/* FIXME: with y_real we assume Im(y) is really 0, which is the case
for example when y comes from pow_fr, but in case Im(y) is +0 or
-0, we might get different results */
mpfr_set_ui (mpc_imagref (z), 0, MPC_RND_IM (rnd));
fix_sign (z, sign_rex, sign_imx, n);
ret = MPC_INEX(ret, 0); /* imaginary part is exact */
}
else
{
ret = MPC_INEX (ret, mpfr_set_ui (mpc_imagref (z), 0, MPC_RND_IM (rnd)));
/* warning: mpfr_set_ui does not set Im(z) to -0 if Im(rnd) = RNDD */
if (MPC_RND_IM (rnd) == MPFR_RNDD || sign_zi)
mpc_conj (z, z, MPC_RNDNN);
}
mpfr_clear (n);
}
else if (z_imag)
{
ret = mpfr_set (mpc_imagref(z), mpc_imagref(u), MPC_RND_IM(rnd));
/* if z is imaginary and y real, then x cannot be real */
if (y_real && x_imag)
{
int sign_rex = mpfr_signbit (mpc_realref (x));
/* If z overlaps with y we set Re(z) before checking Re(y) below,
but in that case y=0, which was dealt with above. */
mpfr_set_ui (mpc_realref (z), 0, MPC_RND_RE (rnd));
/* Note: fix_sign only does something when y is an integer,
then necessarily y = 1 or 3 (mod 4), and in that case the
sign of Im(x) is irrelevant. */
fix_sign (z, sign_rex, 0, mpc_realref (y));
ret = MPC_INEX(0, ret);
}
else
ret = MPC_INEX(mpfr_set_ui (mpc_realref(z), 0, MPC_RND_RE(rnd)), ret);
}
else
ret = mpc_set (z, u, rnd);
exact:
mpc_clear (t);
mpc_clear (u);
/* restore underflow and overflow flags from MPFR */
if (saved_underflow)
mpfr_set_underflow ();
if (saved_overflow)
mpfr_set_overflow ();
end:
return ret;
}
/* Put in z the value of x^y, rounded according to 'rnd'.
Return the inexact flag in [0, 10]. */
int
mpc_pow (mpc_ptr z, mpc_srcptr x, mpc_srcptr y, mpc_rnd_t rnd)
{
int ret = -2, loop, x_real, y_real, z_real = 0, z_imag = 0;
mpc_t t, u;
mp_prec_t p, q, pr, pi, maxprec;
long Q;
x_real = mpfr_zero_p (MPC_IM(x));
y_real = mpfr_zero_p (MPC_IM(y));
if (y_real && mpfr_zero_p (MPC_RE(y))) /* case y zero */
{
if (x_real && mpfr_zero_p (MPC_RE(x))) /* 0^0 = NaN +i*NaN */
{
mpfr_set_nan (MPC_RE(z));
mpfr_set_nan (MPC_IM(z));
return 0;
}
else /* x^0 = 1 +/- i*0 even for x=NaN see algorithms.tex for the
sign of zero */
{
mpfr_t n;
int inex, cx1;
int sign_zi;
/* cx1 < 0 if |x| < 1
cx1 = 0 if |x| = 1
cx1 > 0 if |x| > 1
*/
mpfr_init (n);
inex = mpc_norm (n, x, GMP_RNDN);
cx1 = mpfr_cmp_ui (n, 1);
if (cx1 == 0 && inex != 0)
cx1 = -inex;
sign_zi = (cx1 < 0 && mpfr_signbit (MPC_IM (y)) == 0)
|| (cx1 == 0
&& mpfr_signbit (MPC_IM (x)) != mpfr_signbit (MPC_RE (y)))
|| (cx1 > 0 && mpfr_signbit (MPC_IM (y)));
/* warning: mpc_set_ui_ui does not set Im(z) to -0 if Im(rnd)=RNDD */
ret = mpc_set_ui_ui (z, 1, 0, rnd);
if (MPC_RND_IM (rnd) == GMP_RNDD || sign_zi)
mpc_conj (z, z, MPC_RNDNN);
mpfr_clear (n);
return ret;
}
}
if (mpfr_nan_p (MPC_RE(x)) || mpfr_nan_p (MPC_IM(x)) ||
mpfr_nan_p (MPC_RE(y)) || mpfr_nan_p (MPC_IM(y)) ||
mpfr_inf_p (MPC_RE(x)) || mpfr_inf_p (MPC_IM(x)) ||
mpfr_inf_p (MPC_RE(y)) || mpfr_inf_p (MPC_IM(y)))
{
/* special values: exp(y*log(x)) */
mpc_init2 (u, 2);
mpc_log (u, x, MPC_RNDNN);
mpc_mul (u, u, y, MPC_RNDNN);
ret = mpc_exp (z, u, rnd);
mpc_clear (u);
goto end;
}
if (x_real) /* case x real */
{
if (mpfr_zero_p (MPC_RE(x))) /* x is zero */
{
/* special values: exp(y*log(x)) */
mpc_init2 (u, 2);
mpc_log (u, x, MPC_RNDNN);
mpc_mul (u, u, y, MPC_RNDNN);
ret = mpc_exp (z, u, rnd);
mpc_clear (u);
goto end;
}
/* Special case 1^y = 1 */
if (mpfr_cmp_ui (MPC_RE(x), 1) == 0)
{
int s1, s2;
s1 = mpfr_signbit (MPC_RE (y));
s2 = mpfr_signbit (MPC_IM (x));
ret = mpc_set_ui (z, +1, rnd);
/* the sign of the zero imaginary part is known in some cases (see
algorithm.tex). In such cases we have
(x +s*0i)^(y+/-0i) = x^y + s*sign(y)*0i
where s = +/-1. We extend here this rule to fix the sign of the
zero part.
Note that the sign must also be set explicitly when rnd=RNDD
because mpfr_set_ui(z_i, 0, rnd) always sets z_i to +0.
*/
if (MPC_RND_IM (rnd) == GMP_RNDD || s1 != s2)
mpc_conj (z, z, MPC_RNDNN);
goto end;
}
/* x^y is real when:
(a) x is real and y is integer
(b) x is real non-negative and y is real */
if (y_real && (mpfr_integer_p (MPC_RE(y)) ||
mpfr_cmp_ui (MPC_RE(x), 0) >= 0))
{
int s1, s2;
s1 = mpfr_signbit (MPC_RE (y));
s2 = mpfr_signbit (MPC_IM (x));
ret = mpfr_pow (MPC_RE(z), MPC_RE(x), MPC_RE(y), MPC_RND_RE(rnd));
ret = MPC_INEX(ret, mpfr_set_ui (MPC_IM(z), 0, MPC_RND_IM(rnd)));
/* the sign of the zero imaginary part is known in some cases
(see algorithm.tex). In such cases we have (x +s*0i)^(y+/-0i)
= x^y + s*sign(y)*0i where s = +/-1.
We extend here this rule to fix the sign of the zero part.
Note that the sign must also be set explicitly when rnd=RNDD
because mpfr_set_ui(z_i, 0, rnd) always sets z_i to +0.
*/
if (MPC_RND_IM(rnd) == GMP_RNDD || s1 != s2)
mpfr_neg (MPC_IM(z), MPC_IM(z), MPC_RND_IM(rnd));
goto end;
}
/* (-1)^(n+I*t) is real for n integer and t real */
if (mpfr_cmp_si (MPC_RE(x), -1) == 0 && mpfr_integer_p (MPC_RE(y)))
z_real = 1;
/* for x real, x^y is imaginary when:
(a) x is negative and y is half-an-integer
(b) x = -1 and Re(y) is half-an-integer
*/
if (mpfr_cmp_ui (MPC_RE(x), 0) < 0 && is_odd (MPC_RE(y), 1) &&
(y_real || mpfr_cmp_si (MPC_RE(x), -1) == 0))
z_imag = 1;
}
else /* x non real */
/* I^(t*I) and (-I)^(t*I) are real for t real,
I^(n+t*I) and (-I)^(n+t*I) are real for n even and t real, and
I^(n+t*I) and (-I)^(n+t*I) are imaginary for n odd and t real
(s*I)^n is real for n even and imaginary for n odd */
if ((mpc_cmp_si_si (x, 0, 1) == 0 || mpc_cmp_si_si (x, 0, -1) == 0 ||
(mpfr_cmp_ui (MPC_RE(x), 0) == 0 && y_real)) &&
mpfr_integer_p (MPC_RE(y)))
{ /* x is I or -I, and Re(y) is an integer */
if (is_odd (MPC_RE(y), 0))
z_imag = 1; /* Re(y) odd: z is imaginary */
else
z_real = 1; /* Re(y) even: z is real */
}
else /* (t+/-t*I)^(2n) is imaginary for n odd and real for n even */
if (mpfr_cmpabs (MPC_RE(x), MPC_IM(x)) == 0 && y_real &&
mpfr_integer_p (MPC_RE(y)) && is_odd (MPC_RE(y), 0) == 0)
{
if (is_odd (MPC_RE(y), -1)) /* y/2 is odd */
z_imag = 1;
else
z_real = 1;
}
/* first bound |Re(y log(x))|, |Im(y log(x)| < 2^q */
mpc_init2 (t, 64);
mpc_log (t, x, MPC_RNDNN);
mpc_mul (t, t, y, MPC_RNDNN);
/* the default maximum exponent for MPFR is emax=2^30-1, thus if
t > log(2^emax) = emax*log(2), then exp(t) will overflow */
if (mpfr_cmp_ui_2exp (MPC_RE(t), 372130558, 1) > 0)
goto overflow;
/* the default minimum exponent for MPFR is emin=-2^30+1, thus the
smallest representable value is 2^(emin-1), and if
t < log(2^(emin-1)) = (emin-1)*log(2), then exp(t) will underflow */
if (mpfr_cmp_si_2exp (MPC_RE(t), -372130558, 1) < 0)
goto underflow;
q = mpfr_get_exp (MPC_RE(t)) > 0 ? mpfr_get_exp (MPC_RE(t)) : 0;
if (mpfr_get_exp (MPC_IM(t)) > (mp_exp_t) q)
q = mpfr_get_exp (MPC_IM(t));
pr = mpfr_get_prec (MPC_RE(z));
pi = mpfr_get_prec (MPC_IM(z));
p = (pr > pi) ? pr : pi;
p += 11; /* experimentally, seems to give less than 10% of failures in
Ziv's strategy */
mpc_init2 (u, p);
pr += MPC_RND_RE(rnd) == GMP_RNDN;
pi += MPC_RND_IM(rnd) == GMP_RNDN;
maxprec = MPFR_PREC(MPC_RE(z));
if (MPFR_PREC(MPC_IM(z)) > maxprec)
maxprec = MPFR_PREC(MPC_IM(z));
for (loop = 0;; loop++)
{
mp_exp_t dr, di;
if (p + q > 64) /* otherwise we reuse the initial approximation
t of y*log(x), avoiding two computations */
{
mpc_set_prec (t, p + q);
mpc_log (t, x, MPC_RNDNN);
mpc_mul (t, t, y, MPC_RNDNN);
}
mpc_exp (u, t, MPC_RNDNN);
/* Since the error bound is global, we have to take into account the
exponent difference between the real and imaginary parts. We assume
either the real or the imaginary part of u is not zero.
*/
dr = mpfr_zero_p (MPC_RE(u)) ? mpfr_get_exp (MPC_IM(u))
: mpfr_get_exp (MPC_RE(u));
di = mpfr_zero_p (MPC_IM(u)) ? dr : mpfr_get_exp (MPC_IM(u));
if (dr > di)
{
di = dr - di;
dr = 0;
}
else
{
dr = di - dr;
di = 0;
}
/* the term -3 takes into account the factor 4 in the complex error
(see algorithms.tex) plus one due to the exponent difference: if
z = a + I*b, where the relative error on z is at most 2^(-p), and
EXP(a) = EXP(b) + k, the relative error on b is at most 2^(k-p) */
if ((z_imag || mpfr_can_round (MPC_RE(u), p - 3 - dr, GMP_RNDN, GMP_RNDZ, pr)) &&
(z_real || mpfr_can_round (MPC_IM(u), p - 3 - di, GMP_RNDN, GMP_RNDZ, pi)))
break;
/* if Re(u) is not known to be zero, assume it is a normal number, i.e.,
neither zero, Inf or NaN, otherwise we might enter an infinite loop */
MPC_ASSERT (z_imag || mpfr_number_p (MPC_RE(u)));
/* idem for Im(u) */
MPC_ASSERT (z_real || mpfr_number_p (MPC_IM(u)));
if (ret == -2) /* we did not yet call mpc_pow_exact, or it aborted
because intermediate computations had > maxprec bits */
{
/* check exact cases (see algorithms.tex) */
if (y_real)
{
maxprec *= 2;
ret = mpc_pow_exact (z, x, MPC_RE(y), rnd, maxprec);
if (ret != -1 && ret != -2)
goto exact;
}
p += dr + di + 64;
}
else
p += p / 2;
mpc_set_prec (t, p + q);
mpc_set_prec (u, p);
}
if (z_real)
{
/* When the result is real (see algorithm.tex for details),
Im(x^y) =
+ sign(imag(y))*0i, if |x| > 1
+ sign(imag(x))*sign(real(y))*0i, if |x| = 1
- sign(imag(y))*0i, if |x| < 1
*/
mpfr_t n;
int inex, cx1;
int sign_zi;
/* cx1 < 0 if |x| < 1
cx1 = 0 if |x| = 1
cx1 > 0 if |x| > 1
*/
mpfr_init (n);
inex = mpc_norm (n, x, GMP_RNDN);
cx1 = mpfr_cmp_ui (n, 1);
if (cx1 == 0 && inex != 0)
cx1 = -inex;
sign_zi = (cx1 < 0 && mpfr_signbit (MPC_IM (y)) == 0)
|| (cx1 == 0
&& mpfr_signbit (MPC_IM (x)) != mpfr_signbit (MPC_RE (y)))
|| (cx1 > 0 && mpfr_signbit (MPC_IM (y)));
ret = mpfr_set (MPC_RE(z), MPC_RE(u), MPC_RND_RE(rnd));
/* warning: mpfr_set_ui does not set Im(z) to -0 if Im(rnd) = RNDD */
ret = MPC_INEX (ret, mpfr_set_ui (MPC_IM (z), 0, MPC_RND_IM (rnd)));
if (MPC_RND_IM (rnd) == GMP_RNDD || sign_zi)
mpc_conj (z, z, MPC_RNDNN);
mpfr_clear (n);
}
else if (z_imag)
{
ret = mpfr_set (MPC_IM(z), MPC_IM(u), MPC_RND_IM(rnd));
ret = MPC_INEX(mpfr_set_ui (MPC_RE(z), 0, MPC_RND_RE(rnd)), ret);
}
else
ret = mpc_set (z, u, rnd);
exact:
mpc_clear (t);
mpc_clear (u);
end:
return ret;
underflow:
/* If we have an underflow, we know that |z| is too small to be
represented, but depending on arg(z), we should return +/-0 +/- I*0.
We assume t is the approximation of y*log(x), thus we want
exp(t) = exp(Re(t))+exp(I*Im(t)).
FIXME: this part of code is not 100% rigorous, since we don't consider
rounding errors.
*/
mpc_init2 (u, 64);
mpfr_const_pi (MPC_RE(u), GMP_RNDN);
mpfr_div_2exp (MPC_RE(u), MPC_RE(u), 1, GMP_RNDN); /* Pi/2 */
mpfr_remquo (MPC_RE(u), &Q, MPC_IM(t), MPC_RE(u), GMP_RNDN);
if (mpfr_sgn (MPC_RE(u)) < 0)
Q--; /* corresponds to positive remainder */
mpfr_set_ui (MPC_RE(z), 0, GMP_RNDN);
mpfr_set_ui (MPC_IM(z), 0, GMP_RNDN);
switch (Q & 3)
{
case 0: /* first quadrant: round to (+0 +0) */
ret = MPC_INEX(-1, -1);
break;
case 1: /* second quadrant: round to (-0 +0) */
mpfr_neg (MPC_RE(z), MPC_RE(z), GMP_RNDN);
ret = MPC_INEX(1, -1);
break;
case 2: /* third quadrant: round to (-0 -0) */
mpfr_neg (MPC_RE(z), MPC_RE(z), GMP_RNDN);
mpfr_neg (MPC_IM(z), MPC_IM(z), GMP_RNDN);
ret = MPC_INEX(1, 1);
break;
case 3: /* fourth quadrant: round to (+0 -0) */
mpfr_neg (MPC_IM(z), MPC_IM(z), GMP_RNDN);
ret = MPC_INEX(-1, 1);
break;
}
goto clear_t_and_u;
overflow:
/* If we have an overflow, we know that |z| is too large to be
represented, but depending on arg(z), we should return +/-Inf +/- I*Inf.
We assume t is the approximation of y*log(x), thus we want
exp(t) = exp(Re(t))+exp(I*Im(t)).
FIXME: this part of code is not 100% rigorous, since we don't consider
rounding errors.
*/
mpc_init2 (u, 64);
mpfr_const_pi (MPC_RE(u), GMP_RNDN);
mpfr_div_2exp (MPC_RE(u), MPC_RE(u), 1, GMP_RNDN); /* Pi/2 */
/* the quotient is rounded to the nearest integer in mpfr_remquo */
mpfr_remquo (MPC_RE(u), &Q, MPC_IM(t), MPC_RE(u), GMP_RNDN);
if (mpfr_sgn (MPC_RE(u)) < 0)
Q--; /* corresponds to positive remainder */
switch (Q & 3)
{
case 0: /* first quadrant */
mpfr_set_inf (MPC_RE(z), 1);
mpfr_set_inf (MPC_IM(z), 1);
ret = MPC_INEX(1, 1);
break;
case 1: /* second quadrant */
mpfr_set_inf (MPC_RE(z), -1);
mpfr_set_inf (MPC_IM(z), 1);
ret = MPC_INEX(-1, 1);
break;
case 2: /* third quadrant */
mpfr_set_inf (MPC_RE(z), -1);
mpfr_set_inf (MPC_IM(z), -1);
ret = MPC_INEX(-1, -1);
break;
case 3: /* fourth quadrant */
mpfr_set_inf (MPC_RE(z), 1);
mpfr_set_inf (MPC_IM(z), -1);
ret = MPC_INEX(1, -1);
break;
}
clear_t_and_u:
mpc_clear (t);
mpc_clear (u);
return ret;
}
static void
check4 (const char *as, const char *bs, mpfr_rnd_t rnd_mode,
const char *res, int inex)
{
mpfr_t ta, tb, tc, tres;
mpfr_exp_t emin, emax;
int i;
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
mpfr_inits2 (53, ta, tb, tc, tres, (mpfr_ptr) 0);
for (i = 0; i <= 2; i++)
{
unsigned int expflags, newflags;
int inex2;
mpfr_set_str1 (ta, as);
mpfr_set_str1 (tb, bs);
mpfr_set_str1 (tc, res);
if (i > 0)
{
mpfr_exp_t ea, eb, ec, e0;
set_emin (MPFR_EMIN_MIN);
set_emax (MPFR_EMAX_MAX);
ea = mpfr_get_exp (ta);
eb = mpfr_get_exp (tb);
ec = mpfr_get_exp (tc);
e0 = i == 1 ? __gmpfr_emin : __gmpfr_emax;
if ((i == 1 && ea < eb) || (i == 2 && ea > eb))
{
mpfr_set_exp (ta, e0);
mpfr_set_exp (tb, e0 + (eb - ea));
mpfr_set_exp (tc, e0 + (ec - ea));
}
else
{
mpfr_set_exp (ta, e0 + (ea - eb));
mpfr_set_exp (tb, e0);
mpfr_set_exp (tc, e0 + (ec - eb));
}
}
__gmpfr_flags = expflags =
(randlimb () & 1) ? MPFR_FLAGS_ALL ^ MPFR_FLAGS_ERANGE : 0;
inex2 = mpfr_agm (tres, ta, tb, rnd_mode);
newflags = __gmpfr_flags;
expflags |= MPFR_FLAGS_INEXACT;
if (SIGN (inex2) != inex || newflags != expflags ||
! mpfr_equal_p (tres, tc))
{
printf ("mpfr_agm failed in rnd_mode=%s for\n",
mpfr_print_rnd_mode (rnd_mode));
printf (" a = ");
mpfr_out_str (stdout, 10, 0, ta, MPFR_RNDN);
printf ("\n");
printf (" b = ");
mpfr_out_str (stdout, 10, 0, tb, MPFR_RNDN);
printf ("\n");
printf ("expected inex = %d, flags = %u,\n"
" ", inex, expflags);
mpfr_dump (tc);
printf ("got inex = %d, flags = %u,\n"
" ", inex2, newflags);
mpfr_dump (tres);
exit (1);
}
set_emin (emin);
set_emax (emax);
}
mpfr_clears (ta, tb, tc, tres, (mpfr_ptr) 0);
}
/* put in rop the value of exp(2*i*pi*k/n) rounded according to rnd */
int
mpc_rootofunity (mpc_ptr rop, unsigned long n, unsigned long k, mpc_rnd_t rnd)
{
unsigned long g;
mpq_t kn;
mpfr_t t, s, c;
mpfr_prec_t prec;
int inex_re, inex_im;
mpfr_rnd_t rnd_re, rnd_im;
if (n == 0) {
/* Compute exp (0 + i*inf). */
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
return MPC_INEX (0, 0);
}
/* Eliminate common denominator. */
k %= n;
g = gcd (k, n);
k /= g;
n /= g;
/* Now 0 <= k < n and gcd(k,n)=1. */
/* We assume that only n=1, 2, 3, 4, 6 and 12 may yield exact results
and treat them separately; n=8 is also treated here for efficiency
reasons. */
if (n == 1)
{
/* necessarily k=0 thus we want exp(0)=1 */
MPC_ASSERT (k == 0);
return mpc_set_ui_ui (rop, 1, 0, rnd);
}
else if (n == 2)
{
/* since gcd(k,n)=1, necessarily k=1, thus we want exp(i*pi)=-1 */
MPC_ASSERT (k == 1);
return mpc_set_si_si (rop, -1, 0, rnd);
}
else if (n == 4)
{
/* since gcd(k,n)=1, necessarily k=1 or k=3, thus we want
exp(2*i*pi/4)=i or exp(2*i*pi*3/4)=-i */
MPC_ASSERT (k == 1 || k == 3);
if (k == 1)
return mpc_set_ui_ui (rop, 0, 1, rnd);
else
return mpc_set_si_si (rop, 0, -1, rnd);
}
else if (n == 3 || n == 6)
{
MPC_ASSERT ((n == 3 && (k == 1 || k == 2)) ||
(n == 6 && (k == 1 || k == 5)));
/* for n=3, necessarily k=1 or k=2: -1/2+/-1/2*sqrt(3)*i;
for n=6, necessarily k=1 or k=5: 1/2+/-1/2*sqrt(3)*i */
inex_re = mpfr_set_si (mpc_realref (rop), (n == 3 ? -1 : 1),
MPC_RND_RE (rnd));
/* inverse the rounding mode for -sqrt(3)/2 for zeta_3^2 and zeta_6^5 */
rnd_im = MPC_RND_IM (rnd);
if (k != 1)
rnd_im = INV_RND (rnd_im);
inex_im = mpfr_sqrt_ui (mpc_imagref (rop), 3, rnd_im);
mpc_div_2ui (rop, rop, 1, MPC_RNDNN);
if (k != 1)
{
mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), MPFR_RNDN);
inex_im = -inex_im;
}
return MPC_INEX (inex_re, inex_im);
}
else if (n == 12)
{
/* necessarily k=1, 5, 7, 11:
k=1: 1/2*sqrt(3) + 1/2*I
k=5: -1/2*sqrt(3) + 1/2*I
k=7: -1/2*sqrt(3) - 1/2*I
k=11: 1/2*sqrt(3) - 1/2*I */
MPC_ASSERT (k == 1 || k == 5 || k == 7 || k == 11);
/* inverse the rounding mode for -sqrt(3)/2 for zeta_12^5 and zeta_12^7 */
rnd_re = MPC_RND_RE (rnd);
if (k == 5 || k == 7)
rnd_re = INV_RND (rnd_re);
inex_re = mpfr_sqrt_ui (mpc_realref (rop), 3, rnd_re);
inex_im = mpfr_set_si (mpc_imagref (rop), k < 6 ? 1 : -1,
MPC_RND_IM (rnd));
mpc_div_2ui (rop, rop, 1, MPC_RNDNN);
if (k == 5 || k == 7)
{
mpfr_neg (mpc_realref (rop), mpc_realref (rop), MPFR_RNDN);
inex_re = -inex_re;
}
return MPC_INEX (inex_re, inex_im);
}
else if (n == 8)
{
/* k=1, 3, 5 or 7:
k=1: (1/2*I + 1/2)*sqrt(2)
k=3: (1/2*I - 1/2)*sqrt(2)
k=5: -(1/2*I + 1/2)*sqrt(2)
k=7: -(1/2*I - 1/2)*sqrt(2) */
MPC_ASSERT (k == 1 || k == 3 || k == 5 || k == 7);
rnd_re = MPC_RND_RE (rnd);
if (k == 3 || k == 5)
rnd_re = INV_RND (rnd_re);
rnd_im = MPC_RND_IM (rnd);
if (k > 4)
rnd_im = INV_RND (rnd_im);
inex_re = mpfr_sqrt_ui (mpc_realref (rop), 2, rnd_re);
inex_im = mpfr_sqrt_ui (mpc_imagref (rop), 2, rnd_im);
mpc_div_2ui (rop, rop, 1, MPC_RNDNN);
if (k == 3 || k == 5)
{
mpfr_neg (mpc_realref (rop), mpc_realref (rop), MPFR_RNDN);
inex_re = -inex_re;
}
if (k > 4)
{
mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), MPFR_RNDN);
inex_im = -inex_im;
}
return MPC_INEX (inex_re, inex_im);
}
prec = MPC_MAX_PREC(rop);
/* For the error analysis justifying the following algorithm,
see algorithms.tex. */
mpfr_init2 (t, 67);
mpfr_init2 (s, 67);
mpfr_init2 (c, 67);
mpq_init (kn);
mpq_set_ui (kn, k, n);
mpq_mul_2exp (kn, kn, 1); /* kn=2*k/n < 2 */
do {
prec += mpc_ceil_log2 (prec) + 5; /* prec >= 6 */
mpfr_set_prec (t, prec);
mpfr_set_prec (s, prec);
mpfr_set_prec (c, prec);
mpfr_const_pi (t, MPFR_RNDN);
mpfr_mul_q (t, t, kn, MPFR_RNDN);
mpfr_sin_cos (s, c, t, MPFR_RNDN);
}
while ( !mpfr_can_round (c, prec - (4 - mpfr_get_exp (c)),
MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_RE(rop) + (MPC_RND_RE(rnd) == MPFR_RNDN))
|| !mpfr_can_round (s, prec - (4 - mpfr_get_exp (s)),
MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_IM(rop) + (MPC_RND_IM(rnd) == MPFR_RNDN)));
inex_re = mpfr_set (mpc_realref(rop), c, MPC_RND_RE(rnd));
inex_im = mpfr_set (mpc_imagref(rop), s, MPC_RND_IM(rnd));
mpfr_clear (t);
mpfr_clear (s);
mpfr_clear (c);
mpq_clear (kn);
return MPC_INEX(inex_re, inex_im);
}
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(void)
{
int i;
flint_rand_t state;
flint_randinit(state);
printf("bsplit_sum_abpq....");
fflush(stdout);
for (i = 0; i < 10000; i++)
{
fmpq *ab, *pq;
fmpq_t s1, s2, t, pqp;
fmpq_bsplit_t sum;
long k, n;
n = n_randint(state, 40);
ab = _fmpq_vec_init(n);
pq = _fmpq_vec_init(n);
fmpq_init(s1);
fmpq_init(s2);
fmpq_init(pqp);
fmpq_init(t);
for (k = 0; k < n; k++) fmpq_randtest(ab + k, state, 10);
for (k = 0; k < n; k++) fmpq_randtest(pq + k, state, 10);
fmpq_bsplit_init(sum);
fmpq_bsplit_sum_abpq(sum, ab, pq, 0, n);
fmpq_bsplit_get_fmpq(s1, sum);
fmpq_zero(s2);
fmpq_one(pqp);
for (k = 0; k < n; k++)
{
fmpq_mul(pqp, pqp, pq + k);
fmpq_mul(t, pqp, ab + k);
fmpq_add(s2, s2, t);
}
if (!fmpq_is_canonical(s1) || !fmpq_equal(s1, s2))
{
printf("FAIL\n");
printf("(a/b) = ");
for (k = 0; k < n; k++) fmpq_print(ab+k), printf(" ");
printf("\n");
printf("(p/q) = ");
for (k = 0; k < n; k++) fmpq_print(pq+k), printf(" ");
printf("\n");
printf("s1: ");
fmpq_print(s1);
printf("\n");
printf("s2: ");
fmpq_print(s2);
printf("\n");
abort();
}
/* Check numerical evaluation */
{
mpfr_t f1, f2;
mpfr_prec_t prec;
prec = 5 + n_randint(state, 1000);
mpfr_init2(f1, prec);
mpfr_init2(f2, prec);
fmpq_bsplit_get_mpfr(f1, sum);
fmpq_get_mpfr(f2, s1, MPFR_RNDN);
mpfr_sub(f1, f1, f2, MPFR_RNDN);
if (!mpfr_zero_p(f1) &&
!(mpfr_get_exp(f1) <= mpfr_get_exp(f2) - prec + 3))
{
printf("FAIL: numerical evaluation\n");
printf("%ld, %ld, %ld\n", prec, mpfr_get_exp(f1),
mpfr_get_exp(f2) - prec + 3);
abort();
}
mpfr_clear(f1);
mpfr_clear(f2);
}
fmpq_bsplit_clear(sum);
fmpq_clear(s1);
fmpq_clear(s2);
fmpq_clear(pqp);
fmpq_clear(t);
_fmpq_vec_clear(ab, n);
_fmpq_vec_clear(pq, n);
}
flint_randclear(state);
_fmpz_cleanup();
printf("PASS\n");
return 0;
}