This is an automated email from the git hooks/post-receive script.

ppm-guest pushed a commit to annotated tag v0.32
in repository libmath-prime-util-perl.

commit 67f3d32f721be4648788dcaeb1fa159e735dd0bf
Author: Dana Jacobsen <d...@acm.org>
Date:   Tue Sep 17 17:21:18 2013 -0700

    Revamp input processing to accept bigints
---
 Changes                |  3 ++
 XS.xs                  | 92 ++++++++++++++++++++++++++++++--------------------
 lib/Math/Prime/Util.pm | 30 +++++++---------
 t/81-bignum.t          |  2 +-
 util.c                 | 44 +++++++++++++-----------
 5 files changed, 96 insertions(+), 75 deletions(-)

diff --git a/Changes b/Changes
index c389969..53c22e5 100644
--- a/Changes
+++ b/Changes
@@ -8,6 +8,9 @@ Revision history for Perl module Math::Prime::Util
       - carmichael_lambda
       - znorder
 
+    - Input validation accepts bigint objects and converts them to scalars
+      entirely in XS.
+
     - random_nbit_prime now uses Fouque and Tibouchi A1.  Slightly better
       uniformity and typically a bit faster.
 
diff --git a/XS.xs b/XS.xs
index 99c0e64..c1f7921 100644
--- a/XS.xs
+++ b/XS.xs
@@ -19,14 +19,25 @@
 #include "lehmer.h"
 #include "aks.h"
 
-/* Workaround perl 5.6 UVs */
+#ifdef WIN32
+  #ifdef _MSC_VER
+    #include <stdlib.h>
+    #define PSTRTOULL(str, end, base) _strtoui64 (str, end, base)
+  #else
+    #define PSTRTOULL(str, end, base) strtoul (str, end, base)
+  #endif
+#else
+  #define PSTRTOULL(str, end, base) strtoull (str, end, base)
+#endif
+
+
+/* Workaround perl 5.6 UVs and bigints in later */
 #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); }
+   val = PSTRTOULL(SvPV_nolen(sv), NULL, 10);
 #else
  #define set_val_from_sv(val, sv) \
-   val = SvUV(sv)
+   val = (!SvROK(sv)) ? SvUV(sv) : PSTRTOULL(SvPV_nolen(sv), NULL, 10);
 #endif
 
 /* multicall compatibility stuff */
@@ -52,6 +63,14 @@ static int pbrent_factor_a1(UV n, UV *factors, UV maxrounds) 
{
   return pbrent_factor(n, factors, maxrounds, 1);
 }
 
+#if BITS_PER_WORD == 32
+  static const unsigned int uvmax_maxlen = 10;
+  static const char uvmax_str[] = "4294967295";
+#else
+  static const unsigned int uvmax_maxlen = 20;
+  static const char uvmax_str[] = "18446744073709551615";
+#endif
+
 /* 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.
@@ -62,38 +81,32 @@ static int _validate_int(SV* n, int negok)
   dTHX;
   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] == '+')
-        /* Allowed */ ;
-      else
-        croak("Parameter '%s' must be a positive integer", ptr); /* TODO NULL 
*/
-    }
+  if (SvROK(n) && !sv_isa(n, "Math::BigInt"))  return 0;
+  ptr = SvPV(n, len);  /* This will stringify bigints for us, yay */
+  if (len == 0 || ptr == 0)  croak("Parameter '' must be a positive integer");
+  if (ptr[0] == '-') {                 /* Read negative sign */
+    if (negok) { isneg = 1; ptr++; len--; }
+    else       croak("Parameter '%s' must be a positive integer", ptr);
   }
