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