Esempio n. 1
0
static int
mpfr_rem1 (mpfr_ptr rem, long *quo, mpfr_rnd_t rnd_q,
           mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd)
{
  mpfr_exp_t ex, ey;
  int compare, inex, q_is_odd, sign, signx = MPFR_SIGN (x);
  mpz_t mx, my, r;
  int tiny = 0;

  MPFR_ASSERTD (rnd_q == MPFR_RNDN || rnd_q == MPFR_RNDZ);

  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))
        {
          /* for remquo, quo is undefined */
          MPFR_SET_NAN (rem);
          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. */
        {
          if (quo)
            *quo = 0;
          return mpfr_set (rem, x, rnd);
        }
    }

  /* now neither x nor y is NaN, Inf or zero */

  mpz_init (mx);
  mpz_init (my);
  mpz_init (r);

  ex = mpfr_get_z_2exp (mx, x);  /* x = mx*2^ex */
  ey = mpfr_get_z_2exp (my, y);  /* y = my*2^ey */

  /* to get rid of sign problems, we compute it separately:
     quo(-x,-y) = quo(x,y), rem(-x,-y) = -rem(x,y)
     quo(-x,y) = -quo(x,y), rem(-x,y)  = -rem(x,y)
     thus quo = sign(x/y)*quo(|x|,|y|), rem = sign(x)*rem(|x|,|y|) */
  sign = (signx == MPFR_SIGN (y)) ? 1 : -1;
  mpz_abs (mx, mx);
  mpz_abs (my, my);
  q_is_odd = 0;

  /* divide my by 2^k if possible to make operations mod my easier */
  {
    unsigned long k = mpz_scan1 (my, 0);
    ey += k;
    mpz_fdiv_q_2exp (my, my, k);
  }

  if (ex <= ey)
    {
      /* q = x/y = mx/(my*2^(ey-ex)) */

      /* First detect cases where q=0, to avoid creating a huge number
         my*2^(ey-ex): if sx = mpz_sizeinbase (mx, 2) and sy =
         mpz_sizeinbase (my, 2), we have x < 2^(ex + sx) and
         y >= 2^(ey + sy - 1), thus if ex + sx <= ey + sy - 1
         the quotient is 0 */
      if (ex + (mpfr_exp_t) mpz_sizeinbase (mx, 2) <
          ey + (mpfr_exp_t) mpz_sizeinbase (my, 2))
        {
          tiny = 1;
          mpz_set (r, mx);
          mpz_set_ui (mx, 0);
        }
      else
        {
          mpz_mul_2exp (my, my, ey - ex);   /* divide mx by my*2^(ey-ex) */

          /* since mx > 0 and my > 0, we can use mpz_tdiv_qr in all cases */
          mpz_tdiv_qr (mx, r, mx, my);
          /* 0 <= |r| <= |my|, r has the same sign as mx */
        }

      if (rnd_q == MPFR_RNDN)
        q_is_odd = mpz_tstbit (mx, 0);
      if (quo)                  /* mx is the quotient */
        {
          mpz_tdiv_r_2exp (mx, mx, WANTED_BITS);
          *quo = mpz_get_si (mx);
        }
    }
  else                          /* ex > ey */
    {
      if (quo) /* remquo case */
        /* for remquo, to get the low WANTED_BITS more bits of the quotient,
           we first compute R =  X mod Y*2^WANTED_BITS, where X and Y are
           defined below. Then the low WANTED_BITS of the quotient are
           floor(R/Y). */
        mpz_mul_2exp (my, my, WANTED_BITS);     /* 2^WANTED_BITS*Y */

      else if (rnd_q == MPFR_RNDN) /* remainder case */
        /* Let X = mx*2^(ex-ey) and Y = my. Then both X and Y are integers.
           Assume X = R mod Y, then x = X*2^ey = R*2^ey mod (Y*2^ey=y).
           To be able to perform the rounding, we need the least significant
           bit of the quotient, i.e., one more bit in the remainder,
           which is obtained by dividing by 2Y. */
        mpz_mul_2exp (my, my, 1);       /* 2Y */

      mpz_set_ui (r, 2);
      mpz_powm_ui (r, r, ex - ey, my);  /* 2^(ex-ey) mod my */
      mpz_mul (r, r, mx);
      mpz_mod (r, r, my);

      if (quo)                  /* now 0 <= r < 2^WANTED_BITS*Y */
        {
          mpz_fdiv_q_2exp (my, my, WANTED_BITS);   /* back to Y */
          mpz_tdiv_qr (mx, r, r, my);
          /* oldr = mx*my + newr */
          *quo = mpz_get_si (mx);
          q_is_odd = *quo & 1;
        }
      else if (rnd_q == MPFR_RNDN) /* now 0 <= r < 2Y in the remainder case */
        {
          mpz_fdiv_q_2exp (my, my, 1);     /* back to Y */
          /* least significant bit of q */
          q_is_odd = mpz_cmpabs (r, my) >= 0;
          if (q_is_odd)
            mpz_sub (r, r, my);
        }
      /* now 0 <= |r| < |my|, and if needed,
         q_is_odd is the least significant bit of q */
    }

  if (mpz_cmp_ui (r, 0) == 0)
    {
      inex = mpfr_set_ui (rem, 0, MPFR_RNDN);
      /* take into account sign of x */
      if (signx < 0)
        mpfr_neg (rem, rem, MPFR_RNDN);
    }
  else
    {
      if (rnd_q == MPFR_RNDN)
        {
          /* FIXME: the comparison 2*r < my could be done more efficiently
             at the mpn level */
          mpz_mul_2exp (r, r, 1);
          /* if tiny=1, we should compare r with my*2^(ey-ex) */
          if (tiny)
            {
              if (ex + (mpfr_exp_t) mpz_sizeinbase (r, 2) <
                  ey + (mpfr_exp_t) mpz_sizeinbase (my, 2))
                compare = 0; /* r*2^ex < my*2^ey */
              else
                {
                  mpz_mul_2exp (my, my, ey - ex);
                  compare = mpz_cmpabs (r, my);
                }
            }
          else
            compare = mpz_cmpabs (r, my);
          mpz_fdiv_q_2exp (r, r, 1);
          compare = ((compare > 0) ||
                     ((rnd_q == MPFR_RNDN) && (compare == 0) && q_is_odd));
          /* if compare != 0, we need to subtract my to r, and add 1 to quo */
          if (compare)
            {
              mpz_sub (r, r, my);
              if (quo && (rnd_q == MPFR_RNDN))
                *quo += 1;
            }
        }
      /* take into account sign of x */
      if (signx < 0)
        mpz_neg (r, r);
      inex = mpfr_set_z_2exp (rem, r, ex > ey ? ey : ex, rnd);
    }

  if (quo)
    *quo *= sign;

  mpz_clear (mx);
  mpz_clear (my);
  mpz_clear (r);

  return inex;
}
/* Implements asymptotic expansion for jn or yn (formulae 9.2.5 and 9.2.6
   from Abramowitz & Stegun).
   Assumes |z| > p log(2)/2, where p is the target precision
   (z can be negative only for jn).
   Return 0 if the expansion does not converge enough (the value 0 as inexact
   flag should not happen for normal input).
*/
static int
FUNCTION (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r)
{
  mpfr_t s, c, P, Q, t, iz, err_t, err_s, err_u;
  mpfr_prec_t w;
  long k;
  int inex, stop, diverge = 0;
  mpfr_exp_t err2, err;
  MPFR_ZIV_DECL (loop);

  mpfr_init (c);

  w = MPFR_PREC(res) + MPFR_INT_CEIL_LOG2(MPFR_PREC(res)) + 4;

  MPFR_ZIV_INIT (loop, w);
  for (;;)
    {
      mpfr_set_prec (c, w);
      mpfr_init2 (s, w);
      mpfr_init2 (P, w);
      mpfr_init2 (Q, w);
      mpfr_init2 (t, w);
      mpfr_init2 (iz, w);
      mpfr_init2 (err_t, 31);
      mpfr_init2 (err_s, 31);
      mpfr_init2 (err_u, 31);

      /* Approximate sin(z) and cos(z). In the following, err <= k means that
         the approximate value y and the true value x are related by
         y = x * (1 + u)^k with |u| <= 2^(-w), following Higham's method. */
      mpfr_sin_cos (s, c, z, MPFR_RNDN);
      if (MPFR_IS_NEG(z))
        mpfr_neg (s, s, MPFR_RNDN); /* compute jn/yn(|z|), fix sign later */
      /* The absolute error on s/c is bounded by 1/2 ulp(1/2) <= 2^(-w-1). */
      mpfr_add (t, s, c, MPFR_RNDN);
      mpfr_sub (c, s, c, MPFR_RNDN);
      mpfr_swap (s, t);
      /* now s approximates sin(z)+cos(z), and c approximates sin(z)-cos(z),
         with total absolute error bounded by 2^(1-w). */

      /* precompute 1/(8|z|) */
      mpfr_si_div (iz, MPFR_IS_POS(z) ? 1 : -1, z, MPFR_RNDN);   /* err <= 1 */
      mpfr_div_2ui (iz, iz, 3, MPFR_RNDN);

      /* compute P and Q */
      mpfr_set_ui (P, 1, MPFR_RNDN);
      mpfr_set_ui (Q, 0, MPFR_RNDN);
      mpfr_set_ui (t, 1, MPFR_RNDN); /* current term */
      mpfr_set_ui (err_t, 0, MPFR_RNDN); /* error on t */
      mpfr_set_ui (err_s, 0, MPFR_RNDN); /* error on P and Q (sum of errors) */
      for (k = 1, stop = 0; stop < 4; k++)
        {
          /* compute next term: t(k)/t(k-1) = (2n+2k-1)(2n-2k+1)/(8kz) */
          mpfr_mul_si (t, t, 2 * (n + k) - 1, MPFR_RNDN); /* err <= err_k + 1 */
          mpfr_mul_si (t, t, 2 * (n - k) + 1, MPFR_RNDN); /* err <= err_k + 2 */
          mpfr_div_ui (t, t, k, MPFR_RNDN);               /* err <= err_k + 3 */
          mpfr_mul (t, t, iz, MPFR_RNDN);                 /* err <= err_k + 5 */
          /* the relative error on t is bounded by (1+u)^(5k)-1, which is
             bounded by 6ku for 6ku <= 0.02: first |5 log(1+u)| <= |5.5u|
             for |u| <= 0.15, then |exp(5.5u)-1| <= 6u for |u| <= 0.02. */
          mpfr_mul_ui (err_t, t, 6 * k, MPFR_IS_POS(t) ? MPFR_RNDU : MPFR_RNDD);
          mpfr_abs (err_t, err_t, MPFR_RNDN); /* exact */
          /* the absolute error on t is bounded by err_t * 2^(-w) */
          mpfr_abs (err_u, t, MPFR_RNDU);
          mpfr_mul_2ui (err_u, err_u, w, MPFR_RNDU); /* t * 2^w */
          mpfr_add (err_u, err_u, err_t, MPFR_RNDU); /* max|t| * 2^w */
          if (stop >= 2)
            {
              /* take into account the neglected terms: t * 2^w */
              mpfr_div_2ui (err_s, err_s, w, MPFR_RNDU);
              if (MPFR_IS_POS(t))
                mpfr_add (err_s, err_s, t, MPFR_RNDU);
              else
                mpfr_sub (err_s, err_s, t, MPFR_RNDU);
              mpfr_mul_2ui (err_s, err_s, w, MPFR_RNDU);
              stop ++;
            }
          /* if k is odd, add to Q, otherwise to P */
          else if (k & 1)
            {
              /* if k = 1 mod 4, add, otherwise subtract */
              if ((k & 2) == 0)
                mpfr_add (Q, Q, t, MPFR_RNDN);
              else
                mpfr_sub (Q, Q, t, MPFR_RNDN);
              /* check if the next term is smaller than ulp(Q): if EXP(err_u)
                 <= EXP(Q), since the current term is bounded by
                 err_u * 2^(-w), it is bounded by ulp(Q) */
              if (MPFR_EXP(err_u) <= MPFR_EXP(Q))
                stop ++;
              else
                stop = 0;
            }
          else
            {
              /* if k = 0 mod 4, add, otherwise subtract */
              if ((k & 2) == 0)
                mpfr_add (P, P, t, MPFR_RNDN);
              else
                mpfr_sub (P, P, t, MPFR_RNDN);
              /* check if the next term is smaller than ulp(P) */
              if (MPFR_EXP(err_u) <= MPFR_EXP(P))
                stop ++;
              else
                stop = 0;
            }
          mpfr_add (err_s, err_s, err_t, MPFR_RNDU);
          /* the sum of the rounding errors on P and Q is bounded by
             err_s * 2^(-w) */

          /* stop when start to diverge */
          if (stop < 2 &&
              ((MPFR_IS_POS(z) && mpfr_cmp_ui (z, (k + 1) / 2) < 0) ||
               (MPFR_IS_NEG(z) && mpfr_cmp_si (z, - ((k + 1) / 2)) > 0)))
            {
              /* if we have to stop the series because it diverges, then
                 increasing the precision will most probably fail, since
                 we will stop to the same point, and thus compute a very
                 similar approximation */
              diverge = 1;
              stop = 2; /* force stop */
            }
        }
      /* the sum of the total errors on P and Q is bounded by err_s * 2^(-w) */

      /* Now combine: the sum of the rounding errors on P and Q is bounded by
         err_s * 2^(-w), and the absolute error on s/c is bounded by 2^(1-w) */
      if ((n & 1) == 0) /* n even: P * (sin + cos) + Q (cos - sin) for jn
                                   Q * (sin + cos) + P (sin - cos) for yn */
        {
#ifdef MPFR_JN
          mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */
          mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */
#else
          mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */
          mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */
#endif
          err = MPFR_EXP(c);
          if (MPFR_EXP(s) > err)
            err = MPFR_EXP(s);
#ifdef MPFR_JN
          mpfr_sub (s, s, c, MPFR_RNDN);
#else
          mpfr_add (s, s, c, MPFR_RNDN);
#endif
        }
      else /* n odd: P * (sin - cos) + Q (cos + sin) for jn,
                     Q * (sin - cos) - P (cos + sin) for yn */
        {
#ifdef MPFR_JN
          mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */
          mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */
#else
          mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */
          mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */
#endif
          err = MPFR_EXP(c);
          if (MPFR_EXP(s) > err)
            err = MPFR_EXP(s);
#ifdef MPFR_JN
          mpfr_add (s, s, c, MPFR_RNDN);
#else
          mpfr_sub (s, c, s, MPFR_RNDN);
#endif
        }
      if ((n & 2) != 0)
        mpfr_neg (s, s, MPFR_RNDN);
      if (MPFR_EXP(s) > err)
        err = MPFR_EXP(s);
      /* the absolute error on s is bounded by P*err(s/c) + Q*err(s/c)
         + err(P)*(s/c) + err(Q)*(s/c) + 3 * 2^(err - w - 1)
         <= (|P|+|Q|) * 2^(1-w) + err_s * 2^(1-w) + 2^err * 2^(1-w),
         since |c|, |old_s| <= 2. */
      err2 = (MPFR_EXP(P) >= MPFR_EXP(Q)) ? MPFR_EXP(P) + 2 : MPFR_EXP(Q) + 2;
      /* (|P| + |Q|) * 2^(1 - w) <= 2^(err2 - w) */
      err = MPFR_EXP(err_s) >= err ? MPFR_EXP(err_s) + 2 : err + 2;
      /* err_s * 2^(1-w) + 2^old_err * 2^(1-w) <= 2^err * 2^(-w) */
      err2 = (err >= err2) ? err + 1 : err2 + 1;
      /* now the absolute error on s is bounded by 2^(err2 - w) */

      /* multiply by sqrt(1/(Pi*z)) */
      mpfr_const_pi (c, MPFR_RNDN);     /* Pi, err <= 1 */
      mpfr_mul (c, c, z, MPFR_RNDN);    /* err <= 2 */
      mpfr_si_div (c, MPFR_IS_POS(z) ? 1 : -1, c, MPFR_RNDN); /* err <= 3 */
      mpfr_sqrt (c, c, MPFR_RNDN);      /* err<=5/2, thus the absolute error is
                                          bounded by 3*u*|c| for |u| <= 0.25 */
      mpfr_mul (err_t, c, s, MPFR_SIGN(c)==MPFR_SIGN(s) ? MPFR_RNDU : MPFR_RNDD);
      mpfr_abs (err_t, err_t, MPFR_RNDU);
      mpfr_mul_ui (err_t, err_t, 3, MPFR_RNDU);
      /* 3*2^(-w)*|old_c|*|s| [see below] is bounded by err_t * 2^(-w) */
      err2 += MPFR_EXP(c);
      /* |old_c| * 2^(err2 - w) [see below] is bounded by 2^(err2-w) */
      mpfr_mul (c, c, s, MPFR_RNDN);    /* the absolute error on c is bounded by
                                          1/2 ulp(c) + 3*2^(-w)*|old_c|*|s|
                                          + |old_c| * 2^(err2 - w) */
      /* compute err_t * 2^(-w) + 1/2 ulp(c) = (err_t + 2^EXP(c)) * 2^(-w) */
      err = (MPFR_EXP(err_t) > MPFR_EXP(c)) ? MPFR_EXP(err_t) + 1 : MPFR_EXP(c) + 1;
      /* err_t * 2^(-w) + 1/2 ulp(c) <= 2^(err - w) */
      /* now err_t * 2^(-w) bounds 1/2 ulp(c) + 3*2^(-w)*|old_c|*|s| */
      err = (err >= err2) ? err + 1 : err2 + 1;
      /* the absolute error on c is bounded by 2^(err - w) */

      mpfr_clear (s);
      mpfr_clear (P);
      mpfr_clear (Q);
      mpfr_clear (t);
      mpfr_clear (iz);
      mpfr_clear (err_t);
      mpfr_clear (err_s);
      mpfr_clear (err_u);

      err -= MPFR_EXP(c);
      if (MPFR_LIKELY (MPFR_CAN_ROUND (c, w - err, MPFR_PREC(res), r)))
        break;
      if (diverge != 0)
        {
          mpfr_set (c, z, r); /* will force inex=0 below, which means the
                               asymptotic expansion failed */
          break;
        }
      MPFR_ZIV_NEXT (loop, w);
    }
  MPFR_ZIV_FREE (loop);

  inex = (MPFR_IS_POS(z) || ((n & 1) == 0)) ? mpfr_set (res, c, r)
    : mpfr_neg (res, c, r);
  mpfr_clear (c);

  return inex;
}
Esempio n. 3
0
int
mpfr_digamma (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
  int inex;
  MPFR_SAVE_EXPO_DECL (expo);

  MPFR_LOG_FUNC
    (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec(x), mpfr_log_prec, x, rnd_mode),
     ("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec(y), mpfr_log_prec, y, inex));


  if (MPFR_UNLIKELY(MPFR_IS_SINGULAR(x)))
    {
      if (MPFR_IS_NAN(x))
        {
          MPFR_SET_NAN(y);
          MPFR_RET_NAN;
        }
      else if (MPFR_IS_INF(x))
        {
          if (MPFR_IS_POS(x)) /* Digamma(+Inf) = +Inf */
            {
              MPFR_SET_SAME_SIGN(y, x);
              MPFR_SET_INF(y);
              MPFR_RET(0);
            }
          else                /* Digamma(-Inf) = NaN */
            {
              MPFR_SET_NAN(y);
              MPFR_RET_NAN;
            }
        }
      else /* Zero case */
        {
          /* the following works also in case of overlap */
          MPFR_SET_INF(y);
          MPFR_SET_OPPOSITE_SIGN(y, x);
          mpfr_set_divby0 ();
          MPFR_RET(0);
        }
    }

  /* Digamma is undefined for negative integers */
  if (MPFR_IS_NEG(x) && mpfr_integer_p (x))
    {
      MPFR_SET_NAN(y);
      MPFR_RET_NAN;
    }

  /* now x is a normal number */

  MPFR_SAVE_EXPO_MARK (expo);
  /* for x very small, we have Digamma(x) = -1/x - gamma + O(x), more precisely
     -1 < Digamma(x) + 1/x < 0 for -0.2 < x < 0.2, thus:
     (i) either x is a power of two, then 1/x is exactly representable, and
         as long as 1/2*ulp(1/x) > 1, we can conclude;
     (ii) otherwise assume x has <= n bits, and y has <= n+1 bits, then
   |y + 1/x| >= 2^(-2n) ufp(y), where ufp means unit in first place.
   Since |Digamma(x) + 1/x| <= 1, if 2^(-2n) ufp(y) >= 2, then
   |y - Digamma(x)| >= 2^(-2n-1)ufp(y), and rounding -1/x gives the correct result.
   If x < 2^E, then y > 2^(-E), thus ufp(y) > 2^(-E-1).
   A sufficient condition is thus EXP(x) <= -2 MAX(PREC(x),PREC(Y)). */
  if (MPFR_EXP(x) < -2)
    {
      if (MPFR_EXP(x) <= -2 * (mpfr_exp_t) MAX(MPFR_PREC(x), MPFR_PREC(y)))
        {
          int signx = MPFR_SIGN(x);
          inex = mpfr_si_div (y, -1, x, rnd_mode);
          if (inex == 0) /* x is a power of two */
            { /* result always -1/x, except when rounding down */
              if (rnd_mode == MPFR_RNDA)
                rnd_mode = (signx > 0) ? MPFR_RNDD : MPFR_RNDU;
              if (rnd_mode == MPFR_RNDZ)
                rnd_mode = (signx > 0) ? MPFR_RNDU : MPFR_RNDD;
              if (rnd_mode == MPFR_RNDU)
                inex = 1;
              else if (rnd_mode == MPFR_RNDD)
                {
                  mpfr_nextbelow (y);
                  inex = -1;
                }
              else /* nearest */
                inex = 1;
            }
          MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags);
          goto end;
        }
    }

  if (MPFR_IS_NEG(x))
    inex = mpfr_digamma_reflection (y, x, rnd_mode);
  /* if x < 1/2 we use the reflection formula */
  else if (MPFR_EXP(x) < 0)
    inex = mpfr_digamma_reflection (y, x, rnd_mode);
  else
    inex = mpfr_digamma_positive (y, x, rnd_mode);

 end:
  MPFR_SAVE_EXPO_FREE (expo);
  return mpfr_check_range (y, inex, rnd_mode);
}
Esempio n. 4
0
File: acos.c Progetto: MiKTeX/miktex
int
mpfr_acos (mpfr_ptr acos, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
  mpfr_t xp, arcc, tmp;
  mpfr_exp_t supplement;
  mpfr_prec_t prec;
  int sign, compared, inexact;
  MPFR_SAVE_EXPO_DECL (expo);
  MPFR_ZIV_DECL (loop);

  MPFR_LOG_FUNC
    (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec(x), mpfr_log_prec, x, rnd_mode),
     ("acos[%Pu]=%.*Rg inexact=%d",
      mpfr_get_prec(acos), mpfr_log_prec, acos, inexact));

  /* Singular cases */
  if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
    {
      if (MPFR_IS_NAN (x) || MPFR_IS_INF (x))
        {
          MPFR_SET_NAN (acos);
          MPFR_RET_NAN;
        }
      else /* necessarily x=0 */
        {
          MPFR_ASSERTD(MPFR_IS_ZERO(x));
          /* acos(0)=Pi/2 */
          MPFR_SAVE_EXPO_MARK (expo);
          inexact = mpfr_const_pi (acos, rnd_mode);
          mpfr_div_2ui (acos, acos, 1, rnd_mode); /* exact */
          MPFR_SAVE_EXPO_FREE (expo);
          return mpfr_check_range (acos, inexact, rnd_mode);
        }
    }

  /* Set x_p=|x| */
  sign = MPFR_SIGN (x);
  mpfr_init2 (xp, MPFR_PREC (x));
  mpfr_abs (xp, x, MPFR_RNDN); /* Exact */

  compared = mpfr_cmp_ui (xp, 1);

  if (MPFR_UNLIKELY (compared >= 0))
    {
      mpfr_clear (xp);
      if (compared > 0) /* acos(x) = NaN for x > 1 */
        {
          MPFR_SET_NAN(acos);
          MPFR_RET_NAN;
        }
      else
        {
          if (MPFR_IS_POS_SIGN (sign)) /* acos(+1) = +0 */
            return mpfr_set_ui (acos, 0, rnd_mode);
          else /* acos(-1) = Pi */
            return mpfr_const_pi (acos, rnd_mode);
        }
    }

  MPFR_SAVE_EXPO_MARK (expo);

  /* Compute the supplement */
  mpfr_ui_sub (xp, 1, xp, MPFR_RNDD);
  if (MPFR_IS_POS_SIGN (sign))
    supplement = 2 - 2 * MPFR_GET_EXP (xp);
  else
    supplement = 2 - MPFR_GET_EXP (xp);
  mpfr_clear (xp);

  prec = MPFR_PREC (acos);
  prec += MPFR_INT_CEIL_LOG2(prec) + 10 + supplement;

  /* VL: The following change concerning prec comes from r3145
     "Optimize mpfr_acos by choosing a better initial precision."
     but it doesn't seem to be correct and leads to problems (assertion
     failure or very important inefficiency) with tiny arguments.
     Therefore, I've disabled it. */
  /* If x ~ 2^-N, acos(x) ~ PI/2 - x - x^3/6
     If Prec < 2*N, we can't round since x^3/6 won't be counted. */
