#include "perl.h"
#include "XSUB.h"
+MGVTBL svtable;
SV* shared_sv_attach_sv (SV* sv, shared_sv* shared) {
HV* shared_hv = get_hv("threads::shared::shared", FALSE);
sv = newRV(SvRV(tiedobject));
}
} else {
- croak("die\n");
+ switch(SvTYPE(SHAREDSvGET(shared))) {
+ case SVt_PVAV: {
+ SV* weakref;
+ SV* obj_ref = newSViv(0);
+ SV* obj = newSVrv(obj_ref,"threads::shared::av");
+ AV* hv = newAV();
+ sv_setiv(obj,(IV)shared);
+ weakref = newRV((SV*)hv);
+ sv = newRV_noinc((SV*)hv);
+ sv_rvweaken(weakref);
+ sv_magic((SV*) hv, obj_ref, PERL_MAGIC_tied, Nullch, 0);
+ hv_store(shared_hv, SvPV(id,length), length, weakref, 0);
+ Perl_sharedsv_thrcnt_inc(aTHX_ shared);
+ }
+ break;
+ case SVt_PVHV: {
+ SV* weakref;
+ SV* obj_ref = newSViv(0);
+ SV* obj = newSVrv(obj_ref,"threads::shared::hv");
+ HV* hv = newHV();
+ sv_setiv(obj,(IV)shared);
+ weakref = newRV((SV*)hv);
+ sv = newRV_noinc((SV*)hv);
+ sv_rvweaken(weakref);
+ sv_magic((SV*) hv, obj_ref, PERL_MAGIC_tied, Nullch, 0);
+ hv_store(shared_hv, SvPV(id,length), length, weakref, 0);
+ Perl_sharedsv_thrcnt_inc(aTHX_ shared);
+ }
+ break;
+ default: {
+ MAGIC* shared_magic;
+ SV* value = newSVsv(SHAREDSvGET(shared));
+ SV* obj = newSViv((IV)shared);
+ sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
+ shared_magic = mg_find(value, PERL_MAGIC_ext);
+ shared_magic->mg_virtual = &svtable;
+ shared_magic->mg_obj = newSViv((IV)shared);
+ shared_magic->mg_flags |= MGf_REFCOUNTED;
+ shared_magic->mg_private = 0;
+ SvMAGICAL_on(value);
+ sv = newRV_noinc(value);
+ value = newRV(value);
+ sv_rvweaken(value);
+ hv_store(shared_hv, SvPV(id,length),length, value, 0);
+ Perl_sharedsv_thrcnt_inc(aTHX_ shared);
+ }
+
+ }
}
return sv;
}
shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
if(!shared)
return 0;
+ {
+ HV* shared_hv = get_hv("threads::shared::shared", FALSE);
+ SV* id = newSViv((IV)shared);
+ STRLEN length = sv_len(id);
+ hv_delete(shared_hv, SvPV(id,length), length,0);
+ }
Perl_sharedsv_thrcnt_dec(aTHX_ shared);
}
croak("thrcnt can only be used on shared values");
Perl_sharedsv_thrcnt_dec(aTHX_ shared);
+void
+unlock_enabled(ref)
+ SV* ref
+ PROTOTYPE: \$
+ CODE:
+ shared_sv* shared;
+ if(SvROK(ref))
+ ref = SvRV(ref);
+ shared = Perl_sharedsv_find(aTHX, ref);
+ if(!shared)
+ croak("unlock can only be used on shared values");
+ SHAREDSvUNLOCK(shared);
+
+void
+lock_enabled(ref)
+ SV* ref
+ PROTOTYPE: \$
+ CODE:
+ shared_sv* shared;
+ if(SvROK(ref))
+ ref = SvRV(ref);
+ shared = Perl_sharedsv_find(aTHX, ref);
+ if(!shared)
+ croak("lock can only be used on shared values");
+ SHAREDSvLOCK(shared);
+
+
+void
+cond_wait_enabled(ref)
+ SV* ref
+ CODE:
+ shared_sv* shared;
+ int locks;
+ if(SvROK(ref))
+ ref = SvRV(ref);
+ shared = Perl_sharedsv_find(aTHX_ ref);
+ if(!shared)
+ croak("cond_wait can only be used on shared values");
+ if(shared->owner != PERL_GET_CONTEXT)
+ 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 = PERL_GET_CONTEXT;
+ shared->locks = locks;
+
+void cond_signal_enabled(ref)
+ SV* ref
+ CODE:
+ shared_sv* shared;
+ if(SvROK(ref))
+ ref = SvRV(ref);
+ shared = Perl_sharedsv_find(aTHX_ ref);
+ if(!shared)
+ croak("cond_signal can only be used on shared values");
+ COND_SIGNAL(&shared->user_cond);
+
+
+void cond_broadcast_enabled(ref)
+ SV* ref
+ CODE:
+ shared_sv* shared;
+ if(SvROK(ref))
+ ref = SvRV(ref);
+ shared = Perl_sharedsv_find(aTHX_ ref);
+ if(!shared)
+ croak("cond_broadcast can only be used on shared values");
+ COND_BROADCAST(&shared->user_cond);
MODULE = threads::shared PACKAGE = threads::shared::sv
shared_sv* slot;
SV* aentry;
SV** aentry_;
+ if(SvROK(value)) {
+ shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
+ if(!target) {
+ Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
+ }
+ value = newRV_noinc(newSViv((IV)target));
+ }
SHAREDSvLOCK(shared);
aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
if(aentry_ && SvIV((*aentry_))) {
av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
SHAREDSvRELEASE(shared);
}
+ if(SvROK(SHAREDSvGET(slot)))
+ Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
+
SHAREDSvUNLOCK(shared);
SV*
retval = &PL_sv_undef;
} else {
slot = (shared_sv*) SvIV(aentry);
- retval = newSVsv(SHAREDSvGET(slot));
+ if(SvROK(SHAREDSvGET(slot))) {
+ shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
+ retval = shared_sv_attach_sv(NULL,target);
+ } else {
+ retval = newSVsv(SHAREDSvGET(slot));
+ }
}
} else {
retval = &PL_sv_undef;
for(i = 1; i < items; i++) {
shared_sv* slot = Perl_sharedsv_new(aTHX);
SV* tmp = ST(i);
+ if(SvROK(tmp)) {
+ shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
+ if(!target) {
+ Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
+ }
+ tmp = newRV_noinc(newSViv((IV)target));
+ }
SHAREDSvEDIT(slot);
SHAREDSvGET(slot) = newSVsv(tmp);
av_push((AV*) SHAREDSvGET(shared), newSViv((IV)slot));
SHAREDSvRELEASE(slot);
+ if(SvROK(SHAREDSvGET(slot)))
+ Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
}
SHAREDSvUNLOCK(shared);
for(i = 1; i < items; i++) {
shared_sv* slot = Perl_sharedsv_new(aTHX);
SV* tmp = ST(i);
+ if(SvROK(tmp)) {
+ shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
+ if(!target) {
+ Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
+ }
+ tmp = newRV_noinc(newSViv((IV)target));
+ }
SHAREDSvEDIT(slot);
SHAREDSvGET(slot) = newSVsv(tmp);
av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv((IV)slot));
SHAREDSvRELEASE(slot);
+ if(SvROK(SHAREDSvGET(slot)))
+ Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
}
SHAREDSvUNLOCK(shared);
SHAREDSvRELEASE(shared);
if(retval && SvIV(retval)) {
slot = (shared_sv*) SvIV(retval);
- retval = newSVsv(SHAREDSvGET(slot));
+ if(SvROK(SHAREDSvGET(slot))) {
+ shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
+ retval = shared_sv_attach_sv(NULL,target);
+ } else {
+ retval = newSVsv(SHAREDSvGET(slot));
+ }
Perl_sharedsv_thrcnt_dec(aTHX_ slot);
} else {
retval = &PL_sv_undef;
SHAREDSvRELEASE(shared);
if(retval && SvIV(retval)) {
slot = (shared_sv*) SvIV(retval);
- retval = newSVsv(SHAREDSvGET(slot));
+ if(SvROK(SHAREDSvGET(slot))) {
+ shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
+ retval = shared_sv_attach_sv(NULL,target);
+ } else {
+ retval = newSVsv(SHAREDSvGET(slot));
+ }
Perl_sharedsv_thrcnt_dec(aTHX_ slot);
} else {
retval = &PL_sv_undef;
SHAREDSvRELEASE(shared);
if(SvIV(tmp)) {
slot = (shared_sv*) SvIV(tmp);
- RETVAL = newSVsv(SHAREDSvGET(slot));
+ if(SvROK(SHAREDSvGET(slot))) {
+ shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
+ RETVAL = shared_sv_attach_sv(NULL,target);
+ } else {
+ RETVAL = newSVsv(SHAREDSvGET(slot));
+ }
Perl_sharedsv_thrcnt_dec(aTHX_ slot);
} else {
RETVAL = &PL_sv_undef;
SV** hentry_;
STRLEN len;
char* ckey = SvPV(key, len);
+ SHAREDSvLOCK(shared);
if(SvROK(value)) {
shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
if(!target) {
Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared hash");
}
+ SHAREDSvEDIT(shared);
value = newRV_noinc(newSViv((IV)target));
+ SHAREDSvRELEASE(shared);
}
- SHAREDSvLOCK(shared);
hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
if(hentry_ && SvIV((*hentry_))) {
hentry = (*hentry_);
projects / p5sagit/p5-mst-13.2.git / blobdiff