#define PERL_IN_SHAREDSV_C
#include "perl.h"
-PerlInterpreter* sharedsv_space;
-
#ifdef USE_ITHREADS
+
+
/*
Shared SV
void
Perl_sharedsv_init(pTHX)
{
- sharedsv_space = PERL_GET_CONTEXT;
+ PerlInterpreter* old_context = PERL_GET_CONTEXT;
+ PL_sharedsv_space = perl_alloc();
+ perl_construct(PL_sharedsv_space);
+ PERL_SET_CONTEXT(old_context);
+ MUTEX_INIT(&PL_sharedsv_space_mutex);
}
/*
New(2555,ssv,1,shared_sv);
MUTEX_INIT(&ssv->mutex);
COND_INIT(&ssv->cond);
+ COND_INIT(&ssv->user_cond);
+ ssv->owner = 0;
ssv->locks = 0;
+ ssv->index = 0;
return ssv;
}
shared_sv *
Perl_sharedsv_find(pTHX_ SV* sv)
{
- /* does all it can to find a shared_sv struct, returns NULL otherwise */
- shared_sv* ssv = NULL;
+ /* does all it can to find a shared_sv struct, returns NULL otherwise */
+ shared_sv* ssv = NULL;
+ switch (SvTYPE(sv)) {
+ case SVt_PVMG:
+ case SVt_PVAV:
+ case SVt_PVHV: {
+ MAGIC* mg = mg_find(sv, PERL_MAGIC_ext);
+ if(mg) {
+ if(strcmp(mg->mg_ptr,"threads::shared"))
+ break;
+ ssv = (shared_sv*) SvIV(mg->mg_obj);
+ break;
+ }
+
+ mg = mg_find(sv,PERL_MAGIC_tied);
+ if(mg) {
+ SV* obj = SvTIED_obj(sv,mg);
+ if(sv_derived_from(obj, "threads::shared"))
+ ssv = (shared_sv*) SvIV(SvRV(obj));
+ break;
+ }
+ }
+ }
return ssv;
}
{
if(!ssv)
return;
+ MUTEX_LOCK(&ssv->mutex);
if(ssv->owner && ssv->owner == my_perl) {
ssv->locks++;
+ MUTEX_UNLOCK(&ssv->mutex);
return;
}
- MUTEX_LOCK(&ssv->mutex);
+ while(ssv->owner)
+ COND_WAIT(&ssv->cond,&ssv->mutex);
ssv->locks++;
ssv->owner = my_perl;
if(ssv->locks == 1)
SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv);
+ MUTEX_UNLOCK(&ssv->mutex);
}
/*
void
Perl_sharedsv_unlock(pTHX_ shared_sv* ssv)
{
- if(ssv->owner != my_perl)
+ MUTEX_LOCK(&ssv->mutex);
+ if(ssv->owner != my_perl) {
+ 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;
- MUTEX_UNLOCK(&ssv->mutex);
+ COND_SIGNAL(&ssv->cond);
}
+ MUTEX_UNLOCK(&ssv->mutex);
}
void
Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv)
{
- if(ssv->owner != my_perl)
+ MUTEX_LOCK(&ssv->mutex);
+ if(ssv->owner != my_perl) {
+ MUTEX_UNLOCK(&ssv->mutex);
return;
+ }
ssv->locks = 0;
ssv->owner = NULL;
+ COND_SIGNAL(&ssv->cond);
MUTEX_UNLOCK(&ssv->mutex);
}
{
SV* sv;
SHAREDSvLOCK(ssv);
- SHAREDSvEDIT(ssv);
sv = SHAREDSvGET(ssv);
if (SvREFCNT(sv) == 1) {
switch (SvTYPE(sv)) {
case SVt_RV:
if (SvROK(sv))
- Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv *)SvIV(SvRV(sv)));
+ Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(SvRV(sv))));
break;
case SVt_PVAV: {
SV **src_ary = AvARRAY((AV *)sv);
while (items-- > 0) {
if(SvTYPE(*src_ary))
- Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv *)SvIV(*src_ary++));
+ Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(*src_ary)));
+ src_ary++;
}
break;
}
(void)hv_iterinit((HV *)sv);
while ((entry = hv_iternext((HV *)sv)))
Perl_sharedsv_thrcnt_dec(
- aTHX_ (shared_sv *)SvIV(hv_iterval((HV *)sv, entry))
+ aTHX_ INT2PTR(shared_sv *, SvIV(hv_iterval((HV *)sv, entry)))
);
break;
}
}
}
- SvREFCNT_dec(sv);
- SHAREDSvRELEASE(ssv);
+ Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(ssv));
SHAREDSvUNLOCK(ssv);
}
-#endif
+#endif /* USE_ITHREADS */
+