-  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;
+  if (ptr[0] == '+') { ptr++; len--; } /* Allow a single plus sign */
+  while (len > 0 && *ptr == '0')       /* Strip all leading zeros */
+    { ptr++; len--; }
+  if (len > uvmax_maxlen)              /* Huge number, don't even look at it */
+    return 0;
+  for (i = 0; i < len; i++)            /* Ensure all characters are digits */
+    if (!isDIGIT(ptr[i]))
+      croak("Parameter '%s' must be a positive integer", ptr);
+  if (isneg)                           /* Negative number (ignore overflow) */
+    return -1;
+  if (len < uvmax_maxlen)              /* Valid small integer */
+    return 1;
+  for (i = 0; i < uvmax_maxlen; i++)   /* Check if in range */
+    if (ptr[i] > uvmax_str[i])
+      return 0;
+  return 1;                            /* Looks good */
 }
 
 /* Call a Perl sub to handle work for us.
@@ -513,19 +526,19 @@ _XS_is_almost_extra_strong_lucas_pseudoprime(IN UV n, IN 
UV increment = 1)
     RETVAL
 
 int
-is_prime(IN SV* n)
+is_prime(IN SV* svn)
   ALIAS:
     is_prob_prime = 1
   PREINIT:
     int status;
   PPCODE:
-    status = _validate_int(n, 1);
+    status = _validate_int(svn, 1);
     if (status == -1) {
       XSRETURN_UV(0);
     } else if (status == 1) {
-      UV val;
-      set_val_from_sv(val, n);
-      XSRETURN_UV(_XS_is_prime(val));
+      UV n;
+      set_val_from_sv(n, svn);
+      XSRETURN_UV(_XS_is_prime(n));
     } else {
       const char* sub = 0;
       if (_XS_get_callgmp())
@@ -693,6 +706,11 @@ _validate_num(SV* n, ...)
   CODE:
     RETVAL = 0;
     if (_validate_int(n, 0)) {
+      if (SvROK(n)) {  /* Convert small Math::BigInt object into scalar */
+        UV val;
+        set_val_from_sv(val, n);
+        sv_setuv(n, val);
+      }
       if (items > 1 && SvOK(ST(1))) {
         UV val, min, max;
         set_val_from_sv(val, n);
diff --git a/lib/Math/Prime/Util.pm b/lib/Math/Prime/Util.pm
index ea1177b..e0ea514 100644
--- a/lib/Math/Prime/Util.pm
+++ b/lib/Math/Prime/Util.pm
@@ -1492,13 +1492,6 @@ sub _generic_forprimes (&$;$) {    ## no critic 
qw(ProhibitSubroutinePrototypes)
   if (!defined $end) { $end = $beg; $beg = 2; }
   _validate_num($beg) || _validate_positive_integer($beg);
   _validate_num($end) || _validate_positive_integer($end);
-  # It's possible we're here just because the arguments were bigints < 2^64
-  # TODO: make a function to convert native size bigints to UVs, and let the
-  #       XS functions call that, so we don't do these loop-de-loops.  This
-  #       also has nasty coupling with the XS implementation.
-  if (!ref($beg) && !ref($end) && $beg <= $_XS_MAXVAL && $end <= $_XS_MAXVAL 
&& $] >= 5.007) {
-    return forprimes( \&$sub, $beg, $end);
-  }
   $beg = 2 if $beg < 2;
   {
     my $pp;
@@ -4100,11 +4093,11 @@ is 40 by default).  Accuracy without MPFR should be 35 
digits.
 
 Print strong pseudoprimes to base 17 up to 10M:
 
+    # Similar to A001262's isStrongPsp function, but over 4x faster
     perl -MMath::Prime::Util=:all -E 'my $n=3; while($n <= 10000000) { print 
"$n " if is_strong_pseudoprime($n,$base) && !is_prime($n); $n+=2; } BEGIN 
{$|=1; $base=17}'
 
 or, slightly faster, use forprimes and loop over the odds between primes:
 
-   # Runs about 5x faster than Pari using A001262's isStrongPsp function
    perl -MMath::Prime::Util=:all -E '$|=1; $base=17; my $prev = 1; forprimes { 
$prev += 2; while ($prev < $_) { print "$prev " if 
is_strong_pseudoprime($prev,$base); $prev += 2; } } 3,10000000'
 
 Print some primes above 64-bit range:
@@ -4272,8 +4265,10 @@ handle using it.  There are still some functions it 
doesn't do well
 L<Math::Prime::XS> has C<is_prime> and C<primes> functionality.  There is no
 bigint support.  The C<is_prime> function uses well-written trial division,
 meaning it is very fast for small numbers, but terribly slow for large
-64-bit numbers.  With the latest release, MPU should be faster for all sizes.
-The prime sieve is an unoptimized non-segmented SoE which returns an
+64-bit numbers.  Because MPU does input validation and bigint conversion,
+there is about 20 microseconds of additional overhead making MPXS a little
+faster for tiny inputs, but once over 700k, MPU is faster for all values.
+MPXS's prime sieve is an unoptimized non-segmented SoE which returns an
 array.  It works well for 32-bit values, but speed and memory are problematic
 for larger values.
 
@@ -4287,8 +4282,7 @@ All this functionality is present in MPU as well, though 
not required.
 
 L<Bit::Vector> supports the C<primes> and C<prime_count> functionality in a
 somewhat similar way to L<Math::Prime::FastSieve>.  It is the slowest of all
-the XS sieves, and has the most memory use.  It is, however, faster than
-the pure Perl code in MPU or elsewhere.
+the XS sieves, and has the most memory use.  It is faster than pure Perl code.
 
 L<Crypt::Primes> supports C<random_maurer_prime> functionality.  MPU has
 more options for random primes (n-digit, n-bit, ranged, and strong) in
