Rewrite thread destruction system using linked list of threads.

Still not completely done. Add methods self, equal, flags, list
to Thread.xs. Add Thread_MAGIC_SIGNATURE check to typemap.

p4raw-id: //depot/perl@120

3 files changed, 56 insertions, 57 deletions

diff --git a/perl.c b/perl.c
index db1cb59dcf..4897da0eb1 100644
--- a/perl.c
+++ b/perl.c
@@ -75,9 +75,6 @@ static void init_predump_symbols _((void));
 static void my_exit_jump _((void)) __attribute__((noreturn));
 static void nuke_stacks _((void));
 static void open_script _((char *, bool, SV *));
-#ifdef USE_THREADS
-static void thread_destruct _((void *));
-#endif /* USE_THREADS */
 static void usage _((char *));
 static void validate_suid _((char *, char*));
 
@@ -121,31 +118,32 @@ register PerlInterpreter *sv_interp;
     Zero(sv_interp, 1, PerlInterpreter);
 #endif
 
-   /* Init the real globals? */
+   /* Init the real globals (and main thread)? */
     if (!linestr) {
 #ifdef USE_THREADS
-#ifdef NEED_PTHREAD_INIT
-    	pthread_init();
-#endif /* NEED_PTHREAD_INIT */
+    	INIT_THREADS;
 	New(53, thr, 1, struct thread);
 	MUTEX_INIT(&malloc_mutex);
 	MUTEX_INIT(&sv_mutex);
 	MUTEX_INIT(&eval_mutex);
 	COND_INIT(&eval_cond);
-	MUTEX_INIT(&nthreads_mutex);
+	MUTEX_INIT(&threads_mutex);
 	COND_INIT(&nthreads_cond);
 	nthreads = 1;
 	cvcache = newHV();
-	thrflags = 0;
 	curcop = &compiling;
+	thr->flags = THRf_NORMAL;
+	thr->next = thr;
+	thr->prev = thr;
 #ifdef FAKE_THREADS
 	self = thr;
-	thr->next = thr->prev = thr->next_run = thr->prev_run = thr;
+	thr->next_run = thr->prev_run = thr;
 	thr->wait_queue = 0;
 	thr->private = 0;
+	thr->tid = 0;
 #else
 	self = pthread_self();
-	if (pthread_key_create(&thr_key, thread_destruct))
+	if (pthread_key_create(&thr_key, 0))
 	    croak("panic: pthread_key_create");
 	if (pthread_setspecific(thr_key, (void *) thr))
 	    croak("panic: pthread_setspecific");
@@ -227,28 +225,6 @@ register PerlInterpreter *sv_interp;
     ENTER;
 }
 
-#ifdef USE_THREADS
-void
-thread_destruct(arg)
-void *arg;
-{
-    struct thread *thr = (struct thread *) arg;
-    /*
-     * Decrement the global thread count and signal anyone listening.
-     * The only official thread listening is the original thread while
-     * in perl_destruct. It waits until it's the only thread and then
-     * performs END blocks and other process clean-ups.
-     */
-    DEBUG_L(PerlIO_printf(PerlIO_stderr(), "thread_destruct: 0x%lx\n", (unsigned long) thr));
-
-    Safefree(thr);
-    MUTEX_LOCK(&nthreads_mutex);
-    nthreads--;
-    COND_BROADCAST(&nthreads_cond);
-    MUTEX_UNLOCK(&nthreads_mutex);
-}    
-#endif /* USE_THREADS */
-
 void
 perl_destruct(sv_interp)
 register PerlInterpreter *sv_interp;
@@ -257,24 +233,37 @@ register PerlInterpreter *sv_interp;
     int destruct_level;  /* 0=none, 1=full, 2=full with checks */
     I32 last_sv_count;
     HV *hv;
+    Thread t;
 
     if (!(curinterp = sv_interp))
 	return;
 
 #ifdef USE_THREADS
 #ifndef FAKE_THREADS
-    /* Wait until all user-created threads go away */
-    MUTEX_LOCK(&nthreads_mutex);
+    /* Detach any remaining joinable threads apart from ourself */
+    MUTEX_LOCK(&threads_mutex);
+    DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+			  "perl_destruct: detaching remaining %d threads\n",
+			  nthreads - 1));
+    for (t = thr->next; t != thr; t = t->next) {
+	if (ThrSTATE(t) == THRf_NORMAL) {
+	    DETACH(t);
+	    ThrSETSTATE(t, THRf_DETACHED);
+	    DEBUG_L(PerlIO_printf(PerlIO_stderr(), "...detached %p\n", t));
+	}
+    }
+    /* 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",
-			nthreads - 1));
-	COND_WAIT(&nthreads_cond, &nthreads_mutex);
+	DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+			      "perl_destruct: waiting for %d threads\n",
+			      nthreads - 1));
+	COND_WAIT(&nthreads_cond, &threads_mutex);
     }
     /* At this point, we're the last thread */
-    MUTEX_UNLOCK(&nthreads_mutex);
+    MUTEX_UNLOCK(&threads_mutex);
     DEBUG_L(PerlIO_printf(PerlIO_stderr(), "perl_destruct: armageddon has arrived\n"));
-    MUTEX_DESTROY(&nthreads_mutex);
+    MUTEX_DESTROY(&threads_mutex);
     COND_DESTROY(&nthreads_cond);
 #endif /* !defined(FAKE_THREADS) */
 #endif /* USE_THREADS */
