This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make die/warn and other diagnostics go to wherever STDERR happens
authorGurusamy Sarathy <gsar@cpan.org>
Wed, 6 Oct 1999 02:36:53 +0000 (02:36 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Wed, 6 Oct 1999 02:36:53 +0000 (02:36 +0000)
to point at; change places that meant Perl_debug_log rather than
PerlIO_stderr()

p4raw-id: //depot/perl@4302

39 files changed:
cop.h
doio.c
embedvar.h
ext/Devel/Peek/Peek.xs
ext/DynaLoader/dl_aix.xs
ext/DynaLoader/dl_beos.xs
ext/DynaLoader/dl_cygwin.xs
ext/DynaLoader/dl_dld.xs
ext/DynaLoader/dl_dlopen.xs
ext/DynaLoader/dl_hpux.xs
ext/DynaLoader/dl_mpeix.xs
ext/DynaLoader/dl_next.xs
ext/DynaLoader/dl_rhapsody.xs
ext/DynaLoader/dl_vmesa.xs
ext/DynaLoader/dl_vms.xs
ext/DynaLoader/dlutils.c
ext/Thread/Thread.xs
ext/Thread/typemap
intrpvar.h
malloc.c
mg.c
objXSUB.h
op.c
perl.c
perl.h
perlio.c
pp.c
pp_ctl.c
pp_hot.c
regexec.c
scope.c
scope.h
sv.c
thread.h
toke.c
util.c
win32/dl_win32.xs
win32/win32.c
win32/win32thread.c

diff --git a/cop.h b/cop.h
index e8221b6..829bbe8 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -195,7 +195,7 @@ struct block {
        cx->blk_oldretsp        = PL_retstack_ix,                       \
        cx->blk_oldpm           = PL_curpm,                             \
        cx->blk_gimme           = gimme;                                \
-       DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Entering block %ld, type %s\n",        \
+       DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n", \
                    (long)cxstack_ix, PL_block_type[CxTYPE(cx)]); )
 
 /* Exit a block (RETURN and LAST). */
@@ -207,7 +207,7 @@ struct block {
        PL_retstack_ix   = cx->blk_oldretsp,                            \
        pm               = cx->blk_oldpm,                               \
        gimme            = cx->blk_gimme;                               \
-       DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Leaving block %ld, type %s\n",         \
+       DEBUG_l( PerlIO_printf(Perl_debug_log, "Leaving block %ld, type %s\n",          \
                    (long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); )
 
 /* Continue a block elsewhere (NEXT and REDO). */
@@ -380,7 +380,7 @@ typedef struct stackinfo PERL_SI;
        djSP;                                                           \
        PERL_SI *prev = PL_curstackinfo->si_prev;                       \
        if (!prev) {                                                    \
-           PerlIO_printf(PerlIO_stderr(), "panic: POPSTACK\n");        \
+           PerlIO_printf(Perl_error_log, "panic: POPSTACK\n");         \
            my_exit(1);                                                 \
        }                                                               \
        SWITCHSTACK(PL_curstack,prev->si_stack);                        \
diff --git a/doio.c b/doio.c
index 2baecec..1b59c37 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -134,7 +134,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        else
            result = PerlIO_close(IoIFP(io));
        if (result == EOF && fd > PL_maxsysfd)
-           PerlIO_printf(PerlIO_stderr(),
+           PerlIO_printf(Perl_error_log,
                          "Warning: unable to close filehandle %s properly.\n",
                          GvENAME(gv));
        IoOFP(io) = IoIFP(io) = Nullfp;
index beaa960..22a970a 100644 (file)
 #define PL_srand_called                (PERL_GET_INTERP->Isrand_called)
 #define PL_statusvalue         (PERL_GET_INTERP->Istatusvalue)
 #define PL_statusvalue_vms     (PERL_GET_INTERP->Istatusvalue_vms)
+#define PL_stderrgv            (PERL_GET_INTERP->Istderrgv)
 #define PL_stdingv             (PERL_GET_INTERP->Istdingv)
 #define PL_strchop             (PERL_GET_INTERP->Istrchop)
 #define PL_strtab              (PERL_GET_INTERP->Istrtab)
 #define PL_srand_called                (vTHX->Isrand_called)
 #define PL_statusvalue         (vTHX->Istatusvalue)
 #define PL_statusvalue_vms     (vTHX->Istatusvalue_vms)
+#define PL_stderrgv            (vTHX->Istderrgv)
 #define PL_stdingv             (vTHX->Istdingv)
 #define PL_strchop             (vTHX->Istrchop)
 #define PL_strtab              (vTHX->Istrtab)
 #define PL_Isrand_called       PL_srand_called
 #define PL_Istatusvalue                PL_statusvalue
 #define PL_Istatusvalue_vms    PL_statusvalue_vms
+#define PL_Istderrgv           PL_stderrgv
 #define PL_Istdingv            PL_stdingv
 #define PL_Istrchop            PL_strchop
 #define PL_Istrtab             PL_strtab
index df91476..4f34003 100644 (file)
@@ -34,12 +34,12 @@ DeadCode(pTHX)
                    continue;           /* file-level scope. */
                }
                if (!CvROOT(cv)) {
-                   /* PerlIO_printf(PerlIO_stderr(), "  no root?!\n"); */
+                   /* PerlIO_printf(Perl_debug_log, "  no root?!\n"); */
                    continue;           /* autoloading stub. */
                }
-               do_gvgv_dump(0, PerlIO_stderr(), "GVGV::GV", CvGV(sv));
+               do_gvgv_dump(0, Perl_debug_log, "GVGV::GV", CvGV(sv));
                if (CvDEPTH(cv)) {
-                   PerlIO_printf(PerlIO_stderr(), "  busy\n");
+                   PerlIO_printf(Perl_debug_log, "  busy\n");
                    continue;
                }
                svp = AvARRAY(padlist);
@@ -49,7 +49,7 @@ DeadCode(pTHX)
                    pad = AvARRAY((AV*)svp[i]);
                    argav = (AV*)pad[0];
                    if (!argav || (SV*)argav == &PL_sv_undef) {
-                       PerlIO_printf(PerlIO_stderr(), "    closure-template\n");
+                       PerlIO_printf(Perl_debug_log, "    closure-template\n");
                        continue;
                    }
                    args = AvARRAY(argav);
@@ -58,7 +58,7 @@ DeadCode(pTHX)
                    if (AvREAL(argav)) {
                        for (j = 0; j < AvFILL(argav); j++) {
                            if (SvROK(args[j])) {
-                               PerlIO_printf(PerlIO_stderr(), "     ref in args!\n");
+                               PerlIO_printf(Perl_debug_log, "     ref in args!\n");
                                levelref++;
                            }
                            /* else if (SvPOK(args[j]) && SvPVX(args[j])) { */
@@ -70,14 +70,14 @@ DeadCode(pTHX)
                    for (j = 1; j < AvFILL((AV*)svp[1]); j++) { /* Vars. */
                        if (SvROK(pad[j])) {
                            levelref++;
-                           do_sv_dump(0, PerlIO_stderr(), pad[j], 0, 4, 0, 0);
+                           do_sv_dump(0, Perl_debug_log, pad[j], 0, 4, 0, 0);
                            dumpit = 1;
                        }
                        /* else if (SvPOK(pad[j]) && SvPVX(pad[j])) { */
                        else if (SvTYPE(pad[j]) >= SVt_PVAV) {
                            if (!SvPADMY(pad[j])) {
                                levelref++;
-                               do_sv_dump(0, PerlIO_stderr(), pad[j], 0, 4, 0, 0);
+                               do_sv_dump(0, Perl_debug_log, pad[j], 0, 4, 0, 0);
                                dumpit = 1;
                            }
                        }
@@ -89,7 +89,7 @@ DeadCode(pTHX)
                                /* Dump(pad[j],4); */
                        }
                    }
-                   PerlIO_printf(PerlIO_stderr(), "    level %i: refs: %i, strings: %i in %i,\targsarray: %i, argsstrings: %i\n", 
+                   PerlIO_printf(Perl_debug_log, "    level %i: refs: %i, strings: %i in %i,\targsarray: %i, argsstrings: %i\n", 
                            i, levelref, levelm, levels, levela, levelas);
                    totm += levelm;
                    tota += levela;
@@ -97,10 +97,10 @@ DeadCode(pTHX)
                    tots += levels;
                    totref += levelref;
                    if (dumpit)
-                       do_sv_dump(0, PerlIO_stderr(), (SV*)cv, 0, 2, 0, 0);
+                       do_sv_dump(0, Perl_debug_log, (SV*)cv, 0, 2, 0, 0);
                }
                if (AvFILL(padlist) > 1) {
-                   PerlIO_printf(PerlIO_stderr(), "  total: refs: %i, strings: %i in %i,\targsarrays: %i, argsstrings: %i\n", 
+                   PerlIO_printf(Perl_debug_log, "  total: refs: %i, strings: %i in %i,\targsarrays: %i, argsstrings: %i\n", 
                            totref, totm, tots, tota, totas);
                }
                tref += totref;
@@ -111,7 +111,7 @@ DeadCode(pTHX)
            }
        }
     }
