ash rewrite

[Kevin Ryde]

I checked in my rewrite of ash, it should be much faster than using
integer-expt.


{
  long bits_to_shift;
  bits_to_shift = scm_to_long (cnt);

  if (SCM_I_INUMP (n))
    {
      long nn = SCM_I_INUM (n);

      if (bits_to_shift > 0)
        {
          /* Left shift of bits_to_shift >= SCM_I_FIXNUM_BIT-1 will always
             overflow a non-zero fixnum.  For smaller shifts we check the
             bits going into positions above SCM_I_FIXNUM_BIT-1.  If they're
             all 0s for nn>=0, or all 1s for nn<0 then there's no overflow.
             Those bits are "nn >> (SCM_I_FIXNUM_BIT-1 -
             bits_to_shift)".  */

          if (nn == 0)
            return n;

          if (bits_to_shift < SCM_I_FIXNUM_BIT-1
              && ((unsigned long)
                  (SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1)
                  <= 1))
            {
              return SCM_I_MAKINUM (nn << bits_to_shift);
            }
          else
            {
              SCM result = scm_i_long2big (nn);
              mpz_mul_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result),
                            bits_to_shift);
              return result;
            }
        }
      else
        {
          bits_to_shift = -bits_to_shift;
          if (bits_to_shift >= SCM_LONG_BIT)
            return (nn >= 0 ? SCM_I_MAKINUM (0) : SCM_I_MAKINUM(-1));
          else
            return SCM_I_MAKINUM (SCM_SRS (nn, bits_to_shift));
        }

    }
  else if (SCM_BIGP (n))
    {
      SCM result;

      if (bits_to_shift == 0)
        return n;

      result = scm_i_mkbig ();
      if (bits_to_shift >= 0)
        {
          mpz_mul_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (n),
                        bits_to_shift);
          return result;
        }
      else
        {
          /* GMP doesn't have an fdiv_q_2exp variant returning just a long, so
             we have to allocate a bignum even if the result is going to be a
             fixnum.  */
          mpz_fdiv_q_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (n),
                           -bits_to_shift);
          return scm_i_normbig (result);
        }

    }
  else
    {
      SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
    }
}