X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2Fthreads%2Fshared%2Fshared.xs;h=34ed30c2b55e6f1c99fa319ed3c71c180cad0a31;hb=6f942b98720ba1a1943b0ad83963ea2d8c233143;hp=9263825572765571a4e6806dd85e6ea6552ff5b5;hpb=aaf3876db79bf446edd52bc20faf44047e53699e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index 9263825..34ed30c 100644
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -3,8 +3,9 @@
 #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);
@@ -12,12 +13,63 @@ void shared_sv_attach_sv (SV* sv, shared_sv* shared) {
     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;
 }
 
 
@@ -43,19 +95,19 @@ int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
     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;
@@ -70,6 +122,12 @@ int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) {
     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);
 }
 
@@ -99,7 +157,10 @@ SV*
 _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);
@@ -121,6 +182,84 @@ thrcnt_inc(ref)
            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		
 
@@ -173,6 +312,13 @@ STORE(self, index, value)
         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_))) {
@@ -191,6 +337,9 @@ STORE(self, index, value)
             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*
@@ -211,7 +360,12 @@ FETCH(self, index)
 	        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;
@@ -231,10 +385,19 @@ PUSH(self, ...)
 	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);
 
@@ -251,10 +414,19 @@ UNSHIFT(self, ...)
 	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);
 
@@ -271,7 +443,12 @@ POP(self)
 	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;
@@ -295,7 +472,12 @@ SHIFT(self)
 	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;
@@ -392,7 +574,12 @@ DELETE(self,index)
 	    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;
@@ -412,4 +599,209 @@ SPLICE(self, offset, length, ...)
 	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