X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/bfed75c6338f0ba740aa210f4b0267e39ca4662b..e69949b13fa3041e19acb67acf4cfd41b23d60a1:/deb.c diff --git a/deb.c b/deb.c index 4bb91ad..bd6e538 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, 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,9 +31,12 @@ 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); +#else + PERL_UNUSED_ARG(pat); #endif /* DEBUGGING */ } #endif @@ -39,23 +44,37 @@ 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; #endif /* DEBUGGING */ + va_end(args); } void Perl_vdeb(pTHX_ const char *pat, va_list *args) { #ifdef DEBUGGING - char* 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 */ } @@ -64,15 +83,17 @@ Perl_debstackptrs(pTHX) { #ifdef DEBUGGING PerlIO_printf(Perl_debug_log, - "%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n", + "%8" UVxf " %8" UVxf " %8" IVdf " %8" IVdf " %8" IVdf "\n", PTR2UV(PL_curstack), PTR2UV(PL_stack_base), (IV)*PL_markstack_ptr, (IV)(PL_stack_sp-PL_stack_base), (IV)(PL_stack_max-PL_stack_base)); PerlIO_printf(Perl_debug_log, - "%8"UVxf" %8"UVxf" %8"UVuf" %8"UVuf" %8"UVuf"\n", + "%8" UVxf " %8" UVxf " %8" UVuf " %8" UVuf " %8" UVuf "\n", PTR2UV(PL_mainstack), PTR2UV(AvARRAY(PL_curstack)), PTR2UV(PL_mainstack), PTR2UV(AvFILLp(PL_curstack)), PTR2UV(AvMAX(PL_curstack))); +#else + PERL_UNUSED_CONTEXT; #endif /* DEBUGGING */ return 0; } @@ -92,8 +113,11 @@ S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, I32 mark_min, I32 mark_max) { #ifdef DEBUGGING - register I32 i = stack_max - 30; - I32 *markscan = PL_markstack + mark_min; + 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; @@ -111,7 +135,7 @@ S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, if (markscan <= PL_markstack + mark_max && *markscan < i) { do { ++markscan; - PerlIO_putc(Perl_debug_log, '*'); + (void)PerlIO_putc(Perl_debug_log, '*'); } while (markscan <= PL_markstack + mark_max && *markscan < i); PerlIO_printf(Perl_debug_log, " "); @@ -122,6 +146,13 @@ 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); + PERL_UNUSED_ARG(mark_min); + PERL_UNUSED_ARG(mark_max); #endif /* DEBUGGING */ } @@ -149,7 +180,7 @@ Perl_debstack(pTHX) #ifdef DEBUGGING -static const char * si_names[] = { +static const char * const si_names[] = { "UNKNOWN", "UNDEF", "MAIN", @@ -160,7 +191,8 @@ static const char * si_names[] = { "DESTROY", "WARNHOOK", "DIEHOOK", - "REQUIRE" + "REQUIRE", + "MULTICALL" }; #endif @@ -171,9 +203,8 @@ void Perl_deb_stack_all(pTHX) { #ifdef DEBUGGING - I32 ix, si_ix; - PERL_SI *si; - PERL_CONTEXT *cx; + I32 si_ix; + const PERL_SI *si; /* rewind to start of chain */ si = PL_curstackinfo; @@ -183,20 +214,19 @@ Perl_deb_stack_all(pTHX) si_ix=0; for (;;) { - char *si_name; - int si_name_ix = si->si_type+1; /* -1 is a valid index */ - if (si_name_ix>= sizeof(si_names)) - si_name = "????"; - else - si_name = si_names[si_name_ix]; - PerlIO_printf(Perl_debug_log, "STACK %"IVdf": %s\n", + const size_t si_name_ix = si->si_type+1; /* -1 is a valid index */ + const char * const si_name = + si_name_ix < C_ARRAY_LENGTH(si_names) ? + si_names[si_name_ix] : "????"; + I32 ix; + PerlIO_printf(Perl_debug_log, "STACK %" IVdf ": %s\n", (IV)si_ix, si_name); for (ix=0; ix<=si->si_cxix; ix++) { - cx = &(si->si_cxstack[ix]); + const PERL_CONTEXT * const cx = &(si->si_cxstack[ix]); PerlIO_printf(Perl_debug_log, - " CX %"IVdf": %-6s => ", + " CX %" IVdf ": %-6s => ", (IV)ix, PL_block_type[CxTYPE(cx)] ); /* substitution contexts don't save stack pointers etc) */ @@ -204,26 +234,24 @@ Perl_deb_stack_all(pTHX) PerlIO_printf(Perl_debug_log, "\n"); else { - /* Find the the current context's stack range by searching + /* Find the current context's stack range by searching * forward for any higher contexts using this stack; failing * that, it will be equal to the size of the stack for old * stacks, or PL_stack_sp for the current stack */ I32 i, stack_min, stack_max, mark_min, mark_max; - PERL_CONTEXT *cx_n; - PERL_SI *si_n; - OP *retop; - - cx_n = Null(PERL_CONTEXT*); + const PERL_CONTEXT *cx_n = NULL; + const PERL_SI *si_n; - /* there's a separate stack per SI, so only search - * this one */ + /* there's a separate argument stack per SI, so only + * search this one */ for (i=ix+1; i<=si->si_cxix; i++) { - if (CxTYPE(cx) == CXt_SUBST) + const PERL_CONTEXT *this_cx = &(si->si_cxstack[i]); + if (CxTYPE(this_cx) == CXt_SUBST) continue; - cx_n = &(si->si_cxstack[i]); + cx_n = this_cx; break; } @@ -239,12 +267,12 @@ Perl_deb_stack_all(pTHX) stack_max = AvFILLp(si->si_stack); } - /* for the other stack types, there's only one stack - * shared between all SIs */ + /* for the markstack, there's only one stack shared + * between all SIs */ si_n = si; i = ix; - cx_n = Null(PERL_CONTEXT*); + cx_n = NULL; for (;;) { i++; if (i > si_n->si_cxix) { @@ -275,8 +303,7 @@ Perl_deb_stack_all(pTHX) if (CxTYPE(cx) == CXt_EVAL || CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { - 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)" @@ -295,7 +322,11 @@ Perl_deb_stack_all(pTHX) } /* next stackinfo */ PerlIO_printf(Perl_debug_log, "\n"); +#else + PERL_UNUSED_CONTEXT; #endif /* DEBUGGING */ } - +/* + * ex: set ts=8 sts=4 sw=4 et: + */