[libmath-prime-util-perl] 106/181: Modify const SV for threads

Partha P. Mukherjee ppm-guest at moszumanska.debian.org
Thu May 21 18:51:11 UTC 2015


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

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

commit 3645d326b70d43d1bcf2b8679133b0a1a58edc66
Author: Dana Jacobsen <dana at acm.org>
Date:   Fri Jan 3 02:48:10 2014 -0800

    Modify const SV for threads
---
 XS.xs                  | 49 ++++++++++++++++++++++++++++++++++++-------------
 lib/Math/Prime/Util.pm | 16 +++++++++++-----
 t/31-threading.t       |  6 +++++-
 3 files changed, 52 insertions(+), 19 deletions(-)

diff --git a/XS.xs b/XS.xs
index 396b0a3..6cc7cb7 100644
--- a/XS.xs
+++ b/XS.xs
@@ -173,13 +173,26 @@ static int _vcallsubn(pTHX_ I32 flags, const char* gmp_name, const char* name, i
 #define _vcallsub(func) (void)_vcallsubn(aTHX_ G_SCALAR, 0, func, items)
 #define _vcallsub_with_gmp(func) (void)_vcallsubn(aTHX_ G_SCALAR, "GMP::" func, "PP::" func, items)
 
-static SV* const_int[4] = {0};   /* -1, 0, 1, 2 */
-/* I wish I had a better name for this */
-#define RETURN_NPARITY(ret) \
-  do { int r_ = ret; \
-       if (r_ >= -1 && r_ <= 2) { ST(0) = const_int[r_+1]; XSRETURN(1); } \
-       else                     { XSRETURN_IV(r_);                      } \
-  } while (0)
+/* In my testing, this constant return works fine with threads, but to be
+ * correct (see perlxs) one has to make a context, store separate copies in
+ * each one, then retrieve them from a struct using a hash index.  This
+ * defeats the purpose if only done once. */
+#ifdef MULTIPLICITY
+  #define RETURN_NPARITY(ret)  XSRETURN_IV(ret)
+  #define PUSH_NPARITY(ret)    PUSHs(sv_2mortal(newSViv( ret )))
+#else
+  static SV* const_int[4] = {0};   /* -1, 0, 1, 2 */
+  #define RETURN_NPARITY(ret) \
+    do { int r_ = ret; \
+         if (r_ >= -1 && r_ <= 2) { ST(0) = const_int[r_+1]; XSRETURN(1); } \
+         else                     { XSRETURN_IV(r_);                      } \
+    } while (0)
+  #define PUSH_NPARITY(ret) \
+    do { int r_ = ret; \
+         if (r_ >= -1 && r_ <= 2) { PUSHs( const_int[r_+1] );       } \
+         else                     { PUSHs(sv_2mortal(newSViv(r_))); } \
+    } while (0)
+#endif
 
 MODULE = Math::Prime::Util	PACKAGE = Math::Prime::Util
 
@@ -187,14 +200,17 @@ PROTOTYPES: ENABLE
 
 BOOT:
 {
-    int i;
     SV * sv = newSViv(BITS_PER_WORD);
     HV * stash = gv_stashpv("Math::Prime::Util", TRUE);
     newCONSTSUB(stash, "_XS_prime_maxbits", sv);
-    for (i = 0; i <= 3; i++) {
-      const_int[i] = newSViv(i-1);
-      SvREADONLY_on(const_int[i]);
+#ifndef MULTIPLICITY
+    { int i;
+      for (i = 0; i <= 3; i++) {
+        const_int[i] = newSViv(i-1);
+        SvREADONLY_on(const_int[i]);
+      }
     }
+#endif
 }
 
 void
@@ -689,9 +705,16 @@ euler_phi(IN SV* svlo, ...)
           Safefree(totients);
         } else {
           signed char* mu = _moebius_range(lo, hi);
-          /* TODO: assert these are -1,0,1 */
+#ifndef MULTIPLICITY
           for (i = lo; i <= hi; i++)
-            PUSHs(const_int[mu[i-lo]+1]);
+            PUSH_NPARITY(mu[i-lo]);
+#else
+          SV* csv[3];
+          for (i = 0; i < 3; i++)
+            { csv[i] = sv_2mortal(newSViv(i-1));  SvREADONLY_on(csv[i]); }
+          for (i = lo; i <= hi; i++)
+            PUSHs(csv[mu[i-lo]+1]);
+#endif
           Safefree(mu);
         }
       }
diff --git a/lib/Math/Prime/Util.pm b/lib/Math/Prime/Util.pm
index 3dd58e1..2a6642a 100644
--- a/lib/Math/Prime/Util.pm
+++ b/lib/Math/Prime/Util.pm
@@ -3194,6 +3194,10 @@ from low to high inclusive.  Large values of high will result in a lot of
 memory use.  The algorithm used is Deléglise and Rivat (1996) algorithm 4.1,
 which is a segmented version of Lioen and van de Lune (1994) algorithm 3.2.
 
+The return values are read-only constants.  This should almost never come up,
+but it does mean trying to modify aliased return values will cause an
+exception (modifying the returned scalar or array is fine).
+
 
 =head2 mertens
 
@@ -3204,13 +3208,15 @@ function is defined as C<sum(moebius(1..n))>, but calculated more efficiently
 for large inputs.  For example, computing Mertens(100M) takes:
 
    time    approx mem
-     0.4s      0.1MB   mertens(100_000_000)
-     4s      890MB     List::Util::sum(moebius(1,100_000_000))
-    89s        0MB     $sum += moebius($_) for 1..100_000_000
+     0.3s      0.1MB   mertens(100_000_000)
+     1.2s    890MB     List::Util::sum(moebius(1,100_000_000))
+    77s        0MB     $sum += moebius($_) for 1..100_000_000
 
 The summation of individual terms via factoring is quite expensive in time,
-though uses O(1) space.  This function will generate the equivalent output
-via a sieving method, which will use some more memory, but be much faster.
+though uses O(1) space.  Using the range version of moebius is much faster,
+but returns a 100M element array which is not good for memory with this many
+items.  In comparison, this function will generate the equivalent output
+via a sieving method that is relatively sparse memory and very fast.
 The current method is a simple C<n^1/2> version of Deléglise and Rivat (1996),
 which involves calculating all moebius values to C<n^1/2>, which in turn will
 require prime sieving to C<n^1/4>.
diff --git a/t/31-threading.t b/t/31-threading.t
index ba5104e..cb7db87 100644
--- a/t/31-threading.t
+++ b/t/31-threading.t
@@ -15,7 +15,7 @@ BEGIN {
   }
 }
 
-use Test::More 'tests' => 9;
+use Test::More 'tests' => 10;
 use Math::Prime::Util ":all";
 
 my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING};
@@ -92,6 +92,10 @@ thread_test(
   sub { my $sum = 0;  $sum += is_prime($_) for (@randn); return $sum;},
   $numthreads, "is_prime");
 
+thread_test(
+  sub { my $sum = 0;  foreach my $n (@randn) { $sum += $_ for moebius($n,$n+50); } return $sum;},
+  $numthreads, "moebius");
+
 # Custom rand, so we get the same result each time.
 {
   my $seed = 1;

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