X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/4608196e45589eea5792cff92b551109899ddb06..6814b069be7aa620af7196466dde7ea2c70e3849:/deb.c diff --git a/deb.c b/deb.c index e246b1a..bccfc18 100644 --- a/deb.c +++ b/deb.c @@ -1,7 +1,7 @@ /* deb.c * - * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, + * 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -9,8 +9,10 @@ */ /* - * "Didst thou think that the eyes of the White Tower were blind? Nay, I - * have seen more than thou knowest, Gray Fool." --Denethor + * 'Didst thou think that the eyes of the White Tower were blind? Nay, + * I have seen more than thou knowest, Grey Fool.' --Denethor + * + * [p.853 of _The Lord of the Rings_, V/vii: "The Pyre of Denethor"] */ /* @@ -29,6 +31,7 @@ Perl_deb_nocontext(const char *pat, ...) #ifdef DEBUGGING dTHX; va_list args; + PERL_ARGS_ASSERT_DEB_NOCONTEXT; va_start(args, pat); vdeb(pat, &args); va_end(args); @@ -41,14 +44,15 @@ Perl_deb_nocontext(const char *pat, ...) void Perl_deb(pTHX_ const char *pat, ...) { -#ifdef DEBUGGING va_list args; + PERL_ARGS_ASSERT_DEB; va_start(args, pat); +#ifdef DEBUGGING vdeb(pat, &args); - va_end(args); #else - PERL_UNUSED_ARG(pat); + PERL_UNUSED_CONTEXT; #endif /* DEBUGGING */ + va_end(args); } void @@ -56,12 +60,20 @@ Perl_vdeb(pTHX_ const char *pat, va_list *args) { #ifdef DEBUGGING dVAR; - const char* const file = OutCopFILE(PL_curcop); + const char* const file = PL_curcop ? OutCopFILE(PL_curcop) : ""; + const char* const display_file = file ? file : ""; + const long line = PL_curcop ? (long)CopLINE(PL_curcop) : 0; + + PERL_ARGS_ASSERT_VDEB; - PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", (file ? file : ""), - (long)CopLINE(PL_curcop)); + if (DEBUG_v_TEST) + PerlIO_printf(Perl_debug_log, "(%ld:%s:%ld)\t", + (long)PerlProc_getpid(), display_file, line); + else + PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", display_file, line); (void) PerlIO_vprintf(Perl_debug_log, pat, *args); #else + PERL_UNUSED_CONTEXT; PERL_UNUSED_ARG(pat); PERL_UNUSED_ARG(args); #endif /* DEBUGGING */ @@ -102,8 +114,11 @@ S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, { #ifdef DEBUGGING dVAR; - register I32 i = stack_max - 30; + I32 i = stack_max - 30; const I32 *markscan = PL_markstack + mark_min; + + PERL_ARGS_ASSERT_DEB_STACK_N; + if (i < stack_min) i = stack_min; @@ -133,6 +148,7 @@ S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, while (1); PerlIO_printf(Perl_debug_log, "\n"); #else + PERL_UNUSED_CONTEXT; PERL_UNUSED_ARG(stack_base); PERL_UNUSED_ARG(stack_min); PERL_UNUSED_ARG(stack_max); @@ -200,8 +216,8 @@ Perl_deb_stack_all(pTHX) si_ix=0; for (;;) { - const int si_name_ix = si->si_type+1; /* -1 is a valid index */ - const char * const si_name = (si_name_ix>= sizeof(si_names)) ? "????" : si_names[si_name_ix]; + const size_t si_name_ix = si->si_type+1; /* -1 is a valid index */ + const char * const si_name = (si_name_ix >= sizeof(si_names)) ? "????" : si_names[si_name_ix]; I32 ix; PerlIO_printf(Perl_debug_log, "STACK %"IVdf": %s\n", (IV)si_ix, si_name); @@ -286,8 +302,7 @@ Perl_deb_stack_all(pTHX) if (CxTYPE(cx) == CXt_EVAL || CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { - const OP * const retop = (CxTYPE(cx) == CXt_EVAL) - ? cx->blk_eval.retop : cx->blk_sub.retop; + const OP * const retop = cx->blk_sub.retop; PerlIO_printf(Perl_debug_log, " retop=%s\n", retop ? OP_NAME(retop) : "(null)" @@ -306,6 +321,8 @@ Perl_deb_stack_all(pTHX) } /* next stackinfo */ PerlIO_printf(Perl_debug_log, "\n"); +#else + PERL_UNUSED_CONTEXT; #endif /* DEBUGGING */ } @@ -313,8 +330,8 @@ Perl_deb_stack_all(pTHX) * Local variables: * c-indentation-style: bsd * c-basic-offset: 4 - * indent-tabs-mode: t + * indent-tabs-mode: nil * End: * - * ex: set ts=8 sts=4 sw=4 noet: + * ex: set ts=8 sts=4 sw=4 et: */