/[guile]/guile/guile-core/libguile/numbers.c
ViewVC logotype

Diff of /guile/guile-core/libguile/numbers.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.214 by kryde, Fri Nov 21 00:07:13 2003 UTC revision 1.215 by kryde, Fri Nov 21 00:33:44 2003 UTC
# Line 1661  SCM_DEFINE (scm_ash, "ash", 2, 0, 0, Line 1661  SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
1661  #undef FUNC_NAME  #undef FUNC_NAME
1662    
1663    
1664    #define MIN(x,y)  ((x) < (y) ? (x) : (y))
1665    
1666  SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,  SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
1667              (SCM n, SCM start, SCM end),              (SCM n, SCM start, SCM end),
1668              "Return the integer composed of the @var{start} (inclusive)\n"              "Return the integer composed of the @var{start} (inclusive)\n"
# Line 1675  SCM_DEFINE (scm_bit_extract, "bit-extrac Line 1677  SCM_DEFINE (scm_bit_extract, "bit-extrac
1677              "@end lisp")              "@end lisp")
1678  #define FUNC_NAME s_scm_bit_extract  #define FUNC_NAME s_scm_bit_extract
1679  {  {
1680    unsigned long int istart, iend;    unsigned long int istart, iend, bits;
1681    SCM_VALIDATE_INUM_MIN_COPY (2, start,0, istart);    SCM_VALIDATE_INUM_MIN_COPY (2, start,0, istart);
1682    SCM_VALIDATE_INUM_MIN_COPY (3, end, 0, iend);    SCM_VALIDATE_INUM_MIN_COPY (3, end, 0, iend);
1683    SCM_ASSERT_RANGE (3, end, (iend >= istart));    SCM_ASSERT_RANGE (3, end, (iend >= istart));
1684    
1685      /* how many bits to keep */
1686      bits = iend - istart;
1687    
1688    if (SCM_INUMP (n))    if (SCM_INUMP (n))
1689      {      {
1690        long int in = SCM_INUM (n);        long int in = SCM_INUM (n);
1691        unsigned long int bits = iend - istart;  
1692          /* When istart>=SCM_I_FIXNUM_BIT we can just limit the shift to
1693             SCM_I_FIXNUM_BIT-1 to get either 0 or -1 per the sign of "in".
1694             FIXME: This shift relies on signed right shifts being arithmetic,
1695             which is not guaranteed by C99. */
1696          in >>= MIN (istart, SCM_I_FIXNUM_BIT-1);
1697    
1698        if (in < 0 && bits >= SCM_I_FIXNUM_BIT)        if (in < 0 && bits >= SCM_I_FIXNUM_BIT)
1699          {          {
1700            /* Since we emulate two's complement encoded numbers, this            /* Since we emulate two's complement encoded numbers, this
1701             * special case requires us to produce a result that has             * special case requires us to produce a result that has
1702             * more bits than can be stored in a fixnum.  Thus, we fall             * more bits than can be stored in a fixnum.
            * back to the more general algorithm that is used for  
            * bignums.  
1703             */             */
1704            goto generalcase;            SCM result = scm_i_long2big (in);
1705              mpz_fdiv_r_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result),
1706                               bits);
1707              return result;
1708          }          }
1709    
1710        if (istart < SCM_I_FIXNUM_BIT)        /* mask down to requisite bits */
1711          {        bits = MIN (bits, SCM_I_FIXNUM_BIT);
1712            in = in >> istart;        return SCM_MAKINUM (in & ((1L << bits) - 1));
           if (bits < SCM_I_FIXNUM_BIT)  
             return SCM_MAKINUM (in & ((1L << bits) - 1));  
           else /* we know: in >= 0 */  
             return SCM_MAKINUM (in);  
         }  
       else if (in < 0)  
         return SCM_MAKINUM (-1L & ((1L << bits) - 1));  
       else  
         return SCM_MAKINUM (0);  
1713      }      }
1714    else if (SCM_BIGP (n))    else if (SCM_BIGP (n))
1715      {      {
1716      generalcase:        SCM result;
1717        {        if (bits == 1)
1718          SCM num1 = SCM_MAKINUM (1L);          {
1719          SCM num2 = SCM_MAKINUM (2L);            result = SCM_MAKINUM (mpz_tstbit (SCM_I_BIG_MPZ (n), istart));
1720          SCM bits = SCM_MAKINUM (iend - istart);          }
1721          SCM mask  = scm_difference (scm_integer_expt (num2, bits), num1);        else
1722          return scm_logand (mask, scm_ash (n, SCM_MAKINUM (-istart)));          {
1723        }            /* ENHANCE-ME: It'd be nice not to allocate a new bignum when
1724                 bits<SCM_I_FIXNUM_BIT.  Would want some help from GMP to get
1725                 such bits into a ulong.  */
1726              result = scm_i_mkbig ();
1727              mpz_fdiv_q_2exp (SCM_I_BIG_MPZ(result), SCM_I_BIG_MPZ(n), istart);
1728              mpz_fdiv_r_2exp (SCM_I_BIG_MPZ(result), SCM_I_BIG_MPZ(result), bits);
1729              result = scm_i_normbig (result);
1730            }
1731          scm_remember_upto_here_1 (n);
1732          return result;
1733      }      }
1734    else    else
1735      SCM_WRONG_TYPE_ARG (SCM_ARG1, n);      SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
1736  }  }
1737  #undef FUNC_NAME  #undef FUNC_NAME
1738    
1739    
1740  static const char scm_logtab[] = {  static const char scm_logtab[] = {
1741    0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4    0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4
1742  };  };

Legend:
Removed from v.1.214  
changed lines
  Added in v.1.215

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26