X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/bb7a0f5422600fd7de7806825a1300a577b7e61f..d5fbd9dd00e27f435423fd4898ed0e5804de0fd6:/deb.c?ds=sidebyside diff --git a/deb.c b/deb.c index 1d3de4c..3664d07 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,15 +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_CONTEXT; - PERL_UNUSED_ARG(pat); #endif /* DEBUGGING */ + va_end(args); } void @@ -57,10 +60,17 @@ 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; @@ -106,6 +116,9 @@ S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, dVAR; register 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; @@ -289,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)"