Esempio n. 1
0
long double
mpfr_get_ld (mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{

  if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
    return (long double) mpfr_get_d (x, rnd_mode);
  else /* now x is a normal non-zero number */
    {
      long double r; /* result */
      long double m;
      double s; /* part of result */
      mpfr_exp_t sh; /* exponent shift, so that x/2^sh is in the double range */
      mpfr_t y, z;
      int sign;

      /* first round x to the target long double precision, so that
         all subsequent operations are exact (this avoids double rounding
         problems) */
      mpfr_init2 (y, MPFR_LDBL_MANT_DIG);
      mpfr_init2 (z, IEEE_DBL_MANT_DIG);

      mpfr_set (y, x, rnd_mode);
      sh = MPFR_GET_EXP (y);
      sign = MPFR_SIGN (y);
      MPFR_SET_EXP (y, 0);
      MPFR_SET_POS (y);

      r = 0.0;
      do {
        s = mpfr_get_d (y, MPFR_RNDN); /* high part of y */
        r += (long double) s;
        mpfr_set_d (z, s, MPFR_RNDN);  /* exact */
        mpfr_sub (y, y, z, MPFR_RNDN); /* exact */
      } while (!MPFR_IS_ZERO (y));

      mpfr_clear (z);
      mpfr_clear (y);

      /* we now have to multiply back by 2^sh */
      MPFR_ASSERTD (r > 0);
      if (sh != 0)
        {
          /* An overflow may occurs (example: 0.5*2^1024) */
          while (r < 1.0)
            {
              r += r;
              sh--;
            }

          if (sh > 0)
            m = 2.0;
          else
            {
              m = 0.5;
              sh = -sh;
            }

          for (;;)
            {
              if (sh % 2)
                r = r * m;
              sh >>= 1;
              if (sh == 0)
                break;
              m = m * m;
            }
        }
      if (sign < 0)
        r = -r;
      return r;
    }
}
Esempio n. 2
0
/* Compute the alternating series
   s = S(z) = \sum_{k=0}^infty B_{2k} (z))^{2k+1} / (2k+1)!
   with 0 < z <= log(2) to the precision of s rounded in the direction
   rnd_mode.
   Return the maximum index of the truncature which is useful
   for determinating the relative error.
*/
static int
li2_series (mpfr_t sum, mpfr_srcptr z, mpfr_rnd_t rnd_mode)
{
  int i, Bm, Bmax;
  mpfr_t s, u, v, w;
  mpfr_prec_t sump, p;
  mp_exp_t se, err;
  mpz_t *B;
  MPFR_ZIV_DECL (loop);

  /* The series converges for |z| < 2 pi, but in mpfr_li2 the argument is
     reduced so that 0 < z <= log(2). Here is additionnal check that z is
     (nearly) correct */
  MPFR_ASSERTD (MPFR_IS_STRICTPOS (z));
  MPFR_ASSERTD (mpfr_cmp_d (z, 0.6953125) <= 0);

  sump = MPFR_PREC (sum);       /* target precision */
  p = sump + MPFR_INT_CEIL_LOG2 (sump) + 4;     /* the working precision */
  mpfr_init2 (s, p);
  mpfr_init2 (u, p);
  mpfr_init2 (v, p);
  mpfr_init2 (w, p);

  B = bernoulli ((mpz_t *) 0, 0);
  Bm = Bmax = 1;

  MPFR_ZIV_INIT (loop, p);
  for (;;)
    {
      mpfr_sqr (u, z, GMP_RNDU);
      mpfr_set (v, z, GMP_RNDU);
      mpfr_set (s, z, GMP_RNDU);
      se = MPFR_GET_EXP (s);
      err = 0;

      for (i = 1;; i++)
        {
          if (i >= Bmax)
            B = bernoulli (B, Bmax++);  /* B_2i * (2i+1)!, exact */

          mpfr_mul (v, u, v, GMP_RNDU);
          mpfr_div_ui (v, v, 2 * i, GMP_RNDU);
          mpfr_div_ui (v, v, 2 * i, GMP_RNDU);
          mpfr_div_ui (v, v, 2 * i + 1, GMP_RNDU);
          mpfr_div_ui (v, v, 2 * i + 1, GMP_RNDU);
          /* here, v_2i = v_{2i-2} / (2i * (2i+1))^2 */

          mpfr_mul_z (w, v, B[i], GMP_RNDN);
          /* here, w_2i = v_2i * B_2i * (2i+1)! with
             error(w_2i) < 2^(5 * i + 8) ulp(w_2i) (see algorithms.tex) */

          mpfr_add (s, s, w, GMP_RNDN);

          err = MAX (err + se, 5 * i + 8 + MPFR_GET_EXP (w))
            - MPFR_GET_EXP (s);
          err = 2 + MAX (-1, err);
          se = MPFR_GET_EXP (s);
          if (MPFR_GET_EXP (w) <= se - (mp_exp_t) p)
            break;
        }

      /* the previous value of err is the rounding error,
         the truncation error is less than EXP(z) - 6 * i - 5
         (see algorithms.tex) */
      err = MAX (err, MPFR_GET_EXP (z) - 6 * i - 5) + 1;
      if (MPFR_CAN_ROUND (s, (mp_exp_t) p - err, sump, rnd_mode))
        break;

      MPFR_ZIV_NEXT (loop, p);
      mpfr_set_prec (s, p);
      mpfr_set_prec (u, p);
      mpfr_set_prec (v, p);
      mpfr_set_prec (w, p);
    }
  MPFR_ZIV_FREE (loop);
  mpfr_set (sum, s, rnd_mode);

  Bm = Bmax;
  while (Bm--)
    mpz_clear (B[Bm]);
  (*__gmp_free_func) (B, Bmax * sizeof (mpz_t));
  mpfr_clears (s, u, v, w, (mpfr_ptr) 0);

  /* Let K be the returned value.
     1. As we compute an alternating series, the truncation error has the same
     sign as the next term w_{K+2} which is positive iff K%4 == 0.
     2. Assume that error(z) <= (1+t) z', where z' is the actual value, then
     error(s) <= 2 * (K+1) * t (see algorithms.tex).
   */
  return 2 * i;
}
Esempio n. 3
0
int
mpfr_round_raw_generic(
#if flag == 0
                       mp_limb_t *yp,
#endif
                       const mp_limb_t *xp, mpfr_prec_t xprec,
                       int neg, mpfr_prec_t yprec, mpfr_rnd_t rnd_mode
#if use_inexp != 0
                       , int *inexp
#endif
                       )
{
  mp_size_t xsize, nw;
  mp_limb_t himask, lomask, sb;
  int rw;
#if flag == 0
  int carry;
#endif
#if use_inexp == 0
  int *inexp;
#endif

  if (use_inexp)
    MPFR_ASSERTD(inexp != ((int*) 0));
  MPFR_ASSERTD(neg == 0 || neg == 1);

  if (flag && !use_inexp &&
      (xprec <= yprec || MPFR_IS_LIKE_RNDZ (rnd_mode, neg)))
    return 0;

  xsize = (xprec-1)/GMP_NUMB_BITS + 1;
  nw = yprec / GMP_NUMB_BITS;
  rw = yprec & (GMP_NUMB_BITS - 1);

  if (MPFR_UNLIKELY(xprec <= yprec))
    { /* No rounding is necessary. */
      /* if yp=xp, maybe an overlap: MPN_COPY_DECR is ok when src <= dst */
      if (MPFR_LIKELY(rw))
        nw++;
      MPFR_ASSERTD(nw >= 1);
      MPFR_ASSERTD(nw >= xsize);
      if (use_inexp)
        *inexp = 0;
#if flag == 0
      MPN_COPY_DECR(yp + (nw - xsize), xp, xsize);
      MPN_ZERO(yp, nw - xsize);
#endif
      return 0;
    }

  if (use_inexp || !MPFR_IS_LIKE_RNDZ(rnd_mode, neg))
    {
      mp_size_t k = xsize - nw - 1;

      if (MPFR_LIKELY(rw))
        {
          nw++;
          lomask = MPFR_LIMB_MASK (GMP_NUMB_BITS - rw);
          himask = ~lomask;
        }
      else
        {
          lomask = ~(mp_limb_t) 0;
          himask = ~(mp_limb_t) 0;
        }
      MPFR_ASSERTD(k >= 0);
      sb = xp[k] & lomask;  /* First non-significant bits */
      /* Rounding to nearest ? */
      if (MPFR_LIKELY( rnd_mode == MPFR_RNDN) )
        {
          /* Rounding to nearest */
          mp_limb_t rbmask = MPFR_LIMB_ONE << (GMP_NUMB_BITS - 1 - rw);
          if (sb & rbmask) /* rounding bit */
            sb &= ~rbmask; /* it is 1, clear it */
          else
            {
              /* Rounding bit is 0, behave like rounding to 0 */
              goto rnd_RNDZ;
            }
          while (MPFR_UNLIKELY(sb == 0) && k > 0)
            sb = xp[--k];
          /* rounding to nearest, with rounding bit = 1 */
          if (MPFR_UNLIKELY(sb == 0)) /* Even rounding. */
            {
              /* sb == 0 && rnd_mode == MPFR_RNDN */
              sb = xp[xsize - nw] & (himask ^ (himask << 1));
              if (sb == 0)
                {
                  if (use_inexp)
                    *inexp = 2*MPFR_EVEN_INEX*neg-MPFR_EVEN_INEX;
                  /* ((neg!=0)^(sb!=0)) ? MPFR_EVEN_INEX  : -MPFR_EVEN_INEX;*/
                  /* Since neg = 0 or 1 and sb=0*/
#if flag == 1
                  return 0 /*sb != 0 && rnd_mode != MPFR_RNDZ */;
#else
                  MPN_COPY_INCR(yp, xp + xsize - nw, nw);
                  yp[0] &= himask;
                  return 0;
#endif
                }
              else
                {
                  /* sb != 0 && rnd_mode == MPFR_RNDN */
                  if (use_inexp)
                    *inexp = MPFR_EVEN_INEX-2*MPFR_EVEN_INEX*neg;
                  /*((neg!=0)^(sb!=0))? MPFR_EVEN_INEX  : -MPFR_EVEN_INEX; */
                  /*Since neg= 0 or 1 and sb != 0 */
                  goto rnd_RNDN_add_one_ulp;
                }
            }
          else /* sb != 0  && rnd_mode == MPFR_RNDN*/
            {
              if (use_inexp)
                /* *inexp = (neg == 0) ? 1 : -1; but since neg = 0 or 1 */
                *inexp = 1-2*neg;
            rnd_RNDN_add_one_ulp:
#if flag == 1
              return 1; /*sb != 0 && rnd_mode != MPFR_RNDZ;*/
#else
              carry = mpn_add_1 (yp, xp + xsize - nw, nw,
                                 rw ?
                                 MPFR_LIMB_ONE << (GMP_NUMB_BITS - rw)
                                 : MPFR_LIMB_ONE);
              yp[0] &= himask;
              return carry;
#endif
            }
        }
      /* Rounding to Zero ? */
      else if (MPFR_IS_LIKE_RNDZ(rnd_mode, neg))
        {
          /* rnd_mode == MPFR_RNDZ */
        rnd_RNDZ:
          while (MPFR_UNLIKELY(sb == 0) && k > 0)
            sb = xp[--k];
          if (use_inexp)
            /* rnd_mode == MPFR_RNDZ and neg = 0 or 1 */
            /* (neg != 0) ^ (rnd_mode != MPFR_RNDZ)) ? 1 : -1);*/
            *inexp = MPFR_UNLIKELY(sb == 0) ? 0 : (2*neg-1);
#if flag == 1
          return 0; /*sb != 0 && rnd_mode != MPFR_RNDZ;*/
#else
          MPN_COPY_INCR(yp, xp + xsize - nw, nw);
          yp[0] &= himask;
          return 0;
#endif
        }
      else
        {
          /* rnd_mode = Away */
          while (MPFR_UNLIKELY(sb == 0) && k > 0)
            sb = xp[--k];
          if (MPFR_UNLIKELY(sb == 0))
            {
              /* sb = 0 && rnd_mode != MPFR_RNDZ */
              if (use_inexp)
                /* (neg != 0) ^ (rnd_mode != MPFR_RNDZ)) ? 1 : -1);*/
                *inexp = 0;
#if flag == 1
              return 0;
#else
              MPN_COPY_INCR(yp, xp + xsize - nw, nw);
              yp[0] &= himask;
              return 0;
#endif
            }
          else
            {
              /* sb != 0 && rnd_mode != MPFR_RNDZ */
              if (use_inexp)
                /* (neg != 0) ^ (rnd_mode != MPFR_RNDZ)) ? 1 : -1);*/
                *inexp = 1-2*neg;
#if flag == 1
              return 1;
#else
              carry = mpn_add_1(yp, xp + xsize - nw, nw,
                                rw ? MPFR_LIMB_ONE << (GMP_NUMB_BITS - rw)
                                : 1);
              yp[0] &= himask;
              return carry;
#endif
            }
        }
    }
  else
    {
      /* Roundind mode = Zero / No inexact flag */
#if flag == 1
      return 0 /*sb != 0 && rnd_mode != MPFR_RNDZ*/;
#else
      if (MPFR_LIKELY(rw))
        {
          nw++;
          himask = ~MPFR_LIMB_MASK (GMP_NUMB_BITS - rw);
        }
      else
        himask = ~(mp_limb_t) 0;
      MPN_COPY_INCR(yp, xp + xsize - nw, nw);
      yp[0] &= himask;
      return 0;
#endif
    }
}
int
mpfr_cmp2 (mpfr_srcptr b, mpfr_srcptr c, mpfr_prec_t *cancel)
{
  mp_limb_t *bp, *cp, bb, cc = 0, lastc = 0, dif, high_dif = 0;
  mp_size_t bn, cn;
  mpfr_uexp_t diff_exp;
  mpfr_prec_t res = 0;
  int sign;

  /* b=c should not happen, since cmp2 is called only from agm
     (with different variables), and from sub1 (if same b=c, then
     sub1sp would be called instead */
  MPFR_ASSERTD (b != c);

  /* the cases b=0 or c=0 are also treated apart in agm and sub
     (which calls sub1) */
  MPFR_ASSERTD (MPFR_IS_PURE_FP(b));
  MPFR_ASSERTD (MPFR_IS_PURE_FP(c));

  if (MPFR_GET_EXP (b) >= MPFR_GET_EXP (c))
    {
      sign = 1;
      diff_exp = (mpfr_uexp_t) MPFR_GET_EXP (b) - MPFR_GET_EXP (c);

      bp = MPFR_MANT(b);
      cp = MPFR_MANT(c);

      bn = (MPFR_PREC(b) - 1) / GMP_NUMB_BITS;
      cn = (MPFR_PREC(c) - 1) / GMP_NUMB_BITS; /* # of limbs of c minus 1 */

      if (MPFR_UNLIKELY( diff_exp == 0 ))
        {
          while (bn >= 0 && cn >= 0 && bp[bn] == cp[cn])
            {
              bn--;
              cn--;
              res += GMP_NUMB_BITS;
            }

          if (MPFR_UNLIKELY (bn < 0))
            {
              if (MPFR_LIKELY (cn < 0)) /* b = c */
                return 0;

              bp = cp;
              bn = cn;
              cn = -1;
              sign = -1;
            }

          if (MPFR_UNLIKELY (cn < 0))
            /* c discards exactly the upper part of b */
            {
              unsigned int z;

              MPFR_ASSERTD (bn >= 0);

              while (bp[bn] == 0)
                {
                  if (--bn < 0) /* b = c */
                    return 0;
                  res += GMP_NUMB_BITS;
                }

              count_leading_zeros(z, bp[bn]); /* bp[bn] <> 0 */
              *cancel = res + z;
              return sign;
            }

          MPFR_ASSERTD (bn >= 0);
          MPFR_ASSERTD (cn >= 0);
          MPFR_ASSERTD (bp[bn] != cp[cn]);
          if (bp[bn] < cp[cn])
            {
              mp_limb_t *tp;
              mp_size_t tn;

              tp = bp; bp = cp; cp = tp;
              tn = bn; bn = cn; cn = tn;
              sign = -1;
            }
        }
    } /* MPFR_EXP(b) >= MPFR_EXP(c) */
  else /* MPFR_EXP(b) < MPFR_EXP(c) */
    {
      sign = -1;
      diff_exp = (mpfr_uexp_t) MPFR_GET_EXP (c) - MPFR_GET_EXP (b);

      bp = MPFR_MANT(c);
      cp = MPFR_MANT(b);

      bn = (MPFR_PREC(c) - 1) / GMP_NUMB_BITS;
      cn = (MPFR_PREC(b) - 1) / GMP_NUMB_BITS;
    }

  /* now we have removed the identical upper limbs of b and c
     (can happen only when diff_exp = 0), and after the possible
     swap, we have |b| > |c|: bp[bn] > cc, bn >= 0, cn >= 0,
     diff_exp = EXP(b) - EXP(c).
  */

  if (MPFR_LIKELY (diff_exp < GMP_NUMB_BITS))
    {
      cc = cp[cn] >> diff_exp;
      /* warning: a shift by GMP_NUMB_BITS may give wrong results */
      if (diff_exp)
        lastc = cp[cn] << (GMP_NUMB_BITS - diff_exp);
      cn--;
    }
Esempio n. 5
0
/* Compute the real part of the dilogarithm defined by
   Li2(x) = -\Int_{t=0}^x log(1-t)/t dt */
int
mpfr_li2 (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
  int inexact;
  mp_exp_t err;
  mpfr_prec_t yp, m;
  MPFR_ZIV_DECL (loop);
  MPFR_SAVE_EXPO_DECL (expo);

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

  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))
        {
          MPFR_SET_NEG (y);
          MPFR_SET_INF (y);
          MPFR_RET (0);
        }
      else                      /* x is zero */
        {
          MPFR_ASSERTD (MPFR_IS_ZERO (x));
          MPFR_SET_SAME_SIGN (y, x);
          MPFR_SET_ZERO (y);
          MPFR_RET (0);
        }
    }

  /* Li2(x) = x + x^2/4 + x^3/9 + ..., more precisely for 0 < x <= 1/2
     we have |Li2(x) - x| < x^2/2 <= 2^(2EXP(x)-1) and for -1/2 <= x < 0
     we have |Li2(x) - x| < x^2/4 <= 2^(2EXP(x)-2) */
  if (MPFR_IS_POS (x))
    MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, -MPFR_GET_EXP (x), 1, 1, rnd_mode,
                                      {});
  else
    MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, -MPFR_GET_EXP (x), 2, 0, rnd_mode,
                                      {});

  MPFR_SAVE_EXPO_MARK (expo);
  yp = MPFR_PREC (y);
  m = yp + MPFR_INT_CEIL_LOG2 (yp) + 13;

  if (MPFR_LIKELY ((mpfr_cmp_ui (x, 0) > 0) && (mpfr_cmp_d (x, 0.5) <= 0)))
    /* 0 < x <= 1/2: Li2(x) = S(-log(1-x))-log^2(1-x)/4 */
    {
      mpfr_t s, u;
      mp_exp_t expo_l;
      int k;

      mpfr_init2 (u, m);
      mpfr_init2 (s, m);

      MPFR_ZIV_INIT (loop, m);
      for (;;)
        {
          mpfr_ui_sub (u, 1, x, GMP_RNDN);
          mpfr_log (u, u, GMP_RNDU);
          if (MPFR_IS_ZERO(u))
            goto next_m;
          mpfr_neg (u, u, GMP_RNDN);    /* u = -log(1-x) */
          expo_l = MPFR_GET_EXP (u);
          k = li2_series (s, u, GMP_RNDU);
          err = 1 + MPFR_INT_CEIL_LOG2 (k + 1);

          mpfr_sqr (u, u, GMP_RNDU);
          mpfr_div_2ui (u, u, 2, GMP_RNDU);     /* u = log^2(1-x) / 4 */
          mpfr_sub (s, s, u, GMP_RNDN);

          /* error(s) <= (0.5 + 2^(d-EXP(s))
             + 2^(3 + MAX(1, - expo_l) - EXP(s))) ulp(s) */
          err = MAX (err, MAX (1, - expo_l) - 1) - MPFR_GET_EXP (s);
          err = 2 + MAX (-1, err);
          if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode))
            break;

        next_m:
          MPFR_ZIV_NEXT (loop, m);
          mpfr_set_prec (u, m);
          mpfr_set_prec (s, m);
        }
      MPFR_ZIV_FREE (loop);
      inexact = mpfr_set (y, s, rnd_mode);

      mpfr_clear (u);
      mpfr_clear (s);
      MPFR_SAVE_EXPO_FREE (expo);
      return mpfr_check_range (y, inexact, rnd_mode);
    }
  else if (!mpfr_cmp_ui (x, 1))
    /* Li2(1)= pi^2 / 6 */
    {
      mpfr_t u;
      mpfr_init2 (u, m);

      MPFR_ZIV_INIT (loop, m);
      for (;;)
        {
          mpfr_const_pi (u, GMP_RNDU);
          mpfr_sqr (u, u, GMP_RNDN);
          mpfr_div_ui (u, u, 6, GMP_RNDN);

          err = m - 4;          /* error(u) <= 19/2 ulp(u) */
          if (MPFR_CAN_ROUND (u, err, yp, rnd_mode))
            break;

          MPFR_ZIV_NEXT (loop, m);
          mpfr_set_prec (u, m);
        }
      MPFR_ZIV_FREE (loop);
      inexact = mpfr_set (y, u, rnd_mode);

      mpfr_clear (u);
      MPFR_SAVE_EXPO_FREE (expo);
      return mpfr_check_range (y, inexact, rnd_mode);
    }
  else if (mpfr_cmp_ui (x, 2) >= 0)
    /* x >= 2: Li2(x) = -S(-log(1-1/x))-log^2(x)/2+log^2(1-1/x)/4+pi^2/3 */
    {
      int k;
      mp_exp_t expo_l;
      mpfr_t s, u, xx;

      if (mpfr_cmp_ui (x, 38) >= 0)
        {
          inexact = mpfr_li2_asympt_pos (y, x, rnd_mode);
          if (inexact != 0)
            goto end_of_case_gt2;
        }

      mpfr_init2 (u, m);
      mpfr_init2 (s, m);
      mpfr_init2 (xx, m);

      MPFR_ZIV_INIT (loop, m);
      for (;;)
        {
          mpfr_ui_div (xx, 1, x, GMP_RNDN);
          mpfr_neg (xx, xx, GMP_RNDN);
          mpfr_log1p (u, xx, GMP_RNDD);
          mpfr_neg (u, u, GMP_RNDU);    /* u = -log(1-1/x) */
          expo_l = MPFR_GET_EXP (u);
          k = li2_series (s, u, GMP_RNDN);
          mpfr_neg (s, s, GMP_RNDN);
          err = MPFR_INT_CEIL_LOG2 (k + 1) + 1; /* error(s) <= 2^err ulp(s) */

          mpfr_sqr (u, u, GMP_RNDN);
          mpfr_div_2ui (u, u, 2, GMP_RNDN);     /* u= log^2(1-1/x)/4 */
          mpfr_add (s, s, u, GMP_RNDN);
          err =
            MAX (err,
                 3 + MAX (1, -expo_l) + MPFR_GET_EXP (u)) - MPFR_GET_EXP (s);
          err = 2 + MAX (-1, err);      /* error(s) <= 2^err ulp(s) */
          err += MPFR_GET_EXP (s);

          mpfr_log (u, x, GMP_RNDU);
          mpfr_sqr (u, u, GMP_RNDN);
          mpfr_div_2ui (u, u, 1, GMP_RNDN);     /* u = log^2(x)/2 */
          mpfr_sub (s, s, u, GMP_RNDN);
          err = MAX (err, 3 + MPFR_GET_EXP (u)) - MPFR_GET_EXP (s);
          err = 2 + MAX (-1, err);      /* error(s) <= 2^err ulp(s) */
          err += MPFR_GET_EXP (s);

          mpfr_const_pi (u, GMP_RNDU);
          mpfr_sqr (u, u, GMP_RNDN);
          mpfr_div_ui (u, u, 3, GMP_RNDN);      /* u = pi^2/3 */
          mpfr_add (s, s, u, GMP_RNDN);
          err = MAX (err, 2) - MPFR_GET_EXP (s);
          err = 2 + MAX (-1, err);      /* error(s) <= 2^err ulp(s) */
          if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode))
            break;

          MPFR_ZIV_NEXT (loop, m);
          mpfr_set_prec (u, m);
          mpfr_set_prec (s, m);
          mpfr_set_prec (xx, m);
        }
      MPFR_ZIV_FREE (loop);
      inexact = mpfr_set (y, s, rnd_mode);
      mpfr_clears (s, u, xx, (mpfr_ptr) 0);

    end_of_case_gt2:
      MPFR_SAVE_EXPO_FREE (expo);
      return mpfr_check_range (y, inexact, rnd_mode);
    }
  else if (mpfr_cmp_ui (x, 1) > 0)
    /* 2 > x > 1: Li2(x) = S(log(x))+log^2(x)/4-log(x)log(x-1)+pi^2/6 */
    {
      int k;
      mp_exp_t e1, e2;
      mpfr_t s, u, v, xx;
      mpfr_init2 (s, m);
      mpfr_init2 (u, m);
      mpfr_init2 (v, m);
      mpfr_init2 (xx, m);

      MPFR_ZIV_INIT (loop, m);
      for (;;)
        {
          mpfr_log (v, x, GMP_RNDU);
          k = li2_series (s, v, GMP_RNDN);
          e1 = MPFR_GET_EXP (s);

          mpfr_sqr (u, v, GMP_RNDN);
          mpfr_div_2ui (u, u, 2, GMP_RNDN);     /* u = log^2(x)/4 */
          mpfr_add (s, s, u, GMP_RNDN);

          mpfr_sub_ui (xx, x, 1, GMP_RNDN);
          mpfr_log (u, xx, GMP_RNDU);
          e2 = MPFR_GET_EXP (u);
          mpfr_mul (u, v, u, GMP_RNDN); /* u = log(x) * log(x-1) */
          mpfr_sub (s, s, u, GMP_RNDN);

          mpfr_const_pi (u, GMP_RNDU);
          mpfr_sqr (u, u, GMP_RNDN);
          mpfr_div_ui (u, u, 6, GMP_RNDN);      /* u = pi^2/6 */
          mpfr_add (s, s, u, GMP_RNDN);
          /* error(s) <= (31 + (k+1) * 2^(1-e1) + 2^(1-e2)) ulp(s)
             see algorithms.tex */
          err = MAX (MPFR_INT_CEIL_LOG2 (k + 1) + 1 - e1, 1 - e2);
          err = 2 + MAX (5, err);
          if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode))
            break;

          MPFR_ZIV_NEXT (loop, m);
          mpfr_set_prec (s, m);
          mpfr_set_prec (u, m);
          mpfr_set_prec (v, m);
          mpfr_set_prec (xx, m);
        }
      MPFR_ZIV_FREE (loop);
      inexact = mpfr_set (y, s, rnd_mode);

      mpfr_clears (s, u, v, xx, (mpfr_ptr) 0);
      MPFR_SAVE_EXPO_FREE (expo);
      return mpfr_check_range (y, inexact, rnd_mode);
    }
  else if (mpfr_cmp_ui_2exp (x, 1, -1) > 0) /*  1/2 < x < 1 */
    /* 1 > x > 1/2: Li2(x) = -S(-log(x))+log^2(x)/4-log(x)log(1-x)+pi^2/6 */
    {
      int k;
      mpfr_t s, u, v, xx;
      mpfr_init2 (s, m);
      mpfr_init2 (u, m);
      mpfr_init2 (v, m);
      mpfr_init2 (xx, m);


      MPFR_ZIV_INIT (loop, m);
      for (;;)
        {
          mpfr_log (u, x, GMP_RNDD);
          mpfr_neg (u, u, GMP_RNDN);
          k = li2_series (s, u, GMP_RNDN);
          mpfr_neg (s, s, GMP_RNDN);
          err = 1 + MPFR_INT_CEIL_LOG2 (k + 1) - MPFR_GET_EXP (s);

          mpfr_ui_sub (xx, 1, x, GMP_RNDN);
          mpfr_log (v, xx, GMP_RNDU);
          mpfr_mul (v, v, u, GMP_RNDN); /* v = - log(x) * log(1-x) */
          mpfr_add (s, s, v, GMP_RNDN);
          err = MAX (err, 1 - MPFR_GET_EXP (v));
          err = 2 + MAX (3, err) - MPFR_GET_EXP (s);

          mpfr_sqr (u, u, GMP_RNDN);
          mpfr_div_2ui (u, u, 2, GMP_RNDN);     /* u = log^2(x)/4 */
          mpfr_add (s, s, u, GMP_RNDN);
          err = MAX (err, 2 + MPFR_GET_EXP (u)) - MPFR_GET_EXP (s);
          err = 2 + MAX (-1, err) + MPFR_GET_EXP (s);

          mpfr_const_pi (u, GMP_RNDU);
          mpfr_sqr (u, u, GMP_RNDN);
          mpfr_div_ui (u, u, 6, GMP_RNDN);      /* u = pi^2/6 */
          mpfr_add (s, s, u, GMP_RNDN);
          err = MAX (err, 3) - MPFR_GET_EXP (s);
          err = 2 + MAX (-1, err);

          if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode))
            break;

          MPFR_ZIV_NEXT (loop, m);
          mpfr_set_prec (s, m);
          mpfr_set_prec (u, m);
          mpfr_set_prec (v, m);
          mpfr_set_prec (xx, m);
        }
      MPFR_ZIV_FREE (loop);
      inexact = mpfr_set (y, s, rnd_mode);

      mpfr_clears (s, u, v, xx, (mpfr_ptr) 0);
      MPFR_SAVE_EXPO_FREE (expo);
      return mpfr_check_range (y, inexact, rnd_mode);
    }
  else if (mpfr_cmp_si (x, -1) >= 0)
    /* 0 > x >= -1: Li2(x) = -S(log(1-x))-log^2(1-x)/4 */
    {
      int k;
      mp_exp_t expo_l;
      mpfr_t s, u, xx;
      mpfr_init2 (s, m);
      mpfr_init2 (u, m);
      mpfr_init2 (xx, m);

      MPFR_ZIV_INIT (loop, m);
      for (;;)
        {
          mpfr_neg (xx, x, GMP_RNDN);
          mpfr_log1p (u, xx, GMP_RNDN);
          k = li2_series (s, u, GMP_RNDN);
          mpfr_neg (s, s, GMP_RNDN);
          expo_l = MPFR_GET_EXP (u);
          err = 1 + MPFR_INT_CEIL_LOG2 (k + 1) - MPFR_GET_EXP (s);

          mpfr_sqr (u, u, GMP_RNDN);
          mpfr_div_2ui (u, u, 2, GMP_RNDN);     /* u = log^2(1-x)/4 */
          mpfr_sub (s, s, u, GMP_RNDN);
          err = MAX (err, - expo_l);
          err = 2 + MAX (err, 3);
          if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode))
            break;

          MPFR_ZIV_NEXT (loop, m);
          mpfr_set_prec (s, m);
          mpfr_set_prec (u, m);
          mpfr_set_prec (xx, m);
        }
      MPFR_ZIV_FREE (loop);
      inexact = mpfr_set (y, s, rnd_mode);

      mpfr_clears (s, u, xx, (mpfr_ptr) 0);
      MPFR_SAVE_EXPO_FREE (expo);
      return mpfr_check_range (y, inexact, rnd_mode);
    }
  else
    /* x < -1: Li2(x)
       = S(log(1-1/x))-log^2(-x)/4-log(1-x)log(-x)/2+log^2(1-x)/4-pi^2/6 */
    {
      int k;
      mpfr_t s, u, v, w, xx;

      if (mpfr_cmp_si (x, -7) <= 0)
        {
          inexact = mpfr_li2_asympt_neg (y, x, rnd_mode);
          if (inexact != 0)
            goto end_of_case_ltm1;
        }

      mpfr_init2 (s, m);
      mpfr_init2 (u, m);
      mpfr_init2 (v, m);
      mpfr_init2 (w, m);
      mpfr_init2 (xx, m);

      MPFR_ZIV_INIT (loop, m);
      for (;;)
        {
          mpfr_ui_div (xx, 1, x, GMP_RNDN);
          mpfr_neg (xx, xx, GMP_RNDN);
          mpfr_log1p (u, xx, GMP_RNDN);
          k = li2_series (s, u, GMP_RNDN);

          mpfr_ui_sub (xx, 1, x, GMP_RNDN);
          mpfr_log (u, xx, GMP_RNDU);
          mpfr_neg (xx, x, GMP_RNDN);
          mpfr_log (v, xx, GMP_RNDU);
          mpfr_mul (w, v, u, GMP_RNDN);
          mpfr_div_2ui (w, w, 1, GMP_RNDN);  /* w = log(-x) * log(1-x) / 2 */
          mpfr_sub (s, s, w, GMP_RNDN);
          err = 1 + MAX (3, MPFR_INT_CEIL_LOG2 (k+1) + 1  - MPFR_GET_EXP (s))
            + MPFR_GET_EXP (s);

          mpfr_sqr (w, v, GMP_RNDN);
          mpfr_div_2ui (w, w, 2, GMP_RNDN);  /* w = log^2(-x) / 4 */
          mpfr_sub (s, s, w, GMP_RNDN);
          err = MAX (err, 3 + MPFR_GET_EXP(w)) - MPFR_GET_EXP (s);
          err = 2 + MAX (-1, err) + MPFR_GET_EXP (s);

          mpfr_sqr (w, u, GMP_RNDN);
          mpfr_div_2ui (w, w, 2, GMP_RNDN);     /* w = log^2(1-x) / 4 */
          mpfr_add (s, s, w, GMP_RNDN);
          err = MAX (err, 3 + MPFR_GET_EXP (w)) - MPFR_GET_EXP (s);
          err = 2 + MAX (-1, err) + MPFR_GET_EXP (s);

          mpfr_const_pi (w, GMP_RNDU);
          mpfr_sqr (w, w, GMP_RNDN);
          mpfr_div_ui (w, w, 6, GMP_RNDN);      /* w = pi^2 / 6 */
          mpfr_sub (s, s, w, GMP_RNDN);
          err = MAX (err, 3) - MPFR_GET_EXP (s);
          err = 2 + MAX (-1, err) + MPFR_GET_EXP (s);

          if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode))
            break;

          MPFR_ZIV_NEXT (loop, m);
          mpfr_set_prec (s, m);
          mpfr_set_prec (u, m);
          mpfr_set_prec (v, m);
          mpfr_set_prec (w, m);
          mpfr_set_prec (xx, m);
        }
      MPFR_ZIV_FREE (loop);
      inexact = mpfr_set (y, s, rnd_mode);
      mpfr_clears (s, u, v, w, xx, (mpfr_ptr) 0);

    end_of_case_ltm1:
      MPFR_SAVE_EXPO_FREE (expo);
      return mpfr_check_range (y, inexact, rnd_mode);
    }

  MPFR_ASSERTN (0);             /* should never reach this point */
}
Esempio n. 6
0
File: get_f.c Progetto: Kirija/XPIR
/* 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. 7
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. 8
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;

  /* initialize 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. 9
0
/* set f to the rational q */
int
mpfr_set_q (mpfr_ptr f, mpq_srcptr q, mpfr_rnd_t rnd)
{
  mpz_srcptr num, den;
  mpfr_t n, d;
  int inexact;
  int cn, cd;
  long shift;
  mp_size_t sn, sd;
  MPFR_SAVE_EXPO_DECL (expo);

  num = mpq_numref (q);
  den = mpq_denref (q);
  /* NAN and INF for mpq are not really documented, but could be found */
  if (MPFR_UNLIKELY (mpz_sgn (num) == 0))
    {
      if (MPFR_UNLIKELY (mpz_sgn (den) == 0))
        {
          MPFR_SET_NAN (f);
          MPFR_RET_NAN;
        }
      else
        {
          MPFR_SET_ZERO (f);
          MPFR_SET_POS (f);
          MPFR_RET (0);
        }
    }
  if (MPFR_UNLIKELY (mpz_sgn (den) == 0))
    {
      MPFR_SET_INF (f);
      MPFR_SET_SIGN (f, mpz_sgn (num));
      MPFR_RET (0);
    }

  MPFR_SAVE_EXPO_MARK (expo);

  cn = set_z (n, num, &sn);
  cd = set_z (d, den, &sd);

  sn -= sd;
  if (MPFR_UNLIKELY (sn > MPFR_EMAX_MAX / GMP_NUMB_BITS))
    {
      MPFR_SAVE_EXPO_FREE (expo);
      inexact = mpfr_overflow (f, rnd, MPFR_SIGN (f));
      goto end;
    }
  if (MPFR_UNLIKELY (sn < MPFR_EMIN_MIN / GMP_NUMB_BITS -1))
    {
      MPFR_SAVE_EXPO_FREE (expo);
      if (rnd == MPFR_RNDN)
        rnd = MPFR_RNDZ;
      inexact = mpfr_underflow (f, rnd, MPFR_SIGN (f));
      goto end;
    }

  inexact = mpfr_div (f, n, d, rnd);
  shift = GMP_NUMB_BITS*sn+cn-cd;
  MPFR_ASSERTD (shift == GMP_NUMB_BITS*sn+cn-cd);
  cd = mpfr_mul_2si (f, f, shift, rnd);
  MPFR_SAVE_EXPO_FREE (expo);
  if (MPFR_UNLIKELY (cd != 0))
    inexact = cd;
  else
    inexact = mpfr_check_range (f, inexact, rnd);
 end:
  mpfr_clear (d);
  mpfr_clear (n);
  MPFR_RET (inexact);
}
Esempio n. 10
0
size_t
mpfr_out_str (FILE *stream, int base, size_t n_digits, mpfr_srcptr op,
              mpfr_rnd_t rnd_mode)
{
  char *s, *s0;
  size_t l;
  mpfr_exp_t e;
  int err;

  MPFR_ASSERTN (base >= 2 && base <= 62);

  /* when stream=NULL, output to stdout */
  if (stream == NULL)
    stream = stdout;

  if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (op)))
    {
      if (MPFR_IS_NAN (op))
        OUT_STR_RET ("@NaN@");
      else if (MPFR_IS_INF (op))
        OUT_STR_RET (MPFR_IS_POS (op) ? "@Inf@" : "-@Inf@");
      else
        {
          MPFR_ASSERTD (MPFR_IS_ZERO (op));
          OUT_STR_RET (MPFR_IS_POS (op) ? "0" : "-0");
        }
    }

  s = mpfr_get_str (NULL, &e, base, n_digits, op, rnd_mode);

  s0 = s;
  /* for op=3.1416 we have s = "31416" and e = 1 */

  l = strlen (s) + 1; /* size of allocated block returned by mpfr_get_str
                         - may be incorrect, as only an upper bound? */

  /* outputs possible sign and significand */
  err = (*s == '-' && fputc (*s++, stream) == EOF)
    || fputc (*s++, stream) == EOF  /* leading digit */
    || fputc ((unsigned char) MPFR_DECIMAL_POINT, stream) == EOF
    || fputs (s, stream) == EOF;     /* trailing significand */
  mpfr_free_func (s0, l);
  if (MPFR_UNLIKELY (err))
    return 0;

  e--;  /* due to the leading digit */

  /* outputs exponent */
  if (e)
    {
      int r;

      MPFR_ASSERTN(e >= LONG_MIN);
      MPFR_ASSERTN(e <= LONG_MAX);

      r = fprintf (stream, (base <= 10 ? "e%ld" : "@%ld"), (long) e);
      if (MPFR_UNLIKELY (r < 0))
        return 0;

      l += r;
    }

  return l;
}
Esempio n. 11
0
File: sin.c Progetto: epowers/mpfr
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[%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,
      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_GET_EXP(xr) < (mpfr_exp_t) 3 - (mpfr_exp_t) m
              || MPFR_IS_ZERO(c)
              || MPFR_GET_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. 12
0
File: eint.c Progetto: Kirija/XPIR
/* compute in y an approximation of sum(x^k/k/k!, k=1..infinity),
   and return e such that the absolute error is bound by 2^e ulp(y) */
static mpfr_exp_t
mpfr_eint_aux (mpfr_t y, mpfr_srcptr x)
{
  mpfr_t eps; /* dynamic (absolute) error bound on t */
  mpfr_t erru, errs;
  mpz_t m, s, t, u;
  mpfr_exp_t e, sizeinbase;
  mpfr_prec_t w = MPFR_PREC(y);
  unsigned long k;
  MPFR_GROUP_DECL (group);

  /* for |x| <= 1, we have S := sum(x^k/k/k!, k=1..infinity) = x + R(x)
     where |R(x)| <= (x/2)^2/(1-x/2) <= 2*(x/2)^2
     thus |R(x)/x| <= |x|/2
     thus if |x| <= 2^(-PREC(y)) we have |S - o(x)| <= ulp(y) */

  if (MPFR_GET_EXP(x) <= - (mpfr_exp_t) w)
    {
      mpfr_set (y, x, MPFR_RNDN);
      return 0;
    }

  mpz_init (s); /* initializes to 0 */
  mpz_init (t);
  mpz_init (u);
  mpz_init (m);
  MPFR_GROUP_INIT_3 (group, 31, eps, erru, errs);
  e = mpfr_get_z_2exp (m, x); /* x = m * 2^e */
  MPFR_ASSERTD (mpz_sizeinbase (m, 2) == MPFR_PREC (x));
  if (MPFR_PREC (x) > w)
    {
      e += MPFR_PREC (x) - w;
      mpz_tdiv_q_2exp (m, m, MPFR_PREC (x) - w);
    }
  /* remove trailing zeroes from m: this will speed up much cases where
     x is a small integer divided by a power of 2 */
  k = mpz_scan1 (m, 0);
  mpz_tdiv_q_2exp (m, m, k);
  e += k;
  /* initialize t to 2^w */
  mpz_set_ui (t, 1);
  mpz_mul_2exp (t, t, w);
  mpfr_set_ui (eps, 0, MPFR_RNDN); /* eps[0] = 0 */
  mpfr_set_ui (errs, 0, MPFR_RNDN);
  for (k = 1;; k++)
    {
      /* let eps[k] be the absolute error on t[k]:
         since t[k] = trunc(t[k-1]*m*2^e/k), we have
         eps[k+1] <= 1 + eps[k-1]*m*2^e/k + t[k-1]*m*2^(1-w)*2^e/k
                  =  1 + (eps[k-1] + t[k-1]*2^(1-w))*m*2^e/k
                  = 1 + (eps[k-1]*2^(w-1) + t[k-1])*2^(1-w)*m*2^e/k */
      mpfr_mul_2ui (eps, eps, w - 1, MPFR_RNDU);
      mpfr_add_z (eps, eps, t, MPFR_RNDU);
      MPFR_MPZ_SIZEINBASE2 (sizeinbase, m);
      mpfr_mul_2si (eps, eps, sizeinbase - (w - 1) + e, MPFR_RNDU);
      mpfr_div_ui (eps, eps, k, MPFR_RNDU);
      mpfr_add_ui (eps, eps, 1, MPFR_RNDU);
      mpz_mul (t, t, m);
      if (e < 0)
        mpz_tdiv_q_2exp (t, t, -e);
      else
        mpz_mul_2exp (t, t, e);
      mpz_tdiv_q_ui (t, t, k);
      mpz_tdiv_q_ui (u, t, k);
      mpz_add (s, s, u);
      /* the absolute error on u is <= 1 + eps[k]/k */
      mpfr_div_ui (erru, eps, k, MPFR_RNDU);
      mpfr_add_ui (erru, erru, 1, MPFR_RNDU);
      /* and that on s is the sum of all errors on u */
      mpfr_add (errs, errs, erru, MPFR_RNDU);
      /* we are done when t is smaller than errs */
      if (mpz_sgn (t) == 0)
        sizeinbase = 0;
      else
        MPFR_MPZ_SIZEINBASE2 (sizeinbase, t);
      if (sizeinbase < MPFR_GET_EXP (errs))
        break;
    }
  /* the truncation error is bounded by (|t|+eps)/k*(|x|/k + |x|^2/k^2 + ...)
     <= (|t|+eps)/k*|x|/(k-|x|) */
  mpz_abs (t, t);
  mpfr_add_z (eps, eps, t, MPFR_RNDU);
  mpfr_div_ui (eps, eps, k, MPFR_RNDU);
  mpfr_abs (erru, x, MPFR_RNDU); /* |x| */
  mpfr_mul (eps, eps, erru, MPFR_RNDU);
  mpfr_ui_sub (erru, k, erru, MPFR_RNDD);
  if (MPFR_IS_NEG (erru))
    {
      /* the truncated series does not converge, return fail */
      e = w;
    }
  else
    {
      mpfr_div (eps, eps, erru, MPFR_RNDU);
      mpfr_add (errs, errs, eps, MPFR_RNDU);
      mpfr_set_z (y, s, MPFR_RNDN);
      mpfr_div_2ui (y, y, w, MPFR_RNDN);
      /* errs was an absolute error bound on s. We must convert it to an error
         in terms of ulp(y). Since ulp(y) = 2^(EXP(y)-PREC(y)), we must
         divide the error by 2^(EXP(y)-PREC(y)), but since we divided also
         y by 2^w = 2^PREC(y), we must simply divide by 2^EXP(y). */
      e = MPFR_GET_EXP (errs) - MPFR_GET_EXP (y);
    }
  MPFR_GROUP_CLEAR (group);
  mpz_clear (s);
  mpz_clear (t);
  mpz_clear (u);
  mpz_clear (m);
  return e;
}