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 35414dd610fb42de1b7396ce2433bec540484cbe
Author: Dana Jacobsen <d...@acm.org>
Date:   Sat May 18 11:26:18 2013 -0700

    Use XS initial validator
---
 Changes                   |  4 +++
 XS.xs                     | 44 +++++++++++++++++++++++
 lib/Math/Prime/Util.pm    | 92 +++++++++++++++++++++++------------------------
 lib/Math/Prime/Util/PP.pm | 14 +++++++-
 4 files changed, 106 insertions(+), 48 deletions(-)

diff --git a/Changes b/Changes
index 3207a94..8b4cc8e 100644
--- a/Changes
+++ b/Changes
@@ -13,6 +13,10 @@ 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 2dfcccf..0dfc5ad 100644
--- a/XS.xs
+++ b/XS.xs
@@ -2,6 +2,7 @@
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
+#include <ctype.h>
 /* We're not using anything for which we need ppport.h */
 #ifndef XSRETURN_UV   /* Er, almost.  Fix 21086 from Sep 2003 */
   #define XST_mUV(i,v)  (ST(i) = sv_2mortal(newSVuv(v))  )
@@ -440,3 +441,46 @@ _XS_chebyshev_psi(IN UV n)
 
 UV
 _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");
+      }
+    }
+    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 91802b5..3a60e6f 100644
--- a/lib/Math/Prime/Util.pm
+++ b/lib/Math/Prime/Util.pm
@@ -85,6 +85,8 @@ BEGIN {
     $_Config{'xs'} = 0;
     $_Config{'maxbits'} = Math::Prime::Util::PP::_PP_prime_maxbits();
 
+    *_validate_num = \&Math::Prime::Util::PP::_validate_num;
+
     *_prime_memfreeall = \&Math::Prime::Util::PP::_prime_memfreeall;
     *prime_memfree  = \&Math::Prime::Util::PP::prime_memfree;
     *prime_precalc  = \&Math::Prime::Util::PP::prime_precalc;
@@ -219,15 +221,11 @@ sub prime_set_config {
   1;
 }
 
-my $_bigint_small;
 sub _validate_positive_integer {
   my($n, $min, $max) = @_;
-  croak "Parameter must be defined" if !defined $n;
+  # 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 '+';
-  } else {
-    croak "Parameter '$n' must be a positive integer"
-          if $n eq '' || $n =~ tr/0123456789//c;
   }
   croak "Parameter '$n' must be >= $min" if defined $min && $n < $min;
   croak "Parameter '$n' must be <= $max" if defined $max && $n > $max;
@@ -299,8 +297,8 @@ sub primes {
   my $low = (@_ == 2)  ?  shift  :  2;
   my $high = shift;
 
-  _validate_positive_integer($low);
-  _validate_positive_integer($high);
+  _validate_num($low) || _validate_positive_integer($low);
+  _validate_num($high) || _validate_positive_integer($high);
 
   my $sref = [];
   return $sref if ($low > $high) || ($high < 2);
@@ -749,8 +747,8 @@ sub primes {
   sub random_prime {
     my $low = (@_ == 2)  ?  shift  :  2;
     my $high = shift;
-    _validate_positive_integer($low);
-    _validate_positive_integer($high);
+    _validate_num($low) || _validate_positive_integer($low);
+    _validate_num($high) || _validate_positive_integer($high);
 
     # Tighten the range to the nearest prime.
     $low = ($low <= 2)  ?  2  :  next_prime($low-1);
@@ -764,7 +762,7 @@ sub primes {
 
   sub random_ndigit_prime {
     my($digits) = @_;
-    _validate_positive_integer($digits, 1);
+    _validate_num($digits, 1) || _validate_positive_integer($digits, 1);
 
     my $bigdigits = $digits >= $_Config{'maxdigits'};
     croak "Large random primes not supported on old Perl" if $] < 5.008 && 
$_Config{'maxbits'} > 32 && !$bigdigits && $digits > 15;
@@ -803,7 +801,7 @@ sub primes {
 
   sub random_nbit_prime {
     my($bits) = @_;
-    _validate_positive_integer($bits, 2);
+    _validate_num($bits, 2) || _validate_positive_integer($bits, 2);
 
     if (!defined $_random_nbit_ranges[$bits]) {
       my $bigbits = $bits > $_Config{'maxbits'};
@@ -841,7 +839,7 @@ sub primes {
 
   sub random_maurer_prime_with_cert {
     my($k) = @_;
-    _validate_positive_integer($k, 2);
+    _validate_num($k, 2) || _validate_positive_integer($k, 2);
     my @cert;
     if ($] < 5.008 && $_Config{'maxbits'} > 32) {
       if ($k <= 49) {
@@ -988,7 +986,7 @@ sub primes {
   # Gordon's algorithm for generating a strong prime.
   sub random_strong_prime {
     my($t) = @_;
-    _validate_positive_integer($t, 128);
+    _validate_num($t, 128) || _validate_positive_integer($t, 128);
     croak "Random strong primes must be >= 173 bits on old Perl" if $] < 5.008 
&& $_Config{'maxbits'} > 32 && $t < 173;
 
     if (!defined $Math::BigInt::VERSION) {
@@ -1031,7 +1029,7 @@ sub primes {
 
 sub primorial {
   my($n) = @_;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
 
   my $pn = 1;
   if ($n >= (($_Config{'maxbits'} == 32) ? 29 : 53)) {
@@ -1065,7 +1063,7 @@ sub pn_primorial {
 
 sub consecutive_integer_lcm {
   my($n) = @_;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
   return 0 if $n < 1;
 
   my $pn = 1;
@@ -1137,10 +1135,10 @@ sub all_factors {
 # A030059, A013929, A030229, A002321, A005117, A013929 all relate.
 sub moebius {
   my($n, $nend) = @_;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
 
   if (defined $nend) {
-    _validate_positive_integer($nend);
+    _validate_num($nend) || _validate_positive_integer($nend);
     return if $nend < $n;
   } else {
     $nend = $n;
@@ -1190,7 +1188,7 @@ sub moebius {
 # A002321 Mertens' function.  mertens(n) = sum(moebius(1,n))
 sub mertens {
   my($n) = @_;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
   return _XS_mertens($n) if $n <= $_XS_MAXVAL;
   # This is the most basic Del├ęglise and Rivat algorithm.  u = n^1/2
   # and no segmenting is done.  Their algorithm uses u = n^1/3, breaks
@@ -1225,9 +1223,9 @@ sub euler_phi {
   # SAGE defines this to be 0 for all n <= 0.  Others choose differently.
   # I am following SAGE's decision for n <= 0.
   return 0 if defined $n && $n < 0;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
   if (defined $nend) {
-    _validate_positive_integer($nend);
+    _validate_num($nend) || _validate_positive_integer($nend);
     return if $nend < $n;
   } else {
     $nend = $n;
@@ -1281,11 +1279,11 @@ sub euler_phi {
 # Jordan's totient -- a generalization of Euler's totient.
 sub jordan_totient {
   my($k, $n) = @_;
-  _validate_positive_integer($k, 1);
+  _validate_num($k, 1) || _validate_positive_integer($k, 1);
   return euler_phi($n) if $k == 1;
 
   return 0 if defined $n && $n <= 0;  # Following SAGE's logic here.
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
   return 1 if $n <= 1;
 
   my %factor_mult;
@@ -1317,7 +1315,7 @@ sub divisor_sum {
   # I really need to get cracking on an XS validator.
   #return _XS_divisor_sum($n) if !defined $sub && defined $n && $n <= 
$_XS_MAXVAL && $_Config{'nobigint'};
   return (0,1)[$n] if defined $n && $n <= 1;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
 
   if (!defined $sub) {
     return _XS_divisor_sum($n) if $n <= $_XS_MAXVAL;
@@ -1350,7 +1348,7 @@ sub divisor_sum {
 sub _omega {
   my($n) = @_;
   return 0 if defined $n && $n <= 1;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
   my %factor_mult;
   my @factors = grep { !$factor_mult{$_}++ } factor($n);
   return scalar @factors;
@@ -1361,7 +1359,7 @@ sub _omega {
 sub exp_mangoldt {
   my($n) = @_;
   return 1 if defined $n && $n <= 1;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
   return _XS_exp_mangoldt($n) if $n <= $_XS_MAXVAL;
 
   # Power of 2
@@ -1377,7 +1375,7 @@ sub exp_mangoldt {
 
 sub chebyshev_theta {
   my($n) = @_;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
   return _XS_chebyshev_theta($n) if $n <= $_XS_MAXVAL;
   my $sum = 0.0;
   foreach my $p (@{primes($n)}) {
@@ -1387,7 +1385,7 @@ sub chebyshev_theta {
 }
 sub chebyshev_psi {
   my($n) = @_;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
   return 0 if $n <= 1;
   return _XS_chebyshev_psi($n) if $n <= $_XS_MAXVAL;
   my ($sum, $logn, $mults_are_one) = (0.0, log($n), 0);
@@ -1424,7 +1422,7 @@ sub chebyshev_psi {
 sub is_prime {
   my($n) = @_;
   return 0 if defined $n && $n < 2;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
 
   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;
@@ -1434,7 +1432,7 @@ sub is_prime {
 sub is_aks_prime {
   my($n) = @_;
   return 0 if defined $n && $n < 2;
-  _validate_positive_integer($n);
+  _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
@@ -1445,7 +1443,7 @@ sub is_aks_prime {
 
 sub next_prime {
   my($n) = @_;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
 
   # If we have XS and n is either small or bigint is unknown, then use XS.
   return _XS_next_prime($n) if ref($n) ne 'Math::BigInt' && $n <= $_XS_MAXVAL
@@ -1465,7 +1463,7 @@ sub next_prime {
 
 sub prev_prime {
   my($n) = @_;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
 
   return _XS_prev_prime($n) if ref($n) ne 'Math::BigInt' && $n <= $_XS_MAXVAL;
   if ($_HAVE_GMP) {
@@ -1480,11 +1478,11 @@ sub prev_prime {
 sub prime_count {
   my($low,$high) = @_;
   if (defined $high) {
-    _validate_positive_integer($low);
-    _validate_positive_integer($high);
+    _validate_num($low) || _validate_positive_integer($low);
+    _validate_num($high) || _validate_positive_integer($high);
   } else {
     ($low,$high) = (2, $low);
-    _validate_positive_integer($high);
+    _validate_num($high) || _validate_positive_integer($high);
   }
   return 0 if $high < 2  ||  $low > $high;
 
@@ -1514,7 +1512,7 @@ sub prime_count {
 
 sub nth_prime {
   my($n) = @_;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
 
   return _XS_nth_prime($n) if $_Config{'xs'} && $n <= $_Config{'maxprimeidx'};
   return Math::Prime::Util::PP::nth_prime($n);
@@ -1522,7 +1520,7 @@ sub nth_prime {
 
 sub factor {
   my($n) = @_;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
 
   return _XS_factor($n) if ref($n) ne 'Math::BigInt' && $n <= $_XS_MAXVAL;
 
@@ -1539,7 +1537,7 @@ sub factor {
 
 sub is_strong_pseudoprime {
   my($n) = shift;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
   # validate bases?
   return _XS_miller_rabin($n, @_) if ref($n) ne 'Math::BigInt' && $n <= 
$_XS_MAXVAL;
   return Math::Prime::Util::GMP::is_strong_pseudoprime($n, @_) if $_HAVE_GMP;
@@ -1548,7 +1546,7 @@ sub is_strong_pseudoprime {
 
 sub is_strong_lucas_pseudoprime {
   my($n) = shift;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
   return Math::Prime::Util::GMP::is_strong_lucas_pseudoprime("$n") if 
$_HAVE_GMP;
   return Math::Prime::Util::PP::is_strong_lucas_pseudoprime($n);
 }
@@ -1585,7 +1583,7 @@ sub miller_rabin {
 sub is_prob_prime {
   my($n) = @_;
   return 0 if defined $n && $n < 2;
-  _validate_positive_integer($n);
+  _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;
@@ -1627,7 +1625,7 @@ sub is_prob_prime {
 sub is_provable_prime {
   my($n) = @_;
   return 0 if defined $n && $n < 2;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
 
   return _XS_is_prime($n) if ref($n) ne 'Math::BigInt' && $n <= $_XS_MAXVAL;
   return Math::Prime::Util::GMP::is_provable_prime($n)
@@ -1648,7 +1646,7 @@ sub prime_certificate {
 sub is_provable_prime_with_cert {
   my($n) = @_;
   return 0 if defined $n && $n < 2;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
 
   # Set to 0 if you want the proof to go down to 11.
   if (1) {
@@ -2016,7 +2014,7 @@ sub verify_prime {
 
 sub prime_count_approx {
   my($x) = @_;
-  _validate_positive_integer($x);
+  _validate_num($x) || _validate_positive_integer($x);
 
   return $_prime_count_small[$x] if $x <= $#_prime_count_small;
 
@@ -2056,7 +2054,7 @@ sub prime_count_approx {
 
 sub prime_count_lower {
   my($x) = @_;
-  _validate_positive_integer($x);
+  _validate_num($x) || _validate_positive_integer($x);
 
   return $_prime_count_small[$x] if $x <= $#_prime_count_small;
 
@@ -2102,7 +2100,7 @@ sub prime_count_lower {
 
 sub prime_count_upper {
   my($x) = @_;
-  _validate_positive_integer($x);
+  _validate_num($x) || _validate_positive_integer($x);
 
   return $_prime_count_small[$x] if $x <= $#_prime_count_small;
 
@@ -2173,7 +2171,7 @@ sub prime_count_upper {
 
 sub nth_prime_approx {
   my($n) = @_;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
 
   return $_primes_small[$n] if $n <= $#_primes_small;
 
@@ -2227,7 +2225,7 @@ sub nth_prime_approx {
 # The nth prime will be greater than or equal to this number
 sub nth_prime_lower {
   my($n) = @_;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
 
   return $_primes_small[$n] if $n <= $#_primes_small;
 
@@ -2252,7 +2250,7 @@ sub nth_prime_lower {
 # The nth prime will be less or equal to this number
 sub nth_prime_upper {
   my($n) = @_;
-  _validate_positive_integer($n);
+  _validate_num($n) || _validate_positive_integer($n);
 
   return $_primes_small[$n] if $n <= $#_primes_small;
 
diff --git a/lib/Math/Prime/Util/PP.pm b/lib/Math/Prime/Util/PP.pm
index c3494a0..d499f16 100644
--- a/lib/Math/Prime/Util/PP.pm
+++ b/lib/Math/Prime/Util/PP.pm
@@ -59,7 +59,19 @@ sub _prime_memfreeall { prime_memfree; }
 
 
 sub _is_positive_int {
-  ((defined $_[0]) && ($_[0] !~ tr/0123456789//c));
+  ((defined $_[0]) && $_[0] ne '' && ($_[0] !~ tr/0123456789//c));
+}
+
+sub _validate_num {
+  my($n, $min, $max) = @_;
+  croak "Parameter must be defined" if !defined $n;
+  return 0 if ref($n);
+  croak "Parameter '$n' must be a positive integer"
+          if $n eq '' || $n =~ tr/0123456789//c;
+  croak "Parameter '$n' must be >= $min" if defined $min && $n < $min;
+  croak "Parameter '$n' must be <= $max" if defined $max && $n > $max;
+  return 0 unless $n < ~0 || int($n) eq ''.~0;
+  1;
 }
 
 sub _validate_positive_integer {

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