mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

Implement scm_bit_extract with new integer library

Browse source 
* libguile/integers.c (scm_integer_bit_extract_i)
(scm_integer_bit_extract_z): New internal functions.
* libguile/integers.h: Declare the new internal functions.
* libguile/numbers.c (scm_bit_extract): Use new internal functions.
This commit is contained in:
Andy Wingo 2022-01-04 09:43:26 +01:00
parent 35861b28bb
commit 88f56e91aa
3 changed files with 63 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

50
libguile/integers.c
View file

@ -2204,3 +2204,53 @@ scm_integer_round_rsh_zu (SCM n, unsigned long count)
scm_remember_upto_here_1 (n);
return take_mpz (q);
}
#define MIN(A, B) ((A) <= (B) ? (A) : (B))
SCM
scm_integer_bit_extract_i (scm_t_inum n, unsigned long start,
unsigned long bits)
{
/* When istart>=SCM_I_FIXNUM_BIT we can just limit the shift to
SCM_I_FIXNUM_BIT-1 to get either 0 or -1 per the sign of "n". */
n = SCM_SRS (n, MIN (start, SCM_I_FIXNUM_BIT-1));
if (n < 0 && bits >= SCM_I_FIXNUM_BIT)
{
/* Since we emulate two's complement encoded numbers, this special
case requires us to produce a result that has more bits than
can be stored in a fixnum. */
mpz_t result;
mpz_init_set_si (result, n);
mpz_fdiv_r_2exp (result, result, bits);
return take_mpz (result);
}
/* mask down to requisite bits */
bits = MIN (bits, SCM_I_FIXNUM_BIT);
return SCM_I_MAKINUM (n & ((1L << bits) - 1));
}
SCM
scm_integer_bit_extract_z (SCM n, unsigned long start, unsigned long bits)
{
mpz_t zn;
alias_bignum_to_mpz (scm_bignum (n), zn);
if (bits == 1)
{
int bit = mpz_tstbit (zn, start);
scm_remember_upto_here_1 (n);
return SCM_I_MAKINUM (bit);
}
/* ENHANCE-ME: It'd be nice not to allocate a new bignum when
bits<SCM_I_FIXNUM_BIT. Would want some help from GMP to get
such bits into a ulong. */
mpz_t result;
mpz_init (result);
mpz_fdiv_q_2exp (result, zn, start);
mpz_fdiv_r_2exp (result, result, bits);
scm_remember_upto_here_1 (n);
return take_mpz (result);
}

5
libguile/integers.h
View file

@ -163,6 +163,11 @@ SCM_INTERNAL SCM scm_integer_floor_rsh_zu (SCM n, unsigned long count);
SCM_INTERNAL SCM scm_integer_round_rsh_iu (scm_t_inum n, unsigned long count);
SCM_INTERNAL SCM scm_integer_round_rsh_zu (SCM n, unsigned long count);
SCM_INTERNAL SCM scm_integer_bit_extract_i (scm_t_inum n, unsigned long start,
unsigned long bits);
SCM_INTERNAL SCM scm_integer_bit_extract_z (SCM n, unsigned long start,
unsigned long bits);
#endif /* SCM_INTEGERS_H */

61
libguile/numbers.c
View file

@ -3340,9 +3340,6 @@ SCM_DEFINE (scm_round_ash, "round-ash", 2, 0, 0,
}
#undef FUNC_NAME
#define MIN(A, B) ((A) <= (B) ? (A) : (B))
SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
(SCM n, SCM start, SCM end),
"Return the integer composed of the @var{start} (inclusive)\n"
@ -3357,60 +3354,18 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
"@end lisp")
#define FUNC_NAME s_scm_bit_extract
{
unsigned long int istart, iend, bits;
istart = scm_to_ulong (start);
iend = scm_to_ulong (end);
SCM_ASSERT_RANGE (3, end, (iend >= istart));
if (!scm_is_exact_integer (n))
SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
/* how many bits to keep */
bits = iend - istart;
unsigned long istart = scm_to_ulong (start);
unsigned long iend = scm_to_ulong (end);
SCM_ASSERT_RANGE (3, end, (iend >= istart));
unsigned long bits = iend - istart;
if (SCM_I_INUMP (n))
{
scm_t_inum in = SCM_I_INUM (n);
/* When istart>=SCM_I_FIXNUM_BIT we can just limit the shift to
SCM_I_FIXNUM_BIT-1 to get either 0 or -1 per the sign of "in". */
in = SCM_SRS (in, MIN (istart, SCM_I_FIXNUM_BIT-1));
if (in < 0 && bits >= SCM_I_FIXNUM_BIT)
{
/* Since we emulate two's complement encoded numbers, this
* special case requires us to produce a result that has
* more bits than can be stored in a fixnum.
*/
SCM result = scm_i_inum2big (in);
mpz_fdiv_r_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result),
bits);
return result;
}
/* mask down to requisite bits */
bits = MIN (bits, SCM_I_FIXNUM_BIT);
return SCM_I_MAKINUM (in & ((1L << bits) - 1));
}
else if (SCM_BIGP (n))
{
SCM result;
if (bits == 1)
{
result = SCM_I_MAKINUM (mpz_tstbit (SCM_I_BIG_MPZ (n), istart));
}
else
{
/* ENHANCE-ME: It'd be nice not to allocate a new bignum when
bits<SCM_I_FIXNUM_BIT. Would want some help from GMP to get
such bits into a ulong. */
result = scm_i_mkbig ();
mpz_fdiv_q_2exp (SCM_I_BIG_MPZ(result), SCM_I_BIG_MPZ(n), istart);
mpz_fdiv_r_2exp (SCM_I_BIG_MPZ(result), SCM_I_BIG_MPZ(result), bits);
result = scm_i_normbig (result);
}
scm_remember_upto_here_1 (n);
return result;
}
return scm_integer_bit_extract_i (SCM_I_INUM (n), istart, bits);
else
SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
return scm_integer_bit_extract_z (n, istart, bits);
}
#undef FUNC_NAME