Rewrite thread return code to distinguish between ordinary return

and die() and make join propagate the die. Add tiny method eval
which just does "return eval { shift->join; }". Add Thread::Specific
class for access to thread specific user data along with specific.t.
Rename Class to classname throughout Thread.xs for consistency.
Fix pp_specific to pp_threadsv in global.sym. Add support to
pp_entersub in pp_hot.c to lock stash for static locked methods.

p4raw-id: //depot/perl@248

5 files changed, 106 insertions, 30 deletions

diff --git a/ext/Thread/Thread.pm b/ext/Thread/Thread.pm
index 2ace5dde2d..1936142e52 100644
--- a/ext/Thread/Thread.pm
+++ b/ext/Thread/Thread.pm
@@ -15,6 +15,10 @@ sub async (&) {
     return new Thread $_[0];
 }
 
+sub eval {
+    return eval { shift->join; };
+}
+
 bootstrap Thread;
 
 1;
diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index 841b5698a1..ba256c9402 100644
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -19,7 +19,7 @@ static int sig_pipe[2];
 typedef struct thread *Thread;
 #define THREAD_RET_TYPE void *
 #define THREAD_RET_CAST(x) ((THREAD_RET_TYPE) x)
-#endif;
+#endif
 
 static void
 remove_thread(struct thread *t)
@@ -47,7 +47,7 @@ threadstart(void *arg)
     dSP;
     I32 oldscope = scopestack_ix;
     I32 retval;
-    AV *returnav;
+    AV *av;
     int i;
 
     DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n",
@@ -86,7 +86,8 @@ threadstart(void *arg)
     I32 oldmark = TOPMARK;
     I32 oldscope = scopestack_ix;
     I32 retval;
-    AV *returnav;
+    SV *sv;
+    AV *av = newAV();
     int i, ret;
     dJMPENV;
     DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n",
@@ -114,6 +115,7 @@ threadstart(void *arg)
     DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n",
 			  thr, SvPEEK(TOPs)));
 
+#ifdef OLD_WAY
     JMPENV_PUSH(ret);
     switch (ret) {
     case 3:
@@ -127,7 +129,10 @@ threadstart(void *arg)
 	while (scopestack_ix > oldscope)
 	    LEAVE;
 	JMPENV_POP;
-	av_store(returnav, 0, newSViv(statusvalue));
+	MUTEX_LOCK(&thr->mutex);
+	thr->flags |= THRf_DID_DIE;
+	MUTEX_UNLOCK(&thr->mutex);
+	av = newSVpvf("Thread called exit with value %d", statusvalue);
 	goto finishoff;
     }
 
@@ -143,18 +148,34 @@ threadstart(void *arg)
     op = pp_entersub(ARGS);
     if (op)
 	runops();
+#else
+    sv = POPs;
+    PUTBACK;
+    perl_call_sv(sv, G_ARRAY|G_EVAL);
+#endif
     SPAGAIN;
     retval = sp - (stack_base + oldmark);
     sp = stack_base + oldmark + 1;
-    DEBUG_L(for (i = 1; i <= retval; i++)
-		PerlIO_printf(PerlIO_stderr(),
-			      "%p returnav[%d] = %s\n",
-			      thr, i, SvPEEK(sp[i - 1]));)
-    returnav = newAV();
-    av_store(returnav, 0, newSVpv("", 0));
-    for (i = 1; i <= retval; i++, sp++)
-	sv_setsv(*av_fetch(returnav, i, TRUE), SvREFCNT_inc(*sp));
-    
+    if (SvCUR(thr->errsv)) {
+	MUTEX_LOCK(&thr->mutex);
+	thr->flags |= THRf_DID_DIE;
+	MUTEX_UNLOCK(&thr->mutex);
+	av_store(av, 0, &sv_no);
+	av_store(av, 1, newSVsv(thr->errsv));
+	DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n",
+			      SvPV(thr->errsv, na));
+    } else {
+	DEBUG_L(STMT_START {
+	    for (i = 1; i <= retval; i++) {
+		PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n",
+				thr, i, SvPEEK(sp[i - 1]));)
+	    }
+	} STMT_END);
+	av_store(av, 0, &sv_yes);
+	for (i = 1; i <= retval; i++, sp++)
+	    sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*sp));
+    }
+
   finishoff:
 #if 0    
     /* removed for debug */
@@ -194,7 +215,7 @@ threadstart(void *arg)
     case THRf_R_DETACHED:
 	ThrSETSTATE(thr, THRf_DEAD);
 	MUTEX_UNLOCK(&thr->mutex);
-	SvREFCNT_dec(returnav);
+	SvREFCNT_dec(av);
 	DEBUG_L(PerlIO_printf(PerlIO_stderr(),
 			      "%p: DETACHED thread finished\n", thr));
 	remove_thread(thr);	/* This might trigger main thread to finish */
@@ -204,7 +225,7 @@ threadstart(void *arg)
 	croak("panic: illegal state %u at end of threadstart", ThrSTATE(thr));
 	/* NOTREACHED */
     }
-    return THREAD_RET_CAST(returnav);	/* Available for anyone to join with */
+    return THREAD_RET_CAST(av);	/* Available for anyone to join with */
 					/* us unless we're detached, in which */
 					/* case noone sees the value anyway. */
 #endif    
@@ -214,7 +235,7 @@ threadstart(void *arg)
 }
 
 static SV *
