X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FThread%2FThread.xs;h=c008160538f57661f513c882939d9e3849e19580;hb=4d1ff10ffec86208b0da135b87c76b89e61c866e;hp=4043a02e577cd0c67f08b688affa1d1443305ca2;hpb=c5be433b5c5658093bc9cae4434721a0b63e7a85;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index 4043a02..c008160 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -21,16 +21,17 @@ static int sig_pipe[2]; #endif static void -remove_thread(pTHX_ struct perl_thread *t) +remove_thread(pTHX_ Thread t) { -#ifdef USE_THREADS - DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(), +#ifdef USE_5005THREADS + DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log, "%p: remove_thread %p\n", thr, t))); MUTEX_LOCK(&PL_threads_mutex); MUTEX_DESTROY(&t->mutex); PL_nthreads--; t->prev->next = t->next; t->next->prev = t->prev; + SvREFCNT_dec(t->oursv); COND_BROADCAST(&PL_nthreads_cond); MUTEX_UNLOCK(&PL_threads_mutex); #endif @@ -39,7 +40,7 @@ remove_thread(pTHX_ struct perl_thread *t) static THREAD_RET_TYPE threadstart(void *arg) { -#ifdef USE_THREADS +#ifdef USE_5005THREADS #ifdef FAKE_THREADS Thread savethread = thr; LOGOP myop; @@ -49,7 +50,7 @@ threadstart(void *arg) AV *av; int i; - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", + DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p starting at %s\n", thr, SvPEEK(TOPs))); thr = (Thread) arg; savemark = TOPMARK; @@ -69,7 +70,7 @@ threadstart(void *arg) myop.op_flags |= OPf_WANT_LIST; PL_op = pp_entersub(ARGS); DEBUG_S(if (!PL_op) - PerlIO_printf(PerlIO_stderr(), "thread starts at Nullop\n")); + PerlIO_printf(Perl_debug_log, "thread starts at Nullop\n")); /* * When this thread is next scheduled, we start in the right * place. When the thread runs off the end of the sub, perl.c @@ -80,19 +81,20 @@ threadstart(void *arg) return 0; #else Thread thr = (Thread) arg; - LOGOP myop; - djSP; + dSP; I32 oldmark = TOPMARK; - I32 oldscope = PL_scopestack_ix; I32 retval; SV *sv; - AV *av = newAV(); - int i, ret; - dJMPENV; - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n", + AV *av; + int i; + +#if defined(MULTIPLICITY) + PERL_SET_INTERP(thr->interp); +#endif + + DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p waiting to start\n", thr)); - /* Don't call *anything* requiring dTHR until after SET_THR() */ /* * Wait until our creator releases us. If we didn't do this, then * it would be potentially possible for out thread to carry on and @@ -108,12 +110,12 @@ threadstart(void *arg) * from our pthread_t structure to our struct perl_thread, since * we're the only thread who can get at it anyway. */ - SET_THR(thr); + PERL_SET_THX(thr); - /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */ - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", + DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p starting at %s\n", thr, SvPEEK(TOPs))); + av = newAV(); sv = POPs; PUTBACK; ENTER; @@ -128,12 +130,13 @@ threadstart(void *arg) MUTEX_UNLOCK(&thr->mutex); av_store(av, 0, &PL_sv_no); av_store(av, 1, newSVsv(thr->errsv)); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n", + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p died: %s\n", thr, SvPV(thr->errsv, PL_na))); - } else { + } + else { DEBUG_S(STMT_START { for (i = 1; i <= retval; i++) { - PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n", + PerlIO_printf(Perl_debug_log, "%p return[%d] = %s\n", thr, i, SvPEEK(SP[i - 1])); } } STMT_END); @@ -144,7 +147,6 @@ threadstart(void *arg) FREETMPS; LEAVE; - finishoff: #if 0 /* removed for debug */ SvREFCNT_dec(PL_curstack); @@ -153,7 +155,6 @@ threadstart(void *arg) SvREFCNT_dec(thr->threadsv); SvREFCNT_dec(thr->specific); SvREFCNT_dec(thr->errsv); - SvREFCNT_dec(thr->errhv); /*Safefree(cxstack);*/ while (PL_curstackinfo->si_next) @@ -170,40 +171,43 @@ threadstart(void *arg) Safefree(PL_savestack); Safefree(PL_retstack); Safefree(PL_tmps_stack); - Safefree(PL_ofs); + SvREFCNT_dec(PL_ofs_sv); SvREFCNT_dec(PL_rs); SvREFCNT_dec(PL_nrs); SvREFCNT_dec(PL_statname); + SvREFCNT_dec(PL_errors); Safefree(PL_screamfirst); Safefree(PL_screamnext); Safefree(PL_reg_start_tmp); SvREFCNT_dec(PL_lastscream); SvREFCNT_dec(PL_defoutgv); + Safefree(PL_reg_poscache); MUTEX_LOCK(&thr->mutex); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + thr->thr_done = 1; + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: threadstart finishing: state is %u\n", thr, ThrSTATE(thr))); switch (ThrSTATE(thr)) { case THRf_R_JOINABLE: ThrSETSTATE(thr, THRf_ZOMBIE); MUTEX_UNLOCK(&thr->mutex); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: R_JOINABLE thread finished\n", thr)); break; case THRf_R_JOINED: ThrSETSTATE(thr, THRf_DEAD); MUTEX_UNLOCK(&thr->mutex); remove_thread(aTHX_ thr); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: R_JOINED thread finished\n", thr)); break; case THRf_R_DETACHED: ThrSETSTATE(thr, THRf_DEAD); MUTEX_UNLOCK(&thr->mutex); SvREFCNT_dec(av); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: DETACHED thread finished\n", thr)); remove_thread(aTHX_ thr); /* This might trigger main thread to finish */ break; @@ -224,7 +228,7 @@ threadstart(void *arg) static SV * newthread (pTHX_ SV *startsv, AV *initargs, char *classname) { -#ifdef USE_THREADS +#ifdef USE_5005THREADS dSP; Thread savethread; int i; @@ -243,9 +247,9 @@ newthread (pTHX_ SV *startsv, AV *initargs, char *classname) * 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); + PERL_SET_THX(thr); SPAGAIN; - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: newthread (%p), tid is %u, preparing stack\n", savethread, thr, thr->tid)); /* The following pushes the arg list and startsv onto the *new* stack */ @@ -257,7 +261,7 @@ newthread (pTHX_ SV *startsv, AV *initargs, char *classname) PUTBACK; /* On your marks... */ - SET_THR(savethread); + PERL_SET_THX(savethread); MUTEX_LOCK(&thr->mutex); #ifdef THREAD_CREATE @@ -271,10 +275,17 @@ newthread (pTHX_ SV *startsv, AV *initargs, char *classname) if (!attr_inited) { attr_inited = 1; err = pthread_attr_init(&attr); +# ifdef THREAD_CREATE_NEEDS_STACK + if (err == 0) + err = pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK); + if (err) + croak("panic: pthread_attr_setstacksize failed"); +# endif # ifdef PTHREAD_ATTR_SETDETACHSTATE if (err == 0) err = PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable); - + if (err) + croak("panic: pthread_attr_setdetachstate failed"); # else croak("panic: can't pthread_attr_setdetachstate"); # endif @@ -285,13 +296,12 @@ newthread (pTHX_ SV *startsv, AV *initargs, char *classname) if (err) { MUTEX_UNLOCK(&thr->mutex); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: create of %p failed %d\n", savethread, thr, err)); /* Thread creation failed--clean up */ SvREFCNT_dec(thr->cvcache); 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); @@ -315,7 +325,13 @@ newthread (pTHX_ SV *startsv, AV *initargs, char *classname) return sv; #else - croak("No threads in this perl"); +# ifdef USE_ITHREADS + croak("This perl was built for \"ithreads\", which currently does not support Thread.pm.\n" + "Run \"perldoc Thread\" for more information"); +# else + croak("This perl was not built with support for 5.005-style threads.\n" + "Run \"perldoc Thread\" for more information"); +# endif return &PL_sv_undef; #endif } @@ -325,15 +341,15 @@ static Signal_t handle_thread_signal (int sig); static Signal_t handle_thread_signal(int sig) { - dTHXo; unsigned char c = (unsigned char) sig; + dTHX; /* * We're not really allowed to call fprintf in a signal handler * so don't be surprised if this isn't robust while debugging * with -DL. */ - DEBUG_S(PerlIO_printf(PerlIO_stderr(), - "handle_thread_signal: got signal %d\n", sig);); + DEBUG_S(PerlIO_printf(Perl_debug_log, + "handle_thread_signal: got signal %d\n", sig)); write(sig_pipe[1], &c, 1); } @@ -354,11 +370,11 @@ join(t) AV * av = NO_INIT int i = NO_INIT PPCODE: -#ifdef USE_THREADS +#ifdef USE_5005THREADS if (t == thr) croak("Attempt to join self"); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n", - thr, t, ThrSTATE(t));); + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: joining %p (state %u)\n", + thr, t, ThrSTATE(t))); MUTEX_LOCK(&t->mutex); switch (ThrSTATE(t)) { case THRf_R_JOINABLE: @@ -378,14 +394,17 @@ join(t) } JOIN(t, &av); + sv_2mortal((SV*)av); + 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 { + XPUSHs(*av_fetch(av, i, FALSE)); + } + else { STRLEN n_a; char *mess = SvPV(*av_fetch(av, 1, FALSE), n_a); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: join propagating die message: %s\n", thr, mess)); croak(mess); @@ -396,9 +415,9 @@ void detach(t) Thread t CODE: -#ifdef USE_THREADS - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n", - thr, t, ThrSTATE(t));); +#ifdef USE_5005THREADS + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: detaching %p (state %u)\n", + thr, t, ThrSTATE(t))); MUTEX_LOCK(&t->mutex); switch (ThrSTATE(t)) { case THRf_R_JOINABLE: @@ -432,17 +451,25 @@ void flags(t) Thread t PPCODE: -#ifdef USE_THREADS +#ifdef USE_5005THREADS PUSHs(sv_2mortal(newSViv(t->flags))); #endif void +done(t) + Thread t + PPCODE: +#ifdef USE_5005THREADS + PUSHs(t->thr_done ? &PL_sv_yes : &PL_sv_no); +#endif + +void self(classname) char * classname PREINIT: SV *sv; PPCODE: -#ifdef USE_THREADS +#ifdef USE_5005THREADS sv = newSViv(thr->tid); sv_magic(sv, thr->oursv, '~', 0, 0); SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; @@ -454,7 +481,7 @@ U32 tid(t) Thread t CODE: -#ifdef USE_THREADS +#ifdef USE_5005THREADS MUTEX_LOCK(&t->mutex); RETVAL = t->tid; MUTEX_UNLOCK(&t->mutex); @@ -468,13 +495,13 @@ void DESTROY(t) SV * t PPCODE: - PUSHs(&PL_sv_yes); + PUSHs(t ? &PL_sv_yes : &PL_sv_no); void yield() CODE: { -#ifdef USE_THREADS +#ifdef USE_5005THREADS YIELD; #endif } @@ -484,12 +511,12 @@ cond_wait(sv) SV * sv MAGIC * mg = NO_INIT CODE: -#ifdef USE_THREADS +#ifdef USE_5005THREADS if (SvROK(sv)) sv = SvRV(sv); mg = condpair_magic(sv); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_wait %p\n", thr, sv)); + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: cond_wait %p\n", thr, sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { MUTEX_UNLOCK(MgMUTEXP(mg)); @@ -509,12 +536,12 @@ cond_signal(sv) SV * sv MAGIC * mg = NO_INIT CODE: -#ifdef USE_THREADS +#ifdef USE_5005THREADS if (SvROK(sv)) sv = SvRV(sv); mg = condpair_magic(sv); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_signal %p\n",thr,sv)); + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: cond_signal %p\n",thr,sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { MUTEX_UNLOCK(MgMUTEXP(mg)); @@ -529,12 +556,12 @@ cond_broadcast(sv) SV * sv MAGIC * mg = NO_INIT CODE: -#ifdef USE_THREADS +#ifdef USE_5005THREADS if (SvROK(sv)) sv = SvRV(sv); mg = condpair_magic(sv); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_broadcast %p\n", + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: cond_broadcast %p\n", thr, sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { @@ -554,7 +581,7 @@ list(classname) SV ** svp; int n = 0; PPCODE: -#ifdef USE_THREADS +#ifdef USE_5005THREADS av = newAV(); /* * Iterate until we have enough dynamic storage for all threads. @@ -637,8 +664,8 @@ await_signal() ST(0) = sv_newmortal(); if (ret) 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)));); + DEBUG_S(PerlIO_printf(Perl_debug_log, + "await_signal returning %s\n", SvPEEK(ST(0)))); MODULE = Thread PACKAGE = Thread::Specific @@ -646,7 +673,7 @@ void data(classname = "Thread::Specific") char * classname PPCODE: -#ifdef USE_THREADS +#ifdef USE_5005THREADS if (AvFILL(thr->specific) == -1) { GV *gv = gv_fetchpv("Thread::Specific::FIELDS", TRUE, SVt_PVHV); av_store(thr->specific, 0, newRV((SV*)GvHV(gv)));