SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
            (SCM n, SCM cnt),
	    "Return @var{n} shifted left by @var{cnt} bits, or shifted right\n"
	    "if @var{cnt} is negative.  This is an ``arithmetic'' shift.\n"
	    "\n"
	    "This is effectively a multiplication by @m{2^{cnt},\n"
	    "address@hidden, and when @var{cnt} is negative it's a division,\n"
	    "rounded towards negative infinity.  (Note that this is not the\n"
	    "same rounding as @code{quotient} does.)\n"
	    "\n"
	    "With @var{n} viewed as an infinite precision twos complement,\n"
	    "@code{ash} means a left shift introducing zero bits, or a right\n"
	    "shift dropping bits.\n"
	    "\n"
	    "@lisp\n"
	    "(number->string (ash #b1 3) 2)     @result{} \"1000\"\n"
	    "(number->string (ash #b1010 -1) 2) @result{} \"101\"\n"
	    "\n"
	    ";; -23 is bits ...11101001, -6 is bits ...111010\n"
	    "(ash -23 -2) @result{} -6\n"
	    "@end lisp")
#define FUNC_NAME s_scm_ash
{
  long  bits_to_shift;
  SCM_VALIDATE_INUM (2, cnt);
  bits_to_shift = SCM_INUM (cnt);

  if (SCM_INUMP (y)) {
    long in = SCM_INUM (n);

    if (bits_to_shift > 0)
      {
        /* Left shift of more than SCM_I_FIXNUM_BIT-1 will certainly
           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 in>=0, or all 1s for in<0 then there's no overflow.  Those
           bits are "in >> (SCM_I_FIXNUM_BIT-1 - bits_to_shift".  */

        if (in == 0)
          return n;

        /* FIXME: This relies on signed right shifts being arithmetic, which
           is not guaranteed by C99.  */
        if (bits_to_shift < SCM_I_FIXNUM_BIT-1
            && ((unsigned long) ((in >> (SCM_I_FIXNUM_BIT-1 - bits_to_shift))
                                 + 1 <= 1)))
          {
            return SCM_MKINUM (in << bits_to_shift);
          }
        else
          {
            SCM result = scm_i_long2big (z);
            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 >= LONG_BIT)
          return (in >= ? 0 : -1);
        else
          {
            /* FIXME: This relies on signed right shifts being arithmetic,
               which is not guaranteed by C99.  */
            return SCM_MKINUM (in >> 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.  We could detect the case of bits_to_shift being so big
           as to leave us with only 0 or -1, and avoid allocating a bignum,
           but that doesn't seem worth worrying about.  */
        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);
  }
}
#undef FUNC_NAME