tweaked version of suggested patch

	Message-Id: <199807210140.VAA17186@monk.mps.ohio-state.edu>
	Subject: [PATCH 5.004_75] Enable -DS

p4raw-id: //depot/maint-5.005/perl@1701

diff --git a/README.threads b/README.threads
index e9f6966..8357056 100644 (file)
--- 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 6659565..48f8aa0 100644 (file)
--- 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 fd6e99d..21eb6c3 100644 (file)
--- 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

diff --git a/mg.c b/mg.c
index 1d78f13..9dfbd4f 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -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");

diff --git a/op.c b/op.c
index 16f528d..f285193 100644 (file)
--- a/op.c
+++ b/op.c
@@ -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));

diff --git a/perl.c b/perl.c
index 0e39dbe..7217536 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -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;

diff --git a/perl.h b/perl.h
index c6cc872..6a063b8 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -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 da96acd..a0c85b9 100644 (file)
--- 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>

diff --git a/pp.c b/pp.c
index 35c76bc..8068f41 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -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 */

diff --git a/pp_hot.c b/pp_hot.c
index 9b68c1c..e82c095 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -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));

diff --git a/scope.c b/scope.c
index 1008ab1..067e29e 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -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) &&

diff --git a/thread.h b/thread.h
index 0f350ed..3eb061a 100644 (file)
--- a/thread.h
+++ b/thread.h
@@ -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
 

diff --git a/util.c b/util.c
index b91601d..431c5fa 100644 (file)
--- a/util.c
+++ b/util.c
@@ -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 14ac5d7..1eb0e87 100644 (file)
--- 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;