-    PerlIO_printf(PerlIO_stderr(), "total: refs: %i, strings: %i in %i\targsarray: %i, argsstrings: %i\n", tref, tm, ts, ta, tas);
+    PerlIO_printf(Perl_debug_log, "total: refs: %i, strings: %i in %i\targsarray: %i, argsstrings: %i\n", tref, tm, ts, ta, tas);
 
     return ret;
 }
@@ -122,7 +122,7 @@ DeadCode(pTHX)
 #   define mstat(str) dump_mstats(str)
 #else
 #   define mstat(str) \
-       PerlIO_printf(PerlIO_stderr(), "%s: perl not compiled with DEBUGGING_MSTATS\n",str);
+       PerlIO_printf(Perl_debug_log, "%s: perl not compiled with DEBUGGING_MSTATS\n",str);
 #endif
 
 MODULE = Devel::Peek           PACKAGE = Devel::Peek
@@ -142,7 +142,7 @@ PPCODE:
     SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", FALSE);
     I32 save_dumpindent = PL_dumpindent;
     PL_dumpindent = 2;
-    do_sv_dump(0, PerlIO_stderr(), sv, 0, lim, dumpop && SvTRUE(dumpop), pv_lim);
+    do_sv_dump(0, Perl_debug_log, sv, 0, lim, dumpop && SvTRUE(dumpop), pv_lim);
     PL_dumpindent = save_dumpindent;
 }
 
@@ -159,8 +159,8 @@ PPCODE:
     PL_dumpindent = 2;
 
     for (i=1; i<items; i++) {
-       PerlIO_printf(PerlIO_stderr(), "Elt No. %ld  0x%lx\n", i - 1, ST(i));
-       do_sv_dump(0, PerlIO_stderr(), ST(i), 0, lim, dumpop && SvTRUE(dumpop), pv_lim);
+       PerlIO_printf(Perl_debug_log, "Elt No. %ld  0x%lx\n", i - 1, ST(i));
+       do_sv_dump(0, Perl_debug_log, ST(i), 0, lim, dumpop && SvTRUE(dumpop), pv_lim);
     }
     PL_dumpindent = save_dumpindent;
 }
index 96bce4e..18003b2 100644 (file)
@@ -581,11 +581,11 @@ dl_load_file(filename, flags=0)
        char *  filename
        int     flags
        CODE:
-       DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+       DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
        if (flags & 0x01)
            Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
        RETVAL = dlopen(filename, 1) ;
-       DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
+       DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
        ST(0) = sv_newmortal() ;
        if (RETVAL == NULL)
            SaveError(aTHX_ "%s",dlerror()) ;
@@ -598,10 +598,10 @@ dl_find_symbol(libhandle, symbolname)
        void *          libhandle
        char *          symbolname
        CODE:
-       DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n",
+       DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n",
                libhandle, symbolname));
        RETVAL = dlsym(libhandle, symbolname);
-       DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "  symbolref = %x\n", RETVAL));
+       DLDEBUG(2,PerlIO_printf(Perl_debug_log, "  symbolref = %x\n", RETVAL));
        ST(0) = sv_newmortal() ;
        if (RETVAL == NULL)
            SaveError(aTHX_ "%s",dlerror()) ;
@@ -623,7 +623,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *     symref 
     char *     filename
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
        perl_name, symref));
     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
                                        (void(*)(pTHX_ CV *))symref,
index c26824e..8779d3c 100644 (file)
@@ -45,13 +45,13 @@ dl_load_file(filename, flags=0)
       strcpy(path, filename);
     }
 
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", path, flags));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", path, flags));
     bogo = load_add_on(path);
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
     ST(0) = sv_newmortal() ;
     if (bogo < 0) {
        SaveError(aTHX_ "%s", strerror(bogo));
-       PerlIO_printf(PerlIO_stderr(), "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo));
+       PerlIO_printf(Perl_debug_log, "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo));
     } else {
        RETVAL = (void *) bogo;
        sv_setiv( ST(0), PTR2IV(RETVAL) );
@@ -70,18 +70,18 @@ dl_find_symbol(libhandle, symbolname)
     symbolname = form("_%s", symbolname);
 #endif
     RETVAL = NULL;
-    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
                             "dl_find_symbol(handle=%lx, symbol=%s)\n",
                             (unsigned long) libhandle, symbolname));
     retcode = get_image_symbol((image_id) libhandle, symbolname,
                                B_SYMBOL_TYPE_TEXT, (void **) &adr);
     RETVAL = adr;
-    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
                             "  symbolref = %lx\n", (unsigned long) RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL) {
        SaveError(aTHX_ "%s", strerror(retcode)) ;
-       PerlIO_printf(PerlIO_stderr(), "retcode = %p (%s)\n", retcode, strerror(retcode));
+       PerlIO_printf(Perl_debug_log, "retcode = %p (%s)\n", retcode, strerror(retcode));
     } else
        sv_setiv( ST(0), PTR2IV(RETVAL));
 
@@ -100,7 +100,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *             symref 
     char *             filename
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
                perl_name, (unsigned long) symref));
     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
                                        (void(*)(pTHX_ CV *))symref,
index 7f74cdd..4055b05 100644 (file)
@@ -86,11 +86,11 @@ dl_load_file(filename,flags=0)
     cygwin_conv_to_full_win32_path(filename, win32_path);
     filename = win32_path;
 
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename));
 
     RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ;
 
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL){
        SaveError(aTHX_ "%d",GetLastError()) ;
@@ -106,10 +106,10 @@ dl_find_symbol(libhandle, symbolname)
     void *     libhandle
     char *     symbolname
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n",
        libhandle, symbolname));
     RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"  symbolref = %x\n", RETVAL));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"  symbolref = %x\n", RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
        SaveError(aTHX_ "%d",GetLastError()) ;
@@ -131,7 +131,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *             symref 
     char *             filename
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
                perl_name, symref));
     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
                                        (void(*)(pTHX_ CV *))symref,
index d427efa..6910739 100644 (file)
@@ -62,7 +62,7 @@ dl_private_init(pTHX)
         if (dlderr) {
             char *msg = dld_strerror(dlderr);
             SaveError(aTHX_ "dld_init(%s) failed: %s", PL_origargv[0], msg);
-            DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "%s", LastError));
+            DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", LastError));
         }
 #ifdef __linux__
     }
@@ -85,13 +85,13 @@ dl_load_file(filename, flags=0)
     GV *gv;
     CODE:
     RETVAL = filename;
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
     if (flags & 0x01)
        Perl_croak(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
     max = AvFILL(dl_require_symbols);
     for (x = 0; x <= max; x++) {
        char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0));
-       DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_create_ref(%s)\n", sym));
+       DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_create_ref(%s)\n", sym));
        if (dlderr = dld_create_reference(sym)) {
            SaveError(aTHX_ "dld_create_reference(%s): %s", sym,
                      dld_strerror(dlderr));
@@ -99,7 +99,7 @@ dl_load_file(filename, flags=0)
        }
     }
 
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_link(%s)\n", filename));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", filename));
     if (dlderr = dld_link(filename)) {
        SaveError(aTHX_ "dld_link(%s): %s", filename, dld_strerror(dlderr));
        goto haverror;
@@ -108,13 +108,13 @@ dl_load_file(filename, flags=0)
     max = AvFILL(dl_resolve_using);
     for (x = 0; x <= max; x++) {
        char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0));
-       DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_link(%s)\n", sym));
+       DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", sym));
        if (dlderr = dld_link(sym)) {
            SaveError(aTHX_ "dld_link(%s): %s", sym, dld_strerror(dlderr));
            goto haverror;
        }
     }
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "libref=%s\n", RETVAL));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "libref=%s\n", RETVAL));
 haverror:
     ST(0) = sv_newmortal() ;
     if (dlderr == 0)
@@ -126,11 +126,11 @@ dl_find_symbol(libhandle, symbolname)
     void *     libhandle
     char *     symbolname
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n",
            libhandle, symbolname));
     RETVAL = (void *)dld_get_func(symbolname);
     /* if RETVAL==NULL we should try looking for a non-function symbol */
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "  symbolref = %x\n", RETVAL));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "  symbolref = %x\n", RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
        SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ;
@@ -160,7 +160,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *     symref 
     char *     filename
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
            perl_name, symref));
     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
                                        (void(*)(pTHX_ CV *))symref,