#if 0
  if (MPFR_PREC (acos) >= MPFR_PREC (x) && MPFR_GET_EXP (x) < 0)
    {
      mpfr_uexp_t pmin = (mpfr_uexp_t) (-2 * MPFR_GET_EXP (x)) + 5;
      MPFR_ASSERTN (pmin <= MPFR_PREC_MAX);
      if (prec < pmin)
        prec = pmin;
    }
#endif

  mpfr_init2 (tmp, prec);
  mpfr_init2 (arcc, prec);

  MPFR_ZIV_INIT (loop, prec);
  for (;;)
    {
      /* acos(x) = Pi/2 - asin(x) = Pi/2 - atan(x/sqrt(1-x^2)) */
      mpfr_sqr (tmp, x, MPFR_RNDN);
      mpfr_ui_sub (tmp, 1, tmp, MPFR_RNDN);
      mpfr_sqrt (tmp, tmp, MPFR_RNDN);
      mpfr_div (tmp, x, tmp, MPFR_RNDN);
      mpfr_atan (arcc, tmp, MPFR_RNDN);
      mpfr_const_pi (tmp, MPFR_RNDN);
      mpfr_div_2ui (tmp, tmp, 1, MPFR_RNDN);
      mpfr_sub (arcc, tmp, arcc, MPFR_RNDN);

      if (MPFR_LIKELY (MPFR_CAN_ROUND (arcc, prec - supplement,
                                       MPFR_PREC (acos), rnd_mode)))
        break;
      MPFR_ZIV_NEXT (loop, prec);
      mpfr_set_prec (tmp, prec);
      mpfr_set_prec (arcc, prec);
    }
  MPFR_ZIV_FREE (loop);

  inexact = mpfr_set (acos, arcc, rnd_mode);
  mpfr_clear (tmp);
  mpfr_clear (arcc);

  MPFR_SAVE_EXPO_FREE (expo);
  return mpfr_check_range (acos, inexact, rnd_mode);
}
Esempio n. 5
0
static void
overfl_exp10_0 (void)
{
  mpfr_t x, y;
  int emax, i, inex, rnd, err = 0;
  mpfr_exp_t old_emax;

  old_emax = mpfr_get_emax ();

  mpfr_init2 (x, 8);
  mpfr_init2 (y, 8);

  for (emax = -1; emax <= 0; emax++)
    {
      mpfr_set_ui_2exp (y, 1, emax, MPFR_RNDN);
      mpfr_nextbelow (y);
      set_emax (emax);  /* 1 is not representable. */
      /* and if emax < 0, 1 - eps is not representable either. */
      for (i = -1; i <= 1; i++)
        RND_LOOP (rnd)
          {
            mpfr_set_si_2exp (x, i, -512 * ABS (i), MPFR_RNDN);
            mpfr_clear_flags ();
            inex = mpfr_exp10 (x, x, (mpfr_rnd_t) rnd);
            if ((i >= 0 || emax < 0 || rnd == MPFR_RNDN || rnd == MPFR_RNDU) &&
                ! mpfr_overflow_p ())
              {
                printf ("Error in overfl_exp10_0 (i = %d, rnd = %s):\n"
                        "  The overflow flag is not set.\n",
                        i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
                err = 1;
              }
            if (rnd == MPFR_RNDZ || rnd == MPFR_RNDD)
              {
                if (inex >= 0)
                  {
                    printf ("Error in overfl_exp10_0 (i = %d, rnd = %s):\n"
                            "  The inexact value must be negative.\n",
                            i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
                    err = 1;
                  }
                if (! mpfr_equal_p (x, y))
                  {
                    printf ("Error in overfl_exp10_0 (i = %d, rnd = %s):\n"
                            "  Got ", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
                    mpfr_print_binary (x);
                    printf (" instead of 0.11111111E%d.\n", emax);
                    err = 1;
                  }
              }
            else
              {
                if (inex <= 0)
                  {
                    printf ("Error in overfl_exp10_0 (i = %d, rnd = %s):\n"
                            "  The inexact value must be positive.\n",
                            i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
                    err = 1;
                  }
                if (! (mpfr_inf_p (x) && MPFR_SIGN (x) > 0))
                  {
                    printf ("Error in overfl_exp10_0 (i = %d, rnd = %s):\n"
                            "  Got ", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
                    mpfr_print_binary (x);
                    printf (" instead of +Inf.\n");
                    err = 1;
                  }
              }
          }
      set_emax (old_emax);
    }

  if (err)
    exit (1);
  mpfr_clear (x);
  mpfr_clear (y);
}
Esempio n. 6
0
File: mul.c Progetto: gnooth/xcl
static int
mpfr_mul3 (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t rnd_mode)
{
    /* Old implementation */
    int sign_product, cc, inexact;
    mpfr_exp_t ax;
    mp_limb_t *tmp;
    mp_limb_t b1;
    mpfr_prec_t bq, cq;
    mp_size_t bn, cn, tn, k;
    MPFR_TMP_DECL(marker);

    /* deal with special cases */
    if (MPFR_ARE_SINGULAR(b,c))
    {
        if (MPFR_IS_NAN(b) || MPFR_IS_NAN(c))
        {
            MPFR_SET_NAN(a);
            MPFR_RET_NAN;
        }
        sign_product = MPFR_MULT_SIGN( MPFR_SIGN(b) , MPFR_SIGN(c) );
        if (MPFR_IS_INF(b))
        {
            if (MPFR_IS_INF(c) || MPFR_NOTZERO(c))
            {
                MPFR_SET_SIGN(a,sign_product);
                MPFR_SET_INF(a);
                MPFR_RET(0); /* exact */
            }
            else
            {
                MPFR_SET_NAN(a);
                MPFR_RET_NAN;
            }
        }
        else if (MPFR_IS_INF(c))
        {
            if (MPFR_NOTZERO(b))
            {
                MPFR_SET_SIGN(a, sign_product);
                MPFR_SET_INF(a);
                MPFR_RET(0); /* exact */
            }
            else
            {
                MPFR_SET_NAN(a);
                MPFR_RET_NAN;
            }
        }
        else
        {
            MPFR_ASSERTD(MPFR_IS_ZERO(b) || MPFR_IS_ZERO(c));
            MPFR_SET_SIGN(a, sign_product);
            MPFR_SET_ZERO(a);
            MPFR_RET(0); /* 0 * 0 is exact */
        }
    }
    sign_product = MPFR_MULT_SIGN( MPFR_SIGN(b) , MPFR_SIGN(c) );

    ax = MPFR_GET_EXP (b) + MPFR_GET_EXP (c);

    bq = MPFR_PREC(b);
    cq = MPFR_PREC(c);

    MPFR_ASSERTD(bq+cq > bq); /* PREC_MAX is /2 so no integer overflow */

    bn = (bq+GMP_NUMB_BITS-1)/GMP_NUMB_BITS; /* number of limbs of b */
    cn = (cq+GMP_NUMB_BITS-1)/GMP_NUMB_BITS; /* number of limbs of c */
    k = bn + cn; /* effective nb of limbs used by b*c (= tn or tn+1) below */
    tn = (bq + cq + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS;
    /* <= k, thus no int overflow */
    MPFR_ASSERTD(tn <= k);

    /* Check for no size_t overflow*/
    MPFR_ASSERTD((size_t) k <= ((size_t) -1) / BYTES_PER_MP_LIMB);
    MPFR_TMP_MARK(marker);
    tmp = (mp_limb_t *) MPFR_TMP_ALLOC((size_t) k * BYTES_PER_MP_LIMB);

    /* multiplies two mantissa in temporary allocated space */
    b1 = (MPFR_LIKELY(bn >= cn)) ?
         mpn_mul (tmp, MPFR_MANT(b), bn, MPFR_MANT(c), cn)
         : mpn_mul (tmp, MPFR_MANT(c), cn, MPFR_MANT(b), bn);

    /* now tmp[0]..tmp[k-1] contains the product of both mantissa,
       with tmp[k-1]>=2^(GMP_NUMB_BITS-2) */
    b1 >>= GMP_NUMB_BITS - 1; /* msb from the product */

    /* if the mantissas of b and c are uniformly distributed in ]1/2, 1],
       then their product is in ]1/4, 1/2] with probability 2*ln(2)-1 ~ 0.386
       and in [1/2, 1] with probability 2-2*ln(2) ~ 0.614 */
    tmp += k - tn;
    if (MPFR_UNLIKELY(b1 == 0))
        mpn_lshift (tmp, tmp, tn, 1); /* tn <= k, so no stack corruption */
    cc = mpfr_round_raw (MPFR_MANT (a), tmp, bq + cq,
                         MPFR_IS_NEG_SIGN(sign_product),
                         MPFR_PREC (a), rnd_mode, &inexact);

    /* cc = 1 ==> result is a power of two */
    if (MPFR_UNLIKELY(cc))
        MPFR_MANT(a)[MPFR_LIMB_SIZE(a)-1] = MPFR_LIMB_HIGHBIT;

    MPFR_TMP_FREE(marker);

    {
        mpfr_exp_t ax2 = ax + (mpfr_exp_t) (b1 - 1 + cc);
        if (MPFR_UNLIKELY( ax2 > __gmpfr_emax))
            return mpfr_overflow (a, rnd_mode, sign_product);
        if (MPFR_UNLIKELY( ax2 < __gmpfr_emin))
        {
            /* In the rounding to the nearest mode, if the exponent of the exact
               result (i.e. before rounding, i.e. without taking cc into account)
               is < __gmpfr_emin - 1 or the exact result is a power of 2 (i.e. if
               both arguments are powers of 2), then round to zero. */
            if (rnd_mode == MPFR_RNDN &&
                    (ax + (mpfr_exp_t) b1 < __gmpfr_emin ||
                     (mpfr_powerof2_raw (b) && mpfr_powerof2_raw (c))))
                rnd_mode = MPFR_RNDZ;
            return mpfr_underflow (a, rnd_mode, sign_product);
        }
        MPFR_SET_EXP (a, ax2);
        MPFR_SET_SIGN(a, sign_product);
    }
    MPFR_RET (inexact);
}
Esempio n. 7
0
static void
test_overflow2 (void)
{
  mpfr_t x, y, z, r;
  int i, inex, rnd, err = 0;

  mpfr_inits2 (8, x, y, z, r, (mpfr_ptr) 0);

  MPFR_SET_POS (x);
  mpfr_setmin (x, mpfr_get_emax ());  /* x = 0.1@emax */
  mpfr_set_si (y, -2, MPFR_RNDN);      /* y = -2 */
  /* The intermediate multiplication x * y will overflow. */

  for (i = -9; i <= 9; i++)
    RND_LOOP (rnd)
      {
        int inf, overflow;

        inf = rnd == MPFR_RNDN || rnd == MPFR_RNDD || rnd == MPFR_RNDA;
        overflow = inf || i <= 0;

        inex = mpfr_set_si_2exp (z, i, mpfr_get_emin (), MPFR_RNDN);
        MPFR_ASSERTN (inex == 0);

        mpfr_clear_flags ();
        /* One has: x * y = -1@emax exactly (but not representable). */
        inex = mpfr_fma (r, x, y, z, (mpfr_rnd_t) rnd);
        if (overflow ^ (mpfr_overflow_p () != 0))
          {
            printf ("Error in test_overflow2 (i = %d, %s): wrong overflow"
                    " flag (should be %d)\n", i,
                    mpfr_print_rnd_mode ((mpfr_rnd_t) rnd), overflow);
            err = 1;
          }
        if (mpfr_nanflag_p ())
          {
            printf ("Error in test_overflow2 (i = %d, %s): NaN flag should"
                    " not be set\n", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
            err = 1;
          }
        if (mpfr_nan_p (r))
          {
            printf ("Error in test_overflow2 (i = %d, %s): got NaN\n",
                    i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
            err = 1;
          }
        else if (MPFR_SIGN (r) >= 0)
          {
            printf ("Error in test_overflow2 (i = %d, %s): wrong sign "
                    "(+ instead of -)\n", i,
                    mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
            err = 1;
          }
        else if (inf && ! mpfr_inf_p (r))
          {
            printf ("Error in test_overflow2 (i = %d, %s): expected -Inf,"
                    " got\n", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
            mpfr_dump (r);
            err = 1;
          }
        else if (!inf && (mpfr_inf_p (r) ||
                          (mpfr_nextbelow (r), ! mpfr_inf_p (r))))
          {
            printf ("Error in test_overflow2 (i = %d, %s): expected -MAX,"
                    " got\n", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
            mpfr_dump (r);
            err = 1;
          }
        if (inf ? inex >= 0 : inex <= 0)
          {
            printf ("Error in test_overflow2 (i = %d, %s): wrong inexact"
                    " flag (got %d)\n", i,
                    mpfr_print_rnd_mode ((mpfr_rnd_t) rnd), inex);
            err = 1;
          }

      }

  if (err)
    exit (1);
  mpfr_clears (x, y, z, r, (mpfr_ptr) 0);
}
Esempio n. 8
0
int
main (void)
{
  mpfr_t x, y;
  float f, g, infp;
  int i;

  infp = (float) DBL_POS_INF;
  if (infp * 0.5 != infp)
    {
      fprintf (stderr, "Error, FLT_MAX + FLT_MAX does not yield INFP\n");
      fprintf (stderr, "(this is probably a compiler bug, please report)\n");
      exit (1);
    }

  tests_start_mpfr ();

  mpfr_init2 (x, 24);
  mpfr_init2 (y, 24);

#if !defined(MPFR_ERRDIVZERO)
  mpfr_set_nan (x);
  f = mpfr_get_flt (x, MPFR_RNDN);
  if (f == f)
    {
      printf ("Error for mpfr_get_flt(NaN)\n");
      exit (1);
    }
  mpfr_set_flt (x, f, MPFR_RNDN);
  if (mpfr_nan_p (x) == 0)
    {
      printf ("Error for mpfr_set_flt(NaN)\n");
      exit (1);
    }

  mpfr_set_inf (x, 1);
  f = mpfr_get_flt (x, MPFR_RNDN);
  mpfr_set_flt (x, f, MPFR_RNDN);
  if (mpfr_inf_p (x) == 0 || mpfr_sgn (x) < 0)
    {
      printf ("Error for mpfr_set_flt(mpfr_get_flt(+Inf)):\n");
      printf ("f=%f, expected -Inf\n", f);
      printf ("got "); mpfr_dump (x);
      exit (1);
    }

  mpfr_set_inf (x, -1);
  f = mpfr_get_flt (x, MPFR_RNDN);
  mpfr_set_flt (x, f, MPFR_RNDN);
  if (mpfr_inf_p (x) == 0 || mpfr_sgn (x) > 0)
    {
      printf ("Error for mpfr_set_flt(mpfr_get_flt(-Inf)):\n");
      printf ("f=%f, expected -Inf\n", f);
      printf ("got "); mpfr_dump (x);
      exit (1);
    }
#endif

  mpfr_set_ui (x, 0, MPFR_RNDN);
  f = mpfr_get_flt (x, MPFR_RNDN);
  mpfr_set_flt (x, f, MPFR_RNDN);
  if (mpfr_zero_p (x) == 0 || MPFR_SIGN (x) < 0)
    {
      printf ("Error for mpfr_set_flt(mpfr_get_flt(+0))\n");
      exit (1);
    }

  mpfr_set_ui (x, 0, MPFR_RNDN);
  mpfr_neg (x, x, MPFR_RNDN);
  f = mpfr_get_flt (x, MPFR_RNDN);
  mpfr_set_flt (x, f, MPFR_RNDN);
  if (mpfr_zero_p (x) == 0 || MPFR_SIGN (x) > 0)
    {
      printf ("Error for mpfr_set_flt(mpfr_get_flt(-0))\n");
      exit (1);
    }

  mpfr_set_ui (x, 17, MPFR_RNDN);
  f = mpfr_get_flt (x, MPFR_RNDN);
  mpfr_set_flt (x, f, MPFR_RNDN);
  if (mpfr_cmp_ui (x, 17) != 0)
    {
      printf ("Error for mpfr_set_flt(mpfr_get_flt(17))\n");
      printf ("expected 17\n");
      printf ("got      ");
      mpfr_dump (x);
      exit (1);
    }

  mpfr_set_si (x, -42, MPFR_RNDN);
  f = mpfr_get_flt (x, MPFR_RNDN);
  mpfr_set_flt (x, f, MPFR_RNDN);
  if (mpfr_cmp_si (x, -42) != 0)
    {
      printf ("Error for mpfr_set_flt(mpfr_get_flt(-42))\n");
      printf ("expected -42\n");
      printf ("got      ");
      mpfr_dump (x);
      exit (1);
    }

  mpfr_set_si_2exp (x, 1, -126, MPFR_RNDN);
  for (i = -126; i < 128; i++)
    {
      f = mpfr_get_flt (x, MPFR_RNDN);
      mpfr_set_flt (y, f, MPFR_RNDN);
      if (mpfr_cmp (x, y) != 0)
        {
          printf ("Error for mpfr_set_flt(mpfr_get_flt(x))\n");
          printf ("expected "); mpfr_dump (x);
          printf ("got      "); mpfr_dump (y);
          exit (1);
        }
      mpfr_mul_2exp (x, x, 1, MPFR_RNDN);
    }

  mpfr_set_prec (x, 53);
  mpfr_set_si_2exp (x, 1, -126, MPFR_RNDN);
  for (i = -126; i < 128; i++)
    {
      mpfr_nextbelow (x);
      f = mpfr_get_flt (x, MPFR_RNDN);
      mpfr_nextabove (x);
      mpfr_set_flt (y, f, MPFR_RNDN);
      if (mpfr_cmp (x, y) != 0)
        {
          printf ("Error for mpfr_set_flt(mpfr_get_flt(x))\n");
          printf ("expected "); mpfr_dump (x);
          printf ("got      "); mpfr_dump (y);
          exit (1);
        }
      mpfr_mul_2exp (x, x, 1, MPFR_RNDN);
    }

  mpfr_set_prec (x, 53);
  mpfr_set_si_2exp (x, 1, -126, MPFR_RNDN);
  for (i = -126; i < 128; i++)
    {
      mpfr_nextabove (x);
      f = mpfr_get_flt (x, MPFR_RNDN);
      mpfr_nextbelow (x);
      mpfr_set_flt (y, f, MPFR_RNDN);
      if (mpfr_cmp (x, y) != 0)
        {
          printf ("Error for mpfr_set_flt(mpfr_get_flt(x))\n");
          printf ("expected "); mpfr_dump (x);
          printf ("got      "); mpfr_dump (y);
          exit (1);
        }
      mpfr_mul_2exp (x, x, 1, MPFR_RNDN);
    }

  mpfr_set_si_2exp (x, 1, -150, MPFR_RNDN);
  g = 0.0;
  f = mpfr_get_flt (x, MPFR_RNDN);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-150),RNDN)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDZ);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-150),RNDZ)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDD);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-150),RNDD)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  g = FLT_MIN * FLT_EPSILON;
  f = mpfr_get_flt (x, MPFR_RNDU);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-150),RNDU)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDA);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-150),RNDA)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }

  mpfr_set_si_2exp (x, 1, -151, MPFR_RNDN);
  g = 0.0;
  f = mpfr_get_flt (x, MPFR_RNDN);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-151),RNDN)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDZ);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-151),RNDZ)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDD);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-151),RNDD)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  g = FLT_MIN * FLT_EPSILON;
  f = mpfr_get_flt (x, MPFR_RNDU);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-151),RNDU)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDA);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-151),RNDA)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }

  mpfr_set_si_2exp (x, 1, -149, MPFR_RNDN);
  g = FLT_MIN * FLT_EPSILON;
  f = mpfr_get_flt (x, MPFR_RNDN);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-149),RNDN)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDZ);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-149),RNDZ)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDD);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-149),RNDD)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDU);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-149),RNDU)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDA);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^(-149),RNDA)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }

  mpfr_set_si_2exp (x, 1, 128, MPFR_RNDN);
  g = FLT_MAX;
  f = mpfr_get_flt (x, MPFR_RNDZ);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^128,RNDZ)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDD);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^128,RNDD)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
