/*
* Only one thread at a time is allowed to mess with shared space.
*/
-perl_mutex PL_sharedsv_space_mutex; /* Mutex protecting the shared sv space */
-PerlInterpreter *PL_shared_owner; /* For locking assertions */
-#define SHARED_LOCK STMT_START { \
- MUTEX_LOCK(&PL_sharedsv_space_mutex); \
- PL_shared_owner = aTHX; \
- } STMT_END
+typedef struct
+{
+ perl_mutex mutex;
+ perl_cond cond;
+ PerlInterpreter *owner;
+ I32 locks;
+} recursive_lock_t;
+
+recursive_lock_t PL_sharedsv_lock; /* Mutex protecting the shared sv space */
+
+void
+recursive_lock_init(pTHX_ recursive_lock_t *lock)
+{
+ Zero(lock,1,recursive_lock_t);
+ MUTEX_INIT(&lock->mutex);
+ COND_INIT(&lock->cond);
+}
+
+void
+recursive_lock_release(pTHX_ recursive_lock_t *lock)
+{
+ MUTEX_LOCK(&lock->mutex);
+ if (lock->owner != aTHX) {
+ MUTEX_UNLOCK(&lock->mutex);
+ }
+ else {
+ if (--lock->locks == 0) {
+ lock->owner = NULL;
+ COND_SIGNAL(&lock->cond);
+ }
+ }
+ MUTEX_UNLOCK(&lock->mutex);
+}
-#define SHARED_UNLOCK STMT_START { \
- PL_shared_owner = NULL; \
- MUTEX_UNLOCK(&PL_sharedsv_space_mutex); \
+void
+recursive_lock_acquire(pTHX_ recursive_lock_t *lock)
+{
+ assert(aTHX);
+ MUTEX_LOCK(&lock->mutex);
+ if (lock->owner == aTHX) {
+ lock->locks++;
+ }
+ else {
+ while (lock->owner)
+ COND_WAIT(&lock->cond,&lock->mutex);
+ lock->locks = 1;
+ lock->owner = aTHX;
+ SAVEDESTRUCTOR_X(recursive_lock_release,lock);
+ }
+ MUTEX_UNLOCK(&lock->mutex);
+}
+
+#define ENTER_LOCK STMT_START { \
+ ENTER; \
+ recursive_lock_acquire(aTHX_ &PL_sharedsv_lock); \
} STMT_END
+#define LEAVE_LOCK LEAVE
+
/* A common idiom is to acquire access and switch in ... */
#define SHARED_EDIT STMT_START { \
- SHARED_LOCK; \
+ ENTER_LOCK; \
SHARED_CONTEXT; \
} STMT_END
/* then switch out and release access. */
#define SHARED_RELEASE STMT_START { \
CALLER_CONTEXT; \
- SHARED_UNLOCK; \
+ LEAVE_LOCK; \
} STMT_END
typedef struct {
SV *sv; /* The actual SV - in shared space */
- perl_mutex mutex; /* Our mutex */
- perl_cond cond; /* Our condition variable */
+ recursive_lock_t lock;
perl_cond user_cond; /* For user-level conditions */
- IV locks; /* Number of locks held */
- PerlInterpreter *owner; /* Who owns the lock? */
} shared_sv;
/* The SV in shared-space has a back-pointer to the shared_sv
assert ( aTHX != PL_sharedsv_space );
/* To avoid need for recursive locks require caller to hold lock */
- if ( PL_shared_owner != aTHX )
+ assert ( PL_sharedsv_lock.owner == aTHX );
+ if ( PL_sharedsv_lock.owner != aTHX )
abort();
- assert ( PL_shared_owner == aTHX );
/* Try shared SV as 1st choice */
if (!data && ssv && SvTYPE(ssv) >= SVt_PVMG) {
if (!data) {
data = PerlMemShared_malloc(sizeof(shared_sv));
Zero(data,1,shared_sv);
- MUTEX_INIT(&data->mutex);
- COND_INIT(&data->cond);
+ recursive_lock_init(aTHX_ &data->lock);
COND_INIT(&data->user_cond);
- data->owner = 0;
- data->locks = 0;
}
if (!ssv)
}
break;
}
+ assert ( Perl_sharedsv_find(aTHX_ *psv) == data );
}
return data;
}
break;
default:
- SHARED_LOCK;
+ ENTER_LOCK;
Perl_sharedsv_associate(aTHX_ &sv, 0, 0);
- SHARED_UNLOCK;
+ LEAVE_LOCK;
SvSETMAGIC(sv);
break;
}
{
shared_sv *shared = (shared_sv *) mg->mg_ptr;
- SHARED_LOCK;
+ ENTER_LOCK;
if (SHAREDSvPTR(shared)) {
if (SvROK(SHAREDSvPTR(shared))) {
SV *obj = Nullsv;
sv_setsv_nomg(sv, SHAREDSvPTR(shared));
}
}
- SHARED_UNLOCK;
+ LEAVE_LOCK;
return 0;
}
dTHXc;
shared_sv *shared;
bool allowed = TRUE;
- SHARED_LOCK;
+ ENTER_LOCK;
shared = Perl_sharedsv_associate(aTHX_ &sv, Nullsv, (shared_sv *) mg->mg_ptr);
if (SvROK(sv)) {
magic such that by the time we get here it has been stored
to its shared counterpart
*/
- SHARED_LOCK;
+ ENTER_LOCK;
+ assert(shared);
+ assert(SHAREDSvPTR(shared));
target = Perl_sharedsv_associate(aTHX_ &sv, Nullsv, 0);
SHARED_CONTEXT;
val = SHAREDSvPTR(target);
return 0;
}
-
int
sharedsv_elem_mg_free(pTHX_ SV *sv, MAGIC *mg)
{
void
Perl_sharedsv_unlock(pTHX_ shared_sv* ssv)
{
- MUTEX_LOCK(&ssv->mutex);
- if (ssv->owner != aTHX) {
- Perl_croak(aTHX_ "panic: Perl_sharedsv_unlock unlocking mutex that we don't own");
- MUTEX_UNLOCK(&ssv->mutex);
- return;
- }
-
- if (--ssv->locks == 0) {
- ssv->owner = NULL;
- COND_SIGNAL(&ssv->cond);
- }
- MUTEX_UNLOCK(&ssv->mutex);
- }
-
-void
-Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv)
-{
- MUTEX_LOCK(&ssv->mutex);
- if (ssv->owner != aTHX) {
- MUTEX_UNLOCK(&ssv->mutex);
- return;
- }
- ssv->locks = 0;
- ssv->owner = NULL;
- COND_SIGNAL(&ssv->cond);
- MUTEX_UNLOCK(&ssv->mutex);
+ recursive_lock_release(aTHX_ &ssv->lock);
}
=for apidoc sharedsv_lock
{
if (!ssv)
return;
- MUTEX_LOCK(&ssv->mutex);
- if (ssv->owner && ssv->owner == aTHX) {
- ssv->locks++;
- MUTEX_UNLOCK(&ssv->mutex);
- return;
- }
- while (ssv->owner)
- COND_WAIT(&ssv->cond,&ssv->mutex);
- ssv->locks++;
- ssv->owner = aTHX;
- if (ssv->locks == 1)
- SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv);
- MUTEX_UNLOCK(&ssv->mutex);
+ recursive_lock_acquire(aTHX_ &ssv->lock);
}
void
PL_sharedsv_space = perl_alloc();
perl_construct(PL_sharedsv_space);
CALLER_CONTEXT;
- MUTEX_INIT(&PL_sharedsv_space_mutex);
+ recursive_lock_init(aTHX_ &PL_sharedsv_lock);
PL_lockhook = &Perl_sharedsv_locksv;
PL_sharehook = &Perl_sharedsv_share;
}
for(i = 1; i < items; i++) {
SV* tmp = newSVsv(ST(i));
shared_sv *target;
- SHARED_LOCK;
+ ENTER_LOCK;
target = Perl_sharedsv_associate(aTHX_ &tmp, Nullsv, 0);
SHARED_CONTEXT;
av_push((AV*) SHAREDSvPTR(shared), SHAREDSvPTR(target));
CODE:
dTHXc;
int i;
- SHARED_LOCK;
+ ENTER_LOCK;
SHARED_CONTEXT;
av_unshift((AV*)SHAREDSvPTR(shared), items - 1);
CALLER_CONTEXT;
CALLER_CONTEXT;
SvREFCNT_dec(tmp);
}
- SHARED_UNLOCK;
+ LEAVE_LOCK;
void
POP(shared_sv *shared)
CODE:
dTHXc;
SV* sv;
- SHARED_LOCK;
+ ENTER_LOCK;
SHARED_CONTEXT;
sv = av_pop((AV*)SHAREDSvPTR(shared));
CALLER_CONTEXT;
ST(0) = Nullsv;
Perl_sharedsv_associate(aTHX_ &ST(0), sv, 0);
- SHARED_UNLOCK;
+ LEAVE_LOCK;
XSRETURN(1);
void
CODE:
dTHXc;
SV* sv;
- SHARED_LOCK;
+ ENTER_LOCK;
SHARED_CONTEXT;
sv = av_shift((AV*)SHAREDSvPTR(shared));
CALLER_CONTEXT;
ST(0) = Nullsv;
Perl_sharedsv_associate(aTHX_ &ST(0), sv, 0);
- SHARED_UNLOCK;
+ LEAVE_LOCK;
XSRETURN(1);
void
char* key = NULL;
I32 len = 0;
HE* entry;
- SHARED_LOCK;
+ ENTER_LOCK;
SHARED_CONTEXT;
hv_iterinit((HV*) SHAREDSvPTR(shared));
entry = hv_iternext((HV*) SHAREDSvPTR(shared));
CALLER_CONTEXT;
ST(0) = &PL_sv_undef;
}
- SHARED_UNLOCK;
+ LEAVE_LOCK;
XSRETURN(1);
void
char* key = NULL;
I32 len = 0;
HE* entry;
- SHARED_LOCK;
+ ENTER_LOCK;
SHARED_CONTEXT;
entry = hv_iternext((HV*) SHAREDSvPTR(shared));
if(entry) {
CALLER_CONTEXT;
ST(0) = &PL_sv_undef;
}
- SHARED_UNLOCK;
+ LEAVE_LOCK;
XSRETURN(1);
MODULE = threads::shared PACKAGE = threads::shared
shared = Perl_sharedsv_find(aTHX_ ref);
if(!shared)
croak("cond_wait can only be used on shared values");
- if(shared->owner != aTHX)
+ if(shared->lock.owner != aTHX)
croak("You need a lock before you can cond_wait");
- MUTEX_LOCK(&shared->mutex);
- shared->owner = NULL;
- locks = shared->locks = 0;
- COND_WAIT(&shared->user_cond, &shared->mutex);
- shared->owner = aTHX;
- shared->locks = locks;
- MUTEX_UNLOCK(&shared->mutex);
+ /* Stealing the members of the lock object worries me - NI-S */
+ MUTEX_LOCK(&shared->lock.mutex);
+ shared->lock.owner = NULL;
+ locks = shared->lock.locks = 0;
+ COND_WAIT(&shared->user_cond, &shared->lock.mutex);
+ shared->lock.owner = aTHX;
+ shared->lock.locks = locks;
+ MUTEX_UNLOCK(&shared->lock.mutex);
void
cond_signal_enabled(SV *ref)
ok(13, $seen{"foo"} == 1, "Keys..");
threads->create(sub { %hash = () })->join();
ok(14, keys %hash == 0, "Check clear");
-ok(15, threads::shared::_thrcnt(\%hash) == 1, "thrcnt");
-threads->create(sub { ok(16, threads::shared::_thrcnt(\%hash) == 2, "thrcnt is up")})->join();
-ok(17, threads::shared::_thrcnt(\%hash) == 1, "thrcnt is down");
-{
+ok(15, threads::shared::_thrcnt(%hash) == 1, "thrcnt");
+threads->create(sub { ok(16, threads::shared::_thrcnt(%hash) == 2, "thrcnt is up")})->join();
+ok(17, threads::shared::_thrcnt(%hash) == 1, "thrcnt is down");
+{
my $test;
my $test2;
share($test);
$test = \%hash;
$test2 = \%hash;
- ok(18, threads::shared::_thrcnt(\%hash) == 2, "thrcnt is up on shared reference");
+ ok(18, threads::shared::_thrcnt(%hash) == 2, "thrcnt is up on shared reference");
$test = "bar";
- ok(19 , threads::shared::_thrcnt(\%hash) == 1, "thrcnt is down when shared reference is dropped");
+ ok(19 , threads::shared::_thrcnt(%hash) == 1, "thrcnt is down when shared reference is dropped");
$test = $test2;
- ok(20, threads::shared::_thrcnt(\%hash) == 2, "thrcnt is up on shared reference");
+ ok(20, threads::shared::_thrcnt(%hash) == 2, "thrcnt is up on shared reference");
}
-ok(21 , threads::shared::_thrcnt(\%hash) == 1, "thrcnt is down when shared reference is killed");
+ok(21 , threads::shared::_thrcnt(%hash) == 1, "thrcnt is down when shared reference is killed");
projects / p5sagit/p5-mst-13.2.git / commitdiff