index 641db33..94cd017 100644 (file)
@@ -159,9 +159,9 @@ dl_load_file(filename, flags=0)
 #else
        Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
 #endif
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
     RETVAL = dlopen(filename, mode) ;
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
        SaveError(aTHX_ "%s",dlerror()) ;
@@ -177,11 +177,11 @@ dl_find_symbol(libhandle, symbolname)
 #ifdef DLSYM_NEEDS_UNDERSCORE
     symbolname = form("_%s", symbolname);
 #endif
-    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
                             "dl_find_symbol(handle=%lx, symbol=%s)\n",
                             (unsigned long) libhandle, symbolname));
     RETVAL = dlsym(libhandle, symbolname);
-    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
                             "  symbolref = %lx\n", (unsigned long) RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
@@ -204,7 +204,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *             symref 
     char *             filename
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
                perl_name, (unsigned long) symref));
     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
                                        (void(*)(pTHX_ CV *))symref,
index 180679f..2155165 100644 (file)
@@ -53,7 +53,7 @@ dl_load_file(filename, flags=0)
     shl_t obj = NULL;
     int        i, max, bind_type;
     CODE:
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
     if (flags & 0x01)
        Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
     if (dl_nonlazy) {
@@ -76,17 +76,17 @@ dl_load_file(filename, flags=0)
     max = AvFILL(dl_resolve_using);
     for (i = 0; i <= max; i++) {
        char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0));
-       DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s) (dependent)\n", sym));
+       DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s) (dependent)\n", sym));
        obj = shl_load(sym, bind_type, 0L);
        if (obj == NULL) {
            goto end;
        }
     }
 
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s): ", filename));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s): ", filename));
     obj = shl_load(filename, bind_type, 0L);
 
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", obj));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", obj));
 end:
     ST(0) = sv_newmortal() ;
     if (obj == NULL)
@@ -106,7 +106,7 @@ dl_find_symbol(libhandle, symbolname)
 #ifdef __hp9000s300
     symbolname = form("_%s", symbolname);
 #endif
-    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
                             "dl_find_symbol(handle=%lx, symbol=%s)\n",
                             (unsigned long) libhandle, symbolname));
 
@@ -114,11 +114,11 @@ dl_find_symbol(libhandle, symbolname)
     errno = 0;
 
     status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr);
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "  symbolref(PROCEDURE) = %x\n", symaddr));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "  symbolref(PROCEDURE) = %x\n", symaddr));
 
     if (status == -1 && errno == 0) {  /* try TYPE_DATA instead */
        status = shl_findsym(&obj, symbolname, TYPE_DATA, &symaddr);
-       DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "  symbolref(DATA) = %x\n", symaddr));
+       DLDEBUG(2,PerlIO_printf(Perl_debug_log, "  symbolref(DATA) = %x\n", symaddr));
     }
 
     if (status == -1) {
@@ -142,7 +142,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *     symref 
     char *     filename
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
            perl_name, symref));
     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
                                        (void(*)(pTHX_ CV *))symref,
index 913e259..eb46f03 100644 (file)
@@ -53,7 +53,7 @@ dl_load_file(filename, flags=0)
     p_mpe_dld           obj = NULL;
     int                 i;
     CODE:
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,
 flags));
     if (flags & 0x01)
         Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s
@@ -68,7 +68,7 @@ flags));
     else
         sprintf(obj->filename," %s ",filename);
 
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", obj));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", obj));
 
     ST(0) = sv_newmortal() ;
     if (obj == NULL)
@@ -86,7 +86,7 @@ dl_find_symbol(libhandle, symbolname)
     char      symname[PATH_MAX + 3];
     void *    symaddr = NULL;
     int       status;
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n",
                 libhandle, symbolname));
     ST(0) = sv_newmortal() ;
     errno = 0;
@@ -95,7 +95,7 @@ dl_find_symbol(libhandle, symbolname)
     HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1,
                     0, &datalen, 1, 0, 0);
 
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"  symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"  symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status));
 
     if (status != 0) {
         SaveError(aTHX_"%s",(errno) ? Strerror(errno) : "Symbol not found") ;
@@ -115,7 +115,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *      symref
     char *      filename
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
             perl_name, symref));
     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
                                        (void(*)(pTHX_ CV *))symref,
index 54d4be0..36ef8b8 100644 (file)
@@ -243,11 +243,11 @@ dl_load_file(filename, flags=0)
     PREINIT:
     int mode = 1;
     CODE:
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
     if (flags & 0x01)
        Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
     RETVAL = dlopen(filename, mode) ;
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
        SaveError(aTHX_ "%s",dlerror()) ;
@@ -263,11 +263,11 @@ dl_find_symbol(libhandle, symbolname)
 #if NS_TARGET_MAJOR >= 4
     symbolname = form("_%s", symbolname);
 #endif
-    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
                             "dl_find_symbol(handle=%lx, symbol=%s)\n",
                             (unsigned long) libhandle, symbolname));
     RETVAL = dlsym(libhandle, symbolname);
-    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
                             "  symbolref = %lx\n", (unsigned long) RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
@@ -290,7 +290,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *     symref 
     char *     filename
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
            perl_name, symref));
     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
                                        (void(*)(pTHX_ CV *))symref,
index a56452e..6cf2df7 100644 (file)
@@ -157,11 +157,11 @@ dl_load_file(filename, flags=0)
     PREINIT:
     int mode = 1;
     CODE:
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
     if (flags & 0x01)
        Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
     RETVAL = dlopen(filename, mode) ;
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
        SaveError(aTHX_ "%s",dlerror()) ;
@@ -175,11 +175,11 @@ dl_find_symbol(libhandle, symbolname)
     char *             symbolname
     CODE:
     symbolname = form("_%s", symbolname);
-    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
                             "dl_find_symbol(handle=%lx, symbol=%s)\n",
                             (unsigned long) libhandle, symbolname));
     RETVAL = dlsym(libhandle, symbolname);
-    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
                             "  symbolref = %lx\n", (unsigned long) RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
@@ -202,7 +202,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *     symref
     char *     filename
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
            perl_name, symref));
     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
                                        (void(*)(pTHX_ CV *))symref,
index 9e4908c..8595e44 100644 (file)
@@ -116,9 +116,9 @@ dl_load_file(filename, flags=0)
     CODE:
     if (flags & 0x01)
        Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
     RETVAL = dlopen(filename) ;
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
        SaveError(aTHX_ "%s",dlerror()) ;
@@ -131,11 +131,11 @@ dl_find_symbol(libhandle, symbolname)
     void *     libhandle
     char *     symbolname
     CODE:
-    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
                             "dl_find_symbol(handle=%lx, symbol=%s)\n",
                             (unsigned long) libhandle, symbolname));
     RETVAL = dlsym(libhandle, symbolname);
-    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
                             "  symbolref = %lx\n", (unsigned long) RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
@@ -158,7 +158,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *             symref
     char *             filename
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
                perl_name, (unsigned long) symref));
     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
                                        (void(*)(pTHX_ CV *))symref,
index 409d586..29ab7c3 100644 (file)
@@ -128,7 +128,7 @@ findsym_handler(void *sig, void *mech)
     myvec[0] = args = usig[0] > 10 ? 9 : usig[0] - 1;
     while (--args) myvec[args] = usig[args];
     _ckvmssts(sys$putmsg(myvec,copy_errmsg,0,0));
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "findsym_handler: received\n\t%s\n",LastError));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "findsym_handler: received\n\t%s\n",LastError));
     return SS$_CONTINUE;
 }
 
@@ -179,11 +179,11 @@ dl_expandspec(filespec)
     dlfab.fab$b_fns = strlen(vmsspec);
     dlfab.fab$l_dna = 0;
     dlfab.fab$b_dns = 0;
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_expand_filespec(%s):\n",vmsspec));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_expand_filespec(%s):\n",vmsspec));
     /* On the first pass, just parse the specification string */
     dlnam.nam$b_nop = NAM$M_SYNCHK;
     sts = sys$parse(&dlfab);
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tSYNCHK sys$parse = %d\n",sts));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tSYNCHK sys$parse = %d\n",sts));
     if (!(sts & 1)) {
       dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
       ST(0) = &PL_sv_undef;
@@ -196,7 +196,7 @@ dl_expandspec(filespec)
              dlnam.nam$b_type + dlnam.nam$b_ver);
       deflen += dlnam.nam$b_type + dlnam.nam$b_ver;
       memcpy(vmsspec,dlnam.nam$l_name,dlnam.nam$b_name);
-      DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsplit filespec: name = %.*s, default = %.*s\n",
+      DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsplit filespec: name = %.*s, default = %.*s\n",
                         dlnam.nam$b_name,vmsspec,deflen,defspec));
       /* . . . and go back to expand it */
       dlnam.nam$b_nop = 0;
@@ -204,7 +204,7 @@ dl_expandspec(filespec)
       dlfab.fab$b_dns = deflen;
       dlfab.fab$b_fns = dlnam.nam$b_name;
       sts = sys$parse(&dlfab);
