Finish thread state machine: fixes global destruction of threads,
Malcolm Beattie [Wed, 15 Oct 1997 16:57:45 +0000 (16:57 +0000)]
detaching, joining etc. Alter FAKE_THREADS-specific fields to use
new HAVE_THREAD_INTERN stuff. Updates docs. Various fixes to
Thread.xs.

p4raw-id: //depot/perl@131

MANIFEST
README.threads
Todo.5.005
perl.c
util.c

index 00b13d9..e6b3b41 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,4 +1,3 @@
-//depot/perl/MANIFEST#9 - integrate change 114 (text)
 Artistic               The "Artistic License"
 Changes                        Differences from previous version
 Changes5.000           Differences between 4.x and 5.000
index 4d20243..014eed8 100644 (file)
@@ -155,15 +155,49 @@ COND_BROADCAST work by putting back all the threads on the
 condition variables list into the run queue. Note that a mutex
 must *not* be held while returning from a PP function.
 
-Perl locks are a condpair_t structure (a triple of a mutex, a
-condtion variable and an owner thread field) attached by 'm'
-magic to any SV. pp_lock locks such an object by waiting on the
-condition variable until the owner field is zero and then setting
-the owner field to its own thread pointer. The lock is recursive
-so if the owner field already matches the current thread then
-pp_lock returns straight away. If the owner field has to be filled
-in then unlock_condpair is queued as an end-of-block destructor and
-that function zeroes out the owner field, releasing the lock.
+Perl locks and condition variables are both implemented as a
+condpair_t structure, containing a mutex, an "owner" condition
+variable, an owner thread field and another condition variable).
+The structure is attached by 'm' magic to any SV. pp_lock locks
+such an object by waiting on the ownercond condition variable until
+the owner field is zero and then setting the owner field to its own
+thread pointer. The lock is semantically recursive so if the owner
+field already matches the current thread then pp_lock returns
+straight away. If the owner field has to be filled in then
+unlock_condpair is queued as an end-of-block destructor and
+that function zeroes out the owner field and signals the ownercond
+condition variable, thus waking up any other thread that wants to
+lock it. When used as a condition variable, the condpair is locked
+(involving the above wait-for-ownership and setting the owner field)
+and the spare condition variable field is used for waiting on.
+
+
+Thread states
+
+
+              $t->join
+R_JOINABLE ---------------------> R_JOINED >----\
+    |      \  pthread_join(t)         |  ^      |
+    |       \                         |  | join | pthread_join
+    |        \                        |  |      |
+    |         \                       |  \------/
+    |          \                      |
+    |           \                     |
+    |  $t->detach\ pthread_detach     |
+    |            _\|                  |
+ends|             R_DETACHED     ends | unlink
+    |                       \         |
+    |                   ends \ unlink |
+    |                         \       |
+    |                          \      |
+    |                           \     |
+    |                            \    |
+    |                             \   |
+    V    join          detach     _\| V
+ZOMBIE ----------------------------> DEAD
+       pthread_join   pthread_detach
+       and unlink     and unlink
+
 
 
 Malcolm Beattie
index 34bb322..1159da5 100644 (file)
@@ -1,17 +1,17 @@
 Merging
-    5.004_02
-    5.004_03
     5.004_04
     oneperl (THIS pointer)
 
 Multi-threading
+    Fix Thread->list
+    $AUTOLOAD. Hmm.
     without USE_THREADS, change extern variable for dTHR
     consistent semantics for exit/die in threads
-    pp_entersub still cloning XSUBs (broken)?
-    test '~'-magic thread addresses
-    test new thread state flags, DESTROY etc.
     SvREFCNT_dec(curstack) in threadstart() in Thread.xs
-    per-thread GV -> [SAH]V dereference for $@ etc.
+    $@ and other magic globals:
+       global lexical pool with auto-binding for magicals
+       move magicals that should be per-thread into thread.h
+       sv_magic for the necessary global lexical pool entries
     Thread::Pool
     check new condition variable word; fix cond.t
     more Configure support
diff --git a/perl.c b/perl.c
index dea0cfd..9f49b83 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -136,12 +136,9 @@ register PerlInterpreter *sv_interp;
        MUTEX_INIT(&thr->mutex);
        thr->next = thr;
        thr->prev = thr;
-#ifdef FAKE_THREADS
-       self = thr;
-       thr->next_run = thr->prev_run = thr;
-       thr->wait_queue = 0;
-       thr->private = 0;
        thr->tid = 0;
+#ifdef HAVE_THREAD_INTERN
+       init_thread_intern(thr);
 #else
        self = pthread_self();
        if (pthread_key_create(&thr_key, 0))
