Test case for #10433/#10424.
[p5sagit/p5-mst-13.2.git] / deb.c
CommitLineData
a0d0e21e 1/* deb.c
79072805 2 *
bc89e66f 3 * Copyright (c) 1991-2001, Larry Wall
79072805 4 *
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.
7 *
a0d0e21e 8 */
9
10/*
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
79072805 13 */
14
15#include "EXTERN.h"
864dbfa3 16#define PERL_IN_DEB_C
79072805 17#include "perl.h"
18
c5be433b 19#if defined(PERL_IMPLICIT_CONTEXT)
20void
21Perl_deb_nocontext(const char *pat, ...)
22{
23#ifdef DEBUGGING
24 dTHX;
25 va_list args;
26 va_start(args, pat);
27 vdeb(pat, &args);
28 va_end(args);
29#endif /* DEBUGGING */
30}
31#endif
32
8990e307 33void
864dbfa3 34Perl_deb(pTHX_ const char *pat, ...)
79072805 35{
17c3b450 36#ifdef DEBUGGING
79072805 37 va_list args;
c5be433b 38 va_start(args, pat);
39 vdeb(pat, &args);
40 va_end(args);
41#endif /* DEBUGGING */
42}
43
44void
45Perl_vdeb(pTHX_ const char *pat, va_list *args)
46{
47#ifdef DEBUGGING
cc49e20b 48 char* file = CopFILE(PL_curcop);
79072805 49
11343788 50#ifdef USE_THREADS
b900a521 51 PerlIO_printf(Perl_debug_log, "0x%"UVxf" (%s:%ld)\t",
52 PTR2UV(thr),
cc49e20b 53 (file ? file : "<free>"),
54 (long)CopLINE(PL_curcop));
11343788 55#else
cc49e20b 56 PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", (file ? file : "<free>"),
57 (long)CopLINE(PL_curcop));
11343788 58#endif /* USE_THREADS */
c5be433b 59 (void) PerlIO_vprintf(Perl_debug_log, pat, *args);
17c3b450 60#endif /* DEBUGGING */
79072805 61}
79072805 62
79072805 63I32
864dbfa3 64Perl_debstackptrs(pTHX)
79072805 65{
17c3b450 66#ifdef DEBUGGING
b900a521 67 PerlIO_printf(Perl_debug_log,
68 "%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n",
69 PTR2UV(PL_curstack), PTR2UV(PL_stack_base),
70 (IV)*PL_markstack_ptr, (IV)(PL_stack_sp-PL_stack_base),
71 (IV)(PL_stack_max-PL_stack_base));
72 PerlIO_printf(Perl_debug_log,
73 "%8"UVxf" %8"UVxf" %8"UVuf" %8"UVuf" %8"UVuf"\n",
74 PTR2UV(PL_mainstack), PTR2UV(AvARRAY(PL_curstack)),
75 PTR2UV(PL_mainstack), PTR2UV(AvFILLp(PL_curstack)),
76 PTR2UV(AvMAX(PL_curstack)));
17c3b450 77#endif /* DEBUGGING */
79072805 78 return 0;
79}
80
81I32
864dbfa3 82Perl_debstack(pTHX)
79072805 83{
17c3b450 84#ifdef DEBUGGING
3280af22 85 I32 top = PL_stack_sp - PL_stack_base;
a0d0e21e 86 register I32 i = top - 30;
ce2f7c3b 87 I32 *markscan = PL_markstack + PL_curstackinfo->si_markoff;
a0d0e21e 88
89 if (i < 0)
90 i = 0;
91
3280af22 92 while (++markscan <= PL_markstack_ptr)
a0d0e21e 93 if (*markscan >= i)
94 break;
79072805 95
11343788 96#ifdef USE_THREADS
b900a521 97 PerlIO_printf(Perl_debug_log,
98 i ? "0x%"UVxf" => ... " : "0x%lx => ",
99 PTR2UV(thr));
11343788 100#else
760ac839 101 PerlIO_printf(Perl_debug_log, i ? " => ... " : " => ");
11343788 102#endif /* USE_THREADS */
3280af22 103 if (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base)
760ac839 104 PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
a0d0e21e 105 do {
106 ++i;
3280af22 107 if (markscan <= PL_markstack_ptr && *markscan < i) {
a0d0e21e 108 do {
109 ++markscan;
760ac839 110 PerlIO_putc(Perl_debug_log, '*');
a0d0e21e 111 }
3280af22 112 while (markscan <= PL_markstack_ptr && *markscan < i);
760ac839 113 PerlIO_printf(Perl_debug_log, " ");
79072805 114 }
a0d0e21e 115 if (i > top)
116 break;
3280af22 117 PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(PL_stack_base[i]));
79072805 118 }
a0d0e21e 119 while (1);
760ac839 120 PerlIO_printf(Perl_debug_log, "\n");
17c3b450 121#endif /* DEBUGGING */
79072805 122 return 0;
123}