From bf49b057b09bec860588a9b554c3a77683394722 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Wed, 6 Oct 1999 02:36:53 +0000 Subject: make die/warn and other diagnostics go to wherever STDERR happens to point at; change places that meant Perl_debug_log rather than PerlIO_stderr() p4raw-id: //depot/perl@4302 --- cop.h | 6 +-- doio.c | 2 +- embedvar.h | 3 ++ ext/Devel/Peek/Peek.xs | 30 +++++------ ext/DynaLoader/dl_aix.xs | 10 ++-- ext/DynaLoader/dl_beos.xs | 14 ++--- ext/DynaLoader/dl_cygwin.xs | 10 ++-- ext/DynaLoader/dl_dld.xs | 18 +++---- ext/DynaLoader/dl_dlopen.xs | 10 ++-- ext/DynaLoader/dl_hpux.xs | 16 +++--- ext/DynaLoader/dl_mpeix.xs | 10 ++-- ext/DynaLoader/dl_next.xs | 10 ++-- ext/DynaLoader/dl_rhapsody.xs | 10 ++-- ext/DynaLoader/dl_vmesa.xs | 10 ++-- ext/DynaLoader/dl_vms.xs | 36 ++++++------- ext/DynaLoader/dlutils.c | 4 +- ext/Thread/Thread.xs | 42 +++++++-------- ext/Thread/typemap | 2 +- intrpvar.h | 1 + malloc.c | 20 +++---- mg.c | 2 +- objXSUB.h | 2 + op.c | 2 +- perl.c | 31 +++++------ perl.h | 8 ++- perlio.c | 8 ++- pp.c | 4 +- pp_ctl.c | 14 ++--- pp_hot.c | 18 +++---- regexec.c | 2 +- scope.c | 4 +- scope.h | 2 +- sv.c | 3 +- thread.h | 2 +- toke.c | 3 +- util.c | 122 +++++++++++++++++++++++------------------- win32/dl_win32.xs | 10 ++-- win32/win32.c | 6 +-- win32/win32thread.c | 4 +- 39 files changed, 268 insertions(+), 243 deletions(-) diff --git a/cop.h b/cop.h index e8221b610c..829bbe83be 100644 --- 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 2baecec6b1..1b59c37a45 100644 --- 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; diff --git a/embedvar.h b/embedvar.h index beaa960874..22a970ac55 100644 --- a/embedvar.h +++ b/embedvar.h @@ -377,6 +377,7 @@ #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) @@ -653,6 +654,7 @@ #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) @@ -931,6 +933,7 @@ #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 diff --git a/ext/Devel/Peek/Peek.xs b/ext/Devel/Peek/Peek.xs index df91476482..4f3400312e 100644 --- a/ext/Devel/Peek/Peek.xs +++ b/ext/Devel/Peek/Peek.xs @@ -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; ifilename," %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, diff --git a/ext/DynaLoader/dl_next.xs b/ext/DynaLoader/dl_next.xs index 54d4be07ab..36ef8b8d4f 100644 --- a/ext/DynaLoader/dl_next.xs +++ b/ext/DynaLoader/dl_next.xs @@ -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, diff --git a/ext/DynaLoader/dl_rhapsody.xs b/ext/DynaLoader/dl_rhapsody.xs index a56452ed7d..6cf2df794d 100644 --- a/ext/DynaLoader/dl_rhapsody.xs +++ b/ext/DynaLoader/dl_rhapsody.xs @@ -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, diff --git a/ext/DynaLoader/dl_vmesa.xs b/ext/DynaLoader/dl_vmesa.xs index 9e4908cecd..8595e440a6 100644 --- a/ext/DynaLoader/dl_vmesa.xs +++ b/ext/DynaLoader/dl_vmesa.xs @@ -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, diff --git a/ext/DynaLoader/dl_vms.xs b/ext/DynaLoader/dl_vms.xs index 409d586ae7..29ab7c31e2 100644 --- a/ext/DynaLoader/dl_vms.xs +++ b/ext/DynaLoader/dl_vms.xs @@ -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, diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c index 73911565d9..377d6dd5ad 100644 --- a/ext/DynaLoader/dlutils.c +++ b/ext/DynaLoader/dlutils.c @@ -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)); } diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index e01f29de06..09d063a992 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -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 diff --git a/ext/Thread/typemap b/ext/Thread/typemap index 21eb6c3240..7ce7d5cce3 100644 --- a/ext/Thread/typemap +++ b/ext/Thread/typemap @@ -13,7 +13,7 @@ T_XSCPTR || mg->mg_private != ${ntype}_MAGIC_SIGNATURE) croak(\"XSUB ${func_name}: $var is a forged ${ntype} object\"); $var = ($type) SvPVX(mg->mg_obj); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, \"XSUB ${func_name}: %p\\n\", $var);) } STMT_END T_IVREF diff --git a/intrpvar.h b/intrpvar.h index cc3eff5e0b..b9a3a3d20c 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -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 *) diff --git a/malloc.c b/malloc.c index 450142d452..4e3e0b8fdd 100644 --- 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 ca07b83467..f72d2875d8 100644 --- 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"); diff --git a/objXSUB.h b/objXSUB.h index 362af7a2f4..cd8f2d8612 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -420,6 +420,8 @@ #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 8f8e796ea2..bc47f6da57 100644 --- 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 d0d4e9ae17..436fd88cc6 100644 --- 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 48765ee2e7..8aec1fd47f 100644 --- 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 diff --git a/perlio.c b/perlio.c index 4c22d3b3cf..81f7d678ff 100644 --- 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 2948d3a89e..6b45946db4 100644 --- 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); diff --git a/pp_ctl.c b/pp_ctl.c index e849e33c68..c2409ba5f4 100644 --- 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 diff --git a/pp_hot.c b/pp_hot.c index 904ee9f878..a25f000d3c 100644 --- 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; diff --git a/regexec.c b/regexec.c index a567353311..0c4cc9546f 100644 --- 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 44c3d923a9..8952f43a59 100644 --- 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 efaf589092..c975cd188f 100644 --- 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 ba5833fad4..3d613d54ae 100644 --- 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); } } diff --git a/thread.h b/thread.h index f09143d1eb..1e2a220ff9 100644 --- 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 a08673f425..ea95f3a63d 100644 --- 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 97401ab9df..24af6622f8 100644 --- 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)); } } diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs index 34dbb4ee17..d959fbdae6 100644 --- a/win32/dl_win32.xs +++ b/win32/dl_win32.xs @@ -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, diff --git a/win32/win32.c b/win32/win32.c index 1d61eb78c9..a2a6502d7e 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -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; } diff --git a/win32/win32thread.c b/win32/win32thread.c index 543fc130f5..1bca3c3ca5 100644 --- a/win32/win32thread.c +++ b/win32/win32thread.c @@ -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; } -- cgit v1.2.1