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

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

commit fd0d5e5b7ac1dc0758cc0cc218dc45030e5c9e7e
Author: Dana Jacobsen <d...@acm.org>
Date:   Mon Jun 18 15:06:33 2012 -0600

    Initial scaffolding for threads
---
 Changes                    |  3 ++
 XS.xs                      |  2 +-
 cache.c                    | 74 +++++++++++++++++++++++++++++++++++++++-------
 examples/bench-nthprime.pl | 45 ++++++++++++++++++++++++----
 util.c                     | 20 ++++++++-----
 5 files changed, 118 insertions(+), 26 deletions(-)

diff --git a/Changes b/Changes
index 7e4d706..aa4f9da 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Perl extension Math::Prime::Util.
 
+0.08  20 June 2012
+    - Added thread scaffolding.
+
 0.07  17 June 2012
     - Fixed a bug in next_prime found by Lou Godio (thank you VERY much!).
       Added more tests for this.  This had been changed in another area but
diff --git a/XS.xs b/XS.xs
index 3f460f4..d0fcb4f 100644
--- a/XS.xs
+++ b/XS.xs
@@ -167,8 +167,8 @@ segment_primes(IN UV low, IN UV high);
 
         /* Sieve from startd*30+1 to endd*30+29.  */
         if (sieve_segment(sieve, low_d, seghigh_d) == 0) {
+          free_prime_segment(sieve);
           croak("Could not segment sieve from %"UVuf" to %"UVuf, segbase+1, 
seghigh);
-          break;
         }
 
         START_DO_FOR_EACH_SIEVE_PRIME( sieve, low - segbase, seghigh - segbase 
)
diff --git a/cache.c b/cache.c
index 3ef511e..e0730f4 100644
--- a/cache.c
+++ b/cache.c
@@ -6,6 +6,26 @@
 #include "cache.h"
 #include "sieve.h"
 
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/*
+ * These functions are used internally by the .c and .xs files.
+ * They handle a cached primary set of primes, as well as a segment
+ * area for use by all the functions that want to do segmented operation.
+ *
+ * Since we're trying to be thread-safe (and ideally allow a good deal
+ * of concurrency), it is imperative these be used correctly.  You need
+ * to call the get method, do your stuff, then call free.  Do *not* return
+ * out of your function or croak without calling free.
+ */
+
+static int mutex_init = 0;
+#ifdef USE_ITHREADS
+static perl_mutex segment_mutex;
+static perl_mutex primary_mutex;
+#endif
 
 static unsigned char* prime_cache_sieve = 0;
 static UV             prime_cache_size = 0;
@@ -51,36 +71,75 @@ UV get_prime_cache(UV n, const unsigned char** sieve)
 
 #define SEGMENT_CHUNK_SIZE  UVCONST(262144)
 static unsigned char* prime_segment = 0;