-      DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tname/default sys$parse = %d\n",sts));
+      DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tname/default sys$parse = %d\n",sts));
       if (!(sts & 1)) {
         dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
         ST(0) = &PL_sv_undef;
@@ -212,14 +212,14 @@ dl_expandspec(filespec)
       else {
         /* Now find the actual file */
         sts = sys$search(&dlfab);
-        DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsys$search = %d\n",sts));
+        DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsys$search = %d\n",sts));
         if (!(sts & 1)) {
           dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
           ST(0) = &PL_sv_undef;
         }
         else {
           ST(0) = sv_2mortal(newSVpvn(dlnam.nam$l_rsa,dlnam.nam$b_rsl));
-          DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "\tresult = \\%.*s\\\n",
+          DLDEBUG(1,PerlIO_printf(Perl_debug_log, "\tresult = \\%.*s\\\n",
                             dlnam.nam$b_rsl,dlnam.nam$l_rsa));
         }
       }
@@ -247,16 +247,16 @@ dl_load_file(filespec, flags)
     void (*entry)();
     CODE:
 
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filespec,flags));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filespec,flags));
     specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec);
     specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer);
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tVMS-ified filespec is %s\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tVMS-ified filespec is %s\n",
                       specdsc.dsc$a_pointer));
     New(1399,dlptr,1,struct libref);
     dlptr->name.dsc$b_dtype = dlptr->defspec.dsc$b_dtype = DSC$K_DTYPE_T;
     dlptr->name.dsc$b_class = dlptr->defspec.dsc$b_class = DSC$K_CLASS_S;
     sts = sys$filescan(&specdsc,namlst,0);
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsys$filescan: returns %d, name is %.*s\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsys$filescan: returns %d, name is %.*s\n",
                       sts,namlst[0].len,namlst[0].string));
     if (!(sts & 1)) {
       failed = 1;
@@ -272,21 +272,21 @@ dl_load_file(filespec, flags)
       memcpy(dlptr->defspec.dsc$a_pointer + deflen,
              namlst[0].string + namlst[0].len,
              dlptr->defspec.dsc$w_length - deflen);
-      DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tlibref = name: %s, defspec: %.*s\n",
+      DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tlibref = name: %s, defspec: %.*s\n",
                         dlptr->name.dsc$a_pointer,
                         dlptr->defspec.dsc$w_length,
                         dlptr->defspec.dsc$a_pointer));
       if (!(reqSVhndl = av_fetch(dl_require_symbols,0,FALSE)) || !(reqSV = *reqSVhndl)) {
-        DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\t@dl_require_symbols empty, returning untested libref\n"));
+        DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\t@dl_require_symbols empty, returning untested libref\n"));
       }
       else {
         symdsc.dsc$w_length = SvCUR(reqSV);
         symdsc.dsc$a_pointer = SvPVX(reqSV);
-        DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\t$dl_require_symbols[0] = %.*s\n",
+        DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\t$dl_require_symbols[0] = %.*s\n",
                           symdsc.dsc$w_length, symdsc.dsc$a_pointer));
         sts = my_find_image_symbol(&(dlptr->name),&symdsc,
                                     &entry,&(dlptr->defspec));
-        DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tlib$find_image_symbol returns %d\n",sts));
+        DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tlib$find_image_symbol returns %d\n",sts));
         if (!(sts&1)) {
           failed = 1;
           dl_set_error(sts,0);
@@ -316,13 +316,13 @@ dl_find_symbol(librefptr,symname)
     void (*entry)();
     vmssts sts;
 
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_find_dymbol(%.*s,%.*s):\n",
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_find_dymbol(%.*s,%.*s):\n",
                       thislib.name.dsc$w_length, thislib.name.dsc$a_pointer,
                       symdsc.dsc$w_length,symdsc.dsc$a_pointer));
     sts = my_find_image_symbol(&(thislib.name),&symdsc,
                                &entry,&(thislib.defspec));
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tlib$find_image_symbol returns %d\n",sts));
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tentry point is %d\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tlib$find_image_symbol returns %d\n",sts));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tentry point is %d\n",
                       (unsigned long int) entry));
     if (!(sts & 1)) {
       /* error message already saved by findsym_handler */
@@ -344,7 +344,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *     symref 
     char *     filename
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
         perl_name, symref));
     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
                                      (void(*)(pTHX_ CV *))symref,
index 7391156..377d6dd 100644 (file)
@@ -35,7 +35,7 @@ dl_generic_private_init(pTHXo)        /* called by dl_*.xs dl_private_init() */
     if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
        dl_nonlazy = atoi(perl_dl_nonlazy);
     if (dl_nonlazy)
-       DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "DynaLoader bind mode is 'non-lazy'\n"));
+       DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
 #ifdef DL_LOADONCEONLY
     if (!dl_loaded_files)
        dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
@@ -69,6 +69,6 @@ SaveError(pTHXo_ char* pat, ...)
 
     /* Copy message into LastError (including terminating null char)   */
     strncpy(LastError, message, len) ;
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "DynaLoader: stored error msg '%s'\n",LastError));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",LastError));
 }
 
index e01f29d..09d063a 100644 (file)
@@ -24,7 +24,7 @@ static void
 remove_thread(pTHX_ struct perl_thread *t)
 {
 #ifdef USE_THREADS
-    DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(),
+    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);
@@ -49,7 +49,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 +69,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
@@ -94,7 +94,7 @@ threadstart(void *arg)
     PERL_SET_INTERP(thr->interp);
 #endif
 
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n",
+    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() */
@@ -116,7 +116,7 @@ threadstart(void *arg)
     SET_THR(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();
@@ -134,12 +134,12 @@ 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 {
        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);
@@ -190,28 +190,28 @@ threadstart(void *arg)
     Safefree(PL_reg_poscache);
 
     MUTEX_LOCK(&thr->mutex);
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+    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;
@@ -253,7 +253,7 @@ newthread (pTHX_ SV *startsv, AV *initargs, char *classname)
      * are the only ones who know about it */
     SET_THR(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 */
@@ -293,7 +293,7 @@ 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 */
@@ -340,7 +340,7 @@ handle_thread_signal(int sig)
      * so don't be surprised if this isn't robust while debugging
      * with -DL.
      */
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+    DEBUG_S(PerlIO_printf(Perl_debug_log,
            "handle_thread_signal: got signal %d\n", sig););
     write(sig_pipe[1], &c, 1);
 }
@@ -365,7 +365,7 @@ join(t)
 #ifdef USE_THREADS
        if (t == thr)
            croak("Attempt to join self");
-       DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n",
+       DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: joining %p (state %u)\n",
                              thr, t, ThrSTATE(t)););
        MUTEX_LOCK(&t->mutex);
        switch (ThrSTATE(t)) {
@@ -393,7 +393,7 @@ join(t)
        } 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);
@@ -405,7 +405,7 @@ detach(t)
        Thread  t
     CODE:
 #ifdef USE_THREADS
-       DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n",
+       DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: detaching %p (state %u)\n",
                              thr, t, ThrSTATE(t)););
        MUTEX_LOCK(&t->mutex);
        switch (ThrSTATE(t)) {
@@ -497,7 +497,7 @@ CODE:
            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));
@@ -522,7 +522,7 @@ CODE:
            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));
@@ -542,7 +542,7 @@ CODE:
            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) {
@@ -645,7 +645,7 @@ 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(),
+       DEBUG_S(PerlIO_printf(Perl_debug_log,
                              "await_signal returning %s\n", SvPEEK(ST(0))););
 
 MODULE = Thread                PACKAGE = Thread::Specific
index 21eb6c3..7ce7d5c 100644 (file)
@@ -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_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  \"XSUB ${func_name}: %p\\n\", $var);)
        } STMT_END
 T_IVREF
index cc3eff5..b9a3a3d 100644 (file)
@@ -64,6 +64,7 @@ PERLVAR(Istatusvalue_vms,U32)
 
 /* shortcuts to various I/O objects */
 PERLVAR(Istdingv,      GV *)
+PERLVAR(Istderrgv,     GV *)
 PERLVAR(Idefgv,                GV *)
 PERLVAR(Iargvgv,       GV *)
 PERLVAR(Iargvoutgv,    GV *)
index 450142d..4e3e0b8 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -1836,49 +1836,49 @@ Perl_dump_mstats(pTHX_ char *s)
        }
        MALLOC_UNLOCK;
        if (s)