#if !defined(MPFR_ERRDIVZERO)
  f = mpfr_get_flt (x, MPFR_RNDN); /* 2^128 rounds to itself with extended
                                      exponent range, we should get +Inf */
  g = infp;
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^128,RNDN)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDU);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^128,RNDU)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDA);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^128,RNDA)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
#endif

  /* corner case: take x with 25 bits just below 2^128 */
  mpfr_set_prec (x, 25);
  mpfr_set_si_2exp (x, 1, 128, MPFR_RNDN);
  mpfr_nextbelow (x);
  g = FLT_MAX;
  f = mpfr_get_flt (x, MPFR_RNDZ);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^128*(1-2^(-25)),RNDZ)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDD);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^128*(1-2^(-25)),RNDD)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDN); /* first round to 2^128 (even rule),
                                      thus we should get +Inf */
  g = infp;
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^128*(1-2^(-25)),RNDN)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDU);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^128*(1-2^(-25)),RNDU)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }
  f = mpfr_get_flt (x, MPFR_RNDA);
  if (f != g)
    {
      printf ("Error for mpfr_get_flt(2^128*(1-2^(-25)),RNDA)\n");
      printf ("expected %.8e, got %.8e\n", g, f);
      exit (1);
    }

  mpfr_clear (x);
  mpfr_clear (y);

  tests_end_mpfr ();
  return 0;
}
Esempio n. 9
0
File: pow_si.c Progetto: Kirija/XPIR
int
mpfr_pow_si (mpfr_ptr y, mpfr_srcptr x, long int n, mpfr_rnd_t rnd)
{
  MPFR_LOG_FUNC
    (("x[%Pu]=%.*Rg n=%ld rnd=%d",
      mpfr_get_prec (x), mpfr_log_prec, x, n, rnd),
     ("y[%Pu]=%.*Rg", mpfr_get_prec (y), mpfr_log_prec, y));

  if (n >= 0)
    return mpfr_pow_ui (y, x, n, rnd);
  else
    {
      if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
        {
          if (MPFR_IS_NAN (x))
            {
              MPFR_SET_NAN (y);
              MPFR_RET_NAN;
            }
          else
            {
              int positive = MPFR_IS_POS (x) || ((unsigned long) n & 1) == 0;
              if (MPFR_IS_INF (x))
                MPFR_SET_ZERO (y);
              else /* x is zero */
                {
                  MPFR_ASSERTD (MPFR_IS_ZERO (x));
                  MPFR_SET_INF (y);
                  mpfr_set_divby0 ();
                }
              if (positive)
                MPFR_SET_POS (y);
              else
                MPFR_SET_NEG (y);
              MPFR_RET (0);
            }
        }

      /* detect exact powers: x^(-n) is exact iff x is a power of 2 */
      if (mpfr_cmp_si_2exp (x, MPFR_SIGN(x), MPFR_EXP(x) - 1) == 0)
        {
          mpfr_exp_t expx = MPFR_EXP (x) - 1, expy;
          MPFR_ASSERTD (n < 0);
          /* Warning: n * expx may overflow!
           *
           * Some systems (apparently alpha-freebsd) abort with
           * LONG_MIN / 1, and LONG_MIN / -1 is undefined.
           * http://www.freebsd.org/cgi/query-pr.cgi?pr=72024
           *
           * Proof of the overflow checking. The expressions below are
           * assumed to be on the rational numbers, but the word "overflow"
           * still has its own meaning in the C context. / still denotes
           * the integer (truncated) division, and // denotes the exact
           * division.
           * - First, (__gmpfr_emin - 1) / n and (__gmpfr_emax - 1) / n
           *   cannot overflow due to the constraints on the exponents of
           *   MPFR numbers.
           * - If n = -1, then n * expx = - expx, which is representable
           *   because of the constraints on the exponents of MPFR numbers.
           * - If expx = 0, then n * expx = 0, which is representable.
           * - If n < -1 and expx > 0:
           *   + If expx > (__gmpfr_emin - 1) / n, then
           *           expx >= (__gmpfr_emin - 1) / n + 1
           *                > (__gmpfr_emin - 1) // n,
           *     and
           *           n * expx < __gmpfr_emin - 1,
           *     i.e.
           *           n * expx <= __gmpfr_emin - 2.
           *     This corresponds to an underflow, with a null result in
           *     the rounding-to-nearest mode.
           *   + If expx <= (__gmpfr_emin - 1) / n, then n * expx cannot
           *     overflow since 0 < expx <= (__gmpfr_emin - 1) / n and
           *           0 > n * expx >= n * ((__gmpfr_emin - 1) / n)
           *                        >= __gmpfr_emin - 1.
           * - If n < -1 and expx < 0:
           *   + If expx < (__gmpfr_emax - 1) / n, then
           *           expx <= (__gmpfr_emax - 1) / n - 1
           *                < (__gmpfr_emax - 1) // n,
           *     and
           *           n * expx > __gmpfr_emax - 1,
           *     i.e.
           *           n * expx >= __gmpfr_emax.
           *     This corresponds to an overflow (2^(n * expx) has an
           *     exponent > __gmpfr_emax).
           *   + If expx >= (__gmpfr_emax - 1) / n, then n * expx cannot
           *     overflow since 0 > expx >= (__gmpfr_emax - 1) / n and
           *           0 < n * expx <= n * ((__gmpfr_emax - 1) / n)
           *                        <= __gmpfr_emax - 1.
           * Note: one could use expx bounds based on MPFR_EXP_MIN and
           * MPFR_EXP_MAX instead of __gmpfr_emin and __gmpfr_emax. The
           * current bounds do not lead to noticeably slower code and
           * allow us to avoid a bug in Sun's compiler for Solaris/x86
           * (when optimizations are enabled); known affected versions:
           *   cc: Sun C 5.8 2005/10/13
           *   cc: Sun C 5.8 Patch 121016-02 2006/03/31
           *   cc: Sun C 5.8 Patch 121016-04 2006/10/18
           */
          expy =
            n != -1 && expx > 0 && expx > (__gmpfr_emin - 1) / n ?
            MPFR_EMIN_MIN - 2 /* Underflow */ :
            n != -1 && expx < 0 && expx < (__gmpfr_emax - 1) / n ?
            MPFR_EMAX_MAX /* Overflow */ : n * expx;
          return mpfr_set_si_2exp (y, n % 2 ? MPFR_INT_SIGN (x) : 1,
                                   expy, rnd);
        }

      /* General case */
      {
        /* Declaration of the intermediary variable */
        mpfr_t t;
        /* Declaration of the size variable */
        mpfr_prec_t Ny;                              /* target precision */
        mpfr_prec_t Nt;                              /* working precision */
        mpfr_rnd_t rnd1;
        int size_n;
        int inexact;
        unsigned long abs_n;
        MPFR_SAVE_EXPO_DECL (expo);
        MPFR_ZIV_DECL (loop);

        abs_n = - (unsigned long) n;
        count_leading_zeros (size_n, (mp_limb_t) abs_n);
        size_n = GMP_NUMB_BITS - size_n;

        /* initial working precision */
        Ny = MPFR_PREC (y);
        Nt = Ny + size_n + 3 + MPFR_INT_CEIL_LOG2 (Ny);

        MPFR_SAVE_EXPO_MARK (expo);

        /* initialise of intermediary   variable */
        mpfr_init2 (t, Nt);

        /* We will compute rnd(rnd1(1/x) ^ |n|), where rnd1 is the rounding
           toward sign(x), to avoid spurious overflow or underflow, as in
           mpfr_pow_z. */
        rnd1 = MPFR_EXP (x) < 1 ? MPFR_RNDZ :
          (MPFR_SIGN (x) > 0 ? MPFR_RNDU : MPFR_RNDD);

        MPFR_ZIV_INIT (loop, Nt);
        for (;;)
          {
            MPFR_BLOCK_DECL (flags);

            /* compute (1/x)^|n| */
            MPFR_BLOCK (flags, mpfr_ui_div (t, 1, x, rnd1));
            MPFR_ASSERTD (! MPFR_UNDERFLOW (flags));
            /* t = (1/x)*(1+theta) where |theta| <= 2^(-Nt) */
            if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags)))
              goto overflow;
            MPFR_BLOCK (flags, mpfr_pow_ui (t, t, abs_n, rnd));
            /* t = (1/x)^|n|*(1+theta')^(|n|+1) where |theta'| <= 2^(-Nt).
               If (|n|+1)*2^(-Nt) <= 1/2, which is satisfied as soon as
               Nt >= bits(n)+2, then we can use Lemma \ref{lemma_graillat}
               from algorithms.tex, which yields x^n*(1+theta) with
               |theta| <= 2(|n|+1)*2^(-Nt), thus the error is bounded by
               2(|n|+1) ulps <= 2^(bits(n)+2) ulps. */
            if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags)))
              {
              overflow:
                MPFR_ZIV_FREE (loop);
                mpfr_clear (t);
                MPFR_SAVE_EXPO_FREE (expo);
                MPFR_LOG_MSG (("overflow\n", 0));
                return mpfr_overflow (y, rnd, abs_n & 1 ?
                                      MPFR_SIGN (x) : MPFR_SIGN_POS);
              }
            if (MPFR_UNLIKELY (MPFR_UNDERFLOW (flags)))
              {
                MPFR_ZIV_FREE (loop);
                mpfr_clear (t);
                MPFR_LOG_MSG (("underflow\n", 0));
                if (rnd == MPFR_RNDN)
                  {
                    mpfr_t y2, nn;

                    /* We cannot decide now whether the result should be
                       rounded toward zero or away from zero. So, like
                       in mpfr_pow_pos_z, let's use the general case of
                       mpfr_pow in precision 2. */
                    MPFR_ASSERTD (mpfr_cmp_si_2exp (x, MPFR_SIGN (x),
                                                    MPFR_EXP (x) - 1) != 0);
                    mpfr_init2 (y2, 2);
                    mpfr_init2 (nn, sizeof (long) * CHAR_BIT);
                    inexact = mpfr_set_si (nn, n, MPFR_RNDN);
                    MPFR_ASSERTN (inexact == 0);
                    inexact = mpfr_pow_general (y2, x, nn, rnd, 1,
                                                (mpfr_save_expo_t *) NULL);
                    mpfr_clear (nn);
                    mpfr_set (y, y2, MPFR_RNDN);
                    mpfr_clear (y2);
                    MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_UNDERFLOW);
                    goto end;
                  }
                else
                  {
                    MPFR_SAVE_EXPO_FREE (expo);
                    return mpfr_underflow (y, rnd, abs_n & 1 ?
                                           MPFR_SIGN (x) : MPFR_SIGN_POS);
                  }
              }
            /* error estimate -- see pow function in algorithms.ps */
            if (MPFR_LIKELY (MPFR_CAN_ROUND (t, Nt - size_n - 2, Ny, rnd)))
              break;

            /* actualisation of the precision */
            MPFR_ZIV_NEXT (loop, Nt);
            mpfr_set_prec (t, Nt);
          }
        MPFR_ZIV_FREE (loop);

        inexact = mpfr_set (y, t, rnd);
        mpfr_clear (t);

      end:
        MPFR_SAVE_EXPO_FREE (expo);
        return mpfr_check_range (y, inexact, rnd);
      }
    }
}
Esempio n. 10
0
int
mpfr_sin (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
  mpfr_t c, xr;
  mpfr_srcptr xx;
  mpfr_exp_t expx, err;
  mpfr_prec_t precy, m;
  int inexact, sign, reduce;
  MPFR_ZIV_DECL (loop);
  MPFR_SAVE_EXPO_DECL (expo);

  MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode),
                  ("y[%#R]=%R inexact=%d", y, y, inexact));

  if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
    {
      if (MPFR_IS_NAN (x) || MPFR_IS_INF (x))
        {
          MPFR_SET_NAN (y);
          MPFR_RET_NAN;

        }
      else /* x is zero */
        {
          MPFR_ASSERTD (MPFR_IS_ZERO (x));
          MPFR_SET_ZERO (y);
          MPFR_SET_SAME_SIGN (y, x);
          MPFR_RET (0);
        }
    }

  /* sin(x) = x - x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */
  MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, -2 * MPFR_GET_EXP (x), 2, 0,
                                    rnd_mode, {});

  MPFR_SAVE_EXPO_MARK (expo);

  /* Compute initial precision */
  precy = MPFR_PREC (y);

  if (precy >= MPFR_SINCOS_THRESHOLD)
    return mpfr_sin_fast (y, x, rnd_mode);

  m = precy + MPFR_INT_CEIL_LOG2 (precy) + 13;
  expx = MPFR_GET_EXP (x);

  mpfr_init (c);
  mpfr_init (xr);

  MPFR_ZIV_INIT (loop, m);
  for (;;)
    {
      /* first perform argument reduction modulo 2*Pi (if needed),
         also helps to determine the sign of sin(x) */
      if (expx >= 2) /* If Pi < x < 4, we need to reduce too, to determine
                        the sign of sin(x). For 2 <= |x| < Pi, we could avoid
                        the reduction. */
        {
          reduce = 1;
          /* As expx + m - 1 will silently be converted into mpfr_prec_t
             in the mpfr_set_prec call, the assert below may be useful to
             avoid undefined behavior. */
          MPFR_ASSERTN (expx + m - 1 <= MPFR_PREC_MAX);
          mpfr_set_prec (c, expx + m - 1);
          mpfr_set_prec (xr, m);
          mpfr_const_pi (c, MPFR_RNDN);
          mpfr_mul_2ui (c, c, 1, MPFR_RNDN);
          mpfr_remainder (xr, x, c, MPFR_RNDN);
          /* The analysis is similar to that of cos.c:
             |xr - x - 2kPi| <= 2^(2-m). Thus we can decide the sign
             of sin(x) if xr is at distance at least 2^(2-m) of both
             0 and +/-Pi. */
          mpfr_div_2ui (c, c, 1, MPFR_RNDN);
          /* Since c approximates Pi with an error <= 2^(2-expx-m) <= 2^(-m),
             it suffices to check that c - |xr| >= 2^(2-m). */
          if (MPFR_SIGN (xr) > 0)
            mpfr_sub (c, c, xr, MPFR_RNDZ);
          else
            mpfr_add (c, c, xr, MPFR_RNDZ);
          if (MPFR_IS_ZERO(xr)
              || MPFR_EXP(xr) < (mpfr_exp_t) 3 - (mpfr_exp_t) m
              || MPFR_EXP(c) < (mpfr_exp_t) 3 - (mpfr_exp_t) m)
            goto ziv_next;

          /* |xr - x - 2kPi| <= 2^(2-m), thus |sin(xr) - sin(x)| <= 2^(2-m) */
          xx = xr;
        }
      else /* the input argument is already reduced */
        {
          reduce = 0;
          xx = x;
        }

      sign = MPFR_SIGN(xx);
      /* now that the argument is reduced, precision m is enough */
      mpfr_set_prec (c, m);
      mpfr_cos (c, xx, MPFR_RNDZ);    /* can't be exact */
      mpfr_nexttoinf (c);           /* now c = cos(x) rounded away */
      mpfr_mul (c, c, c, MPFR_RNDU); /* away */
      mpfr_ui_sub (c, 1, c, MPFR_RNDZ);
      mpfr_sqrt (c, c, MPFR_RNDZ);
      if (MPFR_IS_NEG_SIGN(sign))
        MPFR_CHANGE_SIGN(c);

      /* Warning: c may be 0! */
      if (MPFR_UNLIKELY (MPFR_IS_ZERO (c)))
        {
          /* Huge cancellation: increase prec a lot! */
          m = MAX (m, MPFR_PREC (x));
          m = 2 * m;
        }
      else
        {
          /* the absolute error on c is at most 2^(3-m-EXP(c)),
             plus 2^(2-m) if there was an argument reduction.
             Since EXP(c) <= 1, 3-m-EXP(c) >= 2-m, thus the error
             is at most 2^(3-m-EXP(c)) in case of argument reduction. */
          err = 2 * MPFR_GET_EXP (c) + (mpfr_exp_t) m - 3 - (reduce != 0);
          if (MPFR_CAN_ROUND (c, err, precy, rnd_mode))
            break;

          /* check for huge cancellation (Near 0) */
          if (err < (mpfr_exp_t) MPFR_PREC (y))
            m += MPFR_PREC (y) - err;
          /* Check if near 1 */
          if (MPFR_GET_EXP (c) == 1)
            m += m;
        }

    ziv_next:
      /* Else generic increase */
      MPFR_ZIV_NEXT (loop, m);
    }
  MPFR_ZIV_FREE (loop);

  inexact = mpfr_set (y, c, rnd_mode);
  /* inexact cannot be 0, since this would mean that c was representable
     within the target precision, but in that case mpfr_can_round will fail */

  mpfr_clear (c);
  mpfr_clear (xr);

  MPFR_SAVE_EXPO_FREE (expo);
  return mpfr_check_range (y, inexact, rnd_mode);
}
Esempio n. 11
0
int
main (int argc, char *argv[])
{
  mpfr_t x, y;
  unsigned long k, bd, nc, i;
  char *str, *str2;
  mpfr_exp_t e;
  int base, logbase, prec, baseprec, ret, obase;

  tests_start_mpfr ();

  if (argc >= 2) /* tset_str <string> [<prec>] [<ibase>] [<obase>] */
    {
      prec = (argc >= 3) ? atoi (argv[2]) : 53;
      base = (argc >= 4) ? atoi (argv[3]) : 2;
      obase = (argc >= 5) ? atoi (argv[4]) : 10;
      mpfr_init2 (x, prec);
      mpfr_set_str (x, argv[1], base, MPFR_RNDN);
      mpfr_out_str (stdout, obase, 0, x, MPFR_RNDN);
      puts ("");
      mpfr_clear (x);
      return 0;
    }

  mpfr_init2 (x, 2);

  nc = (argc > 1) ? atoi(argv[1]) : 53;
  if (nc < 100)
    nc = 100;

  bd = randlimb () & 8;

  str2 = str = (char*) (*__gmp_allocate_func) (nc);

  if (bd)
    {
      for(k = 1; k <= bd; k++)
        *(str2++) = (randlimb () & 1) + '0';
    }
  else
    *(str2++) = '0';

  *(str2++) = '.';

  for (k = 1; k < nc - 17 - bd; k++)
    *(str2++) = '0' + (char) (randlimb () & 1);

  *(str2++) = 'e';
  sprintf (str2, "%d", (int) (randlimb () & INT_MAX) + INT_MIN/2);

  mpfr_set_prec (x, nc + 10);
  mpfr_set_str_binary (x, str);

  mpfr_set_prec (x, 54);
  mpfr_set_str_binary (x, "0.100100100110110101001010010101111000001011100100101010E-529");
  mpfr_init2 (y, 54);
  mpfr_set_str (y, "4.936a52bc17254@-133", 16, MPFR_RNDN);
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (1a):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  mpfr_set_str_binary (x, "0.111111101101110010111010100110000111011001010100001101E-529");
  mpfr_set_str (y, "0.fedcba98765434P-529", 16, MPFR_RNDN);
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (1b):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  (*__gmp_free_func) (str, nc);

  mpfr_set_prec (x, 53);
  mpfr_set_str_binary (x, "+110101100.01010000101101000000100111001000101011101110E00");

  mpfr_set_str_binary (x, "1.0");
  if (mpfr_cmp_ui (x, 1))
    {
      printf ("Error in mpfr_set_str_binary for s=1.0\n");
      mpfr_clear(x);
      mpfr_clear(y);
      exit(1);
    }

  mpfr_set_str_binary (x, "+0000");
  mpfr_set_str_binary (x, "+0000E0");
  mpfr_set_str_binary (x, "0000E0");
  if (mpfr_cmp_ui (x, 0))
    {
      printf ("Error in mpfr_set_str_binary for s=0.0\n");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  mpfr_set_str (x, "+243495834958.53452345E1", 10, MPFR_RNDN);
  mpfr_set_str (x, "9007199254740993", 10, MPFR_RNDN);
  mpfr_set_str (x, "9007199254740992", 10, MPFR_RNDU);
  mpfr_set_str (x, "9007199254740992", 10, MPFR_RNDD);
  mpfr_set_str (x, "9007199254740992", 10, MPFR_RNDZ);

  /* check a random number printed and read is not modified */
  prec = 53;
  mpfr_set_prec (x, prec);
  mpfr_set_prec (y, prec);
  for (i=0;i<N;i++)
    {
      mpfr_rnd_t rnd;

      mpfr_urandomb (x, RANDS);
      rnd = RND_RAND ();
      logbase = (randlimb () % 5) + 1;
      base = 1 << logbase;
      /* Warning: the number of bits needed to print exactly a number of
         'prec' bits in base 2^logbase may be greater than ceil(prec/logbase),
         for example 0.11E-1 in base 2 cannot be written exactly with only
         one digit in base 4 */
      if (base == 2)
        baseprec = prec;
      else
        baseprec = 1 + (prec - 2 + logbase) / logbase;
      str = mpfr_get_str (NULL, &e, base, baseprec, x, rnd);
      mpfr_set_str (y, str, base, rnd);
      MPFR_EXP(y) += logbase * (e - strlen (str));
      if (mpfr_cmp (x, y))
        {
          printf ("mpfr_set_str o mpfr_get_str <> id for rnd_mode=%s\n",
                  mpfr_print_rnd_mode (rnd));
          printf ("x=");
          mpfr_print_binary (x);
          puts ("");
          printf ("s=%s, exp=%d, base=%d\n", str, (int) e, base);
          printf ("y=");
          mpfr_print_binary (y);
          puts ("");
          mpfr_clear (x);
          mpfr_clear (y);
          exit (1);
        }
      (*__gmp_free_func) (str, strlen (str) + 1);
    }

  for (i = 2; i <= 62; i++)
    {
      if (mpfr_set_str (x, "@NaN@(garbage)", i, MPFR_RNDN) != 0 ||
          !mpfr_nan_p(x))
        {
          printf ("mpfr_set_str failed on @NaN@(garbage)\n");
          exit (1);
        }

      /*
      if (mpfr_set_str (x, "@Inf@garbage", i, MPFR_RNDN) != 0 ||
          !mpfr_inf_p(x) || MPFR_SIGN(x) < 0)
        {
          printf ("mpfr_set_str failed on @Inf@garbage\n");
          exit (1);
        }

      if (mpfr_set_str (x, "-@Inf@garbage", i, MPFR_RNDN) != 0 ||
          !mpfr_inf_p(x) || MPFR_SIGN(x) > 0)
        {
          printf ("mpfr_set_str failed on -@Inf@garbage\n");
          exit (1);
        }

      if (mpfr_set_str (x, "+@Inf@garbage", i, MPFR_RNDN) != 0 ||
          !mpfr_inf_p(x) || MPFR_SIGN(x) < 0)
        {
          printf ("mpfr_set_str failed on +@Inf@garbage\n");
          exit (1);
        }
      */

      if (i > 16)
        continue;

      if (mpfr_set_str (x, "NaN", i, MPFR_RNDN) != 0 ||
          !mpfr_nan_p(x))
        {
          printf ("mpfr_set_str failed on NaN\n");
          exit (1);
        }

      if (mpfr_set_str (x, "Inf", i, MPFR_RNDN) != 0 ||
          !mpfr_inf_p(x) || MPFR_SIGN(x) < 0)
        {
          printf ("mpfr_set_str failed on Inf\n");
          exit (1);
        }

      if (mpfr_set_str (x, "-Inf", i, MPFR_RNDN) != 0 ||
          !mpfr_inf_p(x) || MPFR_SIGN(x) > 0)
        {
          printf ("mpfr_set_str failed on -Inf\n");
          exit (1);
        }

      if (mpfr_set_str (x, "+Inf", i, MPFR_RNDN) != 0 ||
          !mpfr_inf_p(x) || MPFR_SIGN(x) < 0)
        {
          printf ("mpfr_set_str failed on +Inf\n");
          exit (1);
        }
    }

  /* check that mpfr_set_str works for uppercase letters too */
  mpfr_set_prec (x, 10);
  mpfr_set_str (x, "B", 16, MPFR_RNDN);
  if (mpfr_cmp_ui (x, 11) != 0)
    {
      printf ("mpfr_set_str does not work for uppercase letters\n");
      exit (1);
    }

  /* start of tests added by Alain Delplanque */

  /* in this example an overflow can occur */
  mpfr_set_prec (x, 64);
  mpfr_set_prec (y, 64);
  mpfr_set_str_binary (x, "1.0E-532");
  mpfr_set_str (y, "0.71128279983522479470@-160", 10, MPFR_RNDU);
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (2):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  /* in this example, I think there was a pb in the old function :
     result of mpfr_set_str_old for the same number , but with more
     precision is: 1.111111111110000000000000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000100111000100001100000010101100111010e184
     this result is the same as mpfr_set_str */
  mpfr_set_prec (x, 64);
  mpfr_set_prec (y, 64);
  mpfr_set_str_binary (x, "1.111111111110000000000000000111111111111111111111111110000000001E184");
  mpfr_set_str (y, "0.jo08hg31hc5mmpj5mjjmgn55p2h35g@39", 27, MPFR_RNDU);
  /* y = 49027884868983130654865109690613178467841148597221480052 */
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (3):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  /* not exact rounding in mpfr_set_str
     same number with more precision is : 1.111111111111111111111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011011111101000001101110110010101101000010100110011101110010001110e195
     this result is the same as mpfr_set_str */
  /* problem was : can_round was call with MPFR_RNDN round mode,
     so can_round use an error : 1/2 * 2^err * ulp(y)
     instead of 2^err * ulp(y)
     I have increase err by 1 */
  mpfr_set_prec (x, 64);  /* it was round down instead of up */
  mpfr_set_prec (y, 64);
  mpfr_set_str_binary (x, "1.111111111111111111111111111000000000000000000000000000000000001e195");
  mpfr_set_str (y, "0.6e23ekb6acgh96abk10b6c9f2ka16i@45", 21, MPFR_RNDU);
  /* y = 100433627392042473064661483711179345482301462325708736552078 */
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (4):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  /* may be an error in mpfr_set_str_old
     with more precision : 1.111111100000001111110000000000011111011111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111110111101010001110111011000010111001011100110110e180 */
  mpfr_set_prec (x, 64);  /* it was round down instead of up */
  mpfr_set_prec (y, 64);
  mpfr_set_str_binary (x, "1.111111100000001111110000000000011111011111111111111111111111111e180");
  mpfr_set_str (y, "0.10j8j2k82ehahha56390df0a1de030@41", 23, MPFR_RNDZ);
  /* y = 3053110535624388280648330929253842828159081875986159414 */
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (5):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  mpfr_set_prec (x, 64);
  mpfr_set_prec (y, 64);
  mpfr_set_str (y, "0.jrchfhpp9en7hidqm9bmcofid9q3jg@39", 28, MPFR_RNDU);
  /* y = 196159429139499688661464718784226062699788036696626429952 */
  mpfr_set_str_binary (x, "0.1111111111111111111111111111111000000000000011100000001111100001E187");
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (6):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  mpfr_set_prec (x, 64);
  mpfr_set_prec (y, 64);
  mpfr_set_str (y, "0.h148m5ld5cf8gk1kd70b6ege92g6ba@47", 24, MPFR_RNDZ);
  /* y = 52652933527468502324759448399183654588831274530295083078827114496 */
  mpfr_set_str_binary (x, "0.1111111111111100000000001000000000000000000011111111111111101111E215");
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (7):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  /* worst cases for rounding to nearest in double precision */
  mpfr_set_prec (x, 53);
  mpfr_set_prec (y, 53);

  mpfr_set_str (y, "5e125", 10, MPFR_RNDN);
  mpfr_set_str_binary (x, "0.10111101000101110110011000100000101001010000000111111E418");
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (8):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  mpfr_set_str (y, "69e267", 10, MPFR_RNDN);
  mpfr_set_str_binary (x, "0.10000101101111100101101100000110010011001010011011010E894");
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (9):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  mpfr_set_str (y, "623e100", 10, MPFR_RNDN);
  mpfr_set_str_binary (x, "0.10110010000001010011000101111001110101000001111011111E342");
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (10):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  mpfr_set_str (y, "3571e263", 10, MPFR_RNDN);
  mpfr_set_str_binary (x, "0.10110001001100100010011000110000111010100000110101010E886");
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (11):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  mpfr_set_str (y, "75569e-254", 10, MPFR_RNDN);
  mpfr_set_str_binary (x, "0.10101101001000110001011011001000111000110101010110011E-827");
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (12):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  mpfr_set_str (y, "920657e-23", 10, MPFR_RNDN);
  mpfr_set_str_binary (x, "0.10101001110101001100110000101110110111101111001101100E-56");
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (13):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  mpfr_set_str (y, "9210917e80", 10, MPFR_RNDN);
  mpfr_set_str_binary (x, "0.11101101000100011001000110100011111100110000000110010E289");
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (14):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  mpfr_set_str (y, "87575437e-309", 10, MPFR_RNDN);
  mpfr_set_str_binary (x, "0.11110000001110011001000000110000000100000010101101100E-1000");
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (15):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  mpfr_set_str (y, "245540327e122", 10, MPFR_RNDN);
  mpfr_set_str_binary (x, "0.10001101101100010001100011110000110001100010111001011E434");
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (16):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  mpfr_set_str (y, "491080654e122", 10, MPFR_RNDN);
  mpfr_set_str_binary (x, "0.10001101101100010001100011110000110001100010111001011E435");
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (17):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  mpfr_set_str (y, "83356057653e193", 10, MPFR_RNDN);
  mpfr_set_str_binary (x, "0.10101010001001110011011011010111011100010101000011000E678");
  if (mpfr_cmp (x, y))
    {
      printf ("Error in mpfr_set_str (18):\n");
      mpfr_print_binary (x);
      puts ("");
      mpfr_print_binary (y);
      puts ("");
      mpfr_clear (x);
      mpfr_clear (y);
      exit (1);
    }

  CHECK53(y, "83356057653e193", MPFR_RNDN, x,
          "0.10101010001001110011011011010111011100010101000011000E678",
          18);

  CHECK53(y, "619534293513e124", MPFR_RNDN, x,
          "0.10001000011000010000000110000001111111110000011110001e452",
          19);

  CHECK53(y, "3142213164987e-294", MPFR_RNDN, x,
          "0.11101001101000000100111011111101111001010001001101111e-935",
          20);

  CHECK53(y, "36167929443327e-159", MPFR_RNDN, x,
          "0.11100111001110111110000101011001100110010100011111100e-483",
          21);

  CHECK53(y, "904198236083175e-161", MPFR_RNDN, x,
          "0.11100111001110111110000101011001100110010100011111100e-485",
          22);

  CHECK53(y, "3743626360493413e-165", MPFR_RNDN, x,
          "0.11000100000100011101001010111101011011011111011111001e-496",
          23);

  CHECK53(y, "94080055902682397e-242", MPFR_RNDN, x,
          "0.10110010010011000000111100011100111100110011011001010e-747",
          24);

  CHECK53(y, "7e-303", MPFR_RNDD, x,
          "0.10011001100111001000100110001110001000110111110001011e-1003",
          25);
  CHECK53(y, "7e-303", MPFR_RNDU, x,
          "0.10011001100111001000100110001110001000110111110001100e-1003",
          26);

  CHECK53(y, "93e-234", MPFR_RNDD, x,
          "0.10010011110110010111001001111001000010000000001110101E-770",
          27);
  CHECK53(y, "93e-234", MPFR_RNDU, x,
          "0.10010011110110010111001001111001000010000000001110110E-770",
          28);

  CHECK53(y, "755e174", MPFR_RNDD, x,
          "0.10111110110010011000110010011111101111000111111000101E588",
          29);
  CHECK53(y, "755e174", MPFR_RNDU, x,
          "0.10111110110010011000110010011111101111000111111000110E588",
          30);

  CHECK53(y, "8699e-276", MPFR_RNDD, x,
          "0.10010110100101101111100100100011011101100110100101100E-903",
          31);
  CHECK53(y, "8699e-276", MPFR_RNDU, x,
          "0.10010110100101101111100100100011011101100110100101101E-903",
          32);

  CHECK53(y, "82081e41", MPFR_RNDD, x,
          "0.10111000000010000010111011111001111010100011111001011E153",
          33);
  CHECK53(y, "82081e41", MPFR_RNDU, x,
          "0.10111000000010000010111011111001111010100011111001100E153",
          34);

  CHECK53(y, "584169e229", MPFR_RNDD, x,
          "0.11101011001010111000001011001110111000111100110101010E780",
          35);
  CHECK53(y, "584169e229", MPFR_RNDU, x,
          "0.11101011001010111000001011001110111000111100110101011E780",
          36);

  CHECK53(y, "5783893e-128", MPFR_RNDD, x,
          "0.10011000111100000110011110000101100111110011101110100E-402",
          37);
  CHECK53(y, "5783893e-128", MPFR_RNDU, x,
          "0.10011000111100000110011110000101100111110011101110101E-402",
          38);

  CHECK53(y, "87575437e-310", MPFR_RNDD, x,
          "0.11000000001011100000110011110011010000000010001010110E-1003",
          39);
  CHECK53(y, "87575437e-310", MPFR_RNDU, x,
          "0.11000000001011100000110011110011010000000010001010111E-1003",
          40);

  CHECK53(y, "245540327e121", MPFR_RNDD, x,
          "0.11100010101101001111010010110100011100000100101000100E430",
          41);
  CHECK53(y, "245540327e121", MPFR_RNDU, x,
          "0.11100010101101001111010010110100011100000100101000101E430",
          42);

  CHECK53(y, "9078555839e-109", MPFR_RNDD, x,
          "0.11111110001010111010110000110011100110001010011101101E-329",
          43);
  CHECK53(y, "9078555839e-109", MPFR_RNDU, x,
          "0.11111110001010111010110000110011100110001010011101110E-329",
          44);

  CHECK53(y, "42333842451e201", MPFR_RNDD, x,
          "0.10000000110001001101000100110110111110101011101011111E704",
          45);
  CHECK53(y, "42333842451e201", MPFR_RNDU, x,
          "0.10000000110001001101000100110110111110101011101100000E704",
          46);

  CHECK53(y, "778380362293e218", MPFR_RNDD, x,
          "0.11001101010111000001001100001100110010000001010010010E764",
          47);
  CHECK53(y, "778380362293e218", MPFR_RNDU, x,
          "0.11001101010111000001001100001100110010000001010010011E764",
          48);

  CHECK53(y, "7812878489261e-179", MPFR_RNDD, x,
          "0.10010011011011010111001111011101111101101101001110100E-551",
          49);
  CHECK53(y, "7812878489261e-179", MPFR_RNDU, x,
          "0.10010011011011010111001111011101111101101101001110101E-551",
          50);

  CHECK53(y, "77003665618895e-73", MPFR_RNDD, x,
          "0.11000101111110111111001111111101001101111000000101001E-196",
          51);
  CHECK53(y, "77003665618895e-73", MPFR_RNDU, x,
          "0.11000101111110111111001111111101001101111000000101010E-196",
          52);

  CHECK53(y, "834735494917063e-300", MPFR_RNDD, x,
          "0.11111110001101100001001101111100010011001110111010001E-947",
          53);
  CHECK53(y, "834735494917063e-300", MPFR_RNDU, x,
          "0.11111110001101100001001101111100010011001110111010010E-947",
          54);

  CHECK53(y, "6182410494241627e-119", MPFR_RNDD, x,
          "0.10001101110010110010001011000010001000101110100000111E-342",
          55);
  CHECK53(y, "6182410494241627e-119", MPFR_RNDU, x,
          "0.10001101110010110010001011000010001000101110100001000E-342",
          56);

  CHECK53(y, "26153245263757307e49", MPFR_RNDD, x,
          "0.10011110111100000000001011011110101100010000011011110E218",
          57);
  CHECK53(y, "26153245263757307e49", MPFR_RNDU, x,
          "0.10011110111100000000001011011110101100010000011011111E218",
          58);

  /* to check this problem : I convert limb (10--0 or 101--1) into base b
     with more than mp_bits_per_limb digits,
     so when convert into base 2 I should have
     the limb that I have choose */
  /* this use mpfr_get_str */
  {
    size_t nb_digit = mp_bits_per_limb;
    mp_limb_t check_limb[2] = {MPFR_LIMB_HIGHBIT, ~(MPFR_LIMB_HIGHBIT >> 1)};
    int base[3] = {10, 16, 19};
    mpfr_rnd_t rnd[3] = {MPFR_RNDU, MPFR_RNDN, MPFR_RNDD};
    int cbase, climb, crnd;
    char *str;

    mpfr_set_prec (x, mp_bits_per_limb); /* x and y have only one limb */
    mpfr_set_prec (y, mp_bits_per_limb);

    str = (char*) (*__gmp_allocate_func) (N + 20);

    mpfr_set_ui (x, 1, MPFR_RNDN); /* ensures that x is not NaN or Inf */
    for (; nb_digit < N; nb_digit *= 10)
      for (cbase = 0; cbase < 3; cbase++)
        for (climb = 0; climb < 2; climb++)
          for (crnd = 0; crnd < 3; crnd++)
            {
              char *str1;
              mpfr_exp_t exp;

              *(MPFR_MANT(x)) = check_limb[climb];
              MPFR_EXP(x) = 0;

              mpfr_get_str (str + 2, &exp, base[cbase],
                            nb_digit, x, rnd[crnd]);
              str[0] = '-';
              str[(str[2] == '-')] =  '0';
              str[(str[2] == '-') + 1] =  '.';

              for (str1 = str; *str1 != 0; str1++)
                ;
              sprintf (str1, "@%i", (int) exp);

              mpfr_set_str (y, str, base[cbase], rnd[2 - crnd]);

              if (mpfr_cmp (x, y) != 0)
                {
                  printf ("Error in mpfr_set_str for nb_digit=%u, base=%d, "
                          "rnd=%s:\n", (unsigned int) nb_digit, base[cbase],
                          mpfr_print_rnd_mode (rnd[crnd]));
                  printf ("instead of: ");
                  mpfr_print_binary (x);
                  puts ("");
                  printf ("return    : ");
                  mpfr_print_binary (y);
                  puts ("");
                  exit (1);
                }
            }

    (*__gmp_free_func) (str, N + 20);
  }

  /* end of tests added by Alain Delplanque */

  /* check that flags are correctly cleared */
  mpfr_set_nan (x);
  mpfr_set_str (x, "+0.0", 10, MPFR_RNDN);
  if (!mpfr_number_p(x) || mpfr_cmp_ui (x, 0) != 0 || mpfr_sgn (x) < 0)
    {
      printf ("x <- +0.0 failed after x=NaN\n");
      exit (1);
    }
  mpfr_set_str (x, "-0.0", 10, MPFR_RNDN);
  if (!mpfr_number_p(x) || mpfr_cmp_ui (x, 0) != 0 || mpfr_sgn (x) > 0)
    {
      printf ("x <- -0.0 failed after x=NaN\n");
      exit (1);
    }

  /* check invalid input */
  ret = mpfr_set_str (x, "1E10toto", 10, MPFR_RNDN);
  MPFR_ASSERTN (ret == -1);
  ret = mpfr_set_str (x, "1p10toto", 16, MPFR_RNDN);
  MPFR_ASSERTN (ret == -1);
  ret = mpfr_set_str (x, "", 16, MPFR_RNDN);
  MPFR_ASSERTN (ret == -1);
  ret = mpfr_set_str (x, "+", 16, MPFR_RNDN);
  MPFR_ASSERTN (ret == -1);
  ret = mpfr_set_str (x, "-", 16, MPFR_RNDN);
  MPFR_ASSERTN (ret == -1);
  ret = mpfr_set_str (x, "this_is_an_invalid_number_in_base_36", 36, MPFR_RNDN);
  MPFR_ASSERTN (ret == -1);
  ret = mpfr_set_str (x, "1.2.3", 10, MPFR_RNDN);
  MPFR_ASSERTN (ret == -1);
  mpfr_set_prec (x, 135);
  ret = mpfr_set_str (x, "thisisavalidnumberinbase36", 36, MPFR_RNDN);
  mpfr_set_prec (y, 135);
  mpfr_set_str (y, "23833565676460972739462619524519814462546", 10, MPFR_RNDN);
  MPFR_ASSERTN (mpfr_cmp (x, y) == 0 && ret == 0);

  /* coverage test for set_str_binary */
  mpfr_set_str_binary (x, "NaN");
  MPFR_ASSERTN(mpfr_nan_p (x));
  mpfr_set_str_binary (x, "Inf");
  MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
  mpfr_set_str_binary (x, "+Inf");
  MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
  mpfr_set_str_binary (x, "-Inf");
  MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) < 0);
  mpfr_set_prec (x, 3);
  mpfr_set_str_binary (x, "0.01E2");
  MPFR_ASSERTN(mpfr_cmp_ui (x, 1) == 0);
  mpfr_set_str_binary (x, "-0.01E2");
  MPFR_ASSERTN(mpfr_cmp_si (x, -1) == 0);

  mpfr_clear (x);
  mpfr_clear (y);

  check_underflow ();
  bug20081028 ();

  tests_end_mpfr ();
  return 0;
}
Esempio n. 12
0
 /// Returns sign of the number
 inline int sign() const { return MPFR_SIGN(val); }
