3 * Copyright (c) 1991-1999, Larry Wall
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
11 * "Didst thou think that the eyes of the White Tower were blind? Nay, I
12 * have seen more than thou knowest, Gray Fool." --Denethor
19 #if defined(PERL_IMPLICIT_CONTEXT)
21 Perl_deb_nocontext(const char *pat, ...)
29 #endif /* DEBUGGING */
34 Perl_deb(pTHX_ const char *pat, ...)
41 #endif /* DEBUGGING */
45 Perl_vdeb(pTHX_ const char *pat, va_list *args)
50 GV* gv = PL_curcop->cop_filegv;
53 PerlIO_printf(Perl_debug_log, "0x%"UVxf" (%s:%ld)\t",
55 SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
56 (long)PL_curcop->cop_line);
58 PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
59 SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
60 (long)PL_curcop->cop_line);
61 #endif /* USE_THREADS */
62 for (i=0; i<PL_dlevel; i++)
63 PerlIO_printf(Perl_debug_log, "%c%c ",PL_debname[i],PL_debdelim[i]);
64 (void) PerlIO_vprintf(Perl_debug_log, pat, *args);
65 #endif /* DEBUGGING */
69 Perl_deb_growlevel(pTHX)
73 Renew(PL_debname, PL_dlmax, char);
74 Renew(PL_debdelim, PL_dlmax, char);
75 #endif /* DEBUGGING */
79 Perl_debstackptrs(pTHX)
83 PerlIO_printf(Perl_debug_log,
84 "%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n",
85 PTR2UV(PL_curstack), PTR2UV(PL_stack_base),
86 (IV)*PL_markstack_ptr, (IV)(PL_stack_sp-PL_stack_base),
87 (IV)(PL_stack_max-PL_stack_base));
88 PerlIO_printf(Perl_debug_log,
89 "%8"UVxf" %8"UVxf" %8"UVuf" %8"UVuf" %8"UVuf"\n",
90 PTR2UV(PL_mainstack), PTR2UV(AvARRAY(PL_curstack)),
91 PTR2UV(PL_mainstack), PTR2UV(AvFILLp(PL_curstack)),
92 PTR2UV(AvMAX(PL_curstack)));
93 #endif /* DEBUGGING */
102 I32 top = PL_stack_sp - PL_stack_base;
103 register I32 i = top - 30;
104 I32 *markscan = PL_curstackinfo->si_markbase;
109 while (++markscan <= PL_markstack_ptr)
114 PerlIO_printf(Perl_debug_log,
115 i ? "0x%"UVxf" => ... " : "0x%lx => ",
118 PerlIO_printf(Perl_debug_log, i ? " => ... " : " => ");
119 #endif /* USE_THREADS */
120 if (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base)
121 PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
124 if (markscan <= PL_markstack_ptr && *markscan < i) {
127 PerlIO_putc(Perl_debug_log, '*');
129 while (markscan <= PL_markstack_ptr && *markscan < i);
130 PerlIO_printf(Perl_debug_log, " ");
134 PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(PL_stack_base[i]));
137 PerlIO_printf(Perl_debug_log, "\n");
138 #endif /* DEBUGGING */