|
 |
63d3d0 |
From 2ec58402d05eb12d0b9387963941f1e445d9aa5b Mon Sep 17 00:00:00 2001
|
|
|
63d3d0 |
From: Jitka Plesnikova <jplesnik@redhat.com>
|
|
|
63d3d0 |
Date: Fri, 26 Apr 2019 15:00:30 +0200
|
|
|
63d3d0 |
Subject: [PATCH] Upgrade to 1.60
|
|
|
63d3d0 |
|
|
|
63d3d0 |
---
|
|
|
63d3d0 |
lib/threads/shared.pm | 4 ++--
|
|
|
63d3d0 |
shared.xs | 39 +++++++++++++++++++++++++++++++++++++++
|
|
|
63d3d0 |
2 files changed, 41 insertions(+), 2 deletions(-)
|
|
|
63d3d0 |
|
|
|
63d3d0 |
diff --git a/lib/threads/shared.pm b/lib/threads/shared.pm
|
|
|
63d3d0 |
index f7e5ff8..45ad154 100644
|
|
|
63d3d0 |
--- a/lib/threads/shared.pm
|
|
|
63d3d0 |
+++ b/lib/threads/shared.pm
|
|
|
63d3d0 |
@@ -8,7 +8,7 @@ use Config;
|
|
|
63d3d0 |
|
|
|
63d3d0 |
use Scalar::Util qw(reftype refaddr blessed);
|
|
|
63d3d0 |
|
|
|
63d3d0 |
-our $VERSION = '1.59'; # Please update the pod, too.
|
|
|
63d3d0 |
+our $VERSION = '1.60'; # Please update the pod, too.
|
|
|
63d3d0 |
my $XS_VERSION = $VERSION;
|
|
|
63d3d0 |
$VERSION = eval $VERSION;
|
|
|
63d3d0 |
|
|
|
63d3d0 |
@@ -196,7 +196,7 @@ threads::shared - Perl extension for sharing data structures between threads
|
|
|
63d3d0 |
|
|
|
63d3d0 |
=head1 VERSION
|
|
|
63d3d0 |
|
|
|
63d3d0 |
-This document describes threads::shared version 1.59
|
|
|
63d3d0 |
+This document describes threads::shared version 1.60
|
|
|
63d3d0 |
|
|
|
63d3d0 |
=head1 SYNOPSIS
|
|
|
63d3d0 |
|
|
|
63d3d0 |
diff --git a/shared.xs b/shared.xs
|
|
|
63d3d0 |
index d0f7d1e..6cdf094 100644
|
|
|
63d3d0 |
--- a/shared.xs
|
|
|
63d3d0 |
+++ b/shared.xs
|
|
|
63d3d0 |
@@ -115,6 +115,17 @@
|
|
|
63d3d0 |
* without the prefix (e.g., sv, tmp or obj).
|
|
|
63d3d0 |
*/
|
|
|
63d3d0 |
|
|
|
63d3d0 |
+/* this is lower overhead than warn() and less likely to interfere
|
|
|
63d3d0 |
+ with other parts of perl (like with the debugger.)
|
|
|
63d3d0 |
+*/
|
|
|
63d3d0 |
+#ifdef SHARED_TRACE_LOCKS
|
|
|
63d3d0 |
+# define TRACE_LOCK(x) DEBUG_U(x)
|
|
|
63d3d0 |
+# define TRACE_LOCKv(x) DEBUG_Uv(x)
|
|
|
63d3d0 |
+#else
|
|
|
63d3d0 |
+# define TRACE_LOCK(x)
|
|
|
63d3d0 |
+# define TRACE_LOCKv(x)
|
|
|
63d3d0 |
+#endif
|
|
|
63d3d0 |
+
|
|
|
63d3d0 |
#define PERL_NO_GET_CONTEXT
|
|
|
63d3d0 |
#include "EXTERN.h"
|
|
|
63d3d0 |
#include "perl.h"
|
|
|
63d3d0 |
@@ -211,8 +222,24 @@ recursive_lock_release(pTHX_ recursive_lock_t *lock)
|
|
|
63d3d0 |
if (--lock->locks == 0) {
|
|
|
63d3d0 |
lock->owner = NULL;
|
|
|
63d3d0 |
COND_SIGNAL(&lock->cond);
|
|
|
63d3d0 |
+ TRACE_LOCK(
|
|
|
63d3d0 |
+ PerlIO_printf(Perl_debug_log, "shared lock released %p for %p at %s:%d\n",
|
|
|
63d3d0 |
+ lock, aTHX, CopFILE(PL_curcop), CopLINE(PL_curcop))
|
|
|
63d3d0 |
+ );
|
|
|
63d3d0 |
+ }
|
|
|
63d3d0 |
+ else {
|
|
|
63d3d0 |
+ TRACE_LOCKv(
|
|
|
63d3d0 |
+ PerlIO_printf(Perl_debug_log, "shared lock unbump %p for %p at %s:%d\n",
|
|
|
63d3d0 |
+ lock, aTHX, CopFILE(PL_curcop), CopLINE(PL_curcop))
|
|
|
63d3d0 |
+ );
|
|
|
63d3d0 |
}
|
|
|
63d3d0 |
}
|
|
|
63d3d0 |
+ else {
|
|
|
63d3d0 |
+ TRACE_LOCK(
|
|
|
63d3d0 |
+ PerlIO_printf(Perl_debug_log, "bad shared lock release %p for %p (owned by %p) at %s:%d\n",
|
|
|
63d3d0 |
+ lock, aTHX, lock->owner, CopFILE(PL_curcop), CopLINE(PL_curcop))
|
|
|
63d3d0 |
+ );
|
|
|
63d3d0 |
+ }
|
|
|
63d3d0 |
MUTEX_UNLOCK(&lock->mutex);
|
|
|
63d3d0 |
}
|
|
|
63d3d0 |
|
|
|
63d3d0 |
@@ -224,8 +251,16 @@ recursive_lock_acquire(pTHX_ recursive_lock_t *lock, const char *file, int line)
|
|
|
63d3d0 |
assert(aTHX);
|
|
|
63d3d0 |
MUTEX_LOCK(&lock->mutex);
|
|
|
63d3d0 |
if (lock->owner == aTHX) {
|
|
|
63d3d0 |
+ TRACE_LOCKv(
|
|
|
63d3d0 |
+ PerlIO_printf(Perl_debug_log, "shared lock bump %p (%p) at %s:%d\n",
|
|
|
63d3d0 |
+ lock, lock->owner, CopFILE(PL_curcop), CopLINE(PL_curcop))
|
|
|
63d3d0 |
+ );
|
|
|
63d3d0 |
lock->locks++;
|
|
|
63d3d0 |
} else {
|
|
|
63d3d0 |
+ TRACE_LOCK(
|
|
|
63d3d0 |
+ PerlIO_printf(Perl_debug_log, "shared lock try %p for %p (owned by %p) at %s:%d\n",
|
|
|
63d3d0 |
+ lock, aTHX, lock->owner, CopFILE(PL_curcop), CopLINE(PL_curcop))
|
|
|
63d3d0 |
+ );
|
|
|
63d3d0 |
while (lock->owner) {
|
|
|
63d3d0 |
#ifdef DEBUG_LOCKS
|
|
|
63d3d0 |
Perl_warn(aTHX_ " %p waiting - owned by %p %s:%d\n",
|
|
|
63d3d0 |
@@ -233,6 +268,10 @@ recursive_lock_acquire(pTHX_ recursive_lock_t *lock, const char *file, int line)
|
|
|
63d3d0 |
#endif
|
|
|
63d3d0 |
COND_WAIT(&lock->cond,&lock->mutex);
|
|
|
63d3d0 |
}
|
|
|
63d3d0 |
+ TRACE_LOCK(
|
|
|
63d3d0 |
+ PerlIO_printf(Perl_debug_log, "shared lock got %p at %s:%d\n",
|
|
|
63d3d0 |
+ lock, CopFILE(PL_curcop), CopLINE(PL_curcop))
|
|
|
63d3d0 |
+ );
|
|
|
63d3d0 |
lock->locks = 1;
|
|
|
63d3d0 |
lock->owner = aTHX;
|
|
|
63d3d0 |
#ifdef DEBUG_LOCKS
|
|
|
63d3d0 |
--
|
|
|
63d3d0 |
2.20.1
|
|
|
63d3d0 |
|