X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FThread%2FThread.xs;h=ad99e2c409b09320eb22bfdc4b0909c460ffbe8e;hb=2c2d71f566f0a758d1486480f45158c0e70ea496;hp=84f9f57fc550e86a7fb639878b45fe572327e04d;hpb=1cfa4ec74d4933da0d98282eed6171cc7ac307b6;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index 84f9f57..ad99e2c 100644
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -1,3 +1,4 @@
+#define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -20,7 +21,7 @@ static int sig_pipe[2];
 #endif
 
 static void
-remove_thread(struct perl_thread *t)
+remove_thread(pTHX_ struct perl_thread *t)
 {
 #ifdef USE_THREADS
     DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(),
@@ -115,6 +116,8 @@ threadstart(void *arg)
 
     sv = POPs;
     PUTBACK;
+    ENTER;
+    SAVETMPS;
     perl_call_sv(sv, G_ARRAY|G_EVAL);
     SPAGAIN;
     retval = SP - (PL_stack_base + oldmark);
@@ -138,6 +141,8 @@ threadstart(void *arg)
 	for (i = 1; i <= retval; i++, SP++)
 	    sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*SP));
     }
+    FREETMPS;
+    LEAVE;
 
   finishoff:
 #if 0    
@@ -174,7 +179,8 @@ threadstart(void *arg)
     Safefree(PL_screamnext);
     Safefree(PL_reg_start_tmp);
     SvREFCNT_dec(PL_lastscream);
-    /*SvREFCNT_dec(PL_defoutgv);*/
+    SvREFCNT_dec(PL_defoutgv);
+    Safefree(PL_reg_poscache);
 
     MUTEX_LOCK(&thr->mutex);
     DEBUG_S(PerlIO_printf(PerlIO_stderr(),
@@ -190,7 +196,7 @@ threadstart(void *arg)
     case THRf_R_JOINED:
 	ThrSETSTATE(thr, THRf_DEAD);
 	MUTEX_UNLOCK(&thr->mutex);
-	remove_thread(thr);
+	remove_thread(aTHX_ thr);
 	DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 			      "%p: R_JOINED thread finished\n", thr));
 	break;
@@ -200,7 +206,7 @@ threadstart(void *arg)
 	SvREFCNT_dec(av);
 	DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 			      "%p: DETACHED thread finished\n", thr));
-	remove_thread(thr);	/* This might trigger main thread to finish */
+	remove_thread(aTHX_ thr);	/* This might trigger main thread to finish */
 	break;
     default:
 	MUTEX_UNLOCK(&thr->mutex);
@@ -217,7 +223,7 @@ threadstart(void *arg)
 }
 
 static SV *
-newthread (SV *startsv, AV *initargs, char *classname)
+newthread (pTHX_ SV *startsv, AV *initargs, char *classname)
 {
 #ifdef USE_THREADS
     dSP;
@@ -229,13 +235,16 @@ newthread (SV *startsv, AV *initargs, char *classname)
     static pthread_attr_t attr;
     static int attr_inited = 0;
     sigset_t fullmask, oldmask;
+    static int attr_joinable = PTHREAD_CREATE_JOINABLE;
 #endif
-#ifdef PTHREAD_SETDETACHSTATE_ARG2_POINTER
-    static int attr_joinable = ATTR_JOINABLE;
-#endif    
 
     savethread = thr;
     thr = new_struct_thread(thr);
+    /* temporarily pretend to be the child thread in case the
+     * XPUSHs() below want to grow the child's stack.  This is
+     * safe, since the other thread is not yet created, and we
+     * are the only ones who know about it */
+    SET_THR(thr);
     SPAGAIN;
     DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 			  "%p: newthread (%p), tid is %u, preparing stack\n",
@@ -247,11 +256,14 @@ newthread (SV *startsv, AV *initargs, char *classname)
 	XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE)));
     XPUSHs(SvREFCNT_inc(startsv));
     PUTBACK;
+
+    /* On your marks... */
+    SET_THR(savethread);
+    MUTEX_LOCK(&thr->mutex);
+
 #ifdef THREAD_CREATE
     err = THREAD_CREATE(thr, threadstart);
 #else    
-    /* On your marks... */
-    MUTEX_LOCK(&thr->mutex);
     /* Get set...  */
     sigfillset(&fullmask);
     if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1)
@@ -259,76 +271,62 @@ newthread (SV *startsv, AV *initargs, char *classname)
     err = 0;
     if (!attr_inited) {
 	attr_inited = 1;
-#ifdef OLD_PTHREADS_API
-	err = pthread_attr_create(&attr);
-#else
 	err = pthread_attr_init(&attr);
-#endif
-#ifdef OLD_PTHREADS_API
-#ifdef VMS
-/* This is available with the old pthreads API, but only with */
-/* DecThreads (VMS and Digital Unix (which has and uses the new one)) */
-	if (err == 0)
-	    err = pthread_attr_setdetach_np(&attr, ATTR_JOINABLE);
-#endif
-#else /* !defined(VMS) */
-#ifdef ATTR_JOINABLE
-	if (err == 0)
-	    err = pthread_attr_setdetachstate(&attr, ATTR_JOINABLE);
-#else /* !defined(ATTR_JOINABLE) */
-#ifdef __UNDETACHED
+#  ifdef PTHREAD_ATTR_SETDETACHSTATE
 	if (err == 0)
-	    err = pthread_attr_setdetachstate(&attr, &__undetached);
-#else /* !defined(__UNDETACHED) */
+	    err = PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable);
+
+#  else
 	croak("panic: can't pthread_attr_setdetachstate");
