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=ca26f44dbd29bcc5abe6c0b9e30d3329ca86299f;hpb=0d76d1177dc2d3806624edeeb9ecf34e36a3fe08;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index ca26f44..34ed30c 100644
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -3,6 +3,7 @@
 #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);
@@ -19,7 +20,54 @@ SV* shared_sv_attach_sv (SV* sv, shared_sv* shared) {
 	    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;
 }
@@ -74,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);
 }
 
@@ -137,6 +191,75 @@ _thrcnt_dec(ref)
            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		
 
@@ -189,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_))) {
@@ -207,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*
@@ -227,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;
@@ -247,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);
 
@@ -267,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);
 
@@ -287,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;
@@ -311,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;
@@ -408,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;
@@ -456,14 +627,16 @@ STORE(self, key, value)
         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_);