-           PerlIO_printf(PerlIO_stderr(),
+           PerlIO_printf(Perl_error_log,
                          "Memory allocation statistics %s (buckets %ld(%ld)..%ld(%ld)\n",
                          s, 
                          (long)BUCKET_SIZE_REAL(MIN_BUCKET), 
                          (long)BUCKET_SIZE(MIN_BUCKET),
                          (long)BUCKET_SIZE_REAL(topbucket), (long)BUCKET_SIZE(topbucket));
-       PerlIO_printf(PerlIO_stderr(), "%8d free:", totfree);
+       PerlIO_printf(Perl_error_log, "%8d free:", totfree);
        for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) {
-               PerlIO_printf(PerlIO_stderr()
+               PerlIO_printf(Perl_error_log
                              ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
                               ? " %5d" 
                               : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
                              nfree[i]);
        }
 #ifdef BUCKETS_ROOT2
-       PerlIO_printf(PerlIO_stderr(), "\n\t   ");
+       PerlIO_printf(Perl_error_log, "\n\t   ");
        for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) {
-               PerlIO_printf(PerlIO_stderr()
+               PerlIO_printf(Perl_error_log
                              ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
                               ? " %5d" 
                               : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
                              nfree[i]);
        }
 #endif 
-       PerlIO_printf(PerlIO_stderr(), "\n%8d used:", total - totfree);
+       PerlIO_printf(Perl_error_log, "\n%8d used:", total - totfree);
        for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) {
-               PerlIO_printf(PerlIO_stderr()
+               PerlIO_printf(Perl_error_log
                              ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
                               ? " %5d" 
                               : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), 
                              nmalloc[i] - nfree[i]);
        }
 #ifdef BUCKETS_ROOT2
-       PerlIO_printf(PerlIO_stderr(), "\n\t   ");
+       PerlIO_printf(Perl_error_log, "\n\t   ");
        for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) {
-               PerlIO_printf(PerlIO_stderr()
+               PerlIO_printf(Perl_error_log
                              ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
                               ? " %5d" 
                               : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
                              nmalloc[i] - nfree[i]);
        }
 #endif 
-       PerlIO_printf(PerlIO_stderr(), "\nTotal sbrk(): %d/%d:%d. Odd ends: pad+heads+chain+tail: %d+%d+%d+%d.\n",
+       PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %d/%d:%d. Odd ends: pad+heads+chain+tail: %d+%d+%d+%d.\n",
                      goodsbrk + sbrk_slack, sbrks, sbrk_good, sbrk_slack,
                      start_slack, total_chain, sbrked_remains);
 #endif /* DEBUGGING_MSTATS */
diff --git a/mg.c b/mg.c
index ca07b83..f72d287 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1941,7 +1941,7 @@ int
 Perl_magic_mutexfree(pTHX_ SV *sv, MAGIC *mg)
 {
     dTHR;
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: magic_mutexfree 0x%lx\n",
+    DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%lx: magic_mutexfree 0x%lx\n",
                          (unsigned long)thr, (unsigned long)sv);)
     if (MgOWNER(mg))
        Perl_croak(aTHX_ "panic: magic_mutexfree");
index 362af7a..cd8f2d8 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
 #define PL_statusvalue         (*Perl_Istatusvalue_ptr(aTHXo))
 #undef  PL_statusvalue_vms
 #define PL_statusvalue_vms     (*Perl_Istatusvalue_vms_ptr(aTHXo))
+#undef  PL_stderrgv
+#define PL_stderrgv            (*Perl_Istderrgv_ptr(aTHXo))
 #undef  PL_stdingv
 #define PL_stdingv             (*Perl_Istdingv_ptr(aTHXo))
 #undef  PL_strchop
diff --git a/op.c b/op.c
index 8f8e796..bc47f6d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -614,7 +614,7 @@ Perl_find_threadsv(pTHX_ const char *name)
        default:
            sv_magic(sv, 0, 0, name, 1); 
        }
-       DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+       DEBUG_S(PerlIO_printf(Perl_error_log,
                              "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 d0d4e9a..436fd88 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -220,7 +220,7 @@ perl_destruct(pTHXx)
     /* Pass 1 on any remaining threads: detach joinables, join zombies */
   retry_cleanup:
     MUTEX_LOCK(&PL_threads_mutex);
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+    DEBUG_S(PerlIO_printf(Perl_debug_log,
                          "perl_destruct: waiting for %d threads...\n",
                          PL_nthreads - 1));
     for (t = thr->next; t != thr; t = t->next) {
@@ -228,7 +228,7 @@ perl_destruct(pTHXx)
        switch (ThrSTATE(t)) {
            AV *av;
        case THRf_ZOMBIE:
-           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "perl_destruct: joining zombie %p\n", t));
            ThrSETSTATE(t, THRf_DEAD);
            MUTEX_UNLOCK(&t->mutex);
@@ -242,11 +242,11 @@ perl_destruct(pTHXx)
            MUTEX_UNLOCK(&PL_threads_mutex);
            JOIN(t, &av);
            SvREFCNT_dec((SV*)av);
-           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "perl_destruct: joined zombie %p OK\n", t));
            goto retry_cleanup;
        case THRf_R_JOINABLE:
-           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "perl_destruct: detaching thread %p\n", t));
            ThrSETSTATE(t, THRf_R_DETACHED);
            /* 
@@ -260,7 +260,7 @@ perl_destruct(pTHXx)
            MUTEX_UNLOCK(&t->mutex);
            goto retry_cleanup;
        default:
-           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "perl_destruct: ignoring %p (state %u)\n",
                                  t, ThrSTATE(t)));
            MUTEX_UNLOCK(&t->mutex);
@@ -272,14 +272,14 @@ perl_destruct(pTHXx)
     /* Pass 2 on remaining threads: wait for the thread count to drop to one */
     while (PL_nthreads > 1)
     {
-       DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+       DEBUG_S(PerlIO_printf(Perl_debug_log,
                              "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_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: armageddon has arrived\n"));
+    DEBUG_S(PerlIO_printf(Perl_debug_log, "perl_destruct: armageddon has arrived\n"));
     MUTEX_DESTROY(&PL_threads_mutex);
     COND_DESTROY(&PL_nthreads_cond);
 #endif /* !defined(FAKE_THREADS) */
@@ -429,6 +429,7 @@ perl_destruct(pTHXx)
     PL_argvgv = Nullgv;
     PL_argvoutgv = Nullgv;
     PL_stdingv = Nullgv;
+    PL_stderrgv = Nullgv;
     PL_last_in_gv = Nullgv;
     PL_replgv = Nullgv;
 
@@ -654,7 +655,7 @@ setuid perl scripts securely.\n");
            call_list(oldscope, PL_endav);
        return STATUS_NATIVE_EXPORT;
     case 3:
-       PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");
+       PerlIO_printf(Perl_error_log, "panic: top_env\n");
        return 1;
     }
     return 0;
@@ -1034,7 +1035,7 @@ perl_run(pTHXx)
            POPSTACK_TO(PL_mainstack);
            goto redo_body;
        }
-       PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
+       PerlIO_printf(Perl_error_log, "panic: restartop\n");
        FREETMPS;
        return 1;
     }
@@ -1059,7 +1060,7 @@ S_run_body(pTHX_ va_list args)
                              (unsigned long) thr));
 
        if (PL_minus_c) {
-           PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", PL_origfilename);
+           PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename);
            my_exit(0);
        }
        if (PERLDB_SINGLE && PL_DBsingle)
@@ -2636,9 +2637,9 @@ S_init_predump_symbols(pTHX)
     GvMULTI_on(tmpgv);
     GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
-    othergv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
-    GvMULTI_on(othergv);
-    io = GvIOp(othergv);
+    PL_stderrgv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
+    GvMULTI_on(PL_stderrgv);
+    io = GvIOp(PL_stderrgv);
     IoOFP(io) = IoIFP(io) = PerlIO_stderr();
     tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);
@@ -2877,7 +2878,7 @@ S_incpush(pTHX_ char *p, int addsubdirs)
                sv_usepvn(libdir,unix,len);
            }
            else
-               PerlIO_printf(PerlIO_stderr(),
+               PerlIO_printf(Perl_error_log,
                              "Failed to unixify @INC element \"%s\"\n",
                              SvPV(libdir,len));
 #endif
@@ -3037,7 +3038,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
                PL_curcop->cop_line = oldline;
                JMPENV_JUMP(3);
            }
-           PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
+           PerlIO_printf(Perl_error_log, "panic: restartop\n");
            FREETMPS;
            break;
        }
diff --git a/perl.h b/perl.h
index 48765ee..8aec1fd 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1959,7 +1959,13 @@ Gid_t getegid (void);
 #endif
 
 #ifndef Perl_debug_log
-#define Perl_debug_log PerlIO_stderr()
+#  define Perl_debug_log       PerlIO_stderr()
+#endif
+
+#ifndef Perl_error_log
+#  define Perl_error_log       (PL_stderrgv                    \
+                                ? IoOFP(GvIOp(PL_stderrgv))    \
+                                : PerlIO_stderr())
 #endif
 
 #ifdef DEBUGGING
