[libmath-prime-util-perl] 25/29: Invert XS/Perl relation for is_prime, is_prob_prime, next_prime, prev_prime
Partha P. Mukherjee
ppm-guest at moszumanska.debian.org
Thu May 21 18:48:17 UTC 2015
This is an automated email from the git hooks/post-receive script.
ppm-guest pushed a commit to annotated tag v0.27
in repository libmath-prime-util-perl.
commit 3c13e381608e7ae2b8bd5d0935fb55c8376c09de
Author: Dana Jacobsen <dana at acm.org>
Date: Sun May 19 00:23:33 2013 -0700
Invert XS/Perl relation for is_prime, is_prob_prime, next_prime, prev_prime
---
Changes | 12 ++-
XS.xs | 197 ++++++++++++++++++++++++++++++++++++++-----------
lib/Math/Prime/Util.pm | 92 +++++++++--------------
3 files changed, 197 insertions(+), 104 deletions(-)
diff --git a/Changes b/Changes
index 8b4cc8e..7438ece 100644
--- a/Changes
+++ b/Changes
@@ -2,6 +2,14 @@ Revision history for Perl extension Math::Prime::Util.
0.27 xx May 2013
+ - is_prime, is_prob_prime, next_prime, and prev_prime now all go straight
+ to XS if possible. This makes them much faster for small inputs without
+ having to use the -nobigint flag.
+
+ - XS simple number validation to lower function call overhead. Still a
+ lot more overhead compared to directly calling the XS functions, but
+ it shaves a little bit of time off every call.
+
- Speedup pure Perl factoring of small numbers.
- is_prob_prime / is_prime about 10% faster for composites.
@@ -13,10 +21,6 @@ Revision history for Perl extension Math::Prime::Util.
- Use EXTENDED_TESTING to turn on extra tests.
- - XS simple number validation to lower function call overhead. Still too
- much overhead compared to directly calling the XS functions, but it
- helps.
-
0.26 21 April 2013
- Pure Perl factoring:
diff --git a/XS.xs b/XS.xs
index 0dfc5ad..917f82d 100644
--- a/XS.xs
+++ b/XS.xs
@@ -16,10 +16,96 @@
#include "lehmer.h"
#include "aks.h"
+#if PERL_REVISION <= 5 && PERL_VERSION <= 6 && BITS_PER_WORD == 64
+ /* This could be blown up with a wacky string, but it's just for 5.6 */
+ #define set_val_from_sv(val, sv) \
+ { char*ptr = SvPV_nolen(sv); val = strtoul(ptr, NULL, 10); }
+#else
+ #define set_val_from_sv(val, sv) \
+ val = SvUV(sv)
+#endif
+
+
static int pbrent_factor_a1(UV n, UV *factors, UV maxrounds) {
return pbrent_factor(n, factors, maxrounds, 1);
}
+/* Is this a pedantically valid integer?
+ * Croaks if undefined or invalid.
+ * Returns 0 if it is an object or a string too large for a UV.
+ * Returns 1 if it is good to process by XS.
+ */
+static int _validate_int(SV* n, int negok)
+{
+ char* ptr;
+ STRLEN i, len;
+ UV val;
+ int isneg = 0;
+
+ if (!SvOK(n)) croak("Parameter must be defined");
+ /* aside: to detect bigint: if ( SvROK(n) && sv_isa(n, "Math::BigInt") ) */
+ if (SvROK(n)) return 0;
+ /* Perhaps SvPVbyte, or other UTF8 stuff? */
+ ptr = SvPV(n, len);
+ if (len == 0) croak("Parameter '' must be a positive integer");
+ for (i = 0; i < len; i++) {
+ if (!isdigit(ptr[i])) {
+ if (i == 0 && ptr[i] == '-' && negok)
+ isneg = 1;
+ else if (i == 0 && ptr[i] != '+')
+ croak("Parameter '%s' must be a positive integer", ptr); /* TODO NULL */
+ }
+ }
+ if (isneg) return -1; /* It's a valid negative number */
+ set_val_from_sv(val, n);
+ if (val == UV_MAX) { /* Could be bigger than UV_MAX. Need to find out. */
+ char vstr[40];
+ sprintf(vstr, "%"UVuf, val);
+ /* Skip possible leading zeros */
+ while (len > 0 && (*ptr == '0' || *ptr == '+'))
+ { ptr++; len--; }
+ for (i = 0; i < len; i++)
+ if (vstr[i] != ptr[i])
+ return 0;
+ }
+ return 1;
+}
+
+/* Call a Perl sub with one SV* in and a SV* return value.
+ * We use this to foist off big inputs onto Perl.
+ */
+static SV* _callsub(SV* arg, const char* name)
+{
+ dSP; /* Local copy of stack pointer */
+ int count;
+ SV* v;
+
+ ENTER; /* Start wrapper */
+ SAVETMPS; /* Start (2) */
+
+ PUSHMARK(SP); /* Start args: note our SP */
+ XPUSHs(arg);
+ PUTBACK; /* End args: set global SP to ours */
+
+ count = call_pv(name, G_SCALAR); /* Call the sub */
+ SPAGAIN; /* refresh local stack pointer */
+
+ if (count != 1)
+ croak("callback sub should return one value");
+
+ v = newSVsv(POPs); /* Get the returned value */
+
+ FREETMPS; /* End wrapper */
+ LEAVE; /* End (2) */
+ return v;
+}
+
+#if BITS_PER_WORD == 64
+static const UV _max_prime = UVCONST(18446744073709551557);
+#else
+static const UV _max_prime = UVCONST(4294967291);
+#endif
+
MODULE = Math::Prime::Util PACKAGE = Math::Prime::Util
@@ -74,17 +160,8 @@ UV
_XS_nth_prime(IN UV n)
int
-_XS_is_prime(IN UV n)
-
-int
_XS_is_aks_prime(IN UV n)
-UV
-_XS_next_prime(IN UV n)
-
-UV
-_XS_prev_prime(IN UV n)
-
UV
_get_prime_cache_size()
@@ -316,9 +393,61 @@ _XS_miller_rabin(IN UV n, ...)
OUTPUT:
RETVAL
+
int
_XS_is_prob_prime(IN UV n)
+int
+_XS_is_prime(IN UV n)
+
+int
+is_prime(IN SV* n)
+ ALIAS:
+ is_prob_prime = 1
+ PREINIT:
+ int status;
+ CODE:
+ status = _validate_int(n, 1);
+ RETVAL = 0;
+ if (status == -1) {
+ /* return 0 */
+ } else if (status == 1) {
+ UV val;
+ set_val_from_sv(val, n);
+ RETVAL = _XS_is_prime(val);
+ } else if (ix == 0) {
+ /* If we knew GMP was allowed and available, we could call it here. */
+ RETVAL = SvIV(_callsub(ST(0), "Math::Prime::Util::_generic_is_prime"));
+ } else if (ix == 1) {
+ RETVAL = SvIV(_callsub(ST(0), "Math::Prime::Util::_generic_is_prob_prime"));
+ }
+ OUTPUT:
+ RETVAL
+
+UV
+_XS_next_prime(IN UV n)
+
+UV
+_XS_prev_prime(IN UV n)
+
+void
+next_prime(IN SV* n)
+ ALIAS:
+ prev_prime = 1
+ PPCODE:
+ if (_validate_int(n, 0)) {
+ UV val;
+ set_val_from_sv(val, n);
+ if ( (ix && val < 3) || (!ix && val >= _max_prime) ) XSRETURN_UV(0);
+ if (ix) XSRETURN_UV(_XS_prev_prime(val));
+ else XSRETURN_UV(_XS_next_prime(val));
+ } else if (ix == 0) {
+ XPUSHs(sv_2mortal(_callsub(ST(0), "Math::Prime::Util::_generic_next_prime")));
+ } else if (ix == 1) {
+ XPUSHs(sv_2mortal(_callsub(ST(0), "Math::Prime::Util::_generic_prev_prime")));
+ }
+
+
double
_XS_ExponentialIntegral(double x)
@@ -444,43 +573,23 @@ _XS_divisor_sum(IN UV n)
int
_validate_num(SV* n, ...)
- PREINIT:
- char* ptr;
- STRLEN len;
- int i;
- UV val;
CODE:
- if (!SvOK(n)) croak("Parameter must be defined");
- if (SvROK(n)) XSRETURN_UV(0);
- /* Perhaps SvPVbyte, or other UTF8 stuff? */
- ptr = SvPV(n, len);
- if (len == 0)
- croak("Parameter '' must be a positive integer");
- for (i = 0; i < (int)len; i++)
- if (!isdigit(ptr[i]))
- croak("Parameter '%s' must be a positive integer", ptr); /* TODO NULL */
- val = SvUV(n);
- if (items > 1 && SvOK(ST(1))) {
- UV min = SvUV(ST(1));
- if (val < min)
- croak("Parameter '%"UVuf"' must be >= %"UVuf, val, min);
- if (items > 2 && SvOK(ST(2))) {
- UV max = SvUV(ST(2));
- if (val > max)
- croak("Parameter '%"UVuf"' must be <= %"UVuf, val, max);
- MPUassert( items <= 3, "_validate_num takes at most 3 parameters");
+ RETVAL = 0;
+ if (_validate_int(n, 0)) {
+ if (items > 1 && SvOK(ST(1))) {
+ UV val, min, max;
+ set_val_from_sv(val, n);
+ set_val_from_sv(min, ST(1));
+ if (val < min)
+ croak("Parameter '%"UVuf"' must be >= %"UVuf, val, min);
+ if (items > 2 && SvOK(ST(2))) {
+ set_val_from_sv(max, ST(2));
+ if (val > max)
+ croak("Parameter '%"UVuf"' must be <= %"UVuf, val, max);
+ MPUassert( items <= 3, "_validate_num takes at most 3 parameters");
+ }
}
+ RETVAL = 1;
}
- if (val == UV_MAX) { /* Could be bigger than UV_MAX. Need to find out. */
- char vstr[40];
- sprintf(vstr, "%"UVuf, val);
- /* Skip possible leading zeros */
- while (len > 0 && *ptr == '0')
- { ptr++; len--; }
- for (i = 0; i < (int)len; i++)
- if (vstr[i] != ptr[i])
- XSRETURN_UV(0);
- }
- RETVAL = 1;
OUTPUT:
RETVAL
diff --git a/lib/Math/Prime/Util.pm b/lib/Math/Prime/Util.pm
index 3a60e6f..b2d3c7a 100644
--- a/lib/Math/Prime/Util.pm
+++ b/lib/Math/Prime/Util.pm
@@ -50,10 +50,6 @@ sub _import_nobigint {
$_Config{'nobigint'} = 1;
return unless $_Config{'xs'};
undef *factor; *factor = \&_XS_factor;
- undef *is_prime; *is_prime = \&_XS_is_prime;
- undef *is_prob_prime; *is_prob_prime = \&_XS_is_prob_prime;
- undef *next_prime; *next_prime = \&_XS_next_prime;
- undef *prev_prime; *prev_prime = \&_XS_prev_prime;
#undef *prime_count; *prime_count = \&_XS_prime_count;
undef *nth_prime; *nth_prime = \&_XS_nth_prime;
undef *is_strong_pseudoprime; *is_strong_pseudoprime = \&_XS_miller_rabin;
@@ -64,6 +60,11 @@ sub _import_nobigint {
undef *exp_mangoldt; *exp_mangoldt = \&_XS_exp_mangoldt;
undef *chebyshev_theta; *chebyshev_theta = \&_XS_chebyshev_theta;
undef *chebyshev_psi; *chebyshev_psi = \&_XS_chebyshev_psi;
+ # These should be fast anyway, but this skips validation.
+ undef *is_prime; *is_prime = \&_XS_is_prime;
+ undef *is_prob_prime; *is_prob_prime = \&_XS_is_prob_prime;
+ undef *next_prime; *next_prime = \&_XS_next_prime;
+ undef *prev_prime; *prev_prime = \&_XS_prev_prime;
}
BEGIN {
@@ -86,6 +87,10 @@ BEGIN {
$_Config{'maxbits'} = Math::Prime::Util::PP::_PP_prime_maxbits();
*_validate_num = \&Math::Prime::Util::PP::_validate_num;
+ *is_prob_prime = \&Math::Prime::Util::_generic_is_prob_prime;
+ *is_prime = \&Math::Prime::Util::_generic_is_prime;
+ *next_prime = \&Math::Prime::Util::_generic_next_prime;
+ *prev_prime = \&Math::Prime::Util::_generic_prev_prime;
*_prime_memfreeall = \&Math::Prime::Util::PP::_prime_memfreeall;
*prime_memfree = \&Math::Prime::Util::PP::prime_memfree;
@@ -224,9 +229,8 @@ sub prime_set_config {
sub _validate_positive_integer {
my($n, $min, $max) = @_;
# We've gone through _validate_num already, so we just need to handle bigints
- if (ref($n) eq 'Math::BigInt') {
- croak "Parameter '$n' must be a positive integer" unless $n->sign() eq '+';
- }
+ croak "Parameter '$n' must be a positive integer"
+ if ref($n) eq 'Math::BigInt' && $n->sign() ne '+';
croak "Parameter '$n' must be >= $min" if defined $min && $n < $min;
croak "Parameter '$n' must be <= $max" if defined $max && $n > $max;
@@ -1419,29 +1423,35 @@ sub chebyshev_psi {
# is, the XS functions will look at the input and make a call here if the input
# is large.
-sub is_prime {
+sub _generic_is_prime {
my($n) = @_;
return 0 if defined $n && $n < 2;
_validate_num($n) || _validate_positive_integer($n);
- return _XS_is_prime($n) if ref($n) ne 'Math::BigInt' && $n <= $_XS_MAXVAL;
+ return _XS_is_prime("$n") if ref($n) ne 'Math::BigInt' && $n <= $_XS_MAXVAL;
return Math::Prime::Util::GMP::is_prime($n) if $_HAVE_GMP;
- return is_prob_prime($n);
+
+ return 2 if ($n == 2) || ($n == 3) || ($n == 5); # 2, 3, 5 are prime
+ return 0 if $n < 7; # everything else below 7 is composite
+ return 0 if !($n % 2) || !($n % 3) || !($n % 5);
+ return Math::Prime::Util::PP::_is_prime7($n);
}
-sub is_aks_prime {
+sub _generic_is_prob_prime {
my($n) = @_;
return 0 if defined $n && $n < 2;
_validate_num($n) || _validate_positive_integer($n);
- return _XS_is_aks_prime($n) if $n <= $_XS_MAXVAL;
- return Math::Prime::Util::GMP::is_aks_prime($n) if $_HAVE_GMP
- && defined &Math::Prime::Util::GMP::is_aks_prime;
- return Math::Prime::Util::PP::is_aks_prime($n);
-}
+ return _XS_is_prob_prime($n) if ref($n) ne 'Math::BigInt' && $n<=$_XS_MAXVAL;
+ return Math::Prime::Util::GMP::is_prob_prime($n) if $_HAVE_GMP;
+ return 2 if ($n == 2) || ($n == 3) || ($n == 5); # 2, 3, 5 are prime
+ return 0 if $n < 7; # everything else below 7 is composite
+ return 0 if !($n % 2) || !($n % 3) || !($n % 5);
+ return Math::Prime::Util::PP::_is_prime7($n);
+}
-sub next_prime {
+sub _generic_next_prime {
my($n) = @_;
_validate_num($n) || _validate_positive_integer($n);
@@ -1461,7 +1471,7 @@ sub next_prime {
return Math::Prime::Util::PP::next_prime($n);
}
-sub prev_prime {
+sub _generic_prev_prime {
my($n) = @_;
_validate_num($n) || _validate_positive_integer($n);
@@ -1580,45 +1590,15 @@ sub miller_rabin {
# 6100uS PP LP with large input
# 7400uS PP LP with bigint
-sub is_prob_prime {
+sub is_aks_prime {
my($n) = @_;
return 0 if defined $n && $n < 2;
_validate_num($n) || _validate_positive_integer($n);
- return _XS_is_prob_prime($n) if ref($n) ne 'Math::BigInt' && $n <= $_XS_MAXVAL;
- return Math::Prime::Util::GMP::is_prob_prime($n) if $_HAVE_GMP;
-
- return 2 if $n == 2 || $n == 3 || $n == 5 || $n == 7;
- return 0 if $n < 11;
- return 0 if !($n % 2) || !($n % 3) || !($n % 5) || !($n % 7);
- foreach my $i (qw/11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71/) {
- return 2 if $i*$i > $n; return 0 if !($n % $i);
- }
-
- if ($n < 105936894253) { # BPSW seems to be faster after this
- # Deterministic set of Miller-Rabin tests. If the MR routines can handle
- # bases greater than n, then this can be simplified.
- my @bases;
- if ($n < 9080191) { @bases = (31, 73); }
- elsif ($n < 19471033) { @bases = ( 2, 299417); }
- elsif ($n < 38010307) { @bases = ( 2, 9332593); }
- elsif ($n < 316349281) { @bases = ( 11000544, 31481107); }
- elsif ($n < 4759123141) { @bases = ( 2, 7, 61); }
- elsif ($n < 105936894253) { @bases = ( 2, 1005905886, 1340600841); }
- elsif ($n < 31858317218647) { @bases = ( 2, 642735, 553174392, 3046413974); }
- elsif ($n < 3071837692357849) { @bases = ( 2, 75088, 642735, 203659041, 3613982119); }
- else { @bases = ( 2, 325, 9375, 28178, 450775, 9780504, 1795265022); }
- return Math::Prime::Util::PP::miller_rabin($n, @bases) ? 2 : 0;
- }
-
- # BPSW probable prime. No composites are known to have passed this test
- # since it was published in 1980, though we know infinitely many exist.
- # It has also been verified that no 64-bit composite will return true.
- # Slow since it's all in PP, but it's the Right Thing To Do.
-
- return 0 unless Math::Prime::Util::PP::miller_rabin($n, 2);
- return 0 unless Math::Prime::Util::PP::is_strong_lucas_pseudoprime($n);
- return ($n <= 18446744073709551615) ? 2 : 1;
+ return _XS_is_aks_prime($n) if $n <= $_XS_MAXVAL;
+ return Math::Prime::Util::GMP::is_aks_prime($n) if $_HAVE_GMP
+ && defined &Math::Prime::Util::GMP::is_aks_prime;
+ return Math::Prime::Util::PP::is_aks_prime($n);
}
# Return just the non-cert portion.
@@ -1627,7 +1607,7 @@ sub is_provable_prime {
return 0 if defined $n && $n < 2;
_validate_num($n) || _validate_positive_integer($n);
- return _XS_is_prime($n) if ref($n) ne 'Math::BigInt' && $n <= $_XS_MAXVAL;
+ return _XS_is_prime("$n") if ref($n) ne 'Math::BigInt' && $n <= $_XS_MAXVAL;
return Math::Prime::Util::GMP::is_provable_prime($n)
if $_HAVE_GMP && defined &Math::Prime::Util::GMP::is_provable_prime;
@@ -1651,7 +1631,7 @@ sub is_provable_prime_with_cert {
# Set to 0 if you want the proof to go down to 11.
if (1) {
if (ref($n) ne 'Math::BigInt' && $n <= $_XS_MAXVAL) {
- my $isp = _XS_is_prime($n);
+ my $isp = _XS_is_prime("$n");
return ($isp == 2) ? ($isp, [$n]) : ($isp, []);
}
if ($_HAVE_GMP && defined &Math::Prime::Util::GMP::is_provable_prime_with_cert) {
@@ -1876,7 +1856,7 @@ sub verify_prime {
}
# 1. Check $B has no factors smaller than $t7_B1
my $no_small_factors = 0;
- if ($_HAVE_GMP) {
+ if ($_HAVE_GMP && defined &Math::Prime::Util::GMP::trial_factor) {
my @trial = Math::Prime::Util::GMP::trial_factor($B, $t7_B1);
$no_small_factors = (scalar @trial == 1);
} elsif ($B <= ''.~0) {
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmath-prime-util-perl.git
More information about the Pkg-perl-cvs-commits
mailing list