[libmath-prime-util-perl] 01/16: Initial scaffolding for threads
Partha P. Mukherjee
ppm-guest at moszumanska.debian.org
Thu May 21 18:44:33 UTC 2015
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 <dana at 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
More information about the Pkg-perl-cvs-commits
mailing list