-newthread (SV *startsv, AV *initargs, char *Class)
+newthread (SV *startsv, AV *initargs, char *classname)
 {
 #ifdef USE_THREADS
     dSP;
@@ -274,7 +295,7 @@ newthread (SV *startsv, AV *initargs, char *Class)
     sv = newSViv(thr->tid);
     sv_magic(sv, thr->oursv, '~', 0, 0);
     SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
-    return sv_bless(newRV_noinc(sv), gv_stashpv(Class, TRUE));
+    return sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE));
 #else
     croak("No threads in this perl");
     return &sv_undef;
@@ -294,12 +315,12 @@ MODULE = Thread		PACKAGE = Thread
 PROTOTYPES: DISABLE
 
 void
-new(Class, startsv, ...)
-	char *		Class
+new(classname, startsv, ...)
+	char *		classname
 	SV *		startsv
 	AV *		av = av_make(items - 2, &ST(2));
     PPCODE:
-	XPUSHs(sv_2mortal(newthread(startsv, av, Class)));
+	XPUSHs(sv_2mortal(newthread(startsv, av, classname)));
 
 void
 join(t)
@@ -329,9 +350,17 @@ join(t)
 	}
 	JOIN(t, &av);
 
-	/* Could easily speed up the following if necessary */
-	for (i = 0; i <= AvFILL(av); i++)
-	    XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
+	if (SvTRUE(*av_fetch(av, 0, FALSE))) {
+	    /* Could easily speed up the following if necessary */
+	    for (i = 1; i <= AvFILL(av); i++)
+		XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
+	} else {
+	    char *mess = SvPV(*av_fetch(av, 1, FALSE), na);
+	    DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+				  "%p: join propagating die message: %s\n",
+				  thr, mess));
+	    croak(mess);
+	}
 #endif
 
 void
@@ -379,8 +408,8 @@ flags(t)
 #endif
 
 void
-self(Class)
-	char *	Class
+self(classname)
+	char *	classname
     PREINIT:
 	SV *sv;
     PPCODE:        
@@ -388,7 +417,8 @@ self(Class)
 	sv = newSViv(thr->tid);
 	sv_magic(sv, thr->oursv, '~', 0, 0);
 	SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
-	PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv), gv_stashpv(Class, TRUE))));
+	PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv),
+				  gv_stashpv(classname, TRUE))));
 #endif
 
 U32
@@ -486,8 +516,8 @@ CODE:
 #endif
 
 void
-list(Class)
-	char *	Class
+list(classname)
+	char *	classname
     PREINIT:
 	Thread	t;
 	AV *	av;
@@ -510,7 +540,7 @@ list(Class)
 		    SV *sv = newSViv(0);	/* fill in tid later */
 		    sv_magic(sv, 0, '~', 0, 0);	/* fill in other magic later */
 		    av_push(av, sv_bless(newRV_noinc(sv),
-					 gv_stashpv(Class, TRUE)));
+					 gv_stashpv(classname, TRUE)));
 	
 		}
 	    }
@@ -580,3 +610,14 @@ await_signal()
     OUTPUT:
 	RETVAL
 
+MODULE = Thread		PACKAGE = Thread::Specific
+
+void
+data(classname = "Thread::Specific")
+	char *	classname
+    PPCODE:
+	if (AvFILL(thr->specific) == -1) {
+	    GV *gv = gv_fetchpv("Thread::Specific::FIELDS", TRUE, SVt_PVHV);
+	    av_store(thr->specific, 0, newRV((SV*)GvHV(gv)));
+	}
+	XPUSHs(sv_bless(newRV((SV*)thr->specific),gv_stashpv(classname,TRUE)));
diff --git a/ext/Thread/Thread/Specific.pm b/ext/Thread/Thread/Specific.pm
new file mode 100644
index 0000000000..ec56539e40
--- /dev/null
+++ b/ext/Thread/Thread/Specific.pm
@@ -0,0 +1,14 @@
+package Thread::Specific;
+
+sub import {
+    use attrs qw(locked method);
+    require fields;
+    fields->import(@_);
+}	
+
+sub key_create {
+    use attrs qw(locked method);
+    return ++$FIELDS{__MAX__};
+}
+
+1;
diff --git a/ext/Thread/join.t b/ext/Thread/join.t
index 640256a9b3..cba2c1cf56 100644
--- a/ext/Thread/join.t
+++ b/ext/Thread/join.t
@@ -8,4 +8,4 @@ print "Starting thread\n";
 $t = new Thread \&foo, qw(foo bar baz);
 print "Joining with $t\n";
 @results = $t->join();
-print "Joining returned @results\n";
+print "Joining returned ", scalar(@results), " values: @results\n";
diff --git a/ext/Thread/specific.t b/ext/Thread/specific.t
new file mode 100644
index 0000000000..da130b1d64
--- /dev/null
+++ b/ext/Thread/specific.t
@@ -0,0 +1,17 @@
+use Thread;
+
+use Thread::Specific qw(foo);
+
+sub count {
+    my $tid = Thread->self->tid;
+    my Thread::Specific $tsd = Thread::Specific::data;
+    for (my $i = 0; $i < 5; $i++) {
+	$tsd->{foo} = $i;
+	print "thread $tid count: $tsd->{foo}\n";
+	select(undef, undef, undef, rand(2));
+    }
+};
+
+for(my $t = 0; $t < 5; $t++) {
+    new Thread \&count;
+}