Esempio n. 13
0
int
main (void)
{
  mpfr_t x, y, z;
  int i, j, k;

  tests_start_mpfr ();

  mpfr_init (x);
  mpfr_init (y);
  mpfr_init (z);

  for (i = 0; i <= 1; i++)
    for (j = 0; j <= 1; j++)
      for (k = 0; k <= 5; k++)
        {
          mpfr_set_nan (x);
          i ? MPFR_SET_NEG (x) : MPFR_SET_POS (x);
          mpfr_set_nan (y);
          j ? MPFR_SET_NEG (y) : MPFR_SET_POS (y);
          copysign_variant (z, x, y, GMP_RNDN, k);
          if (MPFR_SIGN (z) != MPFR_SIGN (y) || !mpfr_nanflag_p ())
            {
              printf ("Error in mpfr_copysign (%cNaN, %cNaN)\n",
                      i ? '-' : '+', j ? '-' : '+');
              exit (1);
            }

          mpfr_set_si (x, i ? -1250 : 1250, GMP_RNDN);
          mpfr_set_nan (y);
          j ? MPFR_SET_NEG (y) : MPFR_SET_POS (y);
          copysign_variant (z, x, y, GMP_RNDN, k);
          if (i != j)
            mpfr_neg (x, x, GMP_RNDN);
          if (! mpfr_equal_p (z, x) || mpfr_nanflag_p ())
            {
              printf ("Error in mpfr_copysign (%c1250, %cNaN)\n",
                      i ? '-' : '+', j ? '-' : '+');
              exit (1);
            }

          mpfr_set_si (x, i ? -1250 : 1250, GMP_RNDN);
          mpfr_set_si (y, j ? -1717 : 1717, GMP_RNDN);
          copysign_variant (z, x, y, GMP_RNDN, k);
          if (i != j)
            mpfr_neg (x, x, GMP_RNDN);
          if (! mpfr_equal_p (z, x) || mpfr_nanflag_p ())
            {
              printf ("Error in mpfr_copysign (%c1250, %c1717)\n",
                      i ? '-' : '+', j ? '-' : '+');
              exit (1);
            }
        }

  mpfr_clear (x);
  mpfr_clear (y);
  mpfr_clear (z);

  tests_end_mpfr ();
  return 0;
}
Esempio n. 14
0
int
mpfr_sub1sp (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t rnd_mode)
{
  mpfr_exp_t bx,cx;
  mpfr_uexp_t d;
  mpfr_prec_t p, sh, cnt;
  mp_size_t n;
  mp_limb_t *ap, *bp, *cp;
  mp_limb_t limb;
  int inexact;
  mp_limb_t bcp,bcp1; /* Cp and C'p+1 */
  mp_limb_t bbcp = (mp_limb_t) -1, bbcp1 = (mp_limb_t) -1; /* Cp+1 and C'p+2,
    gcc claims that they might be used uninitialized. We fill them with invalid
    values, which should produce a failure if so. See README.dev file. */

  MPFR_TMP_DECL(marker);

  MPFR_TMP_MARK(marker);

  MPFR_ASSERTD(MPFR_PREC(a) == MPFR_PREC(b) && MPFR_PREC(b) == MPFR_PREC(c));
  MPFR_ASSERTD(MPFR_IS_PURE_FP(b));
  MPFR_ASSERTD(MPFR_IS_PURE_FP(c));

  /* Read prec and num of limbs */
  p = MPFR_PREC (b);
  n = MPFR_PREC2LIMBS (p);

  /* Fast cmp of |b| and |c|*/
  bx = MPFR_GET_EXP (b);
  cx = MPFR_GET_EXP (c);
  if (MPFR_UNLIKELY(bx == cx))
    {
      mp_size_t k = n - 1;
      /* Check mantissa since exponent are equals */
      bp = MPFR_MANT(b);
      cp = MPFR_MANT(c);
      while (k>=0 && MPFR_UNLIKELY(bp[k] == cp[k]))
        k--;
      if (MPFR_UNLIKELY(k < 0))
        /* b == c ! */
        {
          /* Return exact number 0 */
          if (rnd_mode == MPFR_RNDD)
            MPFR_SET_NEG(a);
          else
            MPFR_SET_POS(a);
          MPFR_SET_ZERO(a);
          MPFR_RET(0);
        }
      else if (bp[k] > cp[k])
        goto BGreater;
      else
        {
          MPFR_ASSERTD(bp[k]<cp[k]);
          goto CGreater;
        }
    }
  else if (MPFR_UNLIKELY(bx < cx))
    {
      /* Swap b and c and set sign */
      mpfr_srcptr t;
      mpfr_exp_t tx;
    CGreater:
      MPFR_SET_OPPOSITE_SIGN(a,b);
      t  = b;  b  = c;  c  = t;
      tx = bx; bx = cx; cx = tx;
    }
  else
    {
      /* b > c */
    BGreater:
      MPFR_SET_SAME_SIGN(a,b);
    }

  /* Now b > c */
  MPFR_ASSERTD(bx >= cx);
  d = (mpfr_uexp_t) bx - cx;
  DEBUG (printf ("New with diff=%lu\n", (unsigned long) d));

  if (MPFR_UNLIKELY(d <= 1))
    {
      if (MPFR_LIKELY(d < 1))
        {
          /* <-- b -->
             <-- c --> : exact sub */
          ap = MPFR_MANT(a);
          mpn_sub_n (ap, MPFR_MANT(b), MPFR_MANT(c), n);
          /* Normalize */
        ExactNormalize:
          limb = ap[n-1];
          if (MPFR_LIKELY(limb))
            {
              /* First limb is not zero. */
              count_leading_zeros(cnt, limb);
              /* cnt could be == 0 <= SubD1Lose */
              if (MPFR_LIKELY(cnt))
                {
                  mpn_lshift(ap, ap, n, cnt); /* Normalize number */
                  bx -= cnt; /* Update final expo */
                }
              /* Last limb should be ok */
              MPFR_ASSERTD(!(ap[0] & MPFR_LIMB_MASK((unsigned int) (-p)
                                                    % GMP_NUMB_BITS)));
            }
          else
            {
              /* First limb is zero */
              mp_size_t k = n-1, len;
              /* Find the first limb not equal to zero.
                 FIXME:It is assume it exists (since |b| > |c| and same prec)*/
              do
                {
                  MPFR_ASSERTD( k > 0 );
                  limb = ap[--k];
                }
              while (limb == 0);
              MPFR_ASSERTD(limb != 0);
              count_leading_zeros(cnt, limb);
              k++;
              len = n - k; /* Number of last limb */
              MPFR_ASSERTD(k >= 0);
              if (MPFR_LIKELY(cnt))
                mpn_lshift(ap+len, ap, k, cnt); /* Normalize the High Limb*/
              else
                {
                  /* Must use DECR since src and dest may overlap & dest>=src*/
                  MPN_COPY_DECR(ap+len, ap, k);
                }
              MPN_ZERO(ap, len); /* Zeroing the last limbs */
              bx -= cnt + len*GMP_NUMB_BITS; /* Update Expo */
              /* Last limb should be ok */
              MPFR_ASSERTD(!(ap[len]&MPFR_LIMB_MASK((unsigned int) (-p)
                                                    % GMP_NUMB_BITS)));
            }
          /* Check expo underflow */
          if (MPFR_UNLIKELY(bx < __gmpfr_emin))
            {
              MPFR_TMP_FREE(marker);
              /* inexact=0 */
              DEBUG( printf("(D==0 Underflow)\n") );
              if (rnd_mode == MPFR_RNDN &&
                  (bx < __gmpfr_emin - 1 ||
                   (/*inexact >= 0 &&*/ mpfr_powerof2_raw (a))))
                rnd_mode = MPFR_RNDZ;
              return mpfr_underflow (a, rnd_mode, MPFR_SIGN(a));
            }
          MPFR_SET_EXP (a, bx);
          /* No rounding is necessary since the result is exact */
          MPFR_ASSERTD(ap[n-1] > ~ap[n-1]);
          MPFR_TMP_FREE(marker);
          return 0;
        }
      else /* if (d == 1) */
        {
          /* | <-- b -->
             |  <-- c --> */
          mp_limb_t c0, mask;
          mp_size_t k;
          MPFR_UNSIGNED_MINUS_MODULO(sh, p);
          /* If we lose at least one bit, compute 2*b-c (Exact)
           * else compute b-c/2 */
          bp = MPFR_MANT(b);
          cp = MPFR_MANT(c);
          k = n-1;
          limb = bp[k] - cp[k]/2;
          if (limb > MPFR_LIMB_HIGHBIT)
            {
              /* We can't lose precision: compute b-c/2 */
              /* Shift c in the allocated temporary block */
            SubD1NoLose:
              c0 = cp[0] & (MPFR_LIMB_ONE<<sh);
              cp = MPFR_TMP_LIMBS_ALLOC (n);
              mpn_rshift(cp, MPFR_MANT(c), n, 1);
              if (MPFR_LIKELY(c0 == 0))
                {
                  /* Result is exact: no need of rounding! */
                  ap = MPFR_MANT(a);
                  mpn_sub_n (ap, bp, cp, n);
                  MPFR_SET_EXP(a, bx); /* No expo overflow! */
                  /* No truncate or normalize is needed */
                  MPFR_ASSERTD(ap[n-1] > ~ap[n-1]);
                  /* No rounding is necessary since the result is exact */
                  MPFR_TMP_FREE(marker);
                  return 0;
                }
              ap = MPFR_MANT(a);
              mask = ~MPFR_LIMB_MASK(sh);
              cp[0] &= mask; /* Delete last bit of c */
              mpn_sub_n (ap, bp, cp, n);
              MPFR_SET_EXP(a, bx);                 /* No expo overflow! */
              MPFR_ASSERTD( !(ap[0] & ~mask) );    /* Check last bits */
              /* No normalize is needed */
              MPFR_ASSERTD(ap[n-1] > ~ap[n-1]);
              /* Rounding is necessary since c0 = 1*/
              /* Cp =-1 and C'p+1=0 */
              bcp = 1; bcp1 = 0;
              if (MPFR_LIKELY(rnd_mode == MPFR_RNDN))
                {
                  /* Even Rule apply: Check Ap-1 */
                  if (MPFR_LIKELY( (ap[0] & (MPFR_LIMB_ONE<<sh)) == 0) )
                    goto truncate;
                  else
                    goto sub_one_ulp;
                }
              MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(a));
              if (rnd_mode == MPFR_RNDZ)
                goto sub_one_ulp;
              else
                goto truncate;
            }
          else if (MPFR_LIKELY(limb < MPFR_LIMB_HIGHBIT))
            {
              /* We lose at least one bit of prec */
              /* Calcul of 2*b-c (Exact) */
              /* Shift b in the allocated temporary block */
            SubD1Lose:
              bp = MPFR_TMP_LIMBS_ALLOC (n);
              mpn_lshift (bp, MPFR_MANT(b), n, 1);
              ap = MPFR_MANT(a);
              mpn_sub_n (ap, bp, cp, n);
              bx--;
              goto ExactNormalize;
            }
          else
            {
              /* Case: limb = 100000000000 */
              /* Check while b[k] == c'[k] (C' is C shifted by 1) */
              /* If b[k]<c'[k] => We lose at least one bit*/
              /* If b[k]>c'[k] => We don't lose any bit */
              /* If k==-1 => We don't lose any bit
                 AND the result is 100000000000 0000000000 00000000000 */
              mp_limb_t carry;
              do {
                carry = cp[k]&MPFR_LIMB_ONE;
                k--;
              } while (k>=0 &&
                       bp[k]==(carry=cp[k]/2+(carry<<(GMP_NUMB_BITS-1))));
              if (MPFR_UNLIKELY(k<0))
                {
                  /*If carry then (sh==0 and Virtual c'[-1] > Virtual b[-1]) */
                  if (MPFR_UNLIKELY(carry)) /* carry = cp[0]&MPFR_LIMB_ONE */
                    {
                      /* FIXME: Can be faster? */
                      MPFR_ASSERTD(sh == 0);
                      goto SubD1Lose;
                    }
                  /* Result is a power of 2 */
                  ap = MPFR_MANT (a);
                  MPN_ZERO (ap, n);
                  ap[n-1] = MPFR_LIMB_HIGHBIT;
                  MPFR_SET_EXP (a, bx); /* No expo overflow! */
                  /* No Normalize is needed*/
                  /* No Rounding is needed */
                  MPFR_TMP_FREE (marker);
                  return 0;
                }
              /* carry = cp[k]/2+(cp[k-1]&1)<<(GMP_NUMB_BITS-1) = c'[k]*/
              else if (bp[k] > carry)
                goto SubD1NoLose;
              else
                {
                  MPFR_ASSERTD(bp[k]<carry);
                  goto SubD1Lose;
                }
            }
        }
    }
  else if (MPFR_UNLIKELY(d >= p))
    {
      ap = MPFR_MANT(a);
      MPFR_UNSIGNED_MINUS_MODULO(sh, p);
      /* We can't set A before since we use cp for rounding... */
      /* Perform rounding: check if a=b or a=b-ulp(b) */
      if (MPFR_UNLIKELY(d == p))
        {
          /* cp == -1 and c'p+1 = ? */
          bcp  = 1;
          /* We need Cp+1 later for a very improbable case. */
          bbcp = (MPFR_MANT(c)[n-1] & (MPFR_LIMB_ONE<<(GMP_NUMB_BITS-2)));
          /* We need also C'p+1 for an even more unprobable case... */
          if (MPFR_LIKELY( bbcp ))
            bcp1 = 1;
          else
            {
              cp = MPFR_MANT(c);
              if (MPFR_UNLIKELY(cp[n-1] == MPFR_LIMB_HIGHBIT))
                {
                  mp_size_t k = n-1;
                  do {
                    k--;
                  } while (k>=0 && cp[k]==0);
                  bcp1 = (k>=0);
                }
              else
                bcp1 = 1;
            }
          DEBUG( printf("(D=P) Cp=-1 Cp+1=%d C'p+1=%d \n", bbcp!=0, bcp1!=0) );
          bp = MPFR_MANT (b);

          /* Even if src and dest overlap, it is ok using MPN_COPY */
          if (MPFR_LIKELY(rnd_mode == MPFR_RNDN))
            {
              if (MPFR_UNLIKELY( bcp && bcp1==0 ))
                /* Cp=-1 and C'p+1=0: Even rule Apply! */
                /* Check Ap-1 = Bp-1 */
                if ((bp[0] & (MPFR_LIMB_ONE<<sh)) == 0)
                  {
                    MPN_COPY(ap, bp, n);
                    goto truncate;
                  }
              MPN_COPY(ap, bp, n);
              goto sub_one_ulp;
            }
          MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(a));
          if (rnd_mode == MPFR_RNDZ)
            {
              MPN_COPY(ap, bp, n);
              goto sub_one_ulp;
            }
          else
            {
              MPN_COPY(ap, bp, n);
              goto truncate;
            }
        }
      else
        {
          /* Cp=0, Cp+1=-1 if d==p+1, C'p+1=-1 */
          bcp = 0; bbcp = (d==p+1); bcp1 = 1;
          DEBUG( printf("(D>P) Cp=%d Cp+1=%d C'p+1=%d\n", bcp!=0,bbcp!=0,bcp1!=0) );
          /* Need to compute C'p+2 if d==p+1 and if rnd_mode=NEAREST
             (Because of a very improbable case) */
          if (MPFR_UNLIKELY(d==p+1 && rnd_mode==MPFR_RNDN))
            {
              cp = MPFR_MANT(c);
              if (MPFR_UNLIKELY(cp[n-1] == MPFR_LIMB_HIGHBIT))
                {
                  mp_size_t k = n-1;
                  do {
                    k--;
                  } while (k>=0 && cp[k]==0);
                  bbcp1 = (k>=0);
                }
              else
                bbcp1 = 1;
              DEBUG( printf("(D>P) C'p+2=%d\n", bbcp1!=0) );
            }
          /* Copy mantissa B in A */
          MPN_COPY(ap, MPFR_MANT(b), n);
          /* Round */
          if (MPFR_LIKELY(rnd_mode == MPFR_RNDN))
            goto truncate;
          MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(a));
          if (rnd_mode == MPFR_RNDZ)
            goto sub_one_ulp;
          else /* rnd_mode = AWAY */
            goto truncate;
        }
    }
  else
    {
      mpfr_uexp_t dm;
      mp_size_t m;
      mp_limb_t mask;

      /* General case: 2 <= d < p */
      MPFR_UNSIGNED_MINUS_MODULO(sh, p);
      cp = MPFR_TMP_LIMBS_ALLOC (n);

      /* Shift c in temporary allocated place */
      dm = d % GMP_NUMB_BITS;
      m = d / GMP_NUMB_BITS;
      if (MPFR_UNLIKELY(dm == 0))
        {
          /* dm = 0 and m > 0: Just copy */
          MPFR_ASSERTD(m!=0);
          MPN_COPY(cp, MPFR_MANT(c)+m, n-m);
          MPN_ZERO(cp+n-m, m);
        }
      else if (MPFR_LIKELY(m == 0))
        {
          /* dm >=2 and m == 0: just shift */
          MPFR_ASSERTD(dm >= 2);
          mpn_rshift(cp, MPFR_MANT(c), n, dm);
        }
      else
        {
          /* dm > 0 and m > 0: shift and zero  */
          mpn_rshift(cp, MPFR_MANT(c)+m, n-m, dm);
          MPN_ZERO(cp+n-m, m);
        }

      DEBUG( mpfr_print_mant_binary("Before", MPFR_MANT(c), p) );
      DEBUG( mpfr_print_mant_binary("B=    ", MPFR_MANT(b), p) );
      DEBUG( mpfr_print_mant_binary("After ", cp, p) );

      /* Compute bcp=Cp and bcp1=C'p+1 */
      if (MPFR_LIKELY(sh))
        {
          /* Try to compute them from C' rather than C (FIXME: Faster?) */
          bcp = (cp[0] & (MPFR_LIMB_ONE<<(sh-1))) ;
          if (MPFR_LIKELY( cp[0] & MPFR_LIMB_MASK(sh-1) ))
            bcp1 = 1;
          else
            {
              /* We can't compute C'p+1 from C'. Compute it from C */
              /* Start from bit x=p-d+sh in mantissa C
                 (+sh since we have already looked sh bits in C'!) */
              mpfr_prec_t x = p-d+sh-1;
              if (MPFR_LIKELY(x>p))
                /* We are already looked at all the bits of c, so C'p+1 = 0*/
                bcp1 = 0;
              else
                {
                  mp_limb_t *tp = MPFR_MANT(c);
                  mp_size_t kx = n-1 - (x / GMP_NUMB_BITS);
                  mpfr_prec_t sx = GMP_NUMB_BITS-1-(x%GMP_NUMB_BITS);
                  DEBUG (printf ("(First) x=%lu Kx=%ld Sx=%lu\n",
                                 (unsigned long) x, (long) kx,
                                 (unsigned long) sx));
                  /* Looks at the last bits of limb kx (if sx=0 does nothing)*/
                  if (tp[kx] & MPFR_LIMB_MASK(sx))
                    bcp1 = 1;
                  else
                    {
                      /*kx += (sx==0);*/
                      /*If sx==0, tp[kx] hasn't been checked*/
                      do {
                        kx--;
                      } while (kx>=0 && tp[kx]==0);
                      bcp1 = (kx >= 0);
                    }
                }
            }
        }
      else
        {
          /* Compute Cp and C'p+1 from C with sh=0 */
          mp_limb_t *tp = MPFR_MANT(c);
          /* Start from bit x=p-d in mantissa C */
          mpfr_prec_t  x = p-d;
          mp_size_t   kx = n-1 - (x / GMP_NUMB_BITS);
          mpfr_prec_t sx = GMP_NUMB_BITS-1-(x%GMP_NUMB_BITS);
          MPFR_ASSERTD(p >= d);
          bcp = (tp[kx] & (MPFR_LIMB_ONE<<sx));
          /* Looks at the last bits of limb kx (If sx=0, does nothing)*/
          if (tp[kx] & MPFR_LIMB_MASK(sx))
            bcp1 = 1;
          else
            {
              /*kx += (sx==0);*/ /*If sx==0, tp[kx] hasn't been checked*/
              do {
                kx--;
              } while (kx>=0 && tp[kx]==0);
              bcp1 = (kx>=0);
            }
        }
      DEBUG( printf("sh=%lu Cp=%d C'p+1=%d\n", sh, bcp!=0, bcp1!=0) );

      /* Check if we can lose a bit, and if so compute Cp+1 and C'p+2 */
      bp = MPFR_MANT(b);
      if (MPFR_UNLIKELY((bp[n-1]-cp[n-1]) <= MPFR_LIMB_HIGHBIT))
        {
          /* We can lose a bit so we precompute Cp+1 and C'p+2 */
          /* Test for trivial case: since C'p+1=0, Cp+1=0 and C'p+2 =0 */
          if (MPFR_LIKELY(bcp1 == 0))
            {
              bbcp = 0;
              bbcp1 = 0;
            }
          else /* bcp1 != 0 */
            {
              /* We can lose a bit:
                 compute Cp+1 and C'p+2 from mantissa C */
              mp_limb_t *tp = MPFR_MANT(c);
              /* Start from bit x=(p+1)-d in mantissa C */
              mpfr_prec_t x  = p+1-d;
              mp_size_t kx = n-1 - (x/GMP_NUMB_BITS);
              mpfr_prec_t sx = GMP_NUMB_BITS-1-(x%GMP_NUMB_BITS);
              MPFR_ASSERTD(p > d);
              DEBUG (printf ("(pre) x=%lu Kx=%ld Sx=%lu\n",
                             (unsigned long) x, (long) kx,
                             (unsigned long) sx));
              bbcp = (tp[kx] & (MPFR_LIMB_ONE<<sx)) ;
              /* Looks at the last bits of limb kx (If sx=0, does nothing)*/
              /* If Cp+1=0, since C'p+1!=0, C'p+2=1 ! */
              if (MPFR_LIKELY(bbcp==0 || (tp[kx]&MPFR_LIMB_MASK(sx))))
                bbcp1 = 1;
              else
                {
                  /*kx += (sx==0);*/ /*If sx==0, tp[kx] hasn't been checked*/
                  do {
                    kx--;
                  } while (kx>=0 && tp[kx]==0);
                  bbcp1 = (kx>=0);
                  DEBUG (printf ("(Pre) Scan done for %ld\n", (long) kx));
                }
            } /*End of Bcp1 != 0*/
          DEBUG( printf("(Pre) Cp+1=%d C'p+2=%d\n", bbcp!=0, bbcp1!=0) );
        } /* End of "can lose a bit" */

      /* Clean shifted C' */
      mask = ~MPFR_LIMB_MASK (sh);
      cp[0] &= mask;

      /* Subtract the mantissa c from b in a */
      ap = MPFR_MANT(a);
      mpn_sub_n (ap, bp, cp, n);
      DEBUG( mpfr_print_mant_binary("Sub=  ", ap, p) );

     /* Normalize: we lose at max one bit*/
      if (MPFR_UNLIKELY(MPFR_LIMB_MSB(ap[n-1]) == 0))
        {
          /* High bit is not set and we have to fix it! */
          /* Ap >= 010000xxx001 */
          mpn_lshift(ap, ap, n, 1);
          /* Ap >= 100000xxx010 */
          if (MPFR_UNLIKELY(bcp!=0)) /* Check if Cp = -1 */
            /* Since Cp == -1, we have to substract one more */
            {
              mpn_sub_1(ap, ap, n, MPFR_LIMB_ONE<<sh);
              MPFR_ASSERTD(MPFR_LIMB_MSB(ap[n-1]) != 0);
            }
          /* Ap >= 10000xxx001 */
          /* Final exponent -1 since we have shifted the mantissa */
          bx--;
          /* Update bcp and bcp1 */
          MPFR_ASSERTN(bbcp != (mp_limb_t) -1);
          MPFR_ASSERTN(bbcp1 != (mp_limb_t) -1);
          bcp  = bbcp;
          bcp1 = bbcp1;
          /* We dont't have anymore a valid Cp+1!
             But since Ap >= 100000xxx001, the final sub can't unnormalize!*/
        }
      MPFR_ASSERTD( !(ap[0] & ~mask) );

      /* Rounding */
      if (MPFR_LIKELY(rnd_mode == MPFR_RNDN))
        {
          if (MPFR_LIKELY(bcp==0))
            goto truncate;
          else if ((bcp1) || ((ap[0] & (MPFR_LIMB_ONE<<sh)) != 0))
            goto sub_one_ulp;
          else
            goto truncate;
        }

      /* Update rounding mode */
      MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(a));
      if (rnd_mode == MPFR_RNDZ && (MPFR_LIKELY(bcp || bcp1)))
        goto sub_one_ulp;
      goto truncate;
    }
  MPFR_RET_NEVER_GO_HERE ();

  /* Sub one ulp to the result */
 sub_one_ulp:
  mpn_sub_1 (ap, ap, n, MPFR_LIMB_ONE << sh);
  /* Result should be smaller than exact value: inexact=-1 */
  inexact = -1;
  /* Check normalisation */
  if (MPFR_UNLIKELY(MPFR_LIMB_MSB(ap[n-1]) == 0))
    {
      /* ap was a power of 2, and we lose a bit */
      /* Now it is 0111111111111111111[00000 */
      mpn_lshift(ap, ap, n, 1);
      bx--;
      /* And the lost bit x depends on Cp+1, and Cp */
      /* Compute Cp+1 if it isn't already compute (ie d==1) */
      /* FIXME: Is this case possible? */
      if (MPFR_UNLIKELY(d == 1))
        bbcp = 0;
      DEBUG( printf("(SubOneUlp)Cp=%d, Cp+1=%d C'p+1=%d\n", bcp!=0,bbcp!=0,bcp1!=0));
      /* Compute the last bit (Since we have shifted the mantissa)
         we need one more bit!*/
      MPFR_ASSERTN(bbcp != (mp_limb_t) -1);
      if ( (rnd_mode == MPFR_RNDZ && bcp==0)
           || (rnd_mode==MPFR_RNDN && bbcp==0)
           || (bcp && bcp1==0) ) /*Exact result*/
        {
          ap[0] |= MPFR_LIMB_ONE<<sh;
          if (rnd_mode == MPFR_RNDN)
            inexact = 1;
          DEBUG( printf("(SubOneUlp) Last bit set\n") );
        }
      /* Result could be exact if C'p+1 = 0 and rnd == Zero
         since we have had one more bit to the result */
      /* Fixme: rnd_mode == MPFR_RNDZ needed ? */
      if (bcp1==0 && rnd_mode==MPFR_RNDZ)
        {
          DEBUG( printf("(SubOneUlp) Exact result\n") );
          inexact = 0;
        }
    }

  goto end_of_sub;

 truncate:
  /* Check if the result is an exact power of 2: 100000000000
     in which cases, we could have to do sub_one_ulp due to some nasty reasons:
     If Result is a Power of 2:
      + If rnd = AWAY,
      |  If Cp=-1 and C'p+1 = 0, SubOneUlp and the result is EXACT.
         If Cp=-1 and C'p+1 =-1, SubOneUlp and the result is above.
         Otherwise truncate
      + If rnd = NEAREST,
         If Cp= 0 and Cp+1  =-1 and C'p+2=-1, SubOneUlp and the result is above
         If cp=-1 and C'p+1 = 0, SubOneUlp and the result is exact.
         Otherwise truncate.
      X bit should always be set if SubOneUlp*/
  if (MPFR_UNLIKELY(ap[n-1] == MPFR_LIMB_HIGHBIT))
    {
      mp_size_t k = n-1;
      do {
        k--;
      } while (k>=0 && ap[k]==0);
      if (MPFR_UNLIKELY(k<0))
        {
          /* It is a power of 2! */
          /* Compute Cp+1 if it isn't already compute (ie d==1) */
          /* FIXME: Is this case possible? */
          if (d == 1)
            bbcp=0;
          DEBUG( printf("(Truncate) Cp=%d, Cp+1=%d C'p+1=%d C'p+2=%d\n", \
                 bcp!=0, bbcp!=0, bcp1!=0, bbcp1!=0) );
          MPFR_ASSERTN(bbcp != (mp_limb_t) -1);
          MPFR_ASSERTN((rnd_mode != MPFR_RNDN) || (bcp != 0) || (bbcp == 0) || (bbcp1 != (mp_limb_t) -1));
          if (((rnd_mode != MPFR_RNDZ) && bcp)
              ||
              ((rnd_mode == MPFR_RNDN) && (bcp == 0) && (bbcp) && (bbcp1)))
            {
              DEBUG( printf("(Truncate) Do sub\n") );
              mpn_sub_1 (ap, ap, n, MPFR_LIMB_ONE << sh);
              mpn_lshift(ap, ap, n, 1);
              ap[0] |= MPFR_LIMB_ONE<<sh;
              bx--;
              /* FIXME: Explain why it works (or why not)... */
              inexact = (bcp1 == 0) ? 0 : (rnd_mode==MPFR_RNDN) ? -1 : 1;
              goto end_of_sub;
            }
        }
    }

  /* Calcul of Inexact flag.*/
  inexact = MPFR_LIKELY(bcp || bcp1) ? 1 : 0;

 end_of_sub:
  /* Update Expo */
  /* FIXME: Is this test really useful?
      If d==0      : Exact case. This is never called.
      if 1 < d < p : bx=MPFR_EXP(b) or MPFR_EXP(b)-1 > MPFR_EXP(c) > emin
      if d == 1    : bx=MPFR_EXP(b). If we could lose any bits, the exact
                     normalisation is called.
      if d >=  p   : bx=MPFR_EXP(b) >= MPFR_EXP(c) + p > emin
     After SubOneUlp, we could have one bit less.
      if 1 < d < p : bx >= MPFR_EXP(b)-2 >= MPFR_EXP(c) > emin
      if d == 1    : bx >= MPFR_EXP(b)-1 = MPFR_EXP(c) > emin.
      if d >=  p   : bx >= MPFR_EXP(b)-1 > emin since p>=2.
  */
  MPFR_ASSERTD( bx >= __gmpfr_emin);
  /*
    if (MPFR_UNLIKELY(bx < __gmpfr_emin))
    {
      DEBUG( printf("(Final Underflow)\n") );
      if (rnd_mode == MPFR_RNDN &&
          (bx < __gmpfr_emin - 1 ||
           (inexact >= 0 && mpfr_powerof2_raw (a))))
        rnd_mode = MPFR_RNDZ;
      MPFR_TMP_FREE(marker);
      return mpfr_underflow (a, rnd_mode, MPFR_SIGN(a));
    }
  */
  MPFR_SET_EXP (a, bx);

  MPFR_TMP_FREE(marker);
  MPFR_RET (inexact * MPFR_INT_SIGN (a));
}
Esempio n. 15
0
File: tgmpop.c Progetto: Canar/mpfr
static void
check_for_zero (void)
{
  /* Check that 0 is unsigned! */
  mpq_t q;
  mpz_t z;
  mpfr_t x;
  int r;
  mpfr_sign_t i;

  mpfr_init (x);
  mpz_init (z);
  mpq_init (q);

  mpz_set_ui (z, 0);
  mpq_set_ui (q, 0, 1);

  MPFR_SET_ZERO (x);
  RND_LOOP (r)
    {
      for (i = MPFR_SIGN_NEG ; i <= MPFR_SIGN_POS ;
           i+=MPFR_SIGN_POS-MPFR_SIGN_NEG)
        {
          MPFR_SET_SIGN(x, i);
          mpfr_add_z (x, x, z, (mpfr_rnd_t) r);
          if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i)
            {
              printf("GMP Zero errors for add_z & rnd=%s & s=%d\n",
                     mpfr_print_rnd_mode ((mpfr_rnd_t) r), i);
              mpfr_dump (x);
              exit (1);
            }
          mpfr_sub_z (x, x, z, (mpfr_rnd_t) r);
          if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i)
            {
              printf("GMP Zero errors for sub_z & rnd=%s & s=%d\n",
                     mpfr_print_rnd_mode ((mpfr_rnd_t) r), i);
              mpfr_dump (x);
              exit (1);
            }
          mpfr_mul_z (x, x, z, (mpfr_rnd_t) r);
          if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i)
            {
              printf("GMP Zero errors for mul_z & rnd=%s & s=%d\n",
                     mpfr_print_rnd_mode ((mpfr_rnd_t) r), i);
              mpfr_dump (x);
              exit (1);
            }
          mpfr_add_q (x, x, q, (mpfr_rnd_t) r);
          if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i)
            {
              printf("GMP Zero errors for add_q & rnd=%s & s=%d\n",
                     mpfr_print_rnd_mode ((mpfr_rnd_t) r), i);
              mpfr_dump (x);
              exit (1);
            }
          mpfr_sub_q (x, x, q, (mpfr_rnd_t) r);
          if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i)
            {
              printf("GMP Zero errors for sub_q & rnd=%s & s=%d\n",
                     mpfr_print_rnd_mode ((mpfr_rnd_t) r), i);
              mpfr_dump (x);
              exit (1);
             }
        }
    }

  mpq_clear (q);
  mpz_clear (z);
  mpfr_clear (x);
}
Esempio n. 16
0
int
mpfr_add (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t rnd_mode)
{
  MPFR_LOG_FUNC (("b[%#R]=%R c[%#R]=%R rnd=%d", b, b, c, c, rnd_mode),
                 ("a[%#R]=%R", a, a));

  if (MPFR_ARE_SINGULAR(b,c))
    {
      if (MPFR_IS_NAN(b) || MPFR_IS_NAN(c))
        {
          MPFR_SET_NAN(a);
          MPFR_RET_NAN;
        }
      /* neither b nor c is NaN here */
      else if (MPFR_IS_INF(b))
        {
          if (!MPFR_IS_INF(c) || MPFR_SIGN(b) == MPFR_SIGN(c))
            {
              MPFR_SET_INF(a);
              MPFR_SET_SAME_SIGN(a, b);
              MPFR_RET(0); /* exact */
            }
          else
            {
              MPFR_SET_NAN(a);
              MPFR_RET_NAN;
            }
        }
      else if (MPFR_IS_INF(c))
          {
            MPFR_SET_INF(a);
            MPFR_SET_SAME_SIGN(a, c);
            MPFR_RET(0); /* exact */
          }
      /* now either b or c is zero */
      else if (MPFR_IS_ZERO(b))
        {
          if (MPFR_IS_ZERO(c))
            {
              /* for round away, we take the same convention for 0 + 0
                 as for round to zero or to nearest: it always gives +0,
                 except (-0) + (-0) = -0. */
              MPFR_SET_SIGN(a,
                            (rnd_mode != MPFR_RNDD ?
                             ((MPFR_IS_NEG(b) && MPFR_IS_NEG(c)) ? -1 : 1) :
                             ((MPFR_IS_POS(b) && MPFR_IS_POS(c)) ? 1 : -1)));
              MPFR_SET_ZERO(a);
              MPFR_RET(0); /* 0 + 0 is exact */
            }
          return mpfr_set (a, c, rnd_mode);
        }
      else
        {
          MPFR_ASSERTD(MPFR_IS_ZERO(c));
          return mpfr_set (a, b, rnd_mode);
        }
    }

  MPFR_ASSERTD(MPFR_IS_PURE_FP(b) && MPFR_IS_PURE_FP(c));

  if (MPFR_UNLIKELY(MPFR_SIGN(b) != MPFR_SIGN(c)))
    { /* signs differ, it's a subtraction */
      if (MPFR_LIKELY(MPFR_PREC(a) == MPFR_PREC(b)
                      && MPFR_PREC(b) == MPFR_PREC(c)))
        return mpfr_sub1sp(a,b,c,rnd_mode);
      else
        return mpfr_sub1(a, b, c, rnd_mode);
    }
  else
    { /* signs are equal, it's an addition */
      if (MPFR_LIKELY(MPFR_PREC(a) == MPFR_PREC(b)
                      && MPFR_PREC(b) == MPFR_PREC(c)))
        if (MPFR_GET_EXP(b) < MPFR_GET_EXP(c))
          return mpfr_add1sp(a, c, b, rnd_mode);
        else
          return mpfr_add1sp(a, b, c, rnd_mode);
      else
        if (MPFR_GET_EXP(b) < MPFR_GET_EXP(c))
          return mpfr_add1(a, c, b, rnd_mode);
        else
          return mpfr_add1(a, b, c, rnd_mode);
    }
}
Esempio n. 17
0
File: mul.c Progetto: gnooth/xcl
int
mpfr_mul (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t rnd_mode)
{
    int sign, inexact;
    mpfr_exp_t ax, ax2;
    mp_limb_t *tmp;
    mp_limb_t b1;
    mpfr_prec_t bq, cq;
    mp_size_t bn, cn, tn, k;
    MPFR_TMP_DECL (marker);

    MPFR_LOG_FUNC (("b[%#R]=%R c[%#R]=%R rnd=%d", b, b, c, c, rnd_mode),
                   ("a[%#R]=%R inexact=%d", a, a, inexact));

    /* deal with special cases */
    if (MPFR_ARE_SINGULAR (b, c))
    {
        if (MPFR_IS_NAN (b) || MPFR_IS_NAN (c))
        {
            MPFR_SET_NAN (a);
            MPFR_RET_NAN;
        }
        sign = MPFR_MULT_SIGN (MPFR_SIGN (b), MPFR_SIGN (c));
        if (MPFR_IS_INF (b))
        {
            if (!MPFR_IS_ZERO (c))
            {
                MPFR_SET_SIGN (a, sign);
                MPFR_SET_INF (a);
                MPFR_RET (0);
            }
            else
            {
                MPFR_SET_NAN (a);
                MPFR_RET_NAN;
            }
        }
        else if (MPFR_IS_INF (c))
        {
            if (!MPFR_IS_ZERO (b))
            {
                MPFR_SET_SIGN (a, sign);
                MPFR_SET_INF (a);
                MPFR_RET(0);
            }
            else
            {
                MPFR_SET_NAN (a);
                MPFR_RET_NAN;
            }
        }
        else
        {
            MPFR_ASSERTD (MPFR_IS_ZERO(b) || MPFR_IS_ZERO(c));
            MPFR_SET_SIGN (a, sign);
            MPFR_SET_ZERO (a);
            MPFR_RET (0);
        }
    }
    sign = MPFR_MULT_SIGN (MPFR_SIGN (b), MPFR_SIGN (c));

    ax = MPFR_GET_EXP (b) + MPFR_GET_EXP (c);
    /* Note: the exponent of the exact result will be e = bx + cx + ec with
       ec in {-1,0,1} and the following assumes that e is representable. */

    /* FIXME: Useful since we do an exponent check after ?
     * It is useful iff the precision is big, there is an overflow
     * and we are doing further mults...*/
#ifdef HUGE
    if (MPFR_UNLIKELY (ax > __gmpfr_emax + 1))
        return mpfr_overflow (a, rnd_mode, sign);
    if (MPFR_UNLIKELY (ax < __gmpfr_emin - 2))
        return mpfr_underflow (a, rnd_mode == MPFR_RNDN ? MPFR_RNDZ : rnd_mode,
                               sign);
#endif

    bq = MPFR_PREC (b);
    cq = MPFR_PREC (c);

    MPFR_ASSERTD (bq+cq > bq); /* PREC_MAX is /2 so no integer overflow */

    bn = (bq+GMP_NUMB_BITS-1)/GMP_NUMB_BITS; /* number of limbs of b */
    cn = (cq+GMP_NUMB_BITS-1)/GMP_NUMB_BITS; /* number of limbs of c */
    k = bn + cn; /* effective nb of limbs used by b*c (= tn or tn+1) below */
    tn = (bq + cq + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS;
    MPFR_ASSERTD (tn <= k); /* tn <= k, thus no int overflow */

    /* Check for no size_t overflow*/
    MPFR_ASSERTD ((size_t) k <= ((size_t) -1) / BYTES_PER_MP_LIMB);
    MPFR_TMP_MARK (marker);
    tmp = (mp_limb_t *) MPFR_TMP_ALLOC ((size_t) k * BYTES_PER_MP_LIMB);

    /* multiplies two mantissa in temporary allocated space */
    if (MPFR_UNLIKELY (bn < cn))
    {
        mpfr_srcptr z = b;
        mp_size_t zn  = bn;
        b = c;
        bn = cn;
        c = z;
        cn = zn;
    }
    MPFR_ASSERTD (bn >= cn);
    if (MPFR_LIKELY (bn <= 2))
    {
        if (bn == 1)
        {
            /* 1 limb * 1 limb */
            umul_ppmm (tmp[1], tmp[0], MPFR_MANT (b)[0], MPFR_MANT (c)[0]);
            b1 = tmp[1];
        }
        else if (MPFR_UNLIKELY (cn == 1))
        {
            /* 2 limbs * 1 limb */
            mp_limb_t t;
            umul_ppmm (tmp[1], tmp[0], MPFR_MANT (b)[0], MPFR_MANT (c)[0]);
            umul_ppmm (tmp[2], t, MPFR_MANT (b)[1], MPFR_MANT (c)[0]);
            add_ssaaaa (tmp[2], tmp[1], tmp[2], tmp[1], 0, t);
            b1 = tmp[2];
        }
        else
        {
            /* 2 limbs * 2 limbs */
            mp_limb_t t1, t2, t3;
            /* First 2 limbs * 1 limb */
            umul_ppmm (tmp[1], tmp[0], MPFR_MANT (b)[0], MPFR_MANT (c)[0]);
            umul_ppmm (tmp[2], t1, MPFR_MANT (b)[1], MPFR_MANT (c)[0]);
            add_ssaaaa (tmp[2], tmp[1], tmp[2], tmp[1], 0, t1);
            /* Second, the other 2 limbs * 1 limb product */
            umul_ppmm (t1, t2, MPFR_MANT (b)[0], MPFR_MANT (c)[1]);
            umul_ppmm (tmp[3], t3, MPFR_MANT (b)[1], MPFR_MANT (c)[1]);
            add_ssaaaa (tmp[3], t1, tmp[3], t1, 0, t3);
            /* Sum those two partial products */
            add_ssaaaa (tmp[2], tmp[1], tmp[2], tmp[1], t1, t2);
            tmp[3] += (tmp[2] < t1);
            b1 = tmp[3];
        }
        b1 >>= (GMP_NUMB_BITS - 1);
        tmp += k - tn;
        if (MPFR_UNLIKELY (b1 == 0))
            mpn_lshift (tmp, tmp, tn, 1); /* tn <= k, so no stack corruption */
    }
    else
        /* Mulders' mulhigh. Disable if squaring, since it is not tuned for
           such a case */
        if (MPFR_UNLIKELY (bn > MPFR_MUL_THRESHOLD && b != c))
Esempio n. 18
0
int
mpfr_rint (mpfr_ptr r, mpfr_srcptr u, mpfr_rnd_t rnd_mode)
{
  int sign;
  int rnd_away;
  mpfr_exp_t exp;

  if (MPFR_UNLIKELY( MPFR_IS_SINGULAR(u) ))
    {
      if (MPFR_IS_NAN(u))
        {
          MPFR_SET_NAN(r);
          MPFR_RET_NAN;
        }
      MPFR_SET_SAME_SIGN(r, u);
      if (MPFR_IS_INF(u))
        {
          MPFR_SET_INF(r);
          MPFR_RET(0);  /* infinity is exact */
        }
      else /* now u is zero */
        {
          MPFR_ASSERTD(MPFR_IS_ZERO(u));
          MPFR_SET_ZERO(r);
          MPFR_RET(0);  /* zero is exact */
        }
    }
  MPFR_SET_SAME_SIGN (r, u); /* Does nothing if r==u */

  sign = MPFR_INT_SIGN (u);
  exp = MPFR_GET_EXP (u);

  rnd_away =
    rnd_mode == MPFR_RNDD ? sign < 0 :
    rnd_mode == MPFR_RNDU ? sign > 0 :
    rnd_mode == MPFR_RNDZ ? 0        :
    rnd_mode == MPFR_RNDA ? 1        :
    -1; /* round to nearest-even (RNDN) or nearest-away (RNDNA) */

  /* rnd_away:
     1 if round away from zero,
     0 if round to zero,
     -1 if not decided yet.
   */

  if (MPFR_UNLIKELY (exp <= 0))  /* 0 < |u| < 1 ==> round |u| to 0 or 1 */
    {
      /* Note: in the MPFR_RNDN mode, 0.5 must be rounded to 0. */
      if (rnd_away != 0 &&
          (rnd_away > 0 ||
           (exp == 0 && (rnd_mode == MPFR_RNDNA ||
                         !mpfr_powerof2_raw (u)))))
        {
          mp_limb_t *rp;
          mp_size_t rm;

          rp = MPFR_MANT(r);
          rm = (MPFR_PREC(r) - 1) / GMP_NUMB_BITS;
          rp[rm] = MPFR_LIMB_HIGHBIT;
          MPN_ZERO(rp, rm);
          MPFR_SET_EXP (r, 1);  /* |r| = 1 */
          MPFR_RET(sign > 0 ? 2 : -2);
        }
      else
        {
          MPFR_SET_ZERO(r);  /* r = 0 */
          MPFR_RET(sign > 0 ? -2 : 2);
        }
    }
  else  /* exp > 0, |u| >= 1 */
    {
      mp_limb_t *up, *rp;
      mp_size_t un, rn, ui;
      int sh, idiff;
      int uflags;

      /*
       * uflags will contain:
       *   _ 0 if u is an integer representable in r,
       *   _ 1 if u is an integer not representable in r,
       *   _ 2 if u is not an integer.
       */

      up = MPFR_MANT(u);
      rp = MPFR_MANT(r);

      un = MPFR_LIMB_SIZE(u);
      rn = MPFR_LIMB_SIZE(r);
      MPFR_UNSIGNED_MINUS_MODULO (sh, MPFR_PREC (r));

      MPFR_SET_EXP (r, exp); /* Does nothing if r==u */

      if ((exp - 1) / GMP_NUMB_BITS >= un)
        {
          ui = un;
          idiff = 0;
          uflags = 0;  /* u is an integer, representable or not in r */
        }
      else
        {
          mp_size_t uj;

          ui = (exp - 1) / GMP_NUMB_BITS + 1;  /* #limbs of the int part */
          MPFR_ASSERTD (un >= ui);
          uj = un - ui;  /* lowest limb of the integer part */
          idiff = exp % GMP_NUMB_BITS;  /* #int-part bits in up[uj] or 0 */

          uflags = idiff == 0 || (up[uj] << idiff) == 0 ? 0 : 2;
          if (uflags == 0)
            while (uj > 0)
              if (up[--uj] != 0)
                {
                  uflags = 2;
                  break;
                }
        }

      if (ui > rn)
        {
          /* More limbs in the integer part of u than in r.
             Just round u with the precision of r. */
          MPFR_ASSERTD (rp != up && un > rn);
          MPN_COPY (rp, up + (un - rn), rn); /* r != u */
          if (rnd_away < 0)
            {
              /* This is a rounding to nearest mode (MPFR_RNDN or MPFR_RNDNA).
                 Decide the rounding direction here. */
              if (rnd_mode == MPFR_RNDN &&
                  (rp[0] & (MPFR_LIMB_ONE << sh)) == 0)
                { /* halfway cases rounded toward zero */
                  mp_limb_t a, b;
                  /* a: rounding bit and some of the following bits */
                  /* b: boundary for a (weight of the rounding bit in a) */
                  if (sh != 0)
                    {
                      a = rp[0] & ((MPFR_LIMB_ONE << sh) - 1);
                      b = MPFR_LIMB_ONE << (sh - 1);
                    }
                  else
                    {
                      a = up[un - rn - 1];
                      b = MPFR_LIMB_HIGHBIT;
                    }
                  rnd_away = a > b;
                  if (a == b)
                    {
                      mp_size_t i;
                      for (i = un - rn - 1 - (sh == 0); i >= 0; i--)
                        if (up[i] != 0)
                          {
                            rnd_away = 1;
                            break;
                          }
                    }
                }
              else  /* halfway cases rounded away from zero */
                rnd_away =  /* rounding bit */
                  ((sh != 0 && (rp[0] & (MPFR_LIMB_ONE << (sh - 1))) != 0) ||
                   (sh == 0 && (up[un - rn - 1] & MPFR_LIMB_HIGHBIT) != 0));
            }
          if (uflags == 0)
            { /* u is an integer; determine if it is representable in r */
              if (sh != 0 && rp[0] << (GMP_NUMB_BITS - sh) != 0)
                uflags = 1;  /* u is not representable in r */
              else
                {
                  mp_size_t i;
                  for (i = un - rn - 1; i >= 0; i--)
                    if (up[i] != 0)
                      {
                        uflags = 1;  /* u is not representable in r */
                        break;
                      }
                }
            }
        }
      else  /* ui <= rn */
        {
          mp_size_t uj, rj;
          int ush;

          uj = un - ui;  /* lowest limb of the integer part in u */
          rj = rn - ui;  /* lowest limb of the integer part in r */

          if (MPFR_LIKELY (rp != up))
            MPN_COPY(rp + rj, up + uj, ui);

          /* Ignore the lowest rj limbs, all equal to zero. */
          rp += rj;
          rn = ui;

          /* number of fractional bits in whole rp[0] */
          ush = idiff == 0 ? 0 : GMP_NUMB_BITS - idiff;

          if (rj == 0 && ush < sh)
            {
              /* If u is an integer (uflags == 0), we need to determine
                 if it is representable in r, i.e. if its sh - ush bits
                 in the non-significant part of r are all 0. */
              if (uflags == 0 && (rp[0] & ((MPFR_LIMB_ONE << sh) -
                                           (MPFR_LIMB_ONE << ush))) != 0)
                uflags = 1;  /* u is an integer not representable in r */
            }
          else  /* The integer part of u fits in r, we'll round to it. */
            sh = ush;

          if (rnd_away < 0)
            {
              /* This is a rounding to nearest mode.
                 Decide the rounding direction here. */
              if (uj == 0 && sh == 0)
                rnd_away = 0; /* rounding bit = 0 (not represented in u) */
              else if (rnd_mode == MPFR_RNDN &&
                       (rp[0] & (MPFR_LIMB_ONE << sh)) == 0)
                { /* halfway cases rounded toward zero */
                  mp_limb_t a, b;
                  /* a: rounding bit and some of the following bits */
                  /* b: boundary for a (weight of the rounding bit in a) */
                  if (sh != 0)
                    {
                      a = rp[0] & ((MPFR_LIMB_ONE << sh) - 1);
                      b = MPFR_LIMB_ONE << (sh - 1);
                    }
                  else
                    {
                      MPFR_ASSERTD (uj >= 1);  /* see above */
                      a = up[uj - 1];
                      b = MPFR_LIMB_HIGHBIT;
                    }
                  rnd_away = a > b;
                  if (a == b)
                    {
                      mp_size_t i;
                      for (i = uj - 1 - (sh == 0); i >= 0; i--)
                        if (up[i] != 0)
                          {
                            rnd_away = 1;
                            break;
                          }
                    }
                }
              else  /* halfway cases rounded away from zero */
                rnd_away =  /* rounding bit */
                  ((sh != 0 && (rp[0] & (MPFR_LIMB_ONE << (sh - 1))) != 0) ||
                   (sh == 0 && (MPFR_ASSERTD (uj >= 1),
                                up[uj - 1] & MPFR_LIMB_HIGHBIT) != 0));
            }
          /* Now we can make the low rj limbs to 0 */
          MPN_ZERO (rp-rj, rj);
        }

      if (sh != 0)
        rp[0] &= MP_LIMB_T_MAX << sh;

      /* If u is a representable integer, there is no rounding. */
      if (uflags == 0)
        MPFR_RET(0);

      MPFR_ASSERTD (rnd_away >= 0);  /* rounding direction is defined */
      if (rnd_away && mpn_add_1(rp, rp, rn, MPFR_LIMB_ONE << sh))
        {
          if (exp == __gmpfr_emax)
            return mpfr_overflow(r, rnd_mode, MPFR_SIGN(r)) >= 0 ?
              uflags : -uflags;
          else
            {
              MPFR_SET_EXP(r, exp + 1);
              rp[rn-1] = MPFR_LIMB_HIGHBIT;
            }
        }

      MPFR_RET (rnd_away ^ (sign < 0) ? uflags : -uflags);
    }  /* exp > 0, |u| >= 1 */
}
Esempio n. 19
0
int
mpfr_sinh_cosh (mpfr_ptr sh, mpfr_ptr ch, mpfr_srcptr xt, mpfr_rnd_t rnd_mode)
{
    mpfr_t x;
    int inexact_sh, inexact_ch;

    MPFR_ASSERTN (sh != ch);

    MPFR_LOG_FUNC
    (("x[%Pu]=%.*Rg rnd=%d",
      mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
     ("sh[%Pu]=%.*Rg ch[%Pu]=%.*Rg",
      mpfr_get_prec (sh), mpfr_log_prec, sh,
      mpfr_get_prec (ch), mpfr_log_prec, ch));

    if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
    {
        if (MPFR_IS_NAN (xt))
        {
            MPFR_SET_NAN (ch);
            MPFR_SET_NAN (sh);
            MPFR_RET_NAN;
        }
        else if (MPFR_IS_INF (xt))
        {
            MPFR_SET_INF (sh);
            MPFR_SET_SAME_SIGN (sh, xt);
            MPFR_SET_INF (ch);
            MPFR_SET_POS (ch);
            MPFR_RET (0);
        }
        else /* xt is zero */
        {
            MPFR_ASSERTD (MPFR_IS_ZERO (xt));
            MPFR_SET_ZERO (sh);                   /* sinh(0) = 0 */
            MPFR_SET_SAME_SIGN (sh, xt);
            inexact_sh = 0;
            inexact_ch = mpfr_set_ui (ch, 1, rnd_mode); /* cosh(0) = 1 */
            return INEX(inexact_sh,inexact_ch);
        }
    }

    /* Warning: if we use MPFR_FAST_COMPUTE_IF_SMALL_INPUT here, make sure
       that the code also works in case of overlap (see sin_cos.c) */

    MPFR_TMP_INIT_ABS (x, xt);

    {
        mpfr_t s, c, ti;
        mpfr_exp_t d;
        mpfr_prec_t N;    /* Precision of the intermediary variables */
        long int err;    /* Precision of error */
        MPFR_ZIV_DECL (loop);
        MPFR_SAVE_EXPO_DECL (expo);
        MPFR_GROUP_DECL (group);

        MPFR_SAVE_EXPO_MARK (expo);

        /* compute the precision of intermediary variable */
        N = MPFR_PREC (ch);
        N = MAX (N, MPFR_PREC (sh));
        /* the optimal number of bits : see algorithms.ps */
        N = N + MPFR_INT_CEIL_LOG2 (N) + 4;

        /* initialise of intermediary variables */
        MPFR_GROUP_INIT_3 (group, N, s, c, ti);

        /* First computation of sinh_cosh */
        MPFR_ZIV_INIT (loop, N);
        for (;;)
        {
            MPFR_BLOCK_DECL (flags);

            /* compute sinh_cosh */
            MPFR_BLOCK (flags, mpfr_exp (s, x, MPFR_RNDD));
            if (MPFR_OVERFLOW (flags))
                /* exp(x) does overflow */
            {
                /* since cosh(x) >= exp(x), cosh(x) overflows too */
                inexact_ch = mpfr_overflow (ch, rnd_mode, MPFR_SIGN_POS);
                /* sinh(x) may be representable */
                inexact_sh = mpfr_sinh (sh, xt, rnd_mode);
                MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
                break;
            }
            d = MPFR_GET_EXP (s);
            mpfr_ui_div (ti, 1, s, MPFR_RNDU);  /* 1/exp(x) */
            mpfr_add (c, s, ti, MPFR_RNDU);     /* exp(x) + 1/exp(x) */
            mpfr_sub (s, s, ti, MPFR_RNDN);     /* exp(x) - 1/exp(x) */
            mpfr_div_2ui (c, c, 1, MPFR_RNDN);  /* 1/2(exp(x) + 1/exp(x)) */
            mpfr_div_2ui (s, s, 1, MPFR_RNDN);  /* 1/2(exp(x) - 1/exp(x)) */

            /* it may be that s is zero (in fact, it can only occur when exp(x)=1,
               and thus ti=1 too) */
            if (MPFR_IS_ZERO (s))
                err = N; /* double the precision */
            else
            {
                /* calculation of the error */
                d = d - MPFR_GET_EXP (s) + 2;
                /* error estimate: err = N-(__gmpfr_ceil_log2(1+pow(2,d)));*/
                err = N - (MAX (d, 0) + 1);
                if (MPFR_LIKELY (MPFR_CAN_ROUND (s, err, MPFR_PREC (sh),
                                                 rnd_mode) &&               \
                                 MPFR_CAN_ROUND (c, err, MPFR_PREC (ch),
                                                 rnd_mode)))
                {
                    inexact_sh = mpfr_set4 (sh, s, rnd_mode, MPFR_SIGN (xt));
                    inexact_ch = mpfr_set (ch, c, rnd_mode);
                    break;
                }
            }
            /* actualisation of the precision */
            N += err;
            MPFR_ZIV_NEXT (loop, N);
            MPFR_GROUP_REPREC_3 (group, N, s, c, ti);
        }
        MPFR_ZIV_FREE (loop);
        MPFR_GROUP_CLEAR (group);
        MPFR_SAVE_EXPO_FREE (expo);
    }

    /* now, let's raise the flags if needed */
    inexact_sh = mpfr_check_range (sh, inexact_sh, rnd_mode);
    inexact_ch = mpfr_check_range (ch, inexact_ch, rnd_mode);

    return INEX(inexact_sh,inexact_ch);
}
Esempio n. 20
0
static void
special (void)
{
  mpfr_t x, y;
  int i;

  mpfr_init (x);
  mpfr_init (y);

  mpfr_set_nan (x);
  test_expm1 (y, x, MPFR_RNDN);
  if (!mpfr_nan_p (y))
    {
      printf ("Error for expm1(NaN)\n");
      exit (1);
    }

  mpfr_set_inf (x, 1);
  test_expm1 (y, x, MPFR_RNDN);
  if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
    {
      printf ("Error for expm1(+Inf)\n");
      exit (1);
    }

  mpfr_set_inf (x, -1);
  test_expm1 (y, x, MPFR_RNDN);
  if (mpfr_cmp_si (y, -1))
    {
      printf ("Error for expm1(-Inf)\n");
      exit (1);
    }

  mpfr_set_ui (x, 0, MPFR_RNDN);
  test_expm1 (y, x, MPFR_RNDN);
  if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0)
    {
      printf ("Error for expm1(+0)\n");
      exit (1);
    }

  mpfr_neg (x, x, MPFR_RNDN);
  test_expm1 (y, x, MPFR_RNDN);
  if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) > 0)
    {
      printf ("Error for expm1(-0)\n");
      exit (1);
    }

  /* Check overflow of expm1(x) */
  mpfr_clear_flags ();
  mpfr_set_str_binary (x, "1.1E1000000000");
  i = test_expm1 (x, x, MPFR_RNDN);
  MPFR_ASSERTN (MPFR_IS_INF (x) && MPFR_SIGN (x) > 0);
  MPFR_ASSERTN (mpfr_overflow_p ());
  MPFR_ASSERTN (i == 1);

  mpfr_clear_flags ();
  mpfr_set_str_binary (x, "1.1E1000000000");
  i = test_expm1 (x, x, MPFR_RNDU);
  MPFR_ASSERTN (MPFR_IS_INF (x) && MPFR_SIGN (x) > 0);
  MPFR_ASSERTN (mpfr_overflow_p ());
  MPFR_ASSERTN (i == 1);

  mpfr_clear_flags ();
  mpfr_set_str_binary (x, "1.1E1000000000");
  i = test_expm1 (x, x, MPFR_RNDD);
  MPFR_ASSERTN (!MPFR_IS_INF (x) && MPFR_SIGN (x) > 0);
  MPFR_ASSERTN (mpfr_overflow_p ());
  MPFR_ASSERTN (i == -1);

  /* Check internal underflow of expm1 (x) */
  mpfr_set_prec (x, 2);
  mpfr_clear_flags ();
  mpfr_set_str_binary (x, "-1.1E1000000000");
  i = test_expm1 (x, x, MPFR_RNDN);
  MPFR_ASSERTN (mpfr_cmp_si (x, -1) == 0);
  MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ());
  MPFR_ASSERTN (i == -1);

  mpfr_set_str_binary (x, "-1.1E1000000000");
  i = test_expm1 (x, x, MPFR_RNDD);
  MPFR_ASSERTN (mpfr_cmp_si (x, -1) == 0);
  MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ());
  MPFR_ASSERTN (i == -1);

  mpfr_set_str_binary (x, "-1.1E1000000000");
  i = test_expm1 (x, x, MPFR_RNDZ);
  MPFR_ASSERTN (mpfr_cmp_str (x, "-0.11", 2, MPFR_RNDN) == 0);
  MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ());
  MPFR_ASSERTN (i == 1);

  mpfr_set_str_binary (x, "-1.1E1000000000");
  i = test_expm1 (x, x, MPFR_RNDU);
  MPFR_ASSERTN (mpfr_cmp_str (x, "-0.11", 2, MPFR_RNDN) == 0);
  MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ());
  MPFR_ASSERTN (i == 1);

  mpfr_clear (x);
  mpfr_clear (y);
}
Esempio n. 21
0
/* Usage: tzeta - generic tests
          tzeta s prec rnd_mode - compute zeta(s) with precision 'prec'
                                  and rounding mode 'mode' */
