1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00

Implement scm_logbit_p with new integer library

* libguile/integers.c (scm_integer_logbit_ui, scm_integer_logbit_uz):
* libguile/integers.h: Declare the new internal functions.
* libguile/numbers.c (scm_logbit_p): Use new internal functions.
This commit is contained in:
Andy Wingo 2021-12-19 11:06:36 +01:00
parent 6298d73115
commit 89cd48fcac
3 changed files with 25 additions and 16 deletions

View file

@ -2008,3 +2008,23 @@ scm_integer_logtest_zz (SCM x, SCM y)
{ {
return scm_is_eq (scm_integer_logand_zz (x, y), SCM_INUM0); return scm_is_eq (scm_integer_logand_zz (x, y), SCM_INUM0);
} }
int
scm_integer_logbit_ui (unsigned long index, scm_t_inum n)
{
if (index < SCM_LONG_BIT)
/* Assume two's complement representation. */
return (n >> index) & 1;
else
return n < 0;
}
int
scm_integer_logbit_uz (unsigned long index, SCM n)
{
mpz_t zn;
alias_bignum_to_mpz (scm_bignum (n), zn);
int val = mpz_tstbit (zn, index);
scm_remember_upto_here_1 (n);
return val;
}

View file

@ -148,6 +148,9 @@ SCM_INTERNAL int scm_integer_logtest_ii (scm_t_inum x, scm_t_inum y);
SCM_INTERNAL int scm_integer_logtest_zi (SCM x, scm_t_inum y); SCM_INTERNAL int scm_integer_logtest_zi (SCM x, scm_t_inum y);
SCM_INTERNAL int scm_integer_logtest_zz (SCM x, SCM y); SCM_INTERNAL int scm_integer_logtest_zz (SCM x, SCM y);
SCM_INTERNAL int scm_integer_logbit_ui (unsigned long bit, scm_t_inum n);
SCM_INTERNAL int scm_integer_logbit_uz (unsigned long bit, SCM n);
#endif /* SCM_INTEGERS_H */ #endif /* SCM_INTEGERS_H */

View file

@ -3155,23 +3155,9 @@ SCM_DEFINE (scm_logbit_p, "logbit?", 2, 0, 0,
iindex = scm_to_ulong (index); iindex = scm_to_ulong (index);
if (SCM_I_INUMP (j)) if (SCM_I_INUMP (j))
{ return scm_from_bool (scm_integer_logbit_ui (iindex, SCM_I_INUM (j)));
if (iindex < SCM_LONG_BIT - 1)
/* Arrange for the number to be converted to unsigned before
checking the bit, to ensure that we're testing the bit in a
two's complement representation (regardless of the native
representation. */
return scm_from_bool ((1UL << iindex) & SCM_I_INUM (j));
else
/* Portably check the sign. */
return scm_from_bool (SCM_I_INUM (j) < 0);
}
else if (SCM_BIGP (j)) else if (SCM_BIGP (j))
{ return scm_from_bool (scm_integer_logbit_uz (iindex, j));
int val = mpz_tstbit (SCM_I_BIG_MPZ (j), iindex);
scm_remember_upto_here_1 (j);
return scm_from_bool (val);
}
else else
SCM_WRONG_TYPE_ARG (SCM_ARG2, j); SCM_WRONG_TYPE_ARG (SCM_ARG2, j);
} }