#include "perl.h"
#include "XSUB.h"
+MGVTBL svtable;
-void shared_sv_attach_sv (SV* sv, shared_sv* shared) {
+SV* shared_sv_attach_sv (SV* sv, shared_sv* shared) {
HV* shared_hv = get_hv("threads::shared::shared", FALSE);
SV* id = newSViv((IV)shared);
STRLEN length = sv_len(id);
SV** tiedobject_ = hv_fetch(shared_hv, SvPV(id,length), length, 0);
if(tiedobject_) {
tiedobject = (*tiedobject_);
- SvROK_on(sv);
- SvRV(sv) = SvRV(tiedobject);
-
+ if(sv) {
+ SvROK_on(sv);
+ SvRV(sv) = SvRV(tiedobject);
+ } else {
+ 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;
}
SHAREDSvLOCK(shared);
if(SvROK(SHAREDSvGET(shared)))
Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
- SHAREDSvEDIT(shared);
if(SvROK(sv)) {
shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
if(!target) {
- SHAREDSvRELEASE(shared);
sv_setsv(sv,SHAREDSvGET(shared));
SHAREDSvUNLOCK(shared);
Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar");
}
+ SHAREDSvEDIT(shared);
Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared));
SHAREDSvGET(shared) = newRV_noinc(newSViv((IV)target));
} else {
- sv_setsv(SHAREDSvGET(shared), sv);
+ SHAREDSvEDIT(shared);
+ sv_setsv(SHAREDSvGET(shared), sv);
}
shared->index++;
mg->mg_private = shared->index;
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);
}
_thrcnt(ref)
SV* ref
CODE:
- shared_sv* shared = Perl_sharedsv_find(aTHX, ref);
+ shared_sv* shared;
+ if(SvROK(ref))
+ ref = SvRV(ref);
+ shared = Perl_sharedsv_find(aTHX, ref);
if(!shared)
croak("thrcnt can only be used on shared values");
SHAREDSvLOCK(shared);
croak("thrcnt can only be used on shared values");
Perl_sharedsv_thrcnt_inc(aTHX_ shared);
+void
+_thrcnt_dec(ref)
+ SV* ref
+ CODE:
+ shared_sv* shared = (shared_sv*) SvIV(ref);
+ if(!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;
CODE:
croak("Splice is not implmented for shared arrays");
+MODULE = threads::shared PACKAGE = threads::shared::hv
+
+SV*
+new(class, value)
+ SV* class
+ SV* value
+ CODE:
+ shared_sv* shared = Perl_sharedsv_new(aTHX);
+ SV* obj = newSViv((IV)shared);
+ SHAREDSvEDIT(shared);
+ SHAREDSvGET(shared) = (SV*) newHV();
+ SHAREDSvRELEASE(shared);
+ RETVAL = obj;
+ OUTPUT:
+ RETVAL
+
+void
+STORE(self, key, value)
+ SV* self
+ SV* key
+ SV* value
+ CODE:
+ shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
+ shared_sv* slot;
+ SV* hentry;
+ 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);
+ }
+ hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
+ if(hentry_ && SvIV((*hentry_))) {
+ hentry = (*hentry_);
+ slot = (shared_sv*) SvIV(hentry);
+ if(SvROK(SHAREDSvGET(slot)))
+ Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
+ SHAREDSvEDIT(slot);
+ sv_setsv(SHAREDSvGET(slot), value);
+ SHAREDSvRELEASE(slot);
+ } else {
+ slot = Perl_sharedsv_new(aTHX);
+ SHAREDSvEDIT(shared);
+ SHAREDSvGET(slot) = newSVsv(value);
+ hentry = newSViv((IV)slot);
+ hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
+ SHAREDSvRELEASE(shared);
+ }
+ if(SvROK(SHAREDSvGET(slot)))
+ Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
+ SHAREDSvUNLOCK(shared);
+
+
+SV*
+FETCH(self, key)
+ SV* self
+ SV* key
+ CODE:
+ shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
+ shared_sv* slot;
+ SV* hentry;
+ SV** hentry_;
+ SV* retval;
+ STRLEN len;
+ char* ckey = SvPV(key, len);
+ SHAREDSvLOCK(shared);
+ hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
+ if(hentry_) {
+ hentry = (*hentry_);
+ if(SvTYPE(hentry) == SVt_NULL) {
+ retval = &PL_sv_undef;
+ } else {
+ slot = (shared_sv*) SvIV(hentry);
+ 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;
+ }
+ SHAREDSvUNLOCK(shared);
+ RETVAL = retval;
+ OUTPUT:
+ RETVAL
+void
+CLEAR(self)
+ SV* self
+ CODE:
+ shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
+ shared_sv* slot;
+ HE* entry;
+ SHAREDSvLOCK(shared);
+ Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
+ entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
+ while(entry) {
+ slot = (shared_sv*) SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry));
+ Perl_sharedsv_thrcnt_dec(aTHX_ slot);
+ entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
+ }
+ SHAREDSvEDIT(shared);
+ hv_clear((HV*) SHAREDSvGET(shared));
+ SHAREDSvRELEASE(shared);
+ SHAREDSvUNLOCK(shared);
+
+SV*
+FIRSTKEY(self)
+ SV* self
+ CODE:
+ shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
+ char* key = NULL;
+ I32 len;
+ HE* entry;
+ SHAREDSvLOCK(shared);
+ Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
+ entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
+ if(entry) {
+ key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
+ RETVAL = newSVpv(key, len);
+ } else {
+ RETVAL = &PL_sv_undef;
+ }
+ SHAREDSvUNLOCK(shared);
+ OUTPUT:
+ RETVAL
+
+
+SV*
+NEXTKEY(self, oldkey)
+ SV* self
+ SV* oldkey
+ CODE:
+ shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
+ char* key = NULL;
+ I32 len;
+ HE* entry;
+ SHAREDSvLOCK(shared);
+ entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
+ if(entry) {
+ key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
+ RETVAL = newSVpv(key, len);
+ } else {
+ RETVAL = &PL_sv_undef;
+ }
+ SHAREDSvUNLOCK(shared);
+ OUTPUT:
+ RETVAL
+
+
+SV*
+EXISTS(self, key)
+ SV* self
+ SV* key
+ CODE:
+ shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
+ STRLEN len;
+ char* ckey = SvPV(key, len);
+ SHAREDSvLOCK(shared);
+ if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
+ RETVAL = &PL_sv_yes;
+ } else {
+ RETVAL = &PL_sv_no;
+ }
+ SHAREDSvUNLOCK(shared);
+ OUTPUT:
+ RETVAL
+
+SV*
+DELETE(self, key)
+ SV* self
+ SV* key
+ CODE:
+ shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
+ shared_sv* slot;
+ STRLEN len;
+ char* ckey = SvPV(key, len);
+ SV* tmp;
+ SHAREDSvLOCK(shared);
+ SHAREDSvEDIT(shared);
+ tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
+ SHAREDSvRELEASE(shared);
+ if(tmp) {
+ slot = (shared_sv*) SvIV(tmp);
+ 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;
+ }
+ SHAREDSvUNLOCK(shared);
+ OUTPUT:
+ RETVAL
projects / p5sagit/p5-mst-13.2.git / blobdiff