int
main (int argc, char *argv[])
{
  mpfr_t s, y, z;
  mpfr_prec_t prec;
  mpfr_rnd_t rnd_mode;
  int inex;

  tests_start_mpfr ();

  if (argc != 1 && argc != 4)
    {
      printf ("Usage: tzeta\n"
              "    or tzeta s prec rnd_mode\n");
      exit (1);
    }

  if (argc == 4)
    {
      prec = atoi(argv[2]);
      mpfr_init2 (s, prec);
      mpfr_init2 (z, prec);
      mpfr_set_str (s, argv[1], 10, MPFR_RNDN);
      rnd_mode = (mpfr_rnd_t) atoi(argv[3]);

      mpfr_zeta (z, s, rnd_mode);
      mpfr_out_str (stdout, 10, 0, z, MPFR_RNDN);
      printf ("\n");

      mpfr_clear (s);
      mpfr_clear (z);

      return 0;
    }

  test1();

  mpfr_init2 (s, MPFR_PREC_MIN);
  mpfr_init2 (y, MPFR_PREC_MIN);
  mpfr_init2 (z, MPFR_PREC_MIN);


  /* the following seems to loop */
  mpfr_set_prec (s, 6);
  mpfr_set_prec (z, 6);
  mpfr_set_str_binary (s, "1.10010e4");
  mpfr_zeta (z, s, MPFR_RNDZ);


  mpfr_set_prec (s, 53);
  mpfr_set_prec (y, 53);
  mpfr_set_prec (z, 53);

  mpfr_set_ui (s, 1, MPFR_RNDN);
  mpfr_clear_divby0();
  mpfr_zeta (z, s, MPFR_RNDN);
  if (!mpfr_inf_p (z) || MPFR_SIGN (z) < 0 || !mpfr_divby0_p())
    {
      printf ("Error in mpfr_zeta for s = 1 (should be +inf) with divby0 flag\n");
      exit (1);
    }

  mpfr_set_str_binary (s, "0.1100011101110111111111111010000110010111001011001011");
  mpfr_set_str_binary (y, "-0.11111101111011001001001111111000101010000100000100100E2");
  mpfr_zeta (z, s, MPFR_RNDN);
  if (mpfr_cmp (z, y) != 0)
    {
      printf ("Error in mpfr_zeta (1,RNDN)\n");
      exit (1);
    }
  mpfr_zeta (z, s, MPFR_RNDZ);
  if (mpfr_cmp (z, y) != 0)
    {
      printf ("Error in mpfr_zeta (1,RNDZ)\n");
      exit (1);
    }
  mpfr_zeta (z, s, MPFR_RNDU);
  if (mpfr_cmp (z, y) != 0)
    {
      printf ("Error in mpfr_zeta (1,RNDU)\n");
      exit (1);
    }
  mpfr_zeta (z, s, MPFR_RNDD);
  mpfr_nexttoinf (y);
  if (mpfr_cmp (z, y) != 0)
    {
      printf ("Error in mpfr_zeta (1,RNDD)\n");
      exit (1);
    }

  mpfr_set_str_binary (s, "0.10001011010011100110010001100100001011000010011001011");
  mpfr_set_str_binary (y, "-0.11010011010010101101110111011010011101111101111010110E1");
  mpfr_zeta (z, s, MPFR_RNDN);
  if (mpfr_cmp (z, y) != 0)
    {
      printf ("Error in mpfr_zeta (2,RNDN)\n");
      exit (1);
    }
  mpfr_zeta (z, s, MPFR_RNDZ);
  if (mpfr_cmp (z, y) != 0)
    {
      printf ("Error in mpfr_zeta (2,RNDZ)\n");
      exit (1);
    }
  mpfr_zeta (z, s, MPFR_RNDU);
  if (mpfr_cmp (z, y) != 0)
    {
      printf ("Error in mpfr_zeta (2,RNDU)\n");
      exit (1);
    }
  mpfr_zeta (z, s, MPFR_RNDD);
  mpfr_nexttoinf (y);
  if (mpfr_cmp (z, y) != 0)
    {
      printf ("Error in mpfr_zeta (2,RNDD)\n");
      exit (1);
    }

  mpfr_set_str_binary (s, "0.1100111110100001111110111000110101111001011101000101");
  mpfr_set_str_binary (y, "-0.10010111010110000111011111001101100001111011000001010E3");
  mpfr_zeta (z, s, MPFR_RNDN);
  if (mpfr_cmp (z, y) != 0)
    {
      printf ("Error in mpfr_zeta (3,RNDN)\n");
      exit (1);
    }
  mpfr_zeta (z, s, MPFR_RNDD);
  if (mpfr_cmp (z, y) != 0)
    {
      printf ("Error in mpfr_zeta (3,RNDD)\n");
      exit (1);
    }
  mpfr_nexttozero (y);
  mpfr_zeta (z, s, MPFR_RNDZ);
  if (mpfr_cmp (z, y) != 0)
    {
      printf ("Error in mpfr_zeta (3,RNDZ)\n");
      exit (1);
    }
  mpfr_zeta (z, s, MPFR_RNDU);
  if (mpfr_cmp (z, y) != 0)
    {
      printf ("Error in mpfr_zeta (3,RNDU)\n");
      exit (1);
    }

  mpfr_set_str (s, "-400000001", 10, MPFR_RNDZ);
  mpfr_zeta (z, s, MPFR_RNDN);
  if (!(mpfr_inf_p (z) && MPFR_SIGN(z) < 0))
    {
      printf ("Error in mpfr_zeta (-400000001)\n");
      exit (1);
    }
  mpfr_set_str (s, "-400000003", 10, MPFR_RNDZ);
  mpfr_zeta (z, s, MPFR_RNDN);
  if (!(mpfr_inf_p (z) && MPFR_SIGN(z) > 0))
    {
      printf ("Error in mpfr_zeta (-400000003)\n");
      exit (1);
    }

  mpfr_set_prec (s, 34);
  mpfr_set_prec (z, 34);
  mpfr_set_str_binary (s, "-1.111111100001011110000010001010000e-35");
  mpfr_zeta (z, s, MPFR_RNDD);
  mpfr_set_str_binary (s, "-1.111111111111111111111111111111111e-2");
  if (mpfr_cmp (s, z))
    {
      printf ("Error in mpfr_zeta, prec=34, MPFR_RNDD\n");
      mpfr_dump (z);
      exit (1);
    }

  /* bug found by nightly tests on June 7, 2007 */
  mpfr_set_prec (s, 23);
  mpfr_set_prec (z, 25);
  mpfr_set_str_binary (s, "-1.0110110110001000000000e-27");
  mpfr_zeta (z, s, MPFR_RNDN);
  mpfr_set_prec (s, 25);
  mpfr_set_str_binary (s, "-1.111111111111111111111111e-2");
  if (mpfr_cmp (s, z))
    {
      printf ("Error in mpfr_zeta, prec=25, MPFR_RNDN\n");
      printf ("expected "); mpfr_dump (s);
      printf ("got      "); mpfr_dump (z);
      exit (1);
    }

  /* bug reported by Kevin Rauch on 26 Oct 2007 */
  mpfr_set_prec (s, 128);
  mpfr_set_prec (z, 128);
  mpfr_set_str_binary (s, "-0.1000000000000000000000000000000000000000000000000000000000000001E64");
  inex = mpfr_zeta (z, s, MPFR_RNDN);
  MPFR_ASSERTN (mpfr_inf_p (z) && MPFR_SIGN (z) < 0 && inex < 0);
  inex = mpfr_zeta (z, s, MPFR_RNDU);
  mpfr_set_inf (s, -1);
  mpfr_nextabove (s);
  MPFR_ASSERTN (mpfr_equal_p (z, s) && inex > 0);

  mpfr_clear (s);
  mpfr_clear (y);
  mpfr_clear (z);

  test_generic (2, 70, 5);
  test2 ();

  tests_end_mpfr ();
  return 0;
}
Esempio n. 22
0
static void
particular_cases (void)
{
    mpfr_t t[11], r;
    static const char *name[11] = {
        "NaN", "+inf", "-inf", "+0", "-0", "+1", "-1", "+2", "-2", "+0.5", "-0.5"
    };
    int i, j;
    int error = 0;

    for (i = 0; i < 11; i++)
        mpfr_init2 (t[i], 2);
    mpfr_init2 (r, 6);

    mpfr_set_nan (t[0]);
    mpfr_set_inf (t[1], 1);
    mpfr_set_ui (t[3], 0, GMP_RNDN);
    mpfr_set_ui (t[5], 1, GMP_RNDN);
    mpfr_set_ui (t[7], 2, GMP_RNDN);
    mpfr_div_2ui (t[9], t[5], 1, GMP_RNDN);
    for (i = 1; i < 11; i += 2)
        mpfr_neg (t[i+1], t[i], GMP_RNDN);

    for (i = 0; i < 11; i++)
        for (j = 0; j < 11; j++)
        {
            double d;
            int p;
            static int q[11][11] = {
                /*          NaN +inf -inf  +0   -0   +1   -1   +2   -2  +0.5 -0.5 */
                /*  NaN */ { 0,   0,   0,  128, 128,  0,   0,   0,   0,   0,   0  },
                /* +inf */ { 0,   1,   2,  128, 128,  1,   2,   1,   2,   1,   2  },
                /* -inf */ { 0,   1,   2,  128, 128, -1,  -2,   1,   2,   1,   2  },
                /*  +0  */ { 0,   2,   1,  128, 128,  2,   1,   2,   1,   2,   1  },
                /*  -0  */ { 0,   2,   1,  128, 128, -2,  -1,   2,   1,   2,   1  },
                /*  +1  */ {128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128 },
                /*  -1  */ { 0,  128, 128, 128, 128,-128,-128, 128, 128,  0,   0  },
                /*  +2  */ { 0,   1,   2,  128, 128, 256,  64, 512,  32, 180,  90 },
                /*  -2  */ { 0,   1,   2,  128, 128,-256, -64, 512,  32,  0,   0  },
                /* +0.5 */ { 0,   2,   1,  128, 128,  64, 256,  32, 512,  90, 180 },
                /* -0.5 */ { 0,   2,   1,  128, 128, -64,-256,  32, 512,  0,   0  }
            };
            test_pow (r, t[i], t[j], GMP_RNDN);
            p = mpfr_nan_p (r) ? 0 : mpfr_inf_p (r) ? 1 :
                mpfr_cmp_ui (r, 0) == 0 ? 2 :
                (d = mpfr_get_d (r, GMP_RNDN), (int) (ABS(d) * 128.0));
            if (p != 0 && MPFR_SIGN(r) < 0)
                p = -p;
            if (p != q[i][j])
            {
                printf ("Error in mpfr_pow for particular case (%s)^(%s) (%d,%d):\n"
                        "got %d instead of %d\n", name[i], name[j], i,j,p, q[i][j]);
                mpfr_dump (r);
                error = 1;
            }
        }

    for (i = 0; i < 11; i++)
        mpfr_clear (t[i]);
    mpfr_clear (r);

    if (error)
        exit (1);
}
Esempio n. 23
0
int
mpfr_copysign (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y, mp_rnd_t rnd_mode)
{
  return mpfr_set4 (z, x, rnd_mode, MPFR_SIGN (y));
}
Esempio n. 24
0
static void
check_pow_ui (void)
{
    mpfr_t a, b;
    int res;

    mpfr_init2 (a, 53);
    mpfr_init2 (b, 53);

    /* check in-place operations */
    mpfr_set_str (b, "0.6926773", 10, GMP_RNDN);
    mpfr_pow_ui (a, b, 10, GMP_RNDN);
    mpfr_pow_ui (b, b, 10, GMP_RNDN);
    if (mpfr_cmp (a, b))
    {
        printf ("Error for mpfr_pow_ui (b, b, ...)\n");
        exit (1);
    }

    /* check large exponents */
    mpfr_set_ui (b, 1, GMP_RNDN);
    mpfr_pow_ui (a, b, 4294967295UL, GMP_RNDN);

    mpfr_set_inf (a, -1);
    mpfr_pow_ui (a, a, 4049053855UL, GMP_RNDN);
    if (!mpfr_inf_p (a) || (mpfr_sgn (a) >= 0))
    {
        printf ("Error for (-Inf)^4049053855\n");
        exit (1);
    }

    mpfr_set_inf (a, -1);
    mpfr_pow_ui (a, a, (unsigned long) 30002752, GMP_RNDN);
    if (!mpfr_inf_p (a) || (mpfr_sgn (a) <= 0))
    {
        printf ("Error for (-Inf)^30002752\n");
        exit (1);
    }

    /* Check underflow */
    mpfr_set_str_binary (a, "1E-1");
    res = mpfr_pow_ui (a, a, -mpfr_get_emin (), GMP_RNDN);
    if (MPFR_GET_EXP (a) != mpfr_get_emin () + 1)
    {
        printf ("Error for (1e-1)^MPFR_EMAX_MAX\n");
        mpfr_dump (a);
        exit (1);
    }

    mpfr_set_str_binary (a, "1E-10");
    res = mpfr_pow_ui (a, a, -mpfr_get_emin (), GMP_RNDZ);
    if (!MPFR_IS_ZERO (a))
    {
        printf ("Error for (1e-10)^MPFR_EMAX_MAX\n");
        mpfr_dump (a);
        exit (1);
    }

    /* Check overflow */
    mpfr_set_str_binary (a, "1E10");
    res = mpfr_pow_ui (a, a, ULONG_MAX, GMP_RNDN);
    if (!MPFR_IS_INF (a) || MPFR_SIGN (a) < 0)
    {
        printf ("Error for (1e10)^ULONG_MAX\n");
        exit (1);
    }

    /* Check 0 */
    MPFR_SET_ZERO (a);
    MPFR_SET_POS (a);
    mpfr_set_si (b, -1, GMP_RNDN);
    res = mpfr_pow_ui (b, a, 1, GMP_RNDN);
    if (res != 0 || MPFR_IS_NEG (b))
    {
        printf ("Error for (0+)^1\n");
        exit (1);
    }
    MPFR_SET_ZERO (a);
    MPFR_SET_NEG (a);
    mpfr_set_ui (b, 1, GMP_RNDN);
    res = mpfr_pow_ui (b, a, 5, GMP_RNDN);
    if (res != 0 || MPFR_IS_POS (b))
    {
        printf ("Error for (0-)^5\n");
        exit (1);
    }
    MPFR_SET_ZERO (a);
    MPFR_SET_NEG (a);
    mpfr_set_si (b, -1, GMP_RNDN);
    res = mpfr_pow_ui (b, a, 6, GMP_RNDN);
    if (res != 0 || MPFR_IS_NEG (b))
    {
        printf ("Error for (0-)^6\n");
        exit (1);
    }

    mpfr_set_prec (a, 122);
    mpfr_set_prec (b, 122);
    mpfr_set_str_binary (a, "0.10000010010000111101001110100101101010011110011100001111000001001101000110011001001001001011001011010110110110101000111011E1");
    mpfr_set_str_binary (b, "0.11111111100101001001000001000001100011100000001110111111100011111000111011100111111111110100011000111011000100100011001011E51290375");
    mpfr_pow_ui (a, a, 2026876995UL, GMP_RNDU);
    if (mpfr_cmp (a, b) != 0)
    {
        printf ("Error for x^2026876995\n");
        exit (1);
    }

    mpfr_set_prec (a, 29);
    mpfr_set_prec (b, 29);
    mpfr_set_str_binary (a, "1.0000000000000000000000001111");
    mpfr_set_str_binary (b, "1.1001101111001100111001010111e165");
    mpfr_pow_ui (a, a, 2055225053, GMP_RNDZ);
    if (mpfr_cmp (a, b) != 0)
    {
        printf ("Error for x^2055225053\n");
        printf ("Expected ");
        mpfr_out_str (stdout, 2, 0, b, GMP_RNDN);
        printf ("\nGot      ");
        mpfr_out_str (stdout, 2, 0, a, GMP_RNDN);
        printf ("\n");
        exit (1);
    }

    /* worst case found by Vincent Lefevre, 25 Nov 2006 */
    mpfr_set_prec (a, 53);
    mpfr_set_prec (b, 53);
    mpfr_set_str_binary (a, "1.0000010110000100001000101101101001011101101011010111");
    mpfr_set_str_binary (b, "1.0000110111101111011010110100001100010000001010110100E1");
    mpfr_pow_ui (a, a, 35, GMP_RNDN);
    if (mpfr_cmp (a, b) != 0)
    {
        printf ("Error in mpfr_pow_ui for worst case (1)\n");
        printf ("Expected ");
        mpfr_out_str (stdout, 2, 0, b, GMP_RNDN);
        printf ("\nGot      ");
        mpfr_out_str (stdout, 2, 0, a, GMP_RNDN);
        printf ("\n");
        exit (1);
    }
    /* worst cases found on 2006-11-26 */
    mpfr_set_str_binary (a, "1.0110100111010001101001010111001110010100111111000011");
    mpfr_set_str_binary (b, "1.1111010011101110001111010110000101110000110110101100E17");
    mpfr_pow_ui (a, a, 36, GMP_RNDD);
    if (mpfr_cmp (a, b) != 0)
    {
        printf ("Error in mpfr_pow_ui for worst case (2)\n");
        printf ("Expected ");
        mpfr_out_str (stdout, 2, 0, b, GMP_RNDN);
        printf ("\nGot      ");
        mpfr_out_str (stdout, 2, 0, a, GMP_RNDN);
        printf ("\n");
        exit (1);
    }
    mpfr_set_str_binary (a, "1.1001010100001110000110111111100011011101110011000100");
    mpfr_set_str_binary (b, "1.1100011101101101100010110001000001110001111110010001E23");
    mpfr_pow_ui (a, a, 36, GMP_RNDU);
    if (mpfr_cmp (a, b) != 0)
    {
        printf ("Error in mpfr_pow_ui for worst case (3)\n");
        printf ("Expected ");
        mpfr_out_str (stdout, 2, 0, b, GMP_RNDN);
        printf ("\nGot      ");
        mpfr_out_str (stdout, 2, 0, a, GMP_RNDN);
        printf ("\n");
        exit (1);
    }

    mpfr_clear (a);
    mpfr_clear (b);
}
Esempio n. 25
0
int
mpfr_atanh (mpfr_ptr y, mpfr_srcptr xt , mpfr_rnd_t rnd_mode)
{
  int inexact;
  mpfr_t x, t, te;
  mpfr_prec_t Nx, Ny, Nt;
  mpfr_exp_t err;
  MPFR_ZIV_DECL (loop);
  MPFR_SAVE_EXPO_DECL (expo);

  MPFR_LOG_FUNC
    (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
    ("y[%Pu]=%.*Rg inexact=%d",
     mpfr_get_prec (y), mpfr_log_prec, y, inexact));

  /* Special cases */
  if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
    {
      /* atanh(NaN) = NaN, and atanh(+/-Inf) = NaN since tanh gives a result
         between -1 and 1 */
      if (MPFR_IS_NAN (xt) || MPFR_IS_INF (xt))
        {
          MPFR_SET_NAN (y);
          MPFR_RET_NAN;
        }
      else /* necessarily xt is 0 */
        {
          MPFR_ASSERTD (MPFR_IS_ZERO (xt));
          MPFR_SET_ZERO (y);   /* atanh(0) = 0 */
          MPFR_SET_SAME_SIGN (y,xt);
          MPFR_RET (0);
        }
    }

  /* atanh (x) = NaN as soon as |x| > 1, and arctanh(+/-1) = +/-Inf */
  if (MPFR_UNLIKELY (MPFR_GET_EXP (xt) > 0))
    {
      if (MPFR_GET_EXP (xt) == 1 && mpfr_powerof2_raw (xt))
        {
          MPFR_SET_INF (y);
          MPFR_SET_SAME_SIGN (y, xt);
          mpfr_set_divby0 ();
          MPFR_RET (0);
        }
      MPFR_SET_NAN (y);
      MPFR_RET_NAN;
    }

  /* atanh(x) = x + x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */
  MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP (xt), 1, 1,
                                    rnd_mode, {});

  MPFR_SAVE_EXPO_MARK (expo);

  /* Compute initial precision */
  Nx = MPFR_PREC (xt);
  MPFR_TMP_INIT_ABS (x, xt);
  Ny = MPFR_PREC (y);
  Nt = MAX (Nx, Ny);
  /* the optimal number of bits : see algorithms.ps */
  Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4;

  /* initialise of intermediary variable */
  mpfr_init2 (t, Nt);
  mpfr_init2 (te, Nt);

  /* First computation of cosh */
  MPFR_ZIV_INIT (loop, Nt);
  for (;;)
    {
      /* compute atanh */
      mpfr_ui_sub (te, 1, x, MPFR_RNDU);   /* (1-xt)*/
      mpfr_add_ui (t,  x, 1, MPFR_RNDD);   /* (xt+1)*/
      mpfr_div (t, t, te, MPFR_RNDN);      /* (1+xt)/(1-xt)*/
      mpfr_log (t, t, MPFR_RNDN);          /* ln((1+xt)/(1-xt))*/
      mpfr_div_2ui (t, t, 1, MPFR_RNDN);   /* (1/2)*ln((1+xt)/(1-xt))*/

      /* error estimate: see algorithms.tex */
      /* FIXME: this does not correspond to the value in algorithms.tex!!! */
      /* err=Nt-__gmpfr_ceil_log2(1+5*pow(2,1-MPFR_EXP(t)));*/
      err = Nt - (MAX (4 - MPFR_GET_EXP (t), 0) + 1);

      if (MPFR_LIKELY (MPFR_IS_ZERO (t)
                       || MPFR_CAN_ROUND (t, err, Ny, rnd_mode)))
        break;

      /* reactualisation of the precision */
      MPFR_ZIV_NEXT (loop, Nt);
      mpfr_set_prec (t, Nt);
      mpfr_set_prec (te, Nt);
    }
  MPFR_ZIV_FREE (loop);

  inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));

  mpfr_clear(t);
  mpfr_clear(te);

  MPFR_SAVE_EXPO_FREE (expo);
  return mpfr_check_range (y, inexact, rnd_mode);
}
Esempio n. 26
0
/* Since MPFR-3.0, return the usual inexact value.
   The erange flag is set if an error occurred in the conversion
   (y is NaN, +Inf, or -Inf that have no equivalent in mpf)
*/
int
mpfr_get_f (mpf_ptr x, mpfr_srcptr y, mpfr_rnd_t rnd_mode)
{
  int inex;
  mp_size_t sx, sy;
  mpfr_prec_t precx, precy;
  mp_limb_t *xp;
  int sh;

  if (MPFR_UNLIKELY(MPFR_IS_SINGULAR(y)))
    {
      if (MPFR_IS_ZERO(y))
        {
          mpf_set_ui (x, 0);
          return 0;
        }
      else if (MPFR_IS_NAN (y))
        {
          MPFR_SET_ERANGE ();
          return 0;
        }
      else /* y is plus infinity (resp. minus infinity), set x to the maximum
              value (resp. the minimum value) in precision PREC(x) */
        {
          int i;
          mp_limb_t *xp;

          MPFR_SET_ERANGE ();

          /* To this day, [mp_exp_t] and mp_size_t are #defined as the same
             type */
          EXP (x) = MP_SIZE_T_MAX;

          sx = PREC (x);
          SIZ (x) = sx;
          xp = PTR (x);
          for (i = 0; i < sx; i++)
            xp[i] = MP_LIMB_T_MAX;

          if (MPFR_IS_POS (y))
            return -1;
          else
            {
              mpf_neg (x, x);
              return +1;
            }
        }
    }

  sx = PREC(x); /* number of limbs of the mantissa of x */

  precy = MPFR_PREC(y);
  precx = (mpfr_prec_t) sx * GMP_NUMB_BITS;
  sy = MPFR_LIMB_SIZE (y);

  xp = PTR (x);

  /* since mpf numbers are represented in base 2^GMP_NUMB_BITS,
     we loose -EXP(y) % GMP_NUMB_BITS bits in the most significant limb */
  sh = MPFR_GET_EXP(y) % GMP_NUMB_BITS;
  sh = sh <= 0 ? - sh : GMP_NUMB_BITS - sh;
  MPFR_ASSERTD (sh >= 0);
  if (precy + sh <= precx) /* we can copy directly */
    {
      mp_size_t ds;

      MPFR_ASSERTN (sx >= sy);
      ds = sx - sy;

      if (sh != 0)
        {
          mp_limb_t out;
          out = mpn_rshift (xp + ds, MPFR_MANT(y), sy, sh);
          MPFR_ASSERTN (ds > 0 || out == 0);
          if (ds > 0)
            xp[--ds] = out;
        }
      else
        MPN_COPY (xp + ds, MPFR_MANT (y), sy);
      if (ds > 0)
        MPN_ZERO (xp, ds);
      EXP(x) = (MPFR_GET_EXP(y) + sh) / GMP_NUMB_BITS;
      inex = 0;
    }
  else /* we have to round to precx - sh bits */
    {
      mpfr_t z;
      mp_size_t sz;

      /* Recall that precx = (mpfr_prec_t) sx * GMP_NUMB_BITS, thus removing
         sh bits (sh < GMP_NUMB_BITSS) won't reduce the number of limbs. */
      mpfr_init2 (z, precx - sh);
      sz = MPFR_LIMB_SIZE (z);
      MPFR_ASSERTN (sx == sz);

      inex = mpfr_set (z, y, rnd_mode);
      /* warning, sh may change due to rounding, but then z is a power of two,
         thus we can safely ignore its last bit which is 0 */
      sh = MPFR_GET_EXP(z) % GMP_NUMB_BITS;
      sh = sh <= 0 ? - sh : GMP_NUMB_BITS - sh;
      MPFR_ASSERTD (sh >= 0);
      if (sh != 0)
        {
          mp_limb_t out;
          out = mpn_rshift (xp, MPFR_MANT(z), sz, sh);
          /* If sh hasn't changed, it is the number of the non-significant
             bits in the lowest limb of z. Therefore out == 0. */
          MPFR_ASSERTD (out == 0);  (void) out; /* avoid a warning */
        }
      else
        MPN_COPY (xp, MPFR_MANT(z), sz);
      EXP(x) = (MPFR_GET_EXP(z) + sh) / GMP_NUMB_BITS;
      mpfr_clear (z);
    }

  /* set size and sign */
  SIZ(x) = (MPFR_FROM_SIGN_TO_INT(MPFR_SIGN(y)) < 0) ? -sx : sx;

  return inex;
}
Esempio n. 27
0
int
mpfr_sinh (mpfr_ptr y, mpfr_srcptr xt, mpfr_rnd_t rnd_mode)
{
  mpfr_t x;
  int inexact;

  MPFR_LOG_FUNC
    (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
     ("y[%Pu]=%.*Rg inexact=%d",
      mpfr_get_prec (y), mpfr_log_prec, y, inexact));

  if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
    {
      if (MPFR_IS_NAN (xt))
        {
          MPFR_SET_NAN (y);
          MPFR_RET_NAN;
        }
      else if (MPFR_IS_INF (xt))
        {
          MPFR_SET_INF (y);
          MPFR_SET_SAME_SIGN (y, xt);
          MPFR_RET (0);
        }
      else /* xt is zero */
        {
          MPFR_ASSERTD (MPFR_IS_ZERO (xt));
          MPFR_SET_ZERO (y);   /* sinh(0) = 0 */
          MPFR_SET_SAME_SIGN (y, xt);
          MPFR_RET (0);
        }
    }

  /* sinh(x) = x + x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */
  MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP(xt), 2, 1,
                                    rnd_mode, {});

  MPFR_TMP_INIT_ABS (x, xt);

  {
    mpfr_t t, ti;
    mpfr_exp_t d;
    mpfr_prec_t Nt;    /* Precision of the intermediary variable */
    long int err;    /* Precision of error */
    MPFR_ZIV_DECL (loop);
    MPFR_SAVE_EXPO_DECL (expo);
    MPFR_GROUP_DECL (group);

    MPFR_SAVE_EXPO_MARK (expo);

    /* compute the precision of intermediary variable */
    Nt = MAX (MPFR_PREC (x), MPFR_PREC (y));
    /* the optimal number of bits : see algorithms.ps */
    Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4;
    /* If x is near 0, exp(x) - 1/exp(x) = 2*x+x^3/3+O(x^5) */
    if (MPFR_GET_EXP (x) < 0)
      Nt -= 2*MPFR_GET_EXP (x);

    /* initialise of intermediary variables */
    MPFR_GROUP_INIT_2 (group, Nt, t, ti);

    /* First computation of sinh */
    MPFR_ZIV_INIT (loop, Nt);
    for (;;)
      {
        MPFR_BLOCK_DECL (flags);

        /* compute sinh */
        MPFR_BLOCK (flags, mpfr_exp (t, x, MPFR_RNDD));
        if (MPFR_OVERFLOW (flags))
          /* exp(x) does overflow */
          {
            /* sinh(x) = 2 * sinh(x/2) * cosh(x/2) */
            mpfr_div_2ui (ti, x, 1, MPFR_RNDD); /* exact */

            /* t <- cosh(x/2): error(t) <= 1 ulp(t) */
            MPFR_BLOCK (flags, mpfr_cosh (t, ti, MPFR_RNDD));
            if (MPFR_OVERFLOW (flags))
              /* when x>1 we have |sinh(x)| >= cosh(x/2), so sinh(x)
                 overflows too */
              {
                inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
                MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
                break;
              }

            /* ti <- sinh(x/2): , error(ti) <= 1 ulp(ti)
               cannot overflow because 0 < sinh(x) < cosh(x) when x > 0 */
            mpfr_sinh (ti, ti, MPFR_RNDD);

            /* multiplication below, error(t) <= 5 ulp(t) */
            MPFR_BLOCK (flags, mpfr_mul (t, t, ti, MPFR_RNDD));
            if (MPFR_OVERFLOW (flags))
              {
                inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
                MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
                break;
              }

            /* doubling below, exact */
            MPFR_BLOCK (flags, mpfr_mul_2ui (t, t, 1, MPFR_RNDN));
            if (MPFR_OVERFLOW (flags))
              {
                inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
                MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
                break;
              }

            /* we have lost at most 3 bits of precision */
            err = Nt - 3;
            if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y),
                                             rnd_mode)))
              {
                inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
                break;
              }
            err = Nt; /* double the precision */
          }
        else
          {
            d = MPFR_GET_EXP (t);
            mpfr_ui_div (ti, 1, t, MPFR_RNDU); /* 1/exp(x) */
            mpfr_sub (t, t, ti, MPFR_RNDN);    /* exp(x) - 1/exp(x) */
            mpfr_div_2ui (t, t, 1, MPFR_RNDN);  /* 1/2(exp(x) - 1/exp(x)) */

            /* it may be that t is zero (in fact, it can only occur when te=1,
               and thus ti=1 too) */
            if (MPFR_IS_ZERO (t))
              err = Nt; /* double the precision */
            else
              {
                /* calculation of the error */
                d = d - MPFR_GET_EXP (t) + 2;
                /* error estimate: err = Nt-(__gmpfr_ceil_log2(1+pow(2,d)));*/
                err = Nt - (MAX (d, 0) + 1);
                if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y),
                                                 rnd_mode)))
                  {
                    inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
                    break;
                  }
              }
          }

        /* actualisation of the precision */
        Nt += err;
        MPFR_ZIV_NEXT (loop, Nt);
        MPFR_GROUP_REPREC_2 (group, Nt, t, ti);
      }
    MPFR_ZIV_FREE (loop);
    MPFR_GROUP_CLEAR (group);
    MPFR_SAVE_EXPO_FREE (expo);
  }

  return mpfr_check_range (y, inexact, rnd_mode);
}
Esempio n. 28
0
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);
}
Esempio n. 29
0
File: tl2b.c Progetto: Canar/mpfr
static void
compute_l2b (int output)
{
  mpfr_ptr p;
  mpfr_srcptr t;
  int beta, i;
  int error = 0;
  char buffer[30];

  if (output)
    printf ("#ifndef UINT64_C\n# define UINT64_C(c) c\n#endif\n\n");

  for (beta = 2; beta <= BASE_MAX; beta++)
    {
      for (i = 0; i < 2; i++)
        {
          p = &l2b[beta-2][i];

          /* Compute the value */
          if (i == 0)
            {
              /* 23-bit upper approximation to log(b)/log(2) */
              mpfr_init2 (p, 23);
              mpfr_set_ui (p, beta, MPFR_RNDU);
              mpfr_log2 (p, p, MPFR_RNDU);
            }
          else
            {
              /* 77-bit upper approximation to log(2)/log(b) */
              mpfr_init2 (p, 77);
              mpfr_set_ui (p, beta, MPFR_RNDD);
              mpfr_log2 (p, p, MPFR_RNDD);
              mpfr_ui_div (p, 1, p, MPFR_RNDU);
            }

          sprintf (buffer, "mpfr_l2b_%d_%d", beta, i);
          if (output)
            print_mpfr (p, buffer);

          /* Check the value */
          t = &__gmpfr_l2b[beta-2][i];
          if (t == NULL || MPFR_PREC (t) == 0 || !mpfr_equal_p (p, t))
            {
              if (!output)
                {
                  error = 1;
                  printf ("Error for constant %s\n", buffer);
                }
            }

          if (!output)
            mpfr_clear (p);
        }
    }

  if (output)
    {
      if (printf ("const __mpfr_struct __gmpfr_l2b[BASE_MAX-1][2] = {\n")
          < 0)
        { fprintf (stderr, "Error in printf\n"); exit (1); }
      for (beta = 2; beta <= BASE_MAX; beta++)
        {
          for (i = 0; i < 2; i++)
            {
              p = &l2b[beta-2][i];
              if (printf ("  %c {%3d,%2d,%3ld, (mp_limb_t *) "
                          "mpfr_l2b_%d_%d__tab }%s\n", i == 0 ? '{' : ' ',
                          (int) MPFR_PREC (p), MPFR_SIGN (p),
                          (long) MPFR_GET_EXP (p), beta, i,
                          i == 0 ? "," : beta < BASE_MAX ? " }," : " } };")
                  < 0)
                { fprintf (stderr, "Error in printf\n"); exit (1); }
              mpfr_clear (p);
            }
        }
    }

  /* If there was an error, the test fails. */
  if (error)
    exit (1);
}
Esempio n. 30
0
/* compute sign(b) * (|b| + |c|)
   Returns 0 iff result is exact,
   a negative value when the result is less than the exact value,
   a positive value otherwise. */
