diff options
author | Mark H Weaver <mhw@netris.org> | 2019-04-28 03:45:11 -0400 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2019-05-23 17:48:55 +0200 |
commit | a3a726c868da81843a96d7107c4042e654700aa6 (patch) | |
tree | 436a3c53caebac746c4a235a4d1e581d6d9df92a /libguile/numbers.c | |
parent | c6692a4825795494cedfab475b89d2efddc3a24e (diff) | |
download | guile-a3a726c868da81843a96d7107c4042e654700aa6.tar.gz |
Optimize fixnum exact integer square roots.
* 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.
Diffstat (limited to 'libguile/numbers.c')
-rw-r--r-- | libguile/numbers.c | 71 |
1 files changed, 40 insertions, 31 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c index 709724e97..d1b463358 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -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) - 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); + 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"); } 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,20 +10214,22 @@ 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); - return SCM_I_MAKINUM (ss); + kk = SCM_I_INUM (k); + mpn_sqrtrem (&ss, &rr, &kk, 1); + return SCM_I_MAKINUM (ss); + } + else + return SCM_INUM0; } else { @@ -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); } } } |