-#endif /* __UNDETACHED */
-#endif /* ATTR_JOINABLE */
-#endif /* VMS */
-#endif /* OLD_PTHREADS_API */
+#  endif
     }
     if (err == 0)
-#ifdef OLD_PTHREADS_API
-	err = pthread_create(&thr->self, attr, threadstart, (void*) thr);
-#else
-	err = pthread_create(&thr->self, &attr, threadstart, (void*) thr);
-#endif
-    /* Go */
-    MUTEX_UNLOCK(&thr->mutex);
+	err = PTHREAD_CREATE(&thr->self, attr, threadstart, (void*) thr);
 #endif
+
     if (err) {
+	MUTEX_UNLOCK(&thr->mutex);
         DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 			      "%p: create of %p failed %d\n",
 			      savethread, thr, err));
 	/* Thread creation failed--clean up */
 	SvREFCNT_dec(thr->cvcache);
-	remove_thread(thr);
+	remove_thread(aTHX_ thr);
 	MUTEX_DESTROY(&thr->mutex);
 	for (i = 0; i <= AvFILL(initargs); i++)
 	    SvREFCNT_dec(*av_fetch(initargs, i, FALSE));
 	SvREFCNT_dec(startsv);
 	return NULL;
     }
+
 #ifdef THREAD_POST_CREATE
     THREAD_POST_CREATE(thr);
 #else
     if (sigprocmask(SIG_SETMASK, &oldmask, 0))
 	croak("panic: sigprocmask");
 #endif
+
     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(classname, TRUE));
+    sv = sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE));
+
+    /* Go */
+    MUTEX_UNLOCK(&thr->mutex);
+
+    return sv;
 #else
     croak("No threads in this perl");
     return &PL_sv_undef;
 #endif
 }
 
-static Signal_t handle_thread_signal _((int sig));
+static Signal_t handle_thread_signal (int sig);
 
 static Signal_t
 handle_thread_signal(int sig)
 {
+    dTHXo;
     unsigned char c = (unsigned char) sig;
     /*
      * We're not really allowed to call fprintf in a signal handler
@@ -349,7 +347,7 @@ new(classname, startsv, ...)
 	SV *		startsv
 	AV *		av = av_make(items - 2, &ST(2));
     PPCODE:
-	XPUSHs(sv_2mortal(newthread(startsv, av, classname)));
+	XPUSHs(sv_2mortal(newthread(aTHX_ startsv, av, classname)));
 
 void
 join(t)
@@ -358,6 +356,8 @@ join(t)
 	int	i = NO_INIT
     PPCODE:
 #ifdef USE_THREADS
+	if (t == thr)
+	    croak("Attempt to join self");
 	DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n",
 			      thr, t, ThrSTATE(t)););
     	MUTEX_LOCK(&t->mutex);
@@ -370,7 +370,7 @@ join(t)
 	case THRf_ZOMBIE:
 	    ThrSETSTATE(t, THRf_DEAD);
 	    MUTEX_UNLOCK(&t->mutex);
-	    remove_thread(t);
+	    remove_thread(aTHX_ t);
 	    break;
 	default:
 	    MUTEX_UNLOCK(&t->mutex);
@@ -384,7 +384,8 @@ join(t)
 	    for (i = 1; i <= AvFILL(av); i++)
 		XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
 	} else {
-	    char *mess = SvPV(*av_fetch(av, 1, FALSE), PL_na);
+	    STRLEN n_a;
+	    char *mess = SvPV(*av_fetch(av, 1, FALSE), n_a);
 	    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 				  "%p: join propagating die message: %s\n",
 				  thr, mess));
@@ -412,7 +413,7 @@ detach(t)
 	    ThrSETSTATE(t, THRf_DEAD);
 	    DETACH(t);
 	    MUTEX_UNLOCK(&t->mutex);
-	    remove_thread(t);
+	    remove_thread(aTHX_ t);
 	    break;
 	default:
 	    MUTEX_UNLOCK(&t->mutex);
@@ -636,7 +637,7 @@ await_signal()
 	    croak("panic: await_signal");
 	ST(0) = sv_newmortal();
 	if (ret)
-	    sv_setsv(ST(0), c ? psig_ptr[c] : &PL_sv_no);
+	    sv_setsv(ST(0), c ? PL_psig_ptr[c] : &PL_sv_no);
 	DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 			      "await_signal returning %s\n", SvPEEK(ST(0))););