Correct threads_mutex locking in main thread destruction.

Add per-interp thrsv to hold SV struct thread for main thread.
Move Thread.xs MUTEX_DESTROY from end of threadstart to remove_thread.
Add Thread/list.t test of Thread->list method.
Let Thread::Semaphore methods up and down take an extra argument.

p4raw-id: //depot/perl@140

diff --git a/embed.h b/embed.h
index a34d057..5f3b765 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1349,6 +1349,7 @@
 #define sv_root                        (curinterp->Isv_root)
 #define tainted                        (curinterp->Itainted)
 #define tainting               (curinterp->Itainting)
+#define thrsv                  (curinterp->Ithrsv)
 #define tmps_floor             (curinterp->Itmps_floor)
 #define tmps_ix                        (curinterp->Itmps_ix)
 #define tmps_max               (curinterp->Itmps_max)
@@ -1500,6 +1501,7 @@
 #define Isv_root               sv_root
 #define Itainted               tainted
 #define Itainting              tainting
+#define Ithrsv                 thrsv
 #define Itmps_floor            tmps_floor
 #define Itmps_ix               tmps_ix
 #define Itmps_max              tmps_max
@@ -1658,6 +1660,7 @@
 #define sv_objcount            Perl_sv_objcount
 #define sv_root                        Perl_sv_root
 #define tainted                        Perl_tainted
+#define thrsv                  Perl_thrsv
 #define tmps_floor             Perl_tmps_floor
 #define tmps_ix                        Perl_tmps_ix
 #define tmps_max               Perl_tmps_max

diff --git a/interp.sym b/interp.sym
index 00eee65..1583ea2 100644 (file)
--- a/interp.sym
+++ b/interp.sym
@@ -138,6 +138,7 @@ sv_root
 sv_arenaroot
 tainted
 tainting
+thrsv
 tmps_floor
 tmps_ix
 tmps_max

diff --git a/perl.c b/perl.c
index 3e592fd..5a2dd70 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -121,10 +121,13 @@ register PerlInterpreter *sv_interp;
    /* Init the real globals (and main thread)? */
     if (!linestr) {
 #ifdef USE_THREADS
+       XPV *xpv;
+
        INIT_THREADS;
        New(53, thr, 1, struct thread);
        MUTEX_INIT(&malloc_mutex);
        MUTEX_INIT(&sv_mutex);
+       /* Safe to use SVs from now on */
        MUTEX_INIT(&eval_mutex);
        COND_INIT(&eval_cond);
        MUTEX_INIT(&threads_mutex);
@@ -137,6 +140,18 @@ register PerlInterpreter *sv_interp;
        thr->next = thr;
        thr->prev = thr;
        thr->tid = 0;
+
+       /* Handcraft thrsv similarly to mess_sv */
+       New(53, thrsv, 1, SV);
+       Newz(53, xpv, 1, XPV);
+       SvFLAGS(thrsv) = SVt_PV;
+       SvANY(thrsv) = (void*)xpv;
+       SvREFCNT(thrsv) = 1 << 30;      /* practically infinite */
+       SvPVX(thrsv) = (char*)thr;
+       SvCUR_set(thrsv, sizeof(thr));
+       SvLEN_set(thrsv, sizeof(thr));
+       *SvEND(thrsv) = '\0';           /* in the trailing_nul field */
+       oursv = thrsv;
 #ifdef HAVE_THREAD_INTERN
        init_thread_intern(thr);
 #else
@@ -241,7 +256,8 @@ register PerlInterpreter *sv_interp;
 
 #ifdef USE_THREADS
 #ifndef FAKE_THREADS
-    /* Join with any remaining non-detached threads */
+    /* Pass 1 on any remaining threads: detach joinables, join zombies */
+  retry_cleanup:
     MUTEX_LOCK(&threads_mutex);
     DEBUG_L(PerlIO_printf(PerlIO_stderr(),
                          "perl_destruct: waiting for %d threads...\n",
@@ -256,13 +272,19 @@ register PerlInterpreter *sv_interp;
            ThrSETSTATE(t, THRf_DEAD);
            MUTEX_UNLOCK(&t->mutex);
            nthreads--;
+           /*
+            * The SvREFCNT_dec below may take a long time (e.g. av
+            * may contain an object scalar whose destructor gets
+            * called) so we have to unlock threads_mutex and start
+            * all over again.
+            */
            MUTEX_UNLOCK(&threads_mutex);
            if (pthread_join(t->Tself, (void**)&av))
                croak("panic: pthread_join failed during global destruction");
            SvREFCNT_dec((SV*)av);
            DEBUG_L(PerlIO_printf(PerlIO_stderr(),
                                  "perl_destruct: joined zombie %p OK\n", t));
-           break;
+           goto retry_cleanup;
        case THRf_R_JOINABLE:
            DEBUG_L(PerlIO_printf(PerlIO_stderr(),
                                  "perl_destruct: detaching thread %p\n", t));
@@ -276,17 +298,18 @@ register PerlInterpreter *sv_interp;
            MUTEX_UNLOCK(&threads_mutex);
            DETACH(t);
            MUTEX_UNLOCK(&t->mutex);
-           break;
+           goto retry_cleanup;
        default:
            DEBUG_L(PerlIO_printf(PerlIO_stderr(),
                                  "perl_destruct: ignoring %p (state %u)\n",
                                  t, ThrSTATE(t)));
            MUTEX_UNLOCK(&t->mutex);
-           MUTEX_UNLOCK(&threads_mutex);
            /* fall through and out */
        }
     }
-    /* Now wait for the thread count nthreads to drop to one */
+    /* We leave the above "Pass 1" loop with threads_mutex still locked */
+
+    /* Pass 2 on remaining threads: wait for the thread count to drop to one */
     while (nthreads > 1)
     {
        DEBUG_L(PerlIO_printf(PerlIO_stderr(),
@@ -556,8 +579,14 @@ register PerlInterpreter *sv_interp;
     MUTEX_DESTROY(&malloc_mutex);
     MUTEX_DESTROY(&eval_mutex);
     COND_DESTROY(&eval_cond);
-#endif /* USE_THREADS */
 
+    /* As the penultimate thing, free the non-arena SV for thrsv */
+    Safefree(SvPVX(thrsv));
+    Safefree(SvANY(thrsv));
+    Safefree(thrsv);
+    thrsv = Nullsv;
+#endif /* USE_THREADS */
+    
     /* As the absolutely last thing, free the non-arena SV for mess() */
 
     if (mess_sv) {

diff --git a/perl.h b/perl.h
index 0287e6a..c8eee3d 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1957,6 +1957,11 @@ IEXT int Ilaststatval IINIT(-1);
 IEXT I32       Ilaststype IINIT(OP_STAT);
 IEXT SV *      Imess_sv;
 
+#ifdef USE_THREADS
+/* threads stuff */
+IEXT SV *      Ithrsv;         /* holds struct thread for main thread */
+#endif /* USE_THREADS */
+
 #undef IEXT
 #undef IINIT
 

diff --git a/thread.h b/thread.h
index 2e1a03b..b375c98 100644 (file)
--- a/thread.h
+++ b/thread.h
@@ -175,6 +175,7 @@ struct thread {
 #ifdef ADD_THREAD_INTERN
     struct thread_intern i;            /* Platform-dependent internals */
 #endif
+    char       trailing_nul;           /* For the sake of thrsv, t->Toursv */
 };
 
 typedef struct thread *Thread;