@@ -244,13 +241,15 @@ register PerlInterpreter *sv_interp;
     /* Join with any remaining non-detached threads */
     MUTEX_LOCK(&threads_mutex);
     DEBUG_L(PerlIO_printf(PerlIO_stderr(),
-                         "perl_destruct: waiting for %d threads\n",
+                         "perl_destruct: waiting for %d threads...\n",
                          nthreads - 1));
     for (t = thr->next; t != thr; t = t->next) {
        MUTEX_LOCK(&t->mutex);
        switch (ThrSTATE(t)) {
            AV *av;
-       case R_ZOMBIE:
+       case THRf_ZOMBIE:
+           DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+                                 "perl_destruct: joining zombie %p\n", t));
            ThrSETSTATE(t, THRf_DEAD);
            MUTEX_UNLOCK(&t->mutex);
            nthreads--;
@@ -258,15 +257,37 @@ register PerlInterpreter *sv_interp;
            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;
-       case XXXX:
+       case THRf_R_JOINABLE:
+           DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+                                 "perl_destruct: detaching thread %p\n", t));
+           ThrSETSTATE(t, THRf_R_DETACHED);
+           /* 
+            * We unlock threads_mutex and t->mutex in the opposite order
+            * from which we locked them just so that DETACH won't
+            * deadlock if it panics. It's only a breach of good style
+            * not a bug since they are unlocks not locks.
+            */
+           MUTEX_UNLOCK(&threads_mutex);
+           DETACH(t);
+           MUTEX_UNLOCK(&t->mutex);
+           break;
+       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 */
     while (nthreads > 1)
     {
        DEBUG_L(PerlIO_printf(PerlIO_stderr(),
-                             "perl_destruct: waiting for %d threads\n",
+                             "perl_destruct: final wait for %d threads\n",
                              nthreads - 1));
        COND_WAIT(&nthreads_cond, &threads_mutex);
     }
diff --git a/util.c b/util.c
index 560ec7d..540181c 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2355,7 +2355,7 @@ I32 *retlen;
 void
 schedule(void)
 {
-    thr = thr->next_run;
+    thr = thr->i.next_run;
 }
 
 void
@@ -2376,11 +2376,11 @@ perl_cond *cp;
        return;
     t = cond->thread;
     /* Insert t in the runnable queue just ahead of us */
-    t->next_run = thr->next_run;
-    thr->next_run->prev_run = t;
-    t->prev_run = thr;
-    thr->next_run = t;
-    thr->wait_queue = 0;
+    t->i.next_run = thr->i.next_run;
+    thr->i.next_run->i.prev_run = t;
+    t->i.prev_run = thr;
+    thr->i.next_run = t;
+    thr->i.wait_queue = 0;
     /* Remove from the wait queue */
     *cp = cond->next;
     Safefree(cond);
@@ -2396,11 +2396,11 @@ perl_cond *cp;
     for (cond = *cp; cond; cond = cond_next) {
        t = cond->thread;
        /* Insert t in the runnable queue just ahead of us */
-       t->next_run = thr->next_run;
-       thr->next_run->prev_run = t;
-       t->prev_run = thr;
-       thr->next_run = t;
-       thr->wait_queue = 0;
+       t->i.next_run = thr->i.next_run;
+       thr->i.next_run->i.prev_run = t;
+       t->i.prev_run = thr;
+       thr->i.next_run = t;
+       thr->i.wait_queue = 0;
        /* Remove from the wait queue */
        cond_next = cond->next;
        Safefree(cond);
@@ -2414,17 +2414,17 @@ perl_cond *cp;
 {
     perl_cond cond;
 
-    if (thr->next_run == thr)
+    if (thr->i.next_run == thr)
        croak("panic: perl_cond_wait called by last runnable thread");
     
     New(666, cond, 1, struct perl_wait_queue);
     cond->thread = thr;
     cond->next = *cp;
     *cp = cond;
-    thr->wait_queue = cond;
+    thr->i.wait_queue = cond;
     /* Remove ourselves from runnable queue */
-    thr->next_run->prev_run = thr->prev_run;
-    thr->prev_run->next_run = thr->next_run;
+    thr->i.next_run->i.prev_run = thr->i.prev_run;
+    thr->i.prev_run->i.next_run = thr->i.next_run;
 }
 #endif /* FAKE_THREADS */
 
@@ -2473,9 +2473,7 @@ SV *sv;
            mg->mg_len = sizeof(cp);
            MUTEX_UNLOCK(&sv_mutex);
            DEBUG_L(WITH_THR(PerlIO_printf(PerlIO_stderr(),
-                                          "0x%lx: condpair_magic 0x%lx\n",
-                                          (unsigned long)thr,
-                                          (unsigned long)sv));)
+                                          "%p: condpair_magic %p\n", thr, sv));)
        }
     }
     return mg;