----------------
____________________________________________________________________________
+[ 4303] By: gsar on 1999/10/06 03:22:46
+ Log: integrate cfgperl contents into mainline
+ Branch: perl
+ +> eg/cgi/dna_small_gif.uu eg/cgi/wilogo_gif.uu
+ - eg/cgi/dna.small.gif.uu eg/cgi/wilogo.gif.uu
+ !> (integrate 31 files)
+____________________________________________________________________________
+[ 4302] By: gsar on 1999/10/06 02:36:53
+ Log: 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()
+ Branch: perl
+ ! cop.h doio.c embedvar.h ext/Devel/Peek/Peek.xs
+ ! ext/DynaLoader/dl_aix.xs ext/DynaLoader/dl_beos.xs
+ ! ext/DynaLoader/dl_cygwin.xs ext/DynaLoader/dl_dld.xs
+ ! ext/DynaLoader/dl_dlopen.xs ext/DynaLoader/dl_hpux.xs
+ ! ext/DynaLoader/dl_mpeix.xs ext/DynaLoader/dl_next.xs
+ ! ext/DynaLoader/dl_rhapsody.xs ext/DynaLoader/dl_vmesa.xs
+ ! ext/DynaLoader/dl_vms.xs ext/DynaLoader/dlutils.c
+ ! ext/Thread/Thread.xs ext/Thread/typemap intrpvar.h malloc.c
+ ! mg.c objXSUB.h op.c perl.c perl.h perlio.c pp.c pp_ctl.c
+ ! pp_hot.c regexec.c scope.c scope.h sv.c thread.h toke.c util.c
+ ! win32/dl_win32.xs win32/win32.c win32/win32thread.c
+____________________________________________________________________________
+[ 4301] By: jhi on 1999/10/05 23:03:46
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ To: François Désarménien <desar@club-internet.fr>
+ Cc: "perl5-porters@perl.org" <perl5-porters@perl.org>
+ Subject: Re: Strange RE engine breakage in 5_61
+ Date: Mon, 4 Oct 1999 19:58:03 -0400
+ Message-ID: <19991004195803.A21760@monk.mps.ohio-state.edu>
+
+ (had to apply pat.t part manually because there
+ already were more tests than there was in _61)
+ Branch: cfgperl
+ ! regcomp.c regexec.c t/op/pat.t t/op/re_tests
+____________________________________________________________________________
+[ 4300] By: jhi on 1999/10/04 17:03:18
+ Log: From: Andy Dougherty <doughera@lafayette.edu>
+ To: Jarkko Hietaniemi <jhi@iki.fi>
+ cc: Perl Porters <perl5-porters@perl.org>, jhi@cc.hut.fi
+ Subject: Re: [ID 19991001.005] [_61] [PATCH] tarball fine on win32, zip isn't
+ Date: Mon, 4 Oct 1999 13:05:08 -0400 (EDT)
+ Message-ID: <Pine.SOL.4.10.9910041302550.6502-100000@maxwell.phys.lafayette.edu>
+ Branch: cfgperl
+ + eg/cgi/dna_small_gif.uu eg/cgi/wilogo_gif.uu
+ - eg/cgi/dna.small.gif.uu eg/cgi/wilogo.gif.uu
+ ! MANIFEST ext/B/defsubs_h.PL
+____________________________________________________________________________
+[ 4299] By: jhi on 1999/10/04 07:15:16
+ Log: From: Michael G Schwern <schwern@pobox.com>
+ To: perl5-porters@perl.org
+ Subject: Re: [PATCH av.c, op.c, perldiag.pod] "array field" -> "pseudo-hash field"
+ Date: Sun, 3 Oct 1999 17:34:17 -0400
+ Message-ID: <19991003173417.A4351@blackrider>
+ Branch: cfgperl
+ ! t/lib/fields.t t/pragma/constant.t
+____________________________________________________________________________
+[ 4298] By: gsar on 1999/10/04 04:57:53
+ Log: some compatibility macros were busted
+ Branch: perl
+ ! embed.h embed.pl toke.c
+____________________________________________________________________________
+[ 4297] By: jhi on 1999/10/03 17:50:59
+ Log: A better version of #4296.
+
+ From: Michael G Schwern <schwern@pobox.com>
+ To: perl5-porters@perl.org
+ Subject: [PATCH av.c, op.c, perldiag.pod] "array field" -> "pseudo-hash field"
+ Date: Sun, 3 Oct 1999 13:54:23 -0400
+ Message-ID: <19991003135423.A3050@blackrider>
+ Branch: cfgperl
+ ! av.c op.c pod/perldiag.pod
+____________________________________________________________________________
+[ 4296] By: jhi on 1999/10/03 17:21:01
+ Log: (Replaced by #4297.)
+
+ From: Michael G Schwern <schwern@pobox.com>
+ To: perl5-porters@perl.org
+ Subject: [PATCH av.c, perldiag.pod] Added field name to "No such array field"
+ Date: Sun, 3 Oct 1999 13:16:47 -0400
+ Message-ID: <19991003131647.A2816@blackrider>
+
+ plus changed the error message to say "No such pseudo-hash field"
+ as discussed in the above mail message.
+ Branch: cfgperl
+ ! av.c pod/perldiag.pod
+____________________________________________________________________________
+[ 4295] By: gsar on 1999/10/03 16:09:36
+ Log: avoid doing irrelevant things on 'make perl'
+ Branch: perl
+ ! Makefile.SH
+____________________________________________________________________________
+[ 4294] By: jhi on 1999/10/03 14:16:24
+ Log: Fix a typo in #4293 spotted by Graham Barr.
+ Branch: cfgperl
+ ! pod/perlref.pod
+____________________________________________________________________________
+[ 4293] By: jhi on 1999/10/03 11:31:22
+ Log: From: Michael G Schwern <schwern@blackrider.aocn.com>
+ To: perl5-porters@perl.org
+ Subject: Re: Should keys in pseudo-hashes -always- exist? [DOC PATCH]
+ Date: Sun, 3 Oct 1999 02:34:01 -0400
+ Message-ID: <19991003023401.A1520@blackrider>
+ Branch: cfgperl
+ ! pod/perlfunc.pod pod/perlref.pod
+____________________________________________________________________________
+[ 4292] By: jhi on 1999/10/03 09:23:16
+ Log: From: Barrie Slaymaker <barries@slaysys.com>
+ To: perl5-porters@perl.org
+ Subject: [PATCH 5.005_61] Benchmark.pm bugfix, tweaks
+ Date: Sun, 3 Oct 1999 00:09:51 -0400
+ Message-Id: <199910030409.AAA18228@jester.slaysys.com>
+ Branch: cfgperl
+ ! lib/Benchmark.pm
+____________________________________________________________________________
+[ 4291] By: jhi on 1999/10/02 23:43:53
+ Log: Be understanding about large file systems.
+ Branch: cfgperl
+ ! t/lib/syslfs.t t/op/lfs.t
+____________________________________________________________________________
+[ 4290] By: jhi on 1999/10/02 23:39:16
+ Log: Configure fixfest continues.
+ Branch: cfgperl
+ ! Configure config_h.SH
+ Branch: metaconfig
+ ! U/modified/d_longdbl.U U/modified/d_longlong.U
+ ! U/threads/d_pthreadj.U U/typedefs/gidsign.U
+ ! U/typedefs/gidsize.U U/typedefs/pidsign.U U/typedefs/pidsize.U
+ ! U/typedefs/uidsign.U U/typedefs/uidsize.U
+ Branch: metaconfig/U/perl
+ ! i_inttypes.U io64.U
+____________________________________________________________________________
+[ 4289] By: jhi on 1999/10/02 23:12:54
+ Log: Regen Porting stuff.
+ Branch: cfgperl
+ ! Porting/Glossary Porting/config.sh Porting/config_H
+____________________________________________________________________________
+[ 4288] By: jhi on 1999/10/02 23:05:50
+ Log: Untangle the IV_IS_QUAD jungle by introduding
+ macros to be used when doing formatted printing:
+ IVdf, UVuf, UVxf, UVof. Also introduce Uid_t_SIGN.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH doio.c dump.c op.c perl.h pp_hot.c pp_sys.c
+ ! regcomp.c sv.c taint.c toke.c util.c
+____________________________________________________________________________
+[ 4287] By: jhi on 1999/10/02 22:54:18
+ Log: metaconfig maintenance.
+ Branch: metaconfig
+ ! U/ebcdic/ebcdic.U U/typedefs/gidsign.U U/typedefs/gidsize.U
+ ! U/typedefs/pidsign.U U/typedefs/pidsize.U U/typedefs/uidsign.U
+ ! U/typedefs/uidsize.U
+____________________________________________________________________________
+[ 4286] By: nick on 1999/10/02 11:11:44
+ Log: Incremental merge of mainline
+ Branch: utfperl
+ +> README.Y2K hints/svr5.sh lib/Pod/Man.pm
+ +> lib/unicode/Unicode.html t/op/args.t t/pod/multiline_items.t
+ +> t/pod/multiline_items.xr t/pod/pod2usage.t t/pod/pod2usage.xr
+ +> t/pod/podselect.t t/pod/podselect.xr
+ - lib/Pod/PlainText.pm
+ !> (integrate 148 files)
+____________________________________________________________________________
+[ 4285] By: jhi on 1999/10/02 10:16:15
+ Log: Battle namespace pollution.
+ Branch: cfgperl
+ ! lib/Benchmark.pm
+____________________________________________________________________________
+[ 4284] By: jhi on 1999/10/02 10:11:20
+ Log: Regen Configure, all of xs_apiversion didn't take.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH patchlevel.h
+____________________________________________________________________________
+[ 4283] By: jhi on 1999/10/02 09:48:17
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ +> lib/Pod/Man.pm t/pod/multiline_items.t
+ +> t/pod/multiline_items.xr t/pod/pod2usage.t t/pod/pod2usage.xr
+ +> t/pod/podselect.t t/pod/podselect.xr
+ - lib/Pod/PlainText.pm
+ !> (integrate 50 files)
+____________________________________________________________________________
+[ 4282] By: gsar on 1999/10/02 06:39:14
+ Log: update pod2man, pod2text and related Pod:: modules with the
+ ones in podlators-0.07 from Russ Allbery
+ Branch: perl
+ + lib/Pod/Man.pm
+ ! lib/Pod/Text.pm lib/Pod/Text/Color.pm lib/Pod/Text/Termcap.pm
+ ! pod/pod2man.PL pod/pod2text.PL
+____________________________________________________________________________
+[ 4281] By: gsar on 1999/10/02 06:14:44
+ Log: fix PodParser testsuite; Pod::Text subsumes Pod::PlainText
+ Branch: perl
+ - lib/Pod/PlainText.pm
+ ! MANIFEST lib/Pod/Text.pm lib/Pod/Usage.pm pod/pod2usage.PL
+ ! pod/podchecker.PL pod/podselect.PL t/pod/emptycmd.t
+ ! t/pod/for.t t/pod/headings.t t/pod/include.t t/pod/included.t
+ ! t/pod/lref.t t/pod/multiline_items.t t/pod/nested_items.t
+ ! t/pod/nested_seqs.t t/pod/oneline_cmds.t t/pod/pod2usage.t
+ ! t/pod/poderrs.t t/pod/poderrs.xr t/pod/podselect.t
+ ! t/pod/special_seqs.t t/pod/testp2pt.pl t/pod/testpchk.pl
+____________________________________________________________________________
+[ 4280] By: gsar on 1999/10/02 04:39:38
+ Log: upgrade to PodParser-1.085 from Brad Appleton <bradapp@enteract.com>
+ Branch: perl
+ + t/pod/multiline_items.t t/pod/multiline_items.xr
+ + t/pod/pod2usage.t t/pod/pod2usage.xr t/pod/podselect.t
+ + t/pod/podselect.xr
+ ! MANIFEST lib/Pod/Checker.pm lib/Pod/InputObjects.pm
+ ! lib/Pod/Parser.pm lib/Pod/PlainText.pm lib/Pod/Select.pm
+ ! lib/Pod/Usage.pm t/pod/for.xr t/pod/headings.xr
+ ! t/pod/include.xr t/pod/included.xr t/pod/lref.xr
+ ! t/pod/nested_items.xr t/pod/nested_seqs.xr
+ ! t/pod/oneline_cmds.xr t/pod/poderrs.xr t/pod/special_seqs.xr
+ ! t/pod/testp2pt.pl
+____________________________________________________________________________
+[ 4279] By: gsar on 1999/10/02 03:36:41
+ Log: make exists() work better on pseudo-hashes (reworked a patch suggested
+ by Michael G Schwern <schwern@pobox.com>)
+ Branch: perl
+ ! av.c t/op/avhv.t
+____________________________________________________________________________
+[ 4278] By: gsar on 1999/10/02 02:36:55
+ Log: deprecate C<use attrs>
+ Branch: perl
+ ! ext/attrs/attrs.pm ext/attrs/attrs.xs t/lib/attrs.t
+ ! t/lib/thread.t t/pragma/sub_lval.t
+____________________________________________________________________________
+[ 4277] By: gsar on 1999/10/02 01:43:25
+ Log: add notes about effect of loop control statements inside
+ LABEL BLOCK continue BLOCK
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 4276] By: gsar on 1999/10/02 01:23:02
+ Log: indent nested =items properly (suggested by Bill Fenner
+ <fenner@research.att.com>)
+ Branch: perl
+ ! pod/pod2man.PL
+____________________________________________________________________________
+[ 4275] By: gsar on 1999/10/02 01:09:16
+ Log: updated ptags generator from Ilya Zakharevich
+ Branch: perl
+ ! emacs/ptags
+____________________________________________________________________________
+[ 4274] By: gsar on 1999/10/01 23:08:52
+ Log: update Changes
+ Branch: perl
+ ! Changes
+____________________________________________________________________________
[ 4273] By: gsar on 1999/10/01 22:58:55
Log: typo, whitespace adjustments
Branch: perl
.c$(OBJ_EXT):
$(CCCMD) $(PLDLFLAGS) $*.c
-all: $(FIRSTMAKEFILE) miniperl $(private) $(plextract) $(public) $(dynamic_ext) $(nonxs_ext)
+all: $(FIRSTMAKEFILE) miniperl $(private) $(public) $(dynamic_ext) $(nonxs_ext)
@echo " ";
@echo " Everything is up to date. 'make test' to run test suite."
translators: miniperl lib/Config.pm FORCE
@echo " "; echo " Making x2p stuff"; cd x2p; $(LDLIBPTH) $(MAKE) all
-utilities: miniperl lib/Config.pm FORCE
+utilities: miniperl lib/Config.pm $(plextract) FORCE
@echo " "; echo " Making utilities"; cd utils; $(LDLIBPTH) $(MAKE) all
# We have to call our ./makedir because Ultrix 4.3 make can't handle the line
# test -d lib/auto || mkdir lib/auto
#
-preplibrary: miniperl lib/Config.pm $(plextract)
+preplibrary: miniperl lib/Config.pm
@sh ./makedir lib/auto
@echo " AutoSplitting perl library"
$(LDLIBPTH) ./miniperl -Ilib -e 'use AutoSplit; \
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). */
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). */
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); \
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;
do_gv_dump(level, file, " FILEGV", CvFILEGV(sv));
Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
#ifdef USE_THREADS
- Perl_dump_indent(aTHX_ level, file, " MUTEXP = 0x%"UVxf"\n", PTR2UV(CvMUTEXP(sv));
- Perl_dump_indent(aTHX_ level, file, " OWNER = 0x%"UVxf"\n", PTR2UV(CvOWNER(sv));
+ Perl_dump_indent(aTHX_ level, file, " MUTEXP = 0x%"UVxf"\n", PTR2UV(CvMUTEXP(sv)));
+ Perl_dump_indent(aTHX_ level, file, " OWNER = 0x%"UVxf"\n", PTR2UV(CvOWNER(sv)));
#endif /* USE_THREADS */
Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", CvFLAGS(sv));
if (type == SVt_PVFM)
The following are not like that, but since they had a "perl_"
prefix in previous versions, we provide compatibility macros.
*/
-# define perl_atexit call_atexit
-# define perl_call_argv call_argv
-# define perl_call_pv call_pv
-# define perl_call_method call_method
-# define perl_call_sv call_sv
-# define perl_eval_sv eval_sv
-# define perl_eval_pv eval_pv
-# define perl_require_pv require_pv
-# define perl_get_sv get_sv
-# define perl_get_av get_av
-# define perl_get_hv get_hv
-# define perl_get_cv get_cv
-# define perl_init_i18nl10n init_i18nl10n
-# define perl_init_i18nl14n init_i18nl14n
-# define perl_new_ctype new_ctype
-# define perl_new_collate new_collate
-# define perl_new_numeric new_numeric
+# define perl_atexit(a,b) call_atexit(a,b)
+# define perl_call_argv(a,b,c) call_argv(a,b,c)
+# define perl_call_pv(a,b) call_pv(a,b)
+# define perl_call_method(a,b) call_method(a,b)
+# define perl_call_sv(a,b) call_sv(a,b)
+# define perl_eval_sv(a,b) eval_sv(a,b)
+# define perl_eval_pv(a,b) eval_pv(a,b)
+# define perl_require_pv(a) require_pv(a)
+# define perl_get_sv(a,b) get_sv(a,b)
+# define perl_get_av(a,b) get_av(a,b)
+# define perl_get_hv(a,b) get_hv(a,b)
+# define perl_get_cv(a,b) get_cv(a,b)
+# define perl_init_i18nl10n(a) init_i18nl10n(a)
+# define perl_init_i18nl14n(a) init_i18nl14n(a)
+# define perl_new_ctype(a) new_ctype(a)
+# define perl_new_collate(a) new_collate(a)
+# define perl_new_numeric(a) new_numeric(a)
/* varargs functions can't be handled with CPP macros. :-(
This provides a set of compatibility functions that don't take
The following are not like that, but since they had a "perl_"
prefix in previous versions, we provide compatibility macros.
*/
-# define perl_atexit call_atexit
-# define perl_call_argv call_argv
-# define perl_call_pv call_pv
-# define perl_call_method call_method
-# define perl_call_sv call_sv
-# define perl_eval_sv eval_sv
-# define perl_eval_pv eval_pv
-# define perl_require_pv require_pv
-# define perl_get_sv get_sv
-# define perl_get_av get_av
-# define perl_get_hv get_hv
-# define perl_get_cv get_cv
-# define perl_init_i18nl10n init_i18nl10n
-# define perl_init_i18nl14n init_i18nl14n
-# define perl_new_ctype new_ctype
-# define perl_new_collate new_collate
-# define perl_new_numeric new_numeric
+# define perl_atexit(a,b) call_atexit(a,b)
+# define perl_call_argv(a,b,c) call_argv(a,b,c)
+# define perl_call_pv(a,b) call_pv(a,b)
+# define perl_call_method(a,b) call_method(a,b)
+# define perl_call_sv(a,b) call_sv(a,b)
+# define perl_eval_sv(a,b) eval_sv(a,b)
+# define perl_eval_pv(a,b) eval_pv(a,b)
+# define perl_require_pv(a) require_pv(a)
+# define perl_get_sv(a,b) get_sv(a,b)
+# define perl_get_av(a,b) get_av(a,b)
+# define perl_get_hv(a,b) get_hv(a,b)
+# define perl_get_cv(a,b) get_cv(a,b)
+# define perl_init_i18nl10n(a) init_i18nl10n(a)
+# define perl_init_i18nl14n(a) init_i18nl14n(a)
+# define perl_new_ctype(a) new_ctype(a)
+# define perl_new_collate(a) new_collate(a)
+# define perl_new_numeric(a) new_numeric(a)
/* varargs functions can't be handled with CPP macros. :-(
This provides a set of compatibility functions that don't take
#define PL_srand_called (PERL_GET_INTERP->Isrand_called)
#define PL_statusvalue (PERL_GET_INTERP->Istatusvalue)
#define PL_statusvalue_vms (PERL_GET_INTERP->Istatusvalue_vms)
+#define PL_stderrgv (PERL_GET_INTERP->Istderrgv)
#define PL_stdingv (PERL_GET_INTERP->Istdingv)
#define PL_strchop (PERL_GET_INTERP->Istrchop)
#define PL_strtab (PERL_GET_INTERP->Istrtab)
#define PL_srand_called (vTHX->Isrand_called)
#define PL_statusvalue (vTHX->Istatusvalue)
#define PL_statusvalue_vms (vTHX->Istatusvalue_vms)
+#define PL_stderrgv (vTHX->Istderrgv)
#define PL_stdingv (vTHX->Istdingv)
#define PL_strchop (vTHX->Istrchop)
#define PL_strtab (vTHX->Istrtab)
#define PL_Isrand_called PL_srand_called
#define PL_Istatusvalue PL_statusvalue
#define PL_Istatusvalue_vms PL_statusvalue_vms
+#define PL_Istderrgv PL_stderrgv
#define PL_Istdingv PL_stdingv
#define PL_Istrchop PL_strchop
#define PL_Istrtab PL_strtab
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);
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);
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])) { */
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;
}
}
/* 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;
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;
}
}
}
- 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;
}
# 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
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;
}
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;
}
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()) ;
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()) ;
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,
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) );
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));
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,
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()) ;
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()) ;
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,
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__
}
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));
}
}
- 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;
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)
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) ;
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,
#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()) ;
#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)
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,
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) {
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)
#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));
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) {
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,
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
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)
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;
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") ;
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,
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()) ;
#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)
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,
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()) ;
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)
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,
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()) ;
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)
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,
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;
}
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;
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;
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;
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));
}
}
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;
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);
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 */
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,
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 */
/* 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));
}
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);
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;
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
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() */
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();
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);
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;
* 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 */
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 */
* 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);
}
#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)) {
} 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);
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)) {
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));
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));
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) {
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
|| 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
/* shortcuts to various I/O objects */
PERLVAR(Istdingv, GV *)
+PERLVAR(Istderrgv, GV *)
PERLVAR(Idefgv, GV *)
PERLVAR(Iargvgv, GV *)
PERLVAR(Iargvoutgv, GV *)
}
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 */
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");
#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
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));
/* 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) {
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);
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);
/*
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);
/* 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) */
PL_argvgv = Nullgv;
PL_argvoutgv = Nullgv;
PL_stdingv = Nullgv;
+ PL_stderrgv = Nullgv;
PL_last_in_gv = Nullgv;
PL_replgv = Nullgv;
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;
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;
}
(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)
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);
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
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;
}
#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
{
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;
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));
}
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);
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:
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);
/* 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
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);
/* 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;
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)"));
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))));
/*
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);
}
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];
&& !(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));
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;
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");
}
#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;
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) &&
} \
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
SvIVX(sv) = I_V(SvNVX(sv));
ret_zero:
DEBUG_c(PerlIO_printf(Perl_debug_log,
- "0x%"UVxf" 2uv(%"IVdf" => %"UVdf") (as signed)\n",
+ "0x%"UVxf" 2uv(%"IVdf" => %"IVdf") (as signed)\n",
PTR2UV(sv),
SvIVX(sv),
(IV)(UV)SvIVX(sv)));
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);
}
}
#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
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:
if (PL_oldoldbufptr &&
PL_oldoldbufptr < PL_bufptr &&
- (PL_oldoldbufptr == PL_last_lop || PL_oldoldbufptr == PL_last_uni) &&
+ (PL_oldoldbufptr == PL_last_lop
+ || PL_oldoldbufptr == PL_last_uni) &&
/* NO SKIPSPACE BEFORE HERE! */
(PL_expect == XREF ||
((PL_opargs[PL_last_lop_op] >> OASHIFT)& 7) == OA_FILEREF))
if (*w)
for (; *w && isSPACE(*w); w++) ;
if (!*w || !strchr(";|})]oaiuw!=", *w)) /* an advisory hack only... */
- Perl_warner(aTHX_ WARN_SYNTAX, "%s (...) interpreted as function",name);
+ Perl_warner(aTHX_ WARN_SYNTAX,
+ "%s (...) interpreted as function",name);
}
}
while (s < PL_bufend && isSPACE(*s))
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);
}
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;
}
#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);
}
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;
}
#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);
}
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;
}
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++) {
: (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++) {
: (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");
}
}
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",
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");
}
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;
}
)
{
if (locwarn)
- PerlIO_printf(PerlIO_stderr(),
+ PerlIO_printf(Perl_error_log,
"perl: warning: Cannot fall back to the standard locale (\"C\").\n");
ok = -1;
}
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));
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) {
}
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)
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) {
/* 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
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)
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() */
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();
}
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);
+ }
}
}
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 */
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));)
}
}
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));
}
}
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",
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",
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,
/* 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;
}
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;
}
#endif
#ifdef __GNUC__
-typedef long long __int64;
+# ifndef __int64 /* some versions seem to #define it already */
+# define __int64 long long
+# endif
# define Win32_Winsock
/* GCC does not do __declspec() - render it a nop
* and turn on options to avoid importing data
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 */
#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;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff