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

71
libguile/numbers.c
View file

@ -96,6 +96,10 @@ verify (sizeof (scm_t_inum) <= sizeof (scm_t_bits));
without overflowing. */ without overflowing. */
verify (SCM_I_FIXNUM_BIT <= SCM_LONG_BIT - 2); 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)) #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 /* 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))) 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);
scm_wrong_type_arg_msg ("exact-integer-sqrt", SCM_ARG1, k, if (mpn_sqrtrem (&ss, &rr, &kk, 1) == 0)
"exact non-negative integer"); rr = 0;
mpz_init_set_ui (kk, SCM_I_INUM (k)); *sp = SCM_I_MAKINUM (ss);
mpz_inits (ss, rr, NULL); *rp = SCM_I_MAKINUM (rr);
mpz_sqrtrem (ss, rr, kk); }
*sp = SCM_I_MAKINUM (mpz_get_ui (ss)); else if (SCM_I_INUM (k) == 0)
*rp = SCM_I_MAKINUM (mpz_get_ui (rr)); *sp = *rp = SCM_INUM0;
mpz_clears (kk, ss, rr, NULL); else
scm_wrong_type_arg_msg ("exact-integer-sqrt", SCM_ARG1, k,
"exact non-negative integer");
} }
else if (SCM_LIKELY (SCM_BIGP (k))) 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))) 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 = mpn_perfect_square_p (&kk, 1);
result = mpz_perfect_square_p (kk); }
mpz_clear (kk); else
result = (SCM_I_INUM (k) == 0);
} }
else else
{ {
@ -10203,20 +10214,22 @@ exact_integer_is_perfect_square (SCM k)
} }
/* Return the floor of the square root of 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 static SCM
exact_integer_floor_square_root (SCM k) exact_integer_floor_square_root (SCM k)
{ {
if (SCM_LIKELY (SCM_I_INUMP (k))) if (SCM_LIKELY (SCM_I_INUMP (k)))
{ {
mpz_t kk; if (SCM_I_INUM (k) > 0)
scm_t_inum ss; {
mp_limb_t kk, ss, rr;
mpz_init_set_ui (kk, SCM_I_INUM (k)); kk = SCM_I_INUM (k);
mpz_sqrt (kk, kk); mpn_sqrtrem (&ss, &rr, &kk, 1);
ss = mpz_get_ui (kk); return SCM_I_MAKINUM (ss);
mpz_clear (kk); }
return SCM_I_MAKINUM (ss); else
return SCM_INUM0;
} }
else else
{ {
@ -10279,19 +10292,15 @@ SCM_PRIMITIVE_GENERIC (scm_sqrt, "sqrt", 1, 0, 0,
} }
else else
{ {
mpz_t xx; mp_limb_t xx, root, rem;
scm_t_inum root;
mpz_init_set_ui (xx, x); assert (x != 0);
if (mpz_perfect_square_p (xx)) xx = x;
if (mpn_perfect_square_p (&xx, 1))
{ {
mpz_sqrt (xx, xx); mpn_sqrtrem (&root, &rem, &xx, 1);
root = mpz_get_ui (xx);
mpz_clear (xx);
return SCM_I_MAKINUM (root); return SCM_I_MAKINUM (root);
} }
else
mpz_clear (xx);
} }
} }
} }