diff options
| -rw-r--r-- | README.threads | 4 | ||||
| -rw-r--r-- | ext/Thread/Thread.xs | 42 | ||||
| -rw-r--r-- | ext/Thread/typemap | 2 | ||||
| -rw-r--r-- | mg.c | 2 | ||||
| -rw-r--r-- | op.c | 2 | ||||
| -rw-r--r-- | perl.c | 24 | ||||
| -rw-r--r-- | perl.h | 8 | ||||
| -rw-r--r-- | pod/perlrun.pod | 1 | ||||
| -rw-r--r-- | pp.c | 4 | ||||
| -rw-r--r-- | pp_hot.c | 18 | ||||
| -rw-r--r-- | scope.c | 4 | ||||
| -rw-r--r-- | thread.h | 2 | ||||
| -rw-r--r-- | util.c | 20 | ||||
| -rw-r--r-- | win32/win32thread.c | 4 |
14 files changed, 66 insertions, 71 deletions
diff --git a/README.threads b/README.threads index e9f69663f9..83570561a7 100644 --- a/README.threads +++ b/README.threads @@ -150,13 +150,13 @@ haven't tracked down yet) and there are very probably others too. Debugging -Use the -DL command-line option to turn on debugging of the +Use the -DS command-line option to turn on debugging of the multi-threading code. Under Linux, that also turns on a quick hack I did to grab a bit of extra information from segfaults. If you have a fancier gdb/threads setup than I do then you'll have to delete the lines in perl.c which say #if defined(DEBUGGING) && defined(USE_THREADS) && defined(__linux__) - DEBUG_L(signal(SIGSEGV, (void(*)(int))catch_sigsegv);); + DEBUG_S(signal(SIGSEGV, (void(*)(int))catch_sigsegv);); #endif diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index 665956577d..48f8aa03fc 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -23,7 +23,7 @@ static void remove_thread(struct perl_thread *t) { #ifdef USE_THREADS - DEBUG_L(WITH_THR(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(), "%p: remove_thread %p\n", thr, t))); MUTEX_LOCK(&PL_threads_mutex); MUTEX_DESTROY(&t->mutex); @@ -48,7 +48,7 @@ threadstart(void *arg) AV *av; int i; - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", thr, SvPEEK(TOPs))); thr = (Thread) arg; savemark = TOPMARK; @@ -67,7 +67,7 @@ threadstart(void *arg) myop.op_flags |= OPf_KNOW; myop.op_flags |= OPf_WANT_LIST; PL_op = pp_entersub(ARGS); - DEBUG_L(if (!PL_op) + DEBUG_S(if (!PL_op) PerlIO_printf(PerlIO_stderr(), "thread starts at Nullop\n")); /* * When this thread is next scheduled, we start in the right @@ -88,7 +88,7 @@ threadstart(void *arg) AV *av = newAV(); int i, ret; dJMPENV; - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n", + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n", thr)); /* Don't call *anything* requiring dTHR until after SET_THR() */ @@ -110,7 +110,7 @@ threadstart(void *arg) SET_THR(thr); /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */ - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", thr, SvPEEK(TOPs))); sv = POPs; @@ -125,10 +125,10 @@ threadstart(void *arg) MUTEX_UNLOCK(&thr->mutex); av_store(av, 0, &PL_sv_no); av_store(av, 1, newSVsv(thr->errsv)); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n", + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n", thr, SvPV(thr->errsv, PL_na))); } else { - DEBUG_L(STMT_START { + DEBUG_S(STMT_START { for (i = 1; i <= retval; i++) { PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n", thr, i, SvPEEK(SP[i - 1])); @@ -177,28 +177,28 @@ threadstart(void *arg) /*SvREFCNT_dec(PL_defoutgv);*/ MUTEX_LOCK(&thr->mutex); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%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_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: R_JOINABLE thread finished\n", thr)); break; case THRf_R_JOINED: ThrSETSTATE(thr, THRf_DEAD); MUTEX_UNLOCK(&thr->mutex); remove_thread(thr); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: R_JOINED thread finished\n", thr)); break; case THRf_R_DETACHED: ThrSETSTATE(thr, THRf_DEAD); MUTEX_UNLOCK(&thr->mutex); SvREFCNT_dec(av); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: DETACHED thread finished\n", thr)); remove_thread(thr); /* This might trigger main thread to finish */ break; @@ -234,7 +234,7 @@ newthread (SV *startsv, AV *initargs, char *classname) savethread = thr; thr = new_struct_thread(thr); SPAGAIN; - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%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 */ @@ -283,7 +283,7 @@ newthread (SV *startsv, AV *initargs, char *classname) MUTEX_UNLOCK(&thr->mutex); #endif if (err) { - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: create of %p failed %d\n", savethread, thr, err)); /* Thread creation failed--clean up */ @@ -322,7 +322,7 @@ handle_thread_signal(int sig) * so don't be surprised if this isn't robust while debugging * with -DL. */ - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "handle_thread_signal: got signal %d\n", sig);); write(sig_pipe[1], &c, 1); } @@ -345,7 +345,7 @@ join(t) int i = NO_INIT PPCODE: #ifdef USE_THREADS - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n", + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n", thr, t, ThrSTATE(t));); MUTEX_LOCK(&t->mutex); switch (ThrSTATE(t)) { @@ -372,7 +372,7 @@ join(t) XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE))); } else { char *mess = SvPV(*av_fetch(av, 1, FALSE), PL_na); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: join propagating die message: %s\n", thr, mess)); croak(mess); @@ -384,7 +384,7 @@ detach(t) Thread t CODE: #ifdef USE_THREADS - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n", + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n", thr, t, ThrSTATE(t));); MUTEX_LOCK(&t->mutex); switch (ThrSTATE(t)) { @@ -476,7 +476,7 @@ CODE: sv = SvRV(sv); mg = condpair_magic(sv); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_wait %p\n", thr, sv)); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_wait %p\n", thr, sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { MUTEX_UNLOCK(MgMUTEXP(mg)); @@ -500,7 +500,7 @@ CODE: sv = SvRV(sv); mg = condpair_magic(sv); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_signal %p\n",thr,sv)); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_signal %p\n",thr,sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { MUTEX_UNLOCK(MgMUTEXP(mg)); @@ -520,7 +520,7 @@ CODE: sv = SvRV(sv); mg = condpair_magic(sv); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_broadcast %p\n", + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_broadcast %p\n", thr, sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { @@ -623,7 +623,7 @@ await_signal() ST(0) = sv_newmortal(); if (ret) sv_setsv(ST(0), c ? psig_ptr[c] : &PL_sv_no); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "await_signal returning %s\n", SvPEEK(ST(0)));); MODULE = Thread PACKAGE = Thread::Specific diff --git a/ext/Thread/typemap b/ext/Thread/typemap index fd6e99d947..21eb6c3240 100644 --- a/ext/Thread/typemap +++ b/ext/Thread/typemap @@ -13,7 +13,7 @@ T_XSCPTR || mg->mg_private != ${ntype}_MAGIC_SIGNATURE) croak(\"XSUB ${func_name}: $var is a forged ${ntype} object\"); $var = ($type) SvPVX(mg->mg_obj); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), \"XSUB ${func_name}: %p\\n\", $var);) } STMT_END T_IVREF @@ -1845,7 +1845,7 @@ int magic_mutexfree(SV *sv, MAGIC *mg) { dTHR; - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: magic_mutexfree 0x%lx\n", + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: magic_mutexfree 0x%lx\n", (unsigned long)thr, (unsigned long)sv);) if (MgOWNER(mg)) croak("panic: magic_mutexfree"); @@ -548,7 +548,7 @@ find_threadsv(char *name) default: sv_magic(sv, 0, 0, name, 1); } - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "find_threadsv: new SV %p for $%s%c\n", sv, (*name < 32) ? "^" : "", (*name < 32) ? toCTRL(*name) : *name)); @@ -256,7 +256,7 @@ perl_destruct(register PerlInterpreter *sv_interp) /* Pass 1 on any remaining threads: detach joinables, join zombies */ retry_cleanup: MUTEX_LOCK(&PL_threads_mutex); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: waiting for %d threads...\n", PL_nthreads - 1)); for (t = thr->next; t != thr; t = t->next) { @@ -264,7 +264,7 @@ perl_destruct(register PerlInterpreter *sv_interp) switch (ThrSTATE(t)) { AV *av; case THRf_ZOMBIE: - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: joining zombie %p\n", t)); ThrSETSTATE(t, THRf_DEAD); MUTEX_UNLOCK(&t->mutex); @@ -278,11 +278,11 @@ perl_destruct(register PerlInterpreter *sv_interp) MUTEX_UNLOCK(&PL_threads_mutex); JOIN(t, &av); SvREFCNT_dec((SV*)av); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: joined zombie %p OK\n", t)); goto retry_cleanup; case THRf_R_JOINABLE: - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: detaching thread %p\n", t)); ThrSETSTATE(t, THRf_R_DETACHED); /* @@ -296,7 +296,7 @@ perl_destruct(register PerlInterpreter *sv_interp) MUTEX_UNLOCK(&t->mutex); goto retry_cleanup; default: - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: ignoring %p (state %u)\n", t, ThrSTATE(t))); MUTEX_UNLOCK(&t->mutex); @@ -308,14 +308,14 @@ perl_destruct(register PerlInterpreter *sv_interp) /* Pass 2 on remaining threads: wait for the thread count to drop to one */ while (PL_nthreads > 1) { - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: final wait for %d threads\n", PL_nthreads - 1)); COND_WAIT(&PL_nthreads_cond, &PL_threads_mutex); } /* At this point, we're the last thread */ MUTEX_UNLOCK(&PL_threads_mutex); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "perl_destruct: armageddon has arrived\n")); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: armageddon has arrived\n")); MUTEX_DESTROY(&PL_threads_mutex); COND_DESTROY(&PL_nthreads_cond); #endif /* !defined(FAKE_THREADS) */ @@ -1064,10 +1064,8 @@ perl_run(PerlInterpreter *sv_interp) if (!PL_restartop) { DEBUG_x(dump_all()); DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n")); -#ifdef USE_THREADS - DEBUG_L(PerlIO_printf(Perl_debug_log, "main thread is 0x%lx\n", + DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%lx\n", (unsigned long) thr)); -#endif /* USE_THREADS */ if (PL_minus_c) { PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", PL_origfilename); @@ -1571,7 +1569,7 @@ moreswitches(char *s) #ifdef DEBUGGING forbid_setid("-D"); if (isALPHA(s[1])) { - static char debopts[] = "psltocPmfrxuLHXD"; + static char debopts[] = "psltocPmfrxuLHXDS"; char *d; for (s++; *s && (d = strchr(debopts,*s)); s++) @@ -2889,10 +2887,8 @@ my_exit(U32 status) { dTHR; -#ifdef USE_THREADS - DEBUG_L(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n", + DEBUG_S(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n", thr, (unsigned long) status)); -#endif /* USE_THREADS */ switch (status) { case 0: STATUS_ALL_SUCCESS; @@ -1443,6 +1443,11 @@ Gid_t getegid _((void)); #define DEBUG_H(a) if (PL_debug & 8192) a #define DEBUG_X(a) if (PL_debug & 16384) a #define DEBUG_D(a) if (PL_debug & 32768) a +# ifdef USE_THREADS +# define DEBUG_S(a) if (PL_debug & (1<<16)) a +# else +# define DEBUG_S(a) +# endif #else #define DEB(a) #define DEBUG(a) @@ -1458,10 +1463,11 @@ Gid_t getegid _((void)); #define DEBUG_r(a) #define DEBUG_x(a) #define DEBUG_u(a) -#define DEBUG_L(a) +#define DEBUG_S(a) #define DEBUG_H(a) #define DEBUG_X(a) #define DEBUG_D(a) +#define DEBUG_S(a) #endif #define YYMAXDEPTH 300 diff --git a/pod/perlrun.pod b/pod/perlrun.pod index da96acd9dc..a0c85b917b 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -272,6 +272,7 @@ equivalent to B<-Dtls>): 8192 H Hash dump -- usurps values() 16384 X Scratchpad allocation 32768 D Cleaning up + 65536 S Thread synchronization All these flags require C<-DDEBUGGING> when you compile the Perl executable. This flag is automatically set if you include C<-g> @@ -4486,7 +4486,7 @@ unlock_condpair(void *svv) croak("panic: unlock_condpair unlocking mutex that we don't own"); MgOWNER(mg) = 0; COND_SIGNAL(MgOWNERCONDP(mg)); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n", + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n", (unsigned long)thr, (unsigned long)svv);) MUTEX_UNLOCK(MgMUTEXP(mg)); } @@ -4511,7 +4511,7 @@ PP(pp_lock) while (MgOWNER(mg)) COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); MgOWNER(mg) = thr; - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n", + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n", (unsigned long)thr, (unsigned long)sv);) MUTEX_UNLOCK(MgMUTEXP(mg)); SvREFCNT_inc(sv); /* keep alive until magic_mutexfree */ @@ -39,10 +39,10 @@ unset_cvowner(void *cvarg) dTHR; #endif /* DEBUGGING */ - DEBUG_L((PerlIO_printf(PerlIO_stderr(), "%p unsetting CvOWNER of %p:%s\n", + DEBUG_S((PerlIO_printf(PerlIO_stderr(), "%p unsetting CvOWNER of %p:%s\n", thr, cv, SvPEEK((SV*)cv)))); MUTEX_LOCK(CvMUTEXP(cv)); - DEBUG_L(if (CvDEPTH(cv) != 0) + DEBUG_S(if (CvDEPTH(cv) != 0) PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n", CvDEPTH(cv));); assert(thr == CvOWNER(cv)); @@ -2091,7 +2091,7 @@ PP(pp_entersub) while (MgOWNER(mg)) COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); MgOWNER(mg) = thr; - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: pp_entersub lock %p\n", + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: pp_entersub lock %p\n", thr, sv);) MUTEX_UNLOCK(MgMUTEXP(mg)); SvREFCNT_inc(sv); /* Keep alive until magic_mutexfree */ @@ -2135,7 +2135,7 @@ PP(pp_entersub) /* We already have a clone to use */ MUTEX_UNLOCK(CvMUTEXP(cv)); cv = *(CV**)svp; - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "entersub: %p already has clone %p:%s\n", thr, cv, SvPEEK((SV*)cv))); CvOWNER(cv) = thr; @@ -2149,7 +2149,7 @@ PP(pp_entersub) CvOWNER(cv) = thr; SvREFCNT_inc(cv); MUTEX_UNLOCK(CvMUTEXP(cv)); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "entersub: %p grabbing %p:%s in stash %s\n", thr, cv, SvPEEK((SV*)cv), CvSTASH(cv) ? HvNAME(CvSTASH(cv)) : "(none)")); @@ -2158,7 +2158,7 @@ PP(pp_entersub) CV *clonecv; SvREFCNT_inc(cv); /* don't let it vanish from under us */ MUTEX_UNLOCK(CvMUTEXP(cv)); - DEBUG_L((PerlIO_printf(PerlIO_stderr(), + DEBUG_S((PerlIO_printf(PerlIO_stderr(), "entersub: %p cloning %p:%s\n", thr, cv, SvPEEK((SV*)cv)))); /* @@ -2175,7 +2175,7 @@ PP(pp_entersub) cv = clonecv; SvREFCNT_inc(cv); } - DEBUG_L(if (CvDEPTH(cv) != 0) + DEBUG_S(if (CvDEPTH(cv) != 0) PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n", CvDEPTH(cv));); SAVEDESTRUCTOR(unset_cvowner, (void*) cv); @@ -2325,7 +2325,7 @@ PP(pp_entersub) SV** ary; #if 0 - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p entersub preparing @_\n", thr)); #endif av = (AV*)PL_curpad[0]; @@ -2363,7 +2363,7 @@ PP(pp_entersub) } } #if 0 - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p entersub returning %p\n", thr, CvSTART(cv))); #endif RETURNOP(CvSTART(cv)); @@ -382,7 +382,7 @@ save_threadsv(PADOFFSET i) #ifdef USE_THREADS dTHR; SV **svp = &THREADSV(i); /* XXX Change to save by offset */ - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n", + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n", i, svp, *svp, SvPEEK(*svp))); save_svref(svp); return svp; @@ -567,7 +567,7 @@ leave_scope(I32 base) ptr = SSPOPPTR; restore_sv: sv = *(SV**)ptr; - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "restore svref: %p %p:%s -> %p:%s\n", ptr, sv, SvPEEK(sv), value, SvPEEK(value))); if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) && @@ -194,7 +194,7 @@ struct perl_thread *getTHR _((void)); #define ThrSETSTATE(t, s) STMT_START { \ (t)->flags &= ~THRf_STATE_MASK; \ (t)->flags |= (s); \ - DEBUG_L(PerlIO_printf(PerlIO_stderr(), \ + DEBUG_S(PerlIO_printf(PerlIO_stderr(), \ "thread %p set to state %d\n", (t), (s))); \ } STMT_END @@ -1253,21 +1253,17 @@ die(const char* pat, ...) GV *gv; CV *cv; -#ifdef USE_THREADS - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: die: curstack = %p, mainstack = %p\n", thr, PL_curstack, PL_mainstack)); -#endif /* USE_THREADS */ va_start(args, pat); message = pat ? mess(pat, &args) : Nullch; va_end(args); -#ifdef USE_THREADS - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: die: message = %s\ndiehook = %p\n", thr, message, PL_diehook)); -#endif /* USE_THREADS */ if (PL_diehook) { /* sv_2cv might call croak() */ SV *olddiehook = PL_diehook; @@ -1301,11 +1297,9 @@ die(const char* pat, ...) } PL_restartop = die_where(message); -#ifdef USE_THREADS - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: die: restartop = %p, was_in_eval = %d, top_env = %p\n", thr, PL_restartop, was_in_eval, PL_top_env)); -#endif /* USE_THREADS */ if ((!PL_restartop && was_in_eval) || PL_top_env->je_prev) JMPENV_JUMP(3); return PL_restartop; @@ -1324,9 +1318,7 @@ croak(const char* pat, ...) va_start(args, pat); message = mess(pat, &args); va_end(args); -#ifdef USE_THREADS - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s", (unsigned long) thr, message)); -#endif /* USE_THREADS */ + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s", (unsigned long) thr, message)); if (PL_diehook) { /* sv_2cv might call croak() */ SV *olddiehook = PL_diehook; @@ -2711,7 +2703,7 @@ condpair_magic(SV *sv) mg->mg_ptr = (char *)cp; mg->mg_len = sizeof(cp); UNLOCK_SV_MUTEX; - DEBUG_L(WITH_THR(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(), "%p: condpair_magic %p\n", thr, sv));) } } @@ -2812,7 +2804,7 @@ new_struct_thread(struct perl_thread *t) SV *sv = newSVsv(*svp); av_store(thr->threadsv, i, sv); sv_magic(sv, 0, 0, &PL_threadsv_names[i], 1); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new_struct_thread: copied threadsv %d %p->%p\n",i, t, thr)); } } diff --git a/win32/win32thread.c b/win32/win32thread.c index 14ac5d7f42..1eb0e872c6 100644 --- a/win32/win32thread.c +++ b/win32/win32thread.c @@ -93,7 +93,7 @@ Perl_thread_create(struct perl_thread *thr, thread_func_t *fn) unsigned long th; MUTEX_LOCK(&thr->mutex); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: create OS thread\n", thr)); #ifdef USE_RTL_THREAD_API /* See comment about USE_RTL_THREAD_API in win32thread.h */ @@ -124,7 +124,7 @@ Perl_thread_create(struct perl_thread *thr, thread_func_t *fn) #else /* !USE_RTL_THREAD_API */ thr->self = CreateThread(NULL, 0, fn, (void*)thr, 0, &junk); #endif /* !USE_RTL_THREAD_API */ - DEBUG_L(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk)); MUTEX_UNLOCK(&thr->mutex); return thr->self ? 0 : -1; |