unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* ash rewrite
@ 2005-01-27 22:48 Kevin Ryde
  2005-01-27 22:50 ` Kevin Ryde
  2005-02-09 21:29 ` Rob Browning
  0 siblings, 2 replies; 8+ messages in thread
From: Kevin Ryde @ 2005-01-27 22:48 UTC (permalink / raw)


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);
    }
}


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 8+ messages in thread
end of thread, other threads:[~2005-03-08 17:05 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2005-01-27 22:48 ash rewrite Kevin Ryde
2005-01-27 22:50 ` Kevin Ryde
2005-02-09 21:29 ` Rob Browning
2005-02-09 22:16   ` Kevin Ryde
2005-02-09 22:33   ` primitive-fork hang (was: ash rewrite) Kevin Ryde
2005-02-28  1:50     ` primitive-fork hang Marius Vollmer
2005-02-28 22:03       ` Kevin Ryde
2005-03-08 17:05         ` Marius Vollmer

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).