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 <d...@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

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to