DOUBLE
FMOD (DOUBLE x, DOUBLE y)
{
  if (isfinite (x) && isfinite (y) && y != L_(0.0))
    {
      if (x == L_(0.0))
        /* Return x, regardless of the sign of y.  */
        return x;

      {
        int negate = ((!signbit (x)) ^ (!signbit (y)));

        /* Take the absolute value of x and y.  */
        x = FABS (x);
        y = FABS (y);

        /* Trivial case that requires no computation.  */
        if (x < y)
          return (negate ? - x : x);

        {
          int yexp;
          DOUBLE ym;
          DOUBLE y1;
          DOUBLE y0;
          int k;
          DOUBLE x2;
          DOUBLE x1;
          DOUBLE x0;

          /* Write y = 2^yexp * (y1 * 2^-LIMB_BITS + y0 * 2^-(2*LIMB_BITS))
             where y1 is an integer, 2^(LIMB_BITS-1) <= y1 < 2^LIMB_BITS,
             y1 has at most LIMB_BITS bits,
             0 <= y0 < 2^LIMB_BITS,
             y0 has at most (MANT_DIG + 1) / 2 bits.  */
          ym = FREXP (y, &yexp);
          ym = ym * TWO_LIMB_BITS;
          y1 = TRUNC (ym);
          y0 = (ym - y1) * TWO_LIMB_BITS;

          /* Write
               x = 2^(yexp+(k-3)*LIMB_BITS)
                   * (x2 * 2^(2*LIMB_BITS) + x1 * 2^LIMB_BITS + x0)
             where x2, x1, x0 are each integers >= 0, < 2^LIMB_BITS.  */
          {
            int xexp;
            DOUBLE xm = FREXP (x, &xexp);
            /* Since we know x >= y, we know xexp >= yexp.  */
            xexp -= yexp;
            /* Compute k = ceil(xexp / LIMB_BITS).  */
            k = (xexp + LIMB_BITS - 1) / LIMB_BITS;
            /* Note: (k - 1) * LIMB_BITS + 1 <= xexp <= k * LIMB_BITS.  */
            /* Note: 0.5 <= xm < 1.0.  */
            xm = LDEXP (xm, xexp - (k - 1) * LIMB_BITS);
            /* Note: Now xm < 2^(xexp - (k - 1) * LIMB_BITS) <= 2^LIMB_BITS
               and xm >= 0.5 * 2^(xexp - (k - 1) * LIMB_BITS) >= 1.0
               and xm has at most MANT_DIG <= 2*LIMB_BITS+1 bits.  */
            x2 = TRUNC (xm);
            x1 = (xm - x2) * TWO_LIMB_BITS;
            /* Split off x0 from x1 later.  */
          }

          /* Test whether [x2,x1,0] >= 2^LIMB_BITS * [y1,y0].  */
          if (x2 > y1 || (x2 == y1 && x1 >= y0))
            {
              /* Subtract 2^LIMB_BITS * [y1,y0] from [x2,x1,0].  */
              x2 -= y1;
              x1 -= y0;
              if (x1 < L_(0.0))
                {
                  if (!(x2 >= L_(1.0)))
                    abort ();
                  x2 -= L_(1.0);
                  x1 += TWO_LIMB_BITS;
                }
            }

          /* Split off x0 from x1.  */
          {
            DOUBLE x1int = TRUNC (x1);
            x0 = TRUNC ((x1 - x1int) * TWO_LIMB_BITS);
            x1 = x1int;
          }

          for (; k > 0; k--)
            {
              /* Multiprecision division of the limb sequence [x2,x1,x0]
                 by [y1,y0].  */
              /* Here [x2,x1,x0] < 2^LIMB_BITS * [y1,y0].  */
              /* The first guess takes into account only [x2,x1] and [y1].

                 By Knuth's theorem, we know that
                   q* = min (floor ([x2,x1] / [y1]), 2^LIMB_BITS - 1)
                 and
                   q = floor ([x2,x1,x0] / [y1,y0])
                 are not far away:
                   q* - 2 <= q <= q* + 1.

                 Proof:
                 a) q* * y1 <= floor ([x2,x1] / [y1]) * y1 <= [x2,x1].
                    Hence
                    [x2,x1,x0] - q* * [y1,y0]
                      = 2^LIMB_BITS * ([x2,x1] - q* * [y1]) + x0 - q* * y0
                      >= x0 - q* * y0
                      >= - q* * y0
                      > - 2^(2*LIMB_BITS)
                      >= - 2 * [y1,y0]
                    So
                      [x2,x1,x0] > (q* - 2) * [y1,y0].
                 b) If q* = floor ([x2,x1] / [y1]), then
                      [x2,x1] < (q* + 1) * y1
                    Hence
                    [x2,x1,x0] - q* * [y1,y0]
                      = 2^LIMB_BITS * ([x2,x1] - q* * [y1]) + x0 - q* * y0
                      <= 2^LIMB_BITS * (y1 - 1) + x0 - q* * y0
                      <= 2^LIMB_BITS * (2^LIMB_BITS-2) + (2^LIMB_BITS-1) - 0
                      < 2^(2*LIMB_BITS)
                      <= 2 * [y1,y0]
                    So
                      [x2,x1,x0] < (q* + 2) * [y1,y0].
                    and so
                      q < q* + 2
                    which implies
                      q <= q* + 1.
                    In the other case, q* = 2^LIMB_BITS - 1.  Then trivially
                      q < 2^LIMB_BITS = q* + 1.

                 We know that floor ([x2,x1] / [y1]) >= 2^LIMB_BITS if and
                 only if x2 >= y1.  */
              DOUBLE q =
                (x2 >= y1
                 ? TWO_LIMB_BITS - L_(1.0)
                 : TRUNC ((x2 * TWO_LIMB_BITS + x1) / y1));
              if (q > L_(0.0))
                {
                  /* Compute
                     [x2,x1,x0] - q* * [y1,y0]
                       = 2^LIMB_BITS * ([x2,x1] - q* * [y1]) + x0 - q* * y0.  */
                  DOUBLE q_y1 = q * y1; /* exact, at most 2*LIMB_BITS bits */
                  DOUBLE q_y1_1 = TRUNC (q_y1 * TWO_LIMB_BITS_INVERSE);
                  DOUBLE q_y1_0 = q_y1 - q_y1_1 * TWO_LIMB_BITS;
                  DOUBLE q_y0 = q * y0; /* exact, at most MANT_DIG bits */
                  DOUBLE q_y0_1 = TRUNC (q_y0 * TWO_LIMB_BITS_INVERSE);
                  DOUBLE q_y0_0 = q_y0 - q_y0_1 * TWO_LIMB_BITS;
                  x2 -= q_y1_1;
                  x1 -= q_y1_0;
                  x1 -= q_y0_1;
                  x0 -= q_y0_0;
                  /* Move negative carry from x0 to x1 and from x1 to x2.  */
                  if (x0 < L_(0.0))
                    {
                      x0 += TWO_LIMB_BITS;
                      x1 -= L_(1.0);
                    }
                  if (x1 < L_(0.0))
                    {
                      x1 += TWO_LIMB_BITS;
                      x2 -= L_(1.0);
                      if (x1 < L_(0.0)) /* not sure this can happen */
                        {
                          x1 += TWO_LIMB_BITS;
                          x2 -= L_(1.0);
                        }
                    }
                  if (x2 < L_(0.0))
                    {
                      /* Reduce q by 1.  */
                      x1 += y1;
                      x0 += y0;
                      /* Move overflow from x0 to x1 and from x1 to x0.  */
                      if (x0 >= TWO_LIMB_BITS)
                        {
                          x0 -= TWO_LIMB_BITS;
                          x1 += L_(1.0);
                        }
                      if (x1 >= TWO_LIMB_BITS)
                        {
                          x1 -= TWO_LIMB_BITS;
                          x2 += L_(1.0);
                        }
                      if (x2 < L_(0.0))
                        {
                          /* Reduce q by 1 again.  */
                          x1 += y1;
                          x0 += y0;
                          /* Move overflow from x0 to x1 and from x1 to x0.  */
                          if (x0 >= TWO_LIMB_BITS)
                            {
                              x0 -= TWO_LIMB_BITS;
                              x1 += L_(1.0);
                            }
                          if (x1 >= TWO_LIMB_BITS)
                            {
                              x1 -= TWO_LIMB_BITS;
                              x2 += L_(1.0);
                            }
                          if (x2 < L_(0.0))
                            /* Shouldn't happen, because we proved that
                               q >= q* - 2.  */
                            abort ();
                        }
                    }
                }
              if (x2 > L_(0.0)
                  || x1 > y1
                  || (x1 == y1 && x0 >= y0))
                {
                  /* Increase q by 1.  */
                  x1 -= y1;
                  x0 -= y0;
                  /* Move negative carry from x0 to x1 and from x1 to x2.  */
                  if (x0 < L_(0.0))
                    {
                      x0 += TWO_LIMB_BITS;
                      x1 -= L_(1.0);
                    }
                  if (x1 < L_(0.0))
                    {
                      x1 += TWO_LIMB_BITS;
                      x2 -= L_(1.0);
                    }
                  if (x2 < L_(0.0))
                    abort ();
                  if (x2 > L_(0.0)
                      || x1 > y1
                      || (x1 == y1 && x0 >= y0))
                    /* Shouldn't happen, because we proved that
                       q <= q* + 1.  */
                    abort ();
                }
              /* Here [x2,x1,x0] < [y1,y0].  */
              /* Next round.  */
              x2 = x1;
#if (MANT_DIG + 1) / 2 > LIMB_BITS /* y0 can have a fractional bit */
              x1 = TRUNC (x0);
              x0 = (x0 - x1) * TWO_LIMB_BITS;
#else
              x1 = x0;
              x0 = L_(0.0);
#endif
              /* Here [x2,x1,x0] < 2^LIMB_BITS * [y1,y0].  */
            }
          /* Here k = 0.
             The result is
               2^(yexp-3*LIMB_BITS)
               * (x2 * 2^(2*LIMB_BITS) + x1 * 2^LIMB_BITS + x0).  */
          {
            DOUBLE r =
              LDEXP ((x2 * TWO_LIMB_BITS + x1) * TWO_LIMB_BITS + x0,
                     yexp - 3 * LIMB_BITS);
            return (negate ? - r : r);
          }
        }
      }
    }
  else
    {
      if (ISNAN (x) || ISNAN (y))
        return x + y; /* NaN */
      else if (isinf (y))
        return x;
      else
        /* x infinite or y zero */
        return NAN;
    }
}
Esempio n. 2
0
/* map floating-point number x to integer relative to exponent e */
static Scalar
_t1(quantize, Scalar)(Scalar x, int e)
{
  return LDEXP(x, (CHAR_BIT * (int)sizeof(Scalar) - 2) - e);
}
Esempio n. 3
0
DOUBLE
FUNC (DOUBLE x, int *expptr)
{
  int exponent;
  DECL_ROUNDING

  BEGIN_ROUNDING ();

#ifdef USE_FREXP_LDEXP
  /* frexp and ldexp are usually faster than the loop below.  */
  x = FREXP (x, &exponent);

  x = x + x;
  exponent -= 1;

  if (exponent < MIN_EXP - 1)
    {
      x = LDEXP (x, exponent - (MIN_EXP - 1));
      exponent = MIN_EXP - 1;
    }
#else
  {
    /* Since the exponent is an 'int', it fits in 64 bits.  Therefore the
       loops are executed no more than 64 times.  */
    DOUBLE pow2[64]; /* pow2[i] = 2^2^i */
    DOUBLE powh[64]; /* powh[i] = 2^-2^i */
    int i;

    exponent = 0;
    if (x >= L_(1.0))
      {
        /* A nonnegative exponent.  */
        {
          DOUBLE pow2_i; /* = pow2[i] */
          DOUBLE powh_i; /* = powh[i] */

          /* Invariants: pow2_i = 2^2^i, powh_i = 2^-2^i,
             x * 2^exponent = argument, x >= 1.0.  */
          for (i = 0, pow2_i = L_(2.0), powh_i = L_(0.5);
               ;
               i++, pow2_i = pow2_i * pow2_i, powh_i = powh_i * powh_i)
            {
              if (x >= pow2_i)
                {
                  exponent += (1 << i);
                  x *= powh_i;
                }
              else
                break;

              pow2[i] = pow2_i;
              powh[i] = powh_i;
            }
        }
        /* Here 1.0 <= x < 2^2^i.  */
      }
    else
      {
        /* A negative exponent.  */
        {
          DOUBLE pow2_i; /* = pow2[i] */
          DOUBLE powh_i; /* = powh[i] */

          /* Invariants: pow2_i = 2^2^i, powh_i = 2^-2^i,
             x * 2^exponent = argument, x < 1.0, exponent >= MIN_EXP - 1.  */
          for (i = 0, pow2_i = L_(2.0), powh_i = L_(0.5);
               ;
               i++, pow2_i = pow2_i * pow2_i, powh_i = powh_i * powh_i)
            {
              if (exponent - (1 << i) < MIN_EXP - 1)
                break;

              exponent -= (1 << i);
              x *= pow2_i;
              if (x >= L_(1.0))
                break;

              pow2[i] = pow2_i;
              powh[i] = powh_i;
            }
        }
        /* Here either x < 1.0 and exponent - 2^i < MIN_EXP - 1 <= exponent,
           or 1.0 <= x < 2^2^i and exponent >= MIN_EXP - 1.  */

        if (x < L_(1.0))
          /* Invariants: x * 2^exponent = argument, x < 1.0 and
             exponent - 2^i < MIN_EXP - 1 <= exponent.  */
          while (i > 0)
            {
              i--;
              if (exponent - (1 << i) >= MIN_EXP - 1)
                {
                  exponent -= (1 << i);
                  x *= pow2[i];
                  if (x >= L_(1.0))
                    break;
                }
            }

        /* Here either x < 1.0 and exponent = MIN_EXP - 1,
           or 1.0 <= x < 2^2^i and exponent >= MIN_EXP - 1.  */
      }

    /* Invariants: x * 2^exponent = argument, and
       either x < 1.0 and exponent = MIN_EXP - 1,
       or 1.0 <= x < 2^2^i and exponent >= MIN_EXP - 1.  */
    while (i > 0)
      {
        i--;
        if (x >= pow2[i])
          {
            exponent += (1 << i);
            x *= powh[i];
          }
      }
    /* Here either x < 1.0 and exponent = MIN_EXP - 1,
       or 1.0 <= x < 2.0 and exponent >= MIN_EXP - 1.  */
  }
#endif

  END_ROUNDING ();

  *expptr = exponent;
  return x;
}