-//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
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
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
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))
/* 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--;
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);
}
void
schedule(void)
{
- thr = thr->next_run;
+ thr = thr->i.next_run;
}
void
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);
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);
{
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 */
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;