diff --git a/perl.h b/perl.h
index 99a027c0ce..6af9ff88a4 100644
--- a/perl.h
+++ b/perl.h
@@ -1347,7 +1347,7 @@ EXT perl_mutex		eval_mutex;	/* Mutex for doeval */
 EXT perl_cond		eval_cond;	/* Condition variable for doeval */
 EXT struct thread *	eval_owner;	/* Owner thread for doeval */
 EXT int			nthreads;	/* Number of threads currently */
-EXT perl_mutex		nthreads_mutex;	/* Mutex for nthreads */
+EXT perl_mutex		threads_mutex;	/* Mutex for nthreads and thread list */
 EXT perl_cond		nthreads_cond;	/* Condition variable for nthreads */
 #ifdef FAKE_THREADS
 EXT struct thread *	thr;		/* Currently executing (fake) thread */
diff --git a/thread.h b/thread.h
index 5e5bebdc97..f379f6bf3d 100644
--- a/thread.h
+++ b/thread.h
@@ -38,7 +38,6 @@ typedef struct thread *perl_thread;
 	SCHEDULE();			\
     } STMT_END
 #define COND_DESTROY(c)
-
 #else
 /* POSIXish threads */
 typedef pthread_t perl_thread;
@@ -70,6 +69,10 @@ typedef pthread_t perl_thread;
     if (pthread_cond_wait((c), (m))) croak("panic: COND_WAIT"); else 1
 #define COND_DESTROY(c) \
     if (pthread_cond_destroy((c))) croak("panic: COND_DESTROY"); else 1
+
+#define DETACH(t) \
+    if (pthread_detach((t)->Tself)) croak("panic: DETACH"); else 1
+
 /* XXX Add "old" (?) POSIX draft interface too */
 #ifdef OLD_PTHREADS_API
 struct thread *getTHR _((void));
@@ -80,20 +83,27 @@ struct thread *getTHR _((void));
 #define dTHR struct thread *thr = THR
 #endif /* FAKE_THREADS */
 
-struct thread {
-    perl_thread	Tself;
-    SV *	Toursv;
+#ifndef INIT_THREADS
+#  ifdef NEED_PTHREAD_INIT
+#    define INIT_THREADS pthread_init()
+#  else
+#    define INIT_THREADS NOOP
+#  endif
+#endif
 
+struct thread {
     /* The fields that used to be global */
-    SV **	Tstack_base;
+    /* Important ones in the first cache line (if alignment is done right) */
     SV **	Tstack_sp;
-    SV **	Tstack_max;
-
 #ifdef OP_IN_REGISTER
     OP *	Topsave;
 #else
     OP *	Top;
 #endif
+    SV **	Tcurpad;
+    SV **	Tstack_base;
+
+    SV **	Tstack_max;
 
     I32 *	Tscopestack;
     I32		Tscopestack_ix;
@@ -111,8 +121,6 @@ struct thread {
     I32 *	Tmarkstack_ptr;
     I32 *	Tmarkstack_max;
 
-    SV **	Tcurpad;
-
     SV *	TSv;
     XPV *	TXpv;
     struct stat	Tstatbuf;
@@ -149,12 +157,15 @@ struct thread {
 
     /* XXX Sort stuff, firstgv, secongv and so on? */
 
+    perl_thread	Tself;
+    SV *	Toursv;
     perl_mutex *Tthreadstart_mutexp;
     HV *	Tcvcache;
-    U32		Tthrflags;
+    U32		flags;
+    U32		tid;
+    struct thread *next, *prev;		/* Circular linked list of threads */
 
 #ifdef FAKE_THREADS
-    perl_thread next, prev;		/* Linked list of all threads */
     perl_thread next_run, prev_run;	/* Linked list of runnable threads */
     perl_cond	wait_queue;		/* Wait queue that we are waiting on */
     IV		private;		/* Holds data across time slices */
@@ -164,7 +175,7 @@ struct thread {
 
 typedef struct thread *Thread;
 
-/* Values and macros for thrflags */
+/* Values and macros for thr->flags */
 #define THRf_STATE_MASK	3
 #define THRf_NORMAL	0
 #define THRf_DETACHED	1
@@ -173,10 +184,10 @@ typedef struct thread *Thread;
 
 #define THRf_DIE_FATAL	4
 
-#define ThrSTATE(t)	(t->Tthrflags & THRf_STATE_MASK)
+#define ThrSTATE(t)	(t->flags & THRf_STATE_MASK)
 #define ThrSETSTATE(t, s) STMT_START {		\
-	(t)->Tthrflags &= ~THRf_STATE_MASK;	\
-	(t)->Tthrflags |= (s);			\
+	(t)->flags &= ~THRf_STATE_MASK;	\
+	(t)->flags |= (s);			\
 	DEBUG_L(fprintf(stderr, "thread 0x%lx set to state %d\n", \
 			(unsigned long)(t), (s))); \
     } STMT_END
@@ -291,5 +302,4 @@ typedef struct condpair {
 
 #define	threadstart_mutexp	(thr->Tthreadstart_mutexp)
 #define	cvcache		(thr->Tcvcache)
-#define	thrflags	(thr->Tthrflags)
 #endif /* USE_THREADS */