Reword the alarm explanation.

[p5sagit/p5-mst-13.2.git] / sharedsv.c

diff --git a/sharedsv.c b/sharedsv.c
index 4359694..e4b6e0f 100644 (file)
--- a/sharedsv.c
+++ b/sharedsv.c
@@ -20,10 +20,10 @@
 #define PERL_IN_SHAREDSV_C
 #include "perl.h"
 
-PerlInterpreter* sharedsv_space;
-
 #ifdef USE_ITHREADS
 
+
+
 /*
   Shared SV
 
@@ -44,7 +44,11 @@ currently only stores a pointer to the first interpreter.
 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);
 }
 
 /*
@@ -61,7 +65,10 @@ Perl_sharedsv_new(pTHX)
     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;
 }
 
@@ -78,8 +85,29 @@ looking at magic, or by checking if it is tied again threads::shared.
 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 = INT2PTR(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 = INT2PTR(shared_sv *, SvIV(SvRV(obj)));
+                 break;
+             }
+       }
+    }            
     return ssv;
 }
 
@@ -87,7 +115,7 @@ Perl_sharedsv_find(pTHX_ SV* sv)
 =for apidoc sharedsv_lock
 
 Recursive locks on a sharedsv.
-Locks are dynamicly scoped at the level of the first lock.
+Locks are dynamically scoped at the level of the first lock.
 =cut
 */
 void
@@ -95,15 +123,19 @@ Perl_sharedsv_lock(pTHX_ shared_sv* 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);
 }
 
 /*
@@ -117,22 +149,31 @@ Recursively unlocks a shared sv.
 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);
 }
 
@@ -164,13 +205,12 @@ Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
 {
     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);
@@ -178,7 +218,8 @@ Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
 
             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;
         }
@@ -187,15 +228,15 @@ Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
             (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 */
+