mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

Optimize fixnum exact integer square roots.

Browse source 
* libguile/numbers.c (scm_exact_integer_sqrt, scm_sqrt)
(exact_integer_is_perfect_square, exact_integer_floor_square_root):
Where it is trivial to do so, use GMP's low-level mpn functions to
avoid heap allocation.
This commit is contained in:
Mark H Weaver 2019-04-28 03:45:11 -04:00 • committed by Andy Wingo
parent c6692a4825
commit a3a726c868
1 changed files with 40 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

65
libguile/numbers.c
View file

@ -96,6 +96,10 @@ verify (sizeof (scm_t_inum) <= sizeof (scm_t_bits));
without overflowing. */
verify (SCM_I_FIXNUM_BIT <= SCM_LONG_BIT - 2);
/* Some functions that use GMP's mpn functions assume that a
non-negative fixnum will always fit in a 'mp_limb_t'. */
verify (SCM_MOST_POSITIVE_FIXNUM <= (mp_limb_t) -1);
#define scm_from_inum(x) (scm_from_signed_integer (x))
/* Test an inum to see if it can be converted to a double without loss
@ -10148,17 +10152,21 @@ scm_exact_integer_sqrt (SCM k, SCM *sp, SCM *rp)
{
if (SCM_LIKELY (SCM_I_INUMP (k)))
{
mpz_t kk, ss, rr;
if (SCM_I_INUM (k) > 0)
{
mp_limb_t kk, ss, rr;
if (SCM_I_INUM (k) < 0)
kk = SCM_I_INUM (k);
if (mpn_sqrtrem (&ss, &rr, &kk, 1) == 0)
rr = 0;
*sp = SCM_I_MAKINUM (ss);
*rp = SCM_I_MAKINUM (rr);
}
else if (SCM_I_INUM (k) == 0)
*sp = *rp = SCM_INUM0;
else
scm_wrong_type_arg_msg ("exact-integer-sqrt", SCM_ARG1, k,
"exact non-negative integer");
mpz_init_set_ui (kk, SCM_I_INUM (k));
mpz_inits (ss, rr, NULL);
mpz_sqrtrem (ss, rr, kk);
*sp = SCM_I_MAKINUM (mpz_get_ui (ss));
*rp = SCM_I_MAKINUM (mpz_get_ui (rr));
mpz_clears (kk, ss, rr, NULL);
}
else if (SCM_LIKELY (SCM_BIGP (k)))
{
@ -10188,11 +10196,14 @@ exact_integer_is_perfect_square (SCM k)
if (SCM_LIKELY (SCM_I_INUMP (k)))
{
mpz_t kk;
if (SCM_I_INUM (k) > 0)
{
mp_limb_t kk = SCM_I_INUM (k);
mpz_init_set_si (kk, SCM_I_INUM (k));
result = mpz_perfect_square_p (kk);
mpz_clear (kk);
result = mpn_perfect_square_p (&kk, 1);
}
else
result = (SCM_I_INUM (k) == 0);
}
else
{
@ -10203,21 +10214,23 @@ exact_integer_is_perfect_square (SCM k)
}
/* Return the floor of the square root of K.
K must be an exact integer. */
K must be an exact non-negative integer. */
static SCM
exact_integer_floor_square_root (SCM k)
{
if (SCM_LIKELY (SCM_I_INUMP (k)))
{
mpz_t kk;
scm_t_inum ss;
if (SCM_I_INUM (k) > 0)
{
mp_limb_t kk, ss, rr;
mpz_init_set_ui (kk, SCM_I_INUM (k));
mpz_sqrt (kk, kk);
ss = mpz_get_ui (kk);
mpz_clear (kk);
kk = SCM_I_INUM (k);
mpn_sqrtrem (&ss, &rr, &kk, 1);
return SCM_I_MAKINUM (ss);
}
else
return SCM_INUM0;
}
else
{
SCM s;
@ -10279,19 +10292,15 @@ SCM_PRIMITIVE_GENERIC (scm_sqrt, "sqrt", 1, 0, 0,
}
else
{
mpz_t xx;
scm_t_inum root;
mp_limb_t xx, root, rem;
mpz_init_set_ui (xx, x);
if (mpz_perfect_square_p (xx))
assert (x != 0);
xx = x;
if (mpn_perfect_square_p (&xx, 1))
{
mpz_sqrt (xx, xx);
root = mpz_get_ui (xx);
mpz_clear (xx);
mpn_sqrtrem (&root, &rem, &xx, 1);
return SCM_I_MAKINUM (root);
}
else
mpz_clear (xx);
}
}
}