index 4c22d3b..81f7d67 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -553,11 +553,9 @@ PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
   {
    if (strlen(s) >= (STRLEN)n)
     {
-     PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
-     {
-      dTHX;
-      my_exit(1);
-     }
+     dTHX;
+     PerlIO_puts(Perl_error_log,"panic: sprintf overflow - memory corrupted!\n");
+     my_exit(1);
     }
   }
  return val;
diff --git a/pp.c b/pp.c
index 2948d3a..6b45946 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -5170,7 +5170,7 @@ Perl_unlock_condpair(pTHX_ void *svv)
        Perl_croak(aTHX_ "panic: unlock_condpair unlocking mutex that we don't own");
     MgOWNER(mg) = 0;
     COND_SIGNAL(MgOWNERCONDP(mg));
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n",
+    DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%lx: unlock 0x%lx\n",
                          (unsigned long)thr, (unsigned long)svv);)
     MUTEX_UNLOCK(MgMUTEXP(mg));
 }
@@ -5195,7 +5195,7 @@ PP(pp_lock)
        while (MgOWNER(mg))
            COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
        MgOWNER(mg) = thr;
-       DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
+       DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%lx: pp_lock lock 0x%lx\n",
                              (unsigned long)thr, (unsigned long)sv);)
        MUTEX_UNLOCK(MgMUTEXP(mg));
        SAVEDESTRUCTOR(Perl_unlock_condpair, sv);
index e849e33..c2409ba 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -330,9 +330,9 @@ PP(pp_formline)
            case FF_END:        name = "END";           break;
            }
            if (arg >= 0)
-               PerlIO_printf(PerlIO_stderr(), "%-16s%ld\n", name, (long) arg);
+               PerlIO_printf(Perl_debug_log, "%-16s%ld\n", name, (long) arg);
            else
-               PerlIO_printf(PerlIO_stderr(), "%-16s\n", name);
+               PerlIO_printf(Perl_debug_log, "%-16s\n", name);
        } )
        switch (*fpc++) {
        case FF_LINEMARK:
@@ -1315,8 +1315,8 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
 
            POPBLOCK(cx,PL_curpm);
            if (CxTYPE(cx) != CXt_EVAL) {
-               PerlIO_write(PerlIO_stderr(), "panic: die ", 11);
-               PerlIO_write(PerlIO_stderr(), message, msglen);
+               PerlIO_write(Perl_error_log, "panic: die ", 11);
+               PerlIO_write(Perl_error_log, message, msglen);
                my_exit(1);
            }
            POPEVAL(cx);
@@ -1342,8 +1342,10 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
        /* SFIO can really mess with your errno */
        int e = errno;
 #endif
-       PerlIO_write(PerlIO_stderr(), message, msglen);
-       (void)PerlIO_flush(PerlIO_stderr());
+       PerlIO *serr = Perl_error_log;
+
+       PerlIO_write(serr, message, msglen);
+       (void)PerlIO_flush(serr);
 #ifdef USE_SFIO
        errno = e;
 #endif
index 904ee9f..a25f000 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2294,7 +2294,7 @@ try_autoload:
            while (MgOWNER(mg))
                COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
            MgOWNER(mg) = thr;
-           DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: pp_entersub lock %p\n",
+           DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: pp_entersub lock %p\n",
                                  thr, sv);)
            MUTEX_UNLOCK(MgMUTEXP(mg));
            SAVEDESTRUCTOR(Perl_unlock_condpair, sv);
@@ -2336,7 +2336,7 @@ try_autoload:
            /* We already have a clone to use */
            MUTEX_UNLOCK(CvMUTEXP(cv));
            cv = *(CV**)svp;
-           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "entersub: %p already has clone %p:%s\n",
                                  thr, cv, SvPEEK((SV*)cv)));
            CvOWNER(cv) = thr;
@@ -2350,7 +2350,7 @@ try_autoload:
                CvOWNER(cv) = thr;
                SvREFCNT_inc(cv);
                MUTEX_UNLOCK(CvMUTEXP(cv));
-               DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+               DEBUG_S(PerlIO_printf(Perl_debug_log,
                            "entersub: %p grabbing %p:%s in stash %s\n",
                            thr, cv, SvPEEK((SV*)cv), CvSTASH(cv) ?
                                HvNAME(CvSTASH(cv)) : "(none)"));
@@ -2360,7 +2360,7 @@ try_autoload:
                CV *clonecv;
                SvREFCNT_inc(cv); /* don't let it vanish from under us */
                MUTEX_UNLOCK(CvMUTEXP(cv));
