This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH@8545] [ID 20000808.005] OP_REFGEN as an lvalue
[perl5.git] / deb.c
CommitLineData
a0d0e21e 1/* deb.c
79072805 2 *
be3c0a43 3 * Copyright (c) 1991-2002, Larry Wall
79072805
LW
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
LW
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
LW
13 */
14
15#include "EXTERN.h"
864dbfa3 16#define PERL_IN_DEB_C
79072805
LW
17#include "perl.h"
18
c5be433b
GS
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
GS
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
248c2a4d 48 char* file = OutCopFILE(PL_curcop);
79072805 49
4d1ff10f 50#ifdef USE_5005THREADS
b900a521
JH
51 PerlIO_printf(Perl_debug_log, "0x%"UVxf" (%s:%ld)\t",
52 PTR2UV(thr),
cc49e20b
GS
53 (file ? file : "<free>"),
54 (long)CopLINE(PL_curcop));
11343788 55#else
cc49e20b
GS
56 PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", (file ? file : "<free>"),
57 (long)CopLINE(PL_curcop));
4d1ff10f 58#endif /* USE_5005THREADS */
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
JH
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
LW
78 return 0;
79}
80
81I32
864dbfa3 82Perl_debstack(pTHX)
79072805 83{
1045810a 84#ifndef SKIP_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
1045810a
IZ
89 if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
90 return 0;
91
a0d0e21e
LW
92 if (i < 0)
93 i = 0;
94
3280af22 95 while (++markscan <= PL_markstack_ptr)
a0d0e21e
LW
96 if (*markscan >= i)
97 break;
79072805 98
4d1ff10f 99#ifdef USE_5005THREADS
b900a521
JH
100 PerlIO_printf(Perl_debug_log,
101 i ? "0x%"UVxf" => ... " : "0x%lx => ",
102 PTR2UV(thr));
11343788 103#else
760ac839 104 PerlIO_printf(Perl_debug_log, i ? " => ... " : " => ");
4d1ff10f 105#endif /* USE_5005THREADS */
3280af22 106 if (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base)
760ac839 107 PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
a0d0e21e
LW
108 do {
109 ++i;
3280af22 110 if (markscan <= PL_markstack_ptr && *markscan < i) {
a0d0e21e
LW
111 do {
112 ++markscan;
760ac839 113 PerlIO_putc(Perl_debug_log, '*');
a0d0e21e 114 }
3280af22 115 while (markscan <= PL_markstack_ptr && *markscan < i);
760ac839 116 PerlIO_printf(Perl_debug_log, " ");
79072805 117 }
a0d0e21e
LW
118 if (i > top)
119 break;
3280af22 120 PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(PL_stack_base[i]));
79072805 121 }
a0d0e21e 122 while (1);
760ac839 123 PerlIO_printf(Perl_debug_log, "\n");
1045810a 124#endif /* SKIP_DEBUGGING */
79072805
LW
125 return 0;
126}