From: Malcolm Beattie Date: Wed, 15 Oct 1997 16:57:45 +0000 (+0000) Subject: Finish thread state machine: fixes global destruction of threads, X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c7848ba184fac8eca4125f4296d6e09fee2c1846;p=p5sagit%2Fp5-mst-13.2.git Finish thread state machine: fixes global destruction of threads, 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 --- diff --git a/MANIFEST b/MANIFEST index 00b13d9..e6b3b41 100644 --- 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 diff --git a/README.threads b/README.threads index 4d20243..014eed8 100644 --- a/README.threads +++ b/README.threads @@ -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 diff --git a/Todo.5.005 b/Todo.5.005 index 34bb322..1159da5 100644 --- a/Todo.5.005 +++ b/Todo.5.005 @@ -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 --- 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 --- 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;