@@ -4302,7 +4296,7 @@ Having L<Math::Prime::Util::GMP> installed also helps 
performance for MPU.
 Crypt::Primes is hardcoded to use L<Crypt::Random>, while MPU uses
 L<Bytes::Random::Secure>, and also allows plugging in a random function.
 This is more flexible, faster, has fewer dependencies, and uses a CSPRNG
-for security.
+for security.  MPU can return a primality certificate.
 What Crypt::Primes has that MPU does not is support for returning a generator.
 
 L<Math::Factor::XS> calculates prime factors and factors, which correspond to
@@ -4674,15 +4668,15 @@ result is uniformly distributed, only about 10% of the 
primes in the range
 are selected for output.  This is a result of the FastPrime algorithm and
 is usually unimportant.
 
-L<Crypt::Primes/maurer> is included for comparison.  It is pretty fast for
-small sizes but gets slow as the size increases.  It does not perform any
-primality checks on the intermediate results or the final result (I highly
-recommended you run a primality test on the output).
+L<Crypt::Primes/maurer> times are included for comparison.  It is pretty
+fast for small sizes but gets slow as the size increases.  It does not
+perform any primality checks on the intermediate results or the final
+result (I highly recommended you run a primality test on the output).
 Additionally important for servers, L<Crypt::Primes/maurer> uses excessive
 system entropy and can grind to a halt if C</dev/random> is exhausted
 (it can take B<days> to return).  The times above are on a machine running
 L<HAVEGED|http://www.issihosts.com/haveged/>
-so never waits for entropy.
+so never waits for entropy.  Without this, the times would be much higher.
 
 
 =head1 AUTHORS
diff --git a/t/81-bignum.t b/t/81-bignum.t
index 77fe482..edca71c 100644
--- a/t/81-bignum.t
+++ b/t/81-bignum.t
@@ -209,7 +209,7 @@ SKIP: {
 ###############################################################################
 
 SKIP: {
-  skip "Your 64-bit Perl is broken, skipping moebius and euler_phi tests", 6 
if $broken64;
+  skip "Your 64-bit Perl is broken, skipping moebius and euler_phi tests", 7 
if $broken64;
   my $n;
   $n = 618970019642690137449562110;
   is( moebius($n), -1, "moebius($n)" );
diff --git a/util.c b/util.c
index 17d927b..7eaaad7 100644
--- a/util.c
+++ b/util.c
@@ -147,30 +147,36 @@ static const unsigned char prime_sieve30[] =
 /* Return of 2 if n is prime, 0 if not.  Do it fast. */
 int _XS_is_prime(UV n)
 {
-  UV d, m;
-  unsigned char mtab;
-  const unsigned char* sieve;
-  int isprime;
+  if (n < UVCONST(2000000000)) {
+    UV d, m;
+    unsigned char mtab;
+    const unsigned char* sieve;
+    int isprime = -1;
 
-  if (n <= 10)  return (n == 2 || n == 3 || n == 5 || n == 7) ? 2 : 0;
-  d = n/30;
-  m = n - d*30;
-  mtab = masktab30[m];  /* Bitmask in mod30 wheel */
+    if (n <= 10)  return (n == 2 || n == 3 || n == 5 || n == 7) ? 2 : 0;
 
-  /* Return 0 if a multiple of 2, 3, or 5 */
-  if (mtab == 0)
-    return 0;
+    d = n/30;
+    m = n - d*30;
+    mtab = masktab30[m];  /* Bitmask in mod30 wheel */
 
-  if (d < NPRIME_SIEVE30)
-    return (prime_sieve30[d] & mtab) ? 0 : 2;
+    /* Return 0 if a multiple of 2, 3, or 5 */
+    if (mtab == 0)
+      return 0;
 
-  isprime = (n <= get_prime_cache(0, &sieve))
-            ?  2*((sieve[d] & mtab) == 0)
-            :  -1;
-  release_prime_cache(sieve);
+    /* Check static tiny sieve */
+    if (d < NPRIME_SIEVE30)
+      return (prime_sieve30[d] & mtab) ? 0 : 2;
+
+    if (!(n%7) || !(n%11) || !(n%13)) return 0;
 
-  /* return (isprime >= 0)  ?  isprime  :  _is_prime7(n); */
-  return (isprime >= 0)  ?  isprime  :  _XS_is_prob_prime(n);
+    /* Check primary cache */
+    if (n <= get_prime_cache(0, &sieve))
+      isprime = 2*((sieve[d] & mtab) == 0);
+    release_prime_cache(sieve);
+    if (isprime >= 0)
+      return isprime;
+  }
+  return _XS_is_prob_prime(n);
 }
 
 

-- 
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