int
mpfr_add1sp (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t rnd_mode)
{
  mpfr_uexp_t d;
  mpfr_prec_t p;
  unsigned int sh;
  mp_size_t n;
  mp_limb_t *ap, *cp;
  mpfr_exp_t bx;
  mp_limb_t limb;
  int inexact;
  MPFR_TMP_DECL(marker);

  MPFR_TMP_MARK(marker);

  MPFR_ASSERTD(MPFR_PREC(a) == MPFR_PREC(b) && MPFR_PREC(b) == MPFR_PREC(c));
  MPFR_ASSERTD(MPFR_IS_PURE_FP(b));
  MPFR_ASSERTD(MPFR_IS_PURE_FP(c));
  MPFR_ASSERTD(MPFR_GET_EXP(b) >= MPFR_GET_EXP(c));

  /* Read prec and num of limbs */
  p = MPFR_PREC(b);
  n = MPFR_PREC2LIMBS (p);
  MPFR_UNSIGNED_MINUS_MODULO(sh, p);
  bx = MPFR_GET_EXP(b);
  d = (mpfr_uexp_t) (bx - MPFR_GET_EXP(c));

  DEBUG (printf ("New add1sp with diff=%lu\n", (unsigned long) d));

  if (MPFR_UNLIKELY(d == 0))
    {
      /* d==0 */
      DEBUG( mpfr_print_mant_binary("C= ", MPFR_MANT(c), p) );
      DEBUG( mpfr_print_mant_binary("B= ", MPFR_MANT(b), p) );
      bx++;                                /* exp + 1 */
      ap = MPFR_MANT(a);
      limb = mpn_add_n(ap, MPFR_MANT(b), MPFR_MANT(c), n);
      DEBUG( mpfr_print_mant_binary("A= ", ap, p) );
      MPFR_ASSERTD(limb != 0);             /* There must be a carry */
      limb = ap[0];                        /* Get LSB (In fact, LSW) */
      mpn_rshift(ap, ap, n, 1);            /* Shift mantissa A */
      ap[n-1] |= MPFR_LIMB_HIGHBIT;        /* Set MSB */
      ap[0]   &= ~MPFR_LIMB_MASK(sh);      /* Clear LSB bit */
      if (MPFR_LIKELY((limb&(MPFR_LIMB_ONE<<sh)) == 0)) /* Check exact case */
        { inexact = 0; goto set_exponent; }
      /* Zero: Truncate
         Nearest: Even Rule => truncate or add 1
         Away: Add 1 */
      if (MPFR_LIKELY(rnd_mode==MPFR_RNDN))
        {
          if (MPFR_LIKELY((ap[0]&(MPFR_LIMB_ONE<<sh))==0))
            { inexact = -1; goto set_exponent; }
          else
            goto add_one_ulp;
        }
      MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(b));
      if (rnd_mode==MPFR_RNDZ)
        { inexact = -1; goto set_exponent; }
      else
        goto add_one_ulp;
    }
  else if (MPFR_UNLIKELY (d >= p))
    {
      if (MPFR_LIKELY (d > p))
        {
          /* d > p : Copy B in A */
          /* Away:    Add 1
             Nearest: Trunc
             Zero:    Trunc */
          if (MPFR_LIKELY (rnd_mode==MPFR_RNDN
                           || MPFR_IS_LIKE_RNDZ (rnd_mode, MPFR_IS_NEG (b))))
            {
            copy_set_exponent:
              ap = MPFR_MANT (a);
              MPN_COPY (ap, MPFR_MANT(b), n);
              inexact = -1;
              goto set_exponent;
            }
          else
            {
            copy_add_one_ulp:
              ap = MPFR_MANT(a);
              MPN_COPY (ap, MPFR_MANT(b), n);
              goto add_one_ulp;
            }
        }
      else
        {
          /* d==p : Copy B in A */
          /* Away:    Add 1
             Nearest: Even Rule if C is a power of 2, else Add 1
             Zero:    Trunc */
          if (MPFR_LIKELY(rnd_mode==MPFR_RNDN))
            {
              /* Check if C was a power of 2 */
              cp = MPFR_MANT(c);
              if (MPFR_UNLIKELY(cp[n-1] == MPFR_LIMB_HIGHBIT))
                {
                  mp_size_t k = n-1;
                  do {
                    k--;
                  } while (k>=0 && cp[k]==0);
                  if (MPFR_UNLIKELY(k<0))
                    /* Power of 2: Even rule */
                    if ((MPFR_MANT (b)[0]&(MPFR_LIMB_ONE<<sh))==0)
                      goto copy_set_exponent;
                }
              /* Not a Power of 2 */
              goto copy_add_one_ulp;
            }
          else if (MPFR_IS_LIKE_RNDZ (rnd_mode, MPFR_IS_NEG (b)))
            goto copy_set_exponent;
          else
            goto copy_add_one_ulp;
        }
    }
  else
    {
      mp_limb_t mask;
      mp_limb_t bcp, bcp1; /* Cp and C'p+1 */

      /* General case: 1 <= d < p */
      cp = MPFR_TMP_LIMBS_ALLOC (n);

      /* Shift c in temporary allocated place */
      {
        mpfr_uexp_t dm;
        mp_size_t m;

        dm = d % GMP_NUMB_BITS;
        m = d / GMP_NUMB_BITS;
        if (MPFR_UNLIKELY(dm == 0))
          {
            /* dm = 0 and m > 0: Just copy */
            MPFR_ASSERTD(m!=0);
            MPN_COPY(cp, MPFR_MANT(c)+m, n-m);
            MPN_ZERO(cp+n-m, m);
          }
        else if (MPFR_LIKELY(m == 0))
          {
            /* dm >=1 and m == 0: just shift */
            MPFR_ASSERTD(dm >= 1);
            mpn_rshift(cp, MPFR_MANT(c), n, dm);
          }
        else
          {
            /* dm > 0 and m > 0: shift and zero  */
            mpn_rshift(cp, MPFR_MANT(c)+m, n-m, dm);
            MPN_ZERO(cp+n-m, m);
          }
      }

      DEBUG( mpfr_print_mant_binary("Before", MPFR_MANT(c), p) );
      DEBUG( mpfr_print_mant_binary("B=    ", MPFR_MANT(b), p) );
      DEBUG( mpfr_print_mant_binary("After ", cp, p) );

      /* Compute bcp=Cp and bcp1=C'p+1 */
      if (MPFR_LIKELY (sh > 0))
        {
          /* Try to compute them from C' rather than C */
          bcp = (cp[0] & (MPFR_LIMB_ONE<<(sh-1))) ;
          if (MPFR_LIKELY(cp[0]&MPFR_LIMB_MASK(sh-1)))
            bcp1 = 1;
          else
            {
              /* We can't compute C'p+1 from C'. Compute it from C */
              /* Start from bit x=p-d+sh in mantissa C
                 (+sh since we have already looked sh bits in C'!) */
              mpfr_prec_t x = p-d+sh-1;
              if (MPFR_LIKELY(x>p))
                /* We are already looked at all the bits of c, so C'p+1 = 0*/
                bcp1 = 0;
              else
                {
                  mp_limb_t *tp = MPFR_MANT(c);
                  mp_size_t kx = n-1 - (x / GMP_NUMB_BITS);
                  mpfr_prec_t sx = GMP_NUMB_BITS-1-(x%GMP_NUMB_BITS);
                  DEBUG (printf ("(First) x=%lu Kx=%ld Sx=%lu\n",
                                 (unsigned long) x, (long) kx,
                                 (unsigned long) sx));
                  /* Looks at the last bits of limb kx (if sx=0 does nothing)*/
                  if (tp[kx] & MPFR_LIMB_MASK(sx))
                    bcp1 = 1;
                  else
                    {
                      /*kx += (sx==0);*/
                      /*If sx==0, tp[kx] hasn't been checked*/
                      do {
                        kx--;
                      } while (kx>=0 && tp[kx]==0);
                      bcp1 = (kx >= 0);
                    }
                }
            }
        }
      else /* sh == 0 */
        {
          /* Compute Cp and C'p+1 from C with sh=0 */
          mp_limb_t *tp = MPFR_MANT(c);
          /* Start from bit x=p-d in mantissa C */
          mpfr_prec_t  x = p-d;
          mp_size_t   kx = n-1 - (x / GMP_NUMB_BITS);
          mpfr_prec_t sx = GMP_NUMB_BITS-1-(x%GMP_NUMB_BITS);
          MPFR_ASSERTD(p >= d);
          bcp = tp[kx] & (MPFR_LIMB_ONE<<sx);
          /* Looks at the last bits of limb kx (If sx=0, does nothing)*/
          if (tp[kx]&MPFR_LIMB_MASK(sx))
            bcp1 = 1;
          else
            {
              do {
                kx--;
              } while (kx>=0 && tp[kx]==0);
              bcp1 = (kx>=0);
            }
        }
      DEBUG (printf("sh=%u Cp=%lu C'p+1=%lu\n", sh,
                    (unsigned long) bcp, (unsigned long) bcp1));

      /* Clean shifted C' */
      mask = ~MPFR_LIMB_MASK(sh);
      cp[0] &= mask;

      /* Add the mantissa c from b in a */
      ap = MPFR_MANT(a);
      limb = mpn_add_n (ap, MPFR_MANT(b), cp, n);
      DEBUG( mpfr_print_mant_binary("Add=  ", ap, p) );

      /* Check for overflow */
      if (MPFR_UNLIKELY (limb))
        {
          limb = ap[0] & (MPFR_LIMB_ONE<<sh); /* Get LSB */
          mpn_rshift (ap, ap, n, 1);          /* Shift mantissa*/
          bx++;                               /* Fix exponent */
          ap[n-1] |= MPFR_LIMB_HIGHBIT;       /* Set MSB */
          ap[0]   &= mask;                    /* Clear LSB bit */
          bcp1    |= bcp;                     /* Recompute C'p+1 */
          bcp      = limb;                    /* Recompute Cp */
          DEBUG (printf ("(Overflow) Cp=%lu C'p+1=%lu\n",
                         (unsigned long) bcp, (unsigned long) bcp1));
          DEBUG (mpfr_print_mant_binary ("Add=  ", ap, p));
        }

      /* Round:
          Zero: Truncate but could be exact.
          Away: Add 1 if Cp or C'p+1 !=0
          Nearest: Truncate but could be exact if Cp==0
                   Add 1 if C'p+1 !=0,
                   Even rule else */
      if (MPFR_LIKELY(rnd_mode == MPFR_RNDN))
        {
          if (MPFR_LIKELY(bcp == 0))
            { inexact = MPFR_LIKELY(bcp1) ? -1 : 0; goto set_exponent; }
          else if (MPFR_UNLIKELY(bcp1==0) && (ap[0]&(MPFR_LIMB_ONE<<sh))==0)
            { inexact = -1; goto set_exponent; }
          else
            goto add_one_ulp;
        }
      MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(b));
      if (rnd_mode == MPFR_RNDZ)
        {
          inexact = MPFR_LIKELY(bcp || bcp1) ? -1 : 0;
          goto set_exponent;
        }
      else
        {
          if (MPFR_UNLIKELY(bcp==0 && bcp1==0))
            { inexact = 0; goto set_exponent; }
          else
            goto add_one_ulp;
        }
    }
  MPFR_ASSERTN(0);

 add_one_ulp:
  /* add one unit in last place to a */
  DEBUG( printf("AddOneUlp\n") );
  if (MPFR_UNLIKELY( mpn_add_1(ap, ap, n, MPFR_LIMB_ONE<<sh) ))
    {
      /* Case 100000x0 = 0x1111x1 + 1*/
      DEBUG( printf("Pow of 2\n") );
      bx++;
      ap[n-1] = MPFR_LIMB_HIGHBIT;
    }
  inexact = 1;

 set_exponent:
  if (MPFR_UNLIKELY(bx > __gmpfr_emax)) /* Check for overflow */
    {
      DEBUG( printf("Overflow\n") );
      MPFR_TMP_FREE(marker);
      MPFR_SET_SAME_SIGN(a,b);
      return mpfr_overflow(a, rnd_mode, MPFR_SIGN(a));
    }
  MPFR_SET_EXP (a, bx);
  MPFR_SET_SAME_SIGN(a,b);

  MPFR_TMP_FREE(marker);
  MPFR_RET (inexact * MPFR_INT_SIGN (a));
}