-               DEBUG_S((PerlIO_printf(PerlIO_stderr(),
+               DEBUG_S((PerlIO_printf(Perl_debug_log,
                                       "entersub: %p cloning %p:%s\n",
                                       thr, cv, SvPEEK((SV*)cv))));
                /*
@@ -2378,7 +2378,7 @@ try_autoload:
                SvREFCNT_inc(cv);
            }
            DEBUG_S(if (CvDEPTH(cv) != 0)
-                       PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n",
+                       PerlIO_printf(Perl_debug_log, "depth %ld != 0\n",
                                      CvDEPTH(cv)););
            SAVEDESTRUCTOR(unset_cvowner, (void*) cv);
        }
@@ -2531,7 +2531,7 @@ try_autoload:
            SV** ary;
 
 #if 0
-           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "%p entersub preparing @_\n", thr));
 #endif
            av = (AV*)PL_curpad[0];
@@ -2573,7 +2573,7 @@ try_autoload:
            && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
            sub_crush_depth(cv);
 #if 0
-       DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+       DEBUG_S(PerlIO_printf(Perl_debug_log,
                              "%p entersub returning %p\n", thr, CvSTART(cv)));
 #endif
        RETURNOP(CvSTART(cv));
@@ -2792,11 +2792,11 @@ unset_cvowner(pTHXo_ void *cvarg)
     dTHR;
 #endif /* DEBUGGING */
 
-    DEBUG_S((PerlIO_printf(PerlIO_stderr(), "%p unsetting CvOWNER of %p:%s\n",
+    DEBUG_S((PerlIO_printf(Perl_debug_log, "%p unsetting CvOWNER of %p:%s\n",
                           thr, cv, SvPEEK((SV*)cv))));
     MUTEX_LOCK(CvMUTEXP(cv));
     DEBUG_S(if (CvDEPTH(cv) != 0)
-               PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n",
+               PerlIO_printf(Perl_debug_log, "depth %ld != 0\n",
                              CvDEPTH(cv)););
     assert(thr == CvOWNER(cv));
     CvOWNER(cv) = 0;
index a567353..0c4cc95 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -3047,7 +3047,7 @@ S_regmatch(pTHX_ regnode *prog)
                next = NULL;
            break;
        default:
-           PerlIO_printf(PerlIO_stderr(), "%lx %d\n",
+           PerlIO_printf(Perl_error_log, "%lx %d\n",
                          (unsigned long)scan, OP(scan));
            Perl_croak(aTHX_ "regexp memory corruption");
        }
diff --git a/scope.c b/scope.c
index 44c3d92..8952f43 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -437,7 +437,7 @@ Perl_save_threadsv(pTHX_ PADOFFSET i)
 #ifdef USE_THREADS
     dTHR;
     SV **svp = &THREADSV(i);   /* XXX Change to save by offset */
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n",
+    DEBUG_S(PerlIO_printf(Perl_debug_log, "save_threadsv %u: %p %p:%s\n",
                          i, svp, *svp, SvPEEK(*svp)));
     save_svref(svp);
     return svp;
@@ -646,7 +646,7 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
        restore_sv:
            sv = *(SV**)ptr;
-           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "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/scope.h b/scope.h
index efaf589..c975cd1 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -260,7 +260,7 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ int *, protect_body_t, ...);
        }                                                       \
        if ((v) == 2)                                           \
            PerlProc_exit(STATUS_NATIVE_EXPORT);                \
-       PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");     \
+       PerlIO_printf(Perl_error_log, "panic: top_env\n");      \
        PerlProc_exit(1);                                       \
     } STMT_END
 
diff --git a/sv.c b/sv.c
index ba5833f..3d613d5 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5640,8 +5640,7 @@ static void
 do_report_used(pTHXo_ SV *sv)
 {
     if (SvTYPE(sv) != SVTYPEMASK) {
-       /* XXX Perhaps this ought to go to Perl_debug_log, if DEBUGGING. */
-       PerlIO_printf(PerlIO_stderr(), "****\n");
+       PerlIO_printf(Perl_debug_log, "****\n");
        sv_dump(sv);
     }
 }
index f09143d..1e2a220 100644 (file)
--- a/thread.h
+++ b/thread.h
@@ -314,7 +314,7 @@ struct perl_thread *getTHR (void);
 #define ThrSETSTATE(t, s) STMT_START {         \
        (t)->flags &= ~THRf_STATE_MASK;         \
        (t)->flags |= (s);                      \
-       DEBUG_S(PerlIO_printf(PerlIO_stderr(),  \
+       DEBUG_S(PerlIO_printf(Perl_debug_log,   \
                              "thread %p set to state %d\n", (t), (s))); \
     } STMT_END
 
diff --git a/toke.c b/toke.c
index a08673f..ea95f3a 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2266,7 +2266,8 @@ Perl_yylex(pTHX)
     PL_oldoldbufptr = PL_oldbufptr;
     PL_oldbufptr = s;
     DEBUG_p( {
-       PerlIO_printf(PerlIO_stderr(), "### Tokener expecting %s at %s\n", exp_name[PL_expect], s);
+       PerlIO_printf(Perl_debug_log, "### Tokener expecting %s at %s\n",
+                     exp_name[PL_expect], s);
     } )
 
   retry:
diff --git a/util.c b/util.c
index 97401ab..24af662 100644 (file)
--- a/util.c
+++ b/util.c
@@ -85,7 +85,7 @@ Perl_safesysmalloc(MEM_SIZE size)
     Malloc_t ptr;
 #ifdef HAS_64K_LIMIT
        if (size > 0xffff) {
-           PerlIO_printf(PerlIO_stderr(),
+           PerlIO_printf(Perl_error_log,
                          "Allocation too large: %lx\n", size) FLUSH;
            my_exit(1);
        }
@@ -101,7 +101,7 @@ Perl_safesysmalloc(MEM_SIZE size)
     else if (PL_nomemok)
        return Nullch;
     else {
-       PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
+       PerlIO_puts(Perl_error_log,PL_no_mem) FLUSH;
        my_exit(1);
         return Nullch;
     }
@@ -121,7 +121,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 
 #ifdef HAS_64K_LIMIT 
     if (size > 0xffff) {
-       PerlIO_printf(PerlIO_stderr(),
+       PerlIO_printf(Perl_error_log,
                      "Reallocation too large: %lx\n", size) FLUSH;
        my_exit(1);
     }
@@ -147,7 +147,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
     else if (PL_nomemok)
        return Nullch;
     else {
-       PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
+       PerlIO_puts(Perl_error_log,PL_no_mem) FLUSH;
        my_exit(1);
        return Nullch;
     }
@@ -177,7 +177,7 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
 
 #ifdef HAS_64K_LIMIT
     if (size * count > 0xffff) {
-       PerlIO_printf(PerlIO_stderr(),
+       PerlIO_printf(Perl_error_log,
                      "Allocation too large: %lx\n", size * count) FLUSH;
        my_exit(1);
     }
@@ -196,7 +196,7 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
     else if (PL_nomemok)
        return Nullch;
     else {
-       PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
+       PerlIO_puts(Perl_error_log,PL_no_mem) FLUSH;
        my_exit(1);
        return Nullch;
     }
@@ -298,7 +298,7 @@ S_xstat(pTHX_ int flag)
        subtot[j] = 0;
     }
     
-    PerlIO_printf(PerlIO_stderr(), "   Id  subtot   4   8  12  16  20  24  28  32  36  40  48  56  64  72  80 80+\n", total);
+    PerlIO_printf(Perl_debug_log, "   Id  subtot   4   8  12  16  20  24  28  32  36  40  48  56  64  72  80 80+\n", total);
     for (i = 0; i < MAXXCOUNT; i++) {
        total += xcount[i];
        for (j = 0; j < MAXYCOUNT; j++) {
@@ -309,7 +309,7 @@ S_xstat(pTHX_ int flag)
            : (flag == 2 
               ? xcount[i] != lastxcount[i] /* Changed */
               : xcount[i] > lastxcount[i])) { /* Growed */
-           PerlIO_printf(PerlIO_stderr(),"%2d %02d %7ld ", i / 100, i % 100, 
+           PerlIO_printf(Perl_debug_log,"%2d %02d %7ld ", i / 100, i % 100, 
                          flag == 2 ? xcount[i] - lastxcount[i] : xcount[i]);
            lastxcount[i] = xcount[i];
            for (j = 0; j < MAXYCOUNT; j++) {
@@ -318,28 +318,28 @@ S_xstat(pTHX_ int flag)
                     : (flag == 2 
                        ? xycount[i][j] != lastxycount[i][j] /* Changed */
                        : xycount[i][j] > lastxycount[i][j])) { /* Growed */
-                   PerlIO_printf(PerlIO_stderr(),"%3ld ", 
+                   PerlIO_printf(Perl_debug_log,"%3ld ", 
                                  flag == 2 
                                  ? xycount[i][j] - lastxycount[i][j] 
                                  : xycount[i][j]);
                    lastxycount[i][j] = xycount[i][j];
                } else {
-                   PerlIO_printf(PerlIO_stderr(), "  . ", xycount[i][j]);
+                   PerlIO_printf(Perl_debug_log, "  . ", xycount[i][j]);
                }
            }
-           PerlIO_printf(PerlIO_stderr(), "\n");
+           PerlIO_printf(Perl_debug_log, "\n");
        }
     }
     if (flag != 2) {
-       PerlIO_printf(PerlIO_stderr(), "Total %7ld ", total);
+       PerlIO_printf(Perl_debug_log, "Total %7ld ", total);
        for (j = 0; j < MAXYCOUNT; j++) {
            if (subtot[j]) {
-               PerlIO_printf(PerlIO_stderr(), "%3ld ", subtot[j]);
+               PerlIO_printf(Perl_debug_log, "%3ld ", subtot[j]);
            } else {
-               PerlIO_printf(PerlIO_stderr(), "  . ");
+               PerlIO_printf(Perl_debug_log, "  . ");
            }
        }
-       PerlIO_printf(PerlIO_stderr(), "\n");   
+       PerlIO_printf(Perl_debug_log, "\n");    
     }
 }
 
@@ -711,41 +711,41 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
        if (locwarn) {
 #ifdef LC_ALL
   
-           PerlIO_printf(PerlIO_stderr(),
+           PerlIO_printf(Perl_error_log,
               "perl: warning: Setting locale failed.\n");
 
 #else /* !LC_ALL */
   
-           PerlIO_printf(PerlIO_stderr(),
+           PerlIO_printf(Perl_error_log,
               "perl: warning: Setting locale failed for the categories:\n\t");
 #ifdef USE_LOCALE_CTYPE
            if (! curctype)
-               PerlIO_printf(PerlIO_stderr(), "LC_CTYPE ");
+               PerlIO_printf(Perl_error_log, "LC_CTYPE ");
 #endif /* USE_LOCALE_CTYPE */
 #ifdef USE_LOCALE_COLLATE
            if (! curcoll)
-               PerlIO_printf(PerlIO_stderr(), "LC_COLLATE ");
+               PerlIO_printf(Perl_error_log, "LC_COLLATE ");
 #endif /* USE_LOCALE_COLLATE */
 #ifdef USE_LOCALE_NUMERIC
            if (! curnum)
-               PerlIO_printf(PerlIO_stderr(), "LC_NUMERIC ");
+               PerlIO_printf(Perl_error_log, "LC_NUMERIC ");
 #endif /* USE_LOCALE_NUMERIC */
-           PerlIO_printf(PerlIO_stderr(), "\n");
+           PerlIO_printf(Perl_error_log, "\n");
 
 #endif /* LC_ALL */
 
-           PerlIO_printf(PerlIO_stderr(),
+           PerlIO_printf(Perl_error_log,
                "perl: warning: Please check that your locale settings:\n");
 
 #ifdef __GLIBC__
-           PerlIO_printf(PerlIO_stderr(),
+           PerlIO_printf(Perl_error_log,
                          "\tLANGUAGE = %c%s%c,\n",
                          language ? '"' : '(',
                          language ? language : "unset",
                          language ? '"' : ')');
 #endif
 
-           PerlIO_printf(PerlIO_stderr(),
+           PerlIO_printf(Perl_error_log,
                          "\tLC_ALL = %c%s%c,\n",
                          lc_all ? '"' : '(',
                          lc_all ? lc_all : "unset",
@@ -757,18 +757,18 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
                  if (strnEQ(*e, "LC_", 3)
                        && strnNE(*e, "LC_ALL=", 7)
                        && (p = strchr(*e, '=')))
-                     PerlIO_printf(PerlIO_stderr(), "\t%.*s = \"%s\",\n",
+                     PerlIO_printf(Perl_error_log, "\t%.*s = \"%s\",\n",
                                    (int)(p - *e), *e, p + 1);
              }
            }
 
-           PerlIO_printf(PerlIO_stderr(),
+           PerlIO_printf(Perl_error_log,
                          "\tLANG = %c%s%c\n",
                          lang ? '"' : '(',
                          lang ? lang : "unset",
                          lang ? '"' : ')');
 
-           PerlIO_printf(PerlIO_stderr(),
+           PerlIO_printf(Perl_error_log,
                          "    are supported and installed on your system.\n");
        }
 
@@ -776,13 +776,13 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 
        if (setlocale(LC_ALL, "C")) {
            if (locwarn)
-               PerlIO_printf(PerlIO_stderr(),
+               PerlIO_printf(Perl_error_log,
       "perl: warning: Falling back to the standard locale (\"C\").\n");
            ok = 0;
        }
        else {
            if (locwarn)
-               PerlIO_printf(PerlIO_stderr(),
+               PerlIO_printf(Perl_error_log,
       "perl: warning: Failed to fall back to the standard locale (\"C\").\n");
            ok = -1;
        }
@@ -802,7 +802,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
            )
        {
            if (locwarn)
-               PerlIO_printf(PerlIO_stderr(),
+               PerlIO_printf(Perl_error_log,
       "perl: warning: Cannot fall back to the standard locale (\"C\").\n");
            ok = -1;
        }
@@ -1463,7 +1463,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
     SV *msv;
     STRLEN msglen;
 
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+    DEBUG_S(PerlIO_printf(Perl_debug_log,
                          "%p: die: curstack = %p, mainstack = %p\n",
                          thr, PL_curstack, PL_mainstack));
 
@@ -1481,7 +1481,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
        message = Nullch;
     }
 
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+    DEBUG_S(PerlIO_printf(Perl_debug_log,
                          "%p: die: message = %s\ndiehook = %p\n",
                          thr, message, PL_diehook));
     if (PL_diehook) {
@@ -1521,7 +1521,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
     }
 
     PL_restartop = die_where(message, msglen);
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+    DEBUG_S(PerlIO_printf(Perl_debug_log,
          "%p: die: restartop = %p, was_in_eval = %d, top_env = %p\n",
          thr, PL_restartop, was_in_eval, PL_top_env));
     if ((!PL_restartop && was_in_eval) || PL_top_env->je_prev)
@@ -1574,7 +1574,7 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args)
     else
        message = SvPV(msv,msglen);
 
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s",
+    DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%lx %s",
                          (unsigned long) thr, message));
 
     if (PL_diehook) {
@@ -1612,8 +1612,10 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args)
        /* SFIO can really mess with your errno */
        int e = errno;
 #endif
-       PerlIO_write(PerlIO_stderr(), message, msglen);
-       (void)PerlIO_flush(PerlIO_stderr());
+       PerlIO *serr = Perl_error_log;
+
+       PerlIO_write(serr, message, msglen);
+       (void)PerlIO_flush(serr);
 #ifdef USE_SFIO
        errno = e;
 #endif
@@ -1685,16 +1687,20 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args)
            return;
        }
     }
-    PerlIO_write(PerlIO_stderr(), message, msglen);
+    {
+       PerlIO *serr = Perl_error_log;
+
+       PerlIO_write(serr, message, msglen);
 #ifdef LEAKTEST
-    DEBUG_L(*message == '!' 
-           ? (xstat(message[1]=='!'
-                    ? (message[2]=='!' ? 2 : 1)
-                    : 0)
-              , 0)
-           : 0);
+       DEBUG_L(*message == '!' 
+               ? (xstat(message[1]=='!'
+                        ? (message[2]=='!' ? 2 : 1)
+                        : 0)
+                  , 0)
+               : 0);
 #endif
-    (void)PerlIO_flush(PerlIO_stderr());
+       (void)PerlIO_flush(serr);
+    }
 }
 
 #if defined(PERL_IMPLICIT_CONTEXT)
@@ -1755,7 +1761,7 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
 
     if (ckDEAD(err)) {
 #ifdef USE_THREADS
-        DEBUG_S(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s", (unsigned long) thr, message));
+        DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%lx %s", (unsigned long) thr, message));
 #endif /* USE_THREADS */
         if (PL_diehook) {
             /* sv_2cv might call Perl_croak() */
@@ -1786,8 +1792,11 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
             PL_restartop = die_where(message, msglen);
             JMPENV_JUMP(3);
         }
-        PerlIO_write(PerlIO_stderr(), message, msglen);
-        (void)PerlIO_flush(PerlIO_stderr());
+       {
+           PerlIO *serr = Perl_error_log;
+           PerlIO_write(serr, message, msglen);
+           (void)PerlIO_flush(serr);
+       }
         my_failure_exit();
 
     }
@@ -1819,11 +1828,14 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
                 return;
             }
         }
-        PerlIO_write(PerlIO_stderr(), message, msglen);
+       {
+           PerlIO *serr = Perl_error_log;
+           PerlIO_write(serr, message, msglen);
 #ifdef LEAKTEST
-        DEBUG_L(xstat());
+           DEBUG_L(xstat());
 #endif
-        (void)PerlIO_flush(PerlIO_stderr());
+           (void)PerlIO_flush(serr);
+       }
     }
 }
 
@@ -2373,12 +2385,12 @@ Perl_dump_fds(pTHX_ char *s)
     int fd;
     struct stat tmpstatbuf;
 
-    PerlIO_printf(PerlIO_stderr(),"%s", s);
+    PerlIO_printf(Perl_debug_log,"%s", s);
     for (fd = 0; fd < 32; fd++) {
        if (PerlLIO_fstat(fd,&tmpstatbuf) >= 0)
-           PerlIO_printf(PerlIO_stderr()," %d",fd);
+           PerlIO_printf(Perl_debug_log," %d",fd);
     }
-    PerlIO_printf(PerlIO_stderr(),"\n");
+    PerlIO_printf(Perl_debug_log,"\n");
 }
 #endif /* DUMP_FDS */
 
@@ -3342,7 +3354,7 @@ Perl_condpair_magic(pTHX_ SV *sv)
            mg->mg_ptr = (char *)cp;
            mg->mg_len = sizeof(cp);
            MUTEX_UNLOCK(&PL_cred_mutex);       /* XXX need separate mutex? */
-           DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log,
                                           "%p: condpair_magic %p\n", thr, sv));)
        }
     }
