summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGurusamy Sarathy <gsar@cpan.org>1999-10-06 02:36:53 +0000
committerGurusamy Sarathy <gsar@cpan.org>1999-10-06 02:36:53 +0000
commitbf49b057b09bec860588a9b554c3a77683394722 (patch)
treefc9654fc3743f5dfbde82f6eb5729519d41f568d
parent65cec58980c279c041788ef30ee8617e63ab5229 (diff)
downloadperl-bf49b057b09bec860588a9b554c3a77683394722.tar.gz
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
-rw-r--r--cop.h6
-rw-r--r--doio.c2
-rw-r--r--embedvar.h3
-rw-r--r--ext/Devel/Peek/Peek.xs30
-rw-r--r--ext/DynaLoader/dl_aix.xs10
-rw-r--r--ext/DynaLoader/dl_beos.xs14
-rw-r--r--ext/DynaLoader/dl_cygwin.xs10
-rw-r--r--ext/DynaLoader/dl_dld.xs18
-rw-r--r--ext/DynaLoader/dl_dlopen.xs10
-rw-r--r--ext/DynaLoader/dl_hpux.xs16
-rw-r--r--ext/DynaLoader/dl_mpeix.xs10
-rw-r--r--ext/DynaLoader/dl_next.xs10
-rw-r--r--ext/DynaLoader/dl_rhapsody.xs10
-rw-r--r--ext/DynaLoader/dl_vmesa.xs10
-rw-r--r--ext/DynaLoader/dl_vms.xs36
-rw-r--r--ext/DynaLoader/dlutils.c4
-rw-r--r--ext/Thread/Thread.xs42
-rw-r--r--ext/Thread/typemap2
-rw-r--r--intrpvar.h1
-rw-r--r--malloc.c20
-rw-r--r--mg.c2
-rw-r--r--objXSUB.h2
-rw-r--r--op.c2
-rw-r--r--perl.c31
-rw-r--r--perl.h8
-rw-r--r--perlio.c8
-rw-r--r--pp.c4
-rw-r--r--pp_ctl.c14
-rw-r--r--pp_hot.c18
-rw-r--r--regexec.c2
-rw-r--r--scope.c4
-rw-r--r--scope.h2
-rw-r--r--sv.c3
-rw-r--r--thread.h2
-rw-r--r--toke.c3
-rw-r--r--util.c122
-rw-r--r--win32/dl_win32.xs10
-rw-r--r--win32/win32.c6
-rw-r--r--win32/win32thread.c4
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; 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;
}
diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs
index 96bce4e1d4..18003b22d2 100644
--- a/ext/DynaLoader/dl_aix.xs
+++ b/ext/DynaLoader/dl_aix.xs
@@ -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,
diff --git a/ext/DynaLoader/dl_beos.xs b/ext/DynaLoader/dl_beos.xs
index c26824e34e..8779d3c95d 100644
--- a/ext/DynaLoader/dl_beos.xs
+++ b/ext/DynaLoader/dl_beos.xs
@@ -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,
diff --git a/ext/DynaLoader/dl_cygwin.xs b/ext/DynaLoader/dl_cygwin.xs
index 7f74cdd83f..4055b058ef 100644
--- a/ext/DynaLoader/dl_cygwin.xs
+++ b/ext/DynaLoader/dl_cygwin.xs
@@ -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,
diff --git a/ext/DynaLoader/dl_dld.xs b/ext/DynaLoader/dl_dld.xs
index d427efa1d0..6910739663 100644
--- a/ext/DynaLoader/dl_dld.xs
+++ b/ext/DynaLoader/dl_dld.xs
@@ -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,
diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs
index 641db33514..94cd0173a1 100644
--- a/ext/DynaLoader/dl_dlopen.xs
+++ b/ext/DynaLoader/dl_dlopen.xs
@@ -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,
diff --git a/ext/DynaLoader/dl_hpux.xs b/ext/DynaLoader/dl_hpux.xs
index 180679fb71..2155165cdc 100644
--- a/ext/DynaLoader/dl_hpux.xs
+++ b/ext/DynaLoader/dl_hpux.xs
@@ -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,
diff --git a/ext/DynaLoader/dl_mpeix.xs b/ext/DynaLoader/dl_mpeix.xs
index 913e259cd9..eb46f037f1 100644
--- a/ext/DynaLoader/dl_mpeix.xs
+++ b/ext/DynaLoader/dl_mpeix.xs
@@ -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,
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;
}