+
 unsigned char* get_prime_segment(UV *size) {
   MPUassert(size != 0, "get_prime_segment given null size pointer");
+  MPUassert(mutex_init == 1, "segment mutex has not been initialized");
+  MUTEX_LOCK(&segment_mutex);
   if (prime_segment == 0)
     New(0, prime_segment, SEGMENT_CHUNK_SIZE, unsigned char);
-  if (prime_segment == 0)
+  if (prime_segment == 0) {
+    MUTEX_UNLOCK(&segment_mutex);
     croak("Could not allocate %"UVuf" bytes for segment sieve", 
SEGMENT_CHUNK_SIZE);
+  }
   *size = SEGMENT_CHUNK_SIZE;
   return prime_segment;
 }
 void free_prime_segment(unsigned char* mem) {
   /* Thanks for letting us know you're done. */
+  MUTEX_UNLOCK(&segment_mutex);
 }
 
 
 
 void prime_precalc(UV n)
 {
-  if (n == 0) {
-    /* On initialization, make a few primes (2-30k using 1k memory) */
-    n = (1024-16)*30;
+  if (!mutex_init) {
+    MUTEX_INIT(&segment_mutex);
+    MUTEX_INIT(&primary_mutex);
+    mutex_init = 1;
   }
 
+  /* On initialization, make a few primes (2-30k using 1k memory) */
+  if (n == 0)
+    n = (1024-16)*30;
   get_prime_cache(n, 0);   /* Sieve to n */
 
   /* TODO: should we prealloc the segment here? */
 }
 
 
+void prime_memfree(void)
+{
+  MPUassert(mutex_init == 1, "segment mutex has not been initialized");
+
+  if (prime_cache_sieve != 0) {
+    MUTEX_LOCK(&primary_mutex);
+    Safefree(prime_cache_sieve);
+    prime_cache_sieve = 0;
+    prime_cache_size = 0;
+    MUTEX_UNLOCK(&primary_mutex);
+  }
+
+  if (prime_segment != 0) {
+    MUTEX_LOCK(&segment_mutex);
+    Safefree(prime_segment);
+    prime_segment = 0;
+    MUTEX_UNLOCK(&segment_mutex);
+  }
+
+  prime_precalc(0);
+}
+
+
 void _prime_memfreeall(void)
 {
+  /* No locks.  We're shutting everything down. */
+  if (mutex_init) {
+    MUTEX_DESTROY(&segment_mutex);
+    MUTEX_DESTROY(&primary_mutex);
+    mutex_init = 0;
+  }
   if (prime_cache_sieve != 0)
     Safefree(prime_cache_sieve);
   prime_cache_sieve = 0;
@@ -90,10 +149,3 @@ void _prime_memfreeall(void)
     Safefree(prime_segment);
   prime_segment = 0;
 }
-
-void prime_memfree(void)
-{
-  _prime_memfreeall();
-
-  prime_precalc(0);
-}
diff --git a/examples/bench-nthprime.pl b/examples/bench-nthprime.pl
index 55c239a..9d5742a 100755
--- a/examples/bench-nthprime.pl
+++ b/examples/bench-nthprime.pl
@@ -2,11 +2,44 @@
 use strict;
 use warnings;
 use Math::Prime::Util qw/nth_prime prime_precalc/;
-use Devel::TimeThis;
-#prime_precalc(100000000);
+use Benchmark qw/:all :hireswallclock/;
+use Data::Dumper;
 
-foreach my $e (3 .. 9) {
-  my $n = 10 ** $e;
-  my $t = Devel::TimeThis->new("nth_prime(10^$e)");
-  nth_prime($n);
+my $count = shift || -5;
+
+#prime_precalc(1000000000);
+
+srand(29);
+my @darray;
+push @darray, [gendigits($_,int(2700/($_*$_*$_)))]  for (2 .. 9);
+
+my $sum;
+foreach my $digits (3 .. 9) {
+  my @digarray = @{$darray[$digits-2]};
+  my $numitems = scalar @digarray;
+  my $timing = cmpthese(
+    $count,
+    { "$digits" => sub { $sum += nth_prime($_) for @digarray }, },
+    'none',
+    );
+  my $secondsper = $timing->[1]->[1];
+  if ($timing->[0]->[1] eq 'Rate') {
+    $secondsper =~ s/\/s$//;
+    $secondsper = 1.0 / $secondsper;
+  }
+  $secondsper /= $numitems;
+  my $timestr = (1.0 / $secondsper) . "/s per number";
+  printf "%4d %2d-digit numbers: %s\n", $numitems, $digits, $timestr;
+}
+
+sub gendigits {
+  my $digits = shift;
+  die "Digits must be > 0" unless $digits > 0;
+  my $num = shift;
+
+  my $base = ($digits == 1) ? 0 : int(10 ** ($digits-1));
+  my $max = int(10 ** $digits);
+  $max = ~0 if $max > ~0;
+  my @nums = map { $base+int(rand($max-$base)) } (1 .. $num);
+  return @nums;
 }
diff --git a/util.c b/util.c
index 86983ca..30c4c8d 100644
--- a/util.c
+++ b/util.c
@@ -239,6 +239,8 @@ static UV count_segment_maxcount(const unsigned char* 
sieve, UV nbytes, UV maxco
 {
   UV count = 0;
   UV byte = 0;
+  const unsigned char* sieveptr = sieve;
+  const unsigned char* maxsieve = sieve + nbytes;
 
   MPUassert(sieve != 0, "count_segment_maxcount incorrect args");
   MPUassert(pos != 0, "count_segment_maxcount incorrect args");
@@ -246,12 +248,14 @@ static UV count_segment_maxcount(const unsigned char* 
sieve, UV nbytes, UV maxco
   if ( (nbytes == 0) || (maxcount == 0) )
     return 0;
 
-  while ( (byte < nbytes) && (count < maxcount) )
-    count += byte_zeros[sieve[byte++]];
-
-  if (count >= maxcount) { /* One too far -- back up */
-    count -= byte_zeros[sieve[--byte]];
-  }
+  /* Count until we reach the end or >= maxcount */
+  while ( (sieveptr < maxsieve) && (count < maxcount) )
+    count += byte_zeros[*sieveptr++];
+  /* If we went one too far, back up.  Count will always be < maxcount */
+  if (count >= maxcount)
+    count -= byte_zeros[*--sieveptr];
+  /* We counted this many bytes */
+  byte = sieveptr - sieve;
 
   MPUassert(count < maxcount, "count_segment_maxcount wrong count");
 
@@ -559,8 +563,8 @@ UV prime_count(UV low, UV high)
     UV seghigh = (seghigh_d == high_d) ? high : (seghigh_d*30+29);
 
     if (sieve_segment(segment, low_d, seghigh_d) == 0) {
+      free_prime_segment(segment);
       croak("Could not segment sieve from %"UVuf" to %"UVuf, low_d*30+1, 
30*seghigh_d+29);
-      break;
     }
 
     count += count_segment_ranged(segment, segment_size, seglow - low_d*30, 
seghigh - low_d*30);
@@ -760,8 +764,8 @@ UV nth_prime(UV n)
 
     /* Do the actual sieving in the range */
     if (sieve_segment(segment, segbase, segbase + segment_size-1) == 0) {
+      free_prime_segment(segment);
       croak("Could not segment sieve from %"UVuf" to %"UVuf, 30*segbase+1, 
30*(segbase+segment_size)+29);
-      break;
     }
 
     /* Count up everything in this segment */

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