@@ -3460,7 +3472,7 @@ Perl_new_struct_thread(pTHX_ 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_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                "new_struct_thread: copied threadsv %d %p->%p\n",i, t, thr));
        }
     } 
index 34dbb4e..d959fbd 100644 (file)
@@ -105,13 +105,13 @@ dl_load_file(filename,flags=0)
     PREINIT:
     CODE:
   {
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename));
     if (dl_static_linked(filename) == 0) {
        RETVAL = PerlProc_DynaLoad(filename);
     }
     else
        RETVAL = (void*) GetModuleHandle(NULL);
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
        SaveError(aTHXo_ "load_file:%s",
@@ -125,10 +125,10 @@ dl_find_symbol(libhandle, symbolname)
     void *     libhandle
     char *     symbolname
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n",
                      libhandle, symbolname));
     RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"  symbolref = %x\n", RETVAL));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"  symbolref = %x\n", RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
        SaveError(aTHXo_ "find_symbol:%s",
@@ -151,7 +151,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *             symref 
     char *             filename
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
                      perl_name, symref));
     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
                                        (void(*)(pTHXo_ CV *))symref,
index 1d61eb7..a2a6502 100644 (file)
@@ -208,9 +208,9 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
 
        /* try to get full path to binary (which may be mangled when perl is
         * run from a 16-bit app) */
-       /*PerlIO_printf(PerlIO_stderr(), "Before %s\n", w32_module_name);*/
+       /*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/
        (void)win32_longpath(w32_module_name);
-       /*PerlIO_printf(PerlIO_stderr(), "After  %s\n", w32_module_name);*/
+       /*PerlIO_printf(Perl_debug_log, "After  %s\n", w32_module_name);*/
 
        /* normalize to forward slashes */
        ptr = w32_module_name;
@@ -1118,7 +1118,7 @@ win32_longpath(char *path)
        }
        else {
            /* failed a step, just return without side effects */
-           /*PerlIO_printf(PerlIO_stderr(), "Failed to find %s\n", path);*/
+           /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/
            *start = sep;
            return Nullch;
        }
index 543fc13..1bca3c3 100644 (file)
@@ -92,7 +92,7 @@ Perl_thread_create(struct perl_thread *thr, thread_func_t *fn)
     DWORD junk;
     unsigned long th;
 
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+    DEBUG_S(PerlIO_printf(Perl_debug_log,
                          "%p: create OS thread\n", thr));
 #ifdef USE_RTL_THREAD_API
     /* See comment about USE_RTL_THREAD_API in win32thread.h */
@@ -123,7 +123,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_S(PerlIO_printf(PerlIO_stderr(),
+    DEBUG_S(PerlIO_printf(Perl_debug_log,
                          "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk));
     return thr->self ? 0 : -1;
 }