This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate with Sarathy.
[perl5.git] / deb.c
CommitLineData
a0d0e21e 1/* deb.c
79072805 2 *
4eb8286e 3 * Copyright (c) 1991-1999, 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
48 dTHR;
79072805 49 register I32 i;
3280af22 50 GV* gv = PL_curcop->cop_filegv;
79072805 51
11343788 52#ifdef USE_THREADS
5dc0d613
MB
53 PerlIO_printf(Perl_debug_log, "0x%lx (%s:%ld)\t",
54 (unsigned long) thr,
55 SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
533c011a 56 (long)PL_curcop->cop_line);
11343788 57#else
760ac839 58 PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
a0d0e21e 59 SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
3280af22 60 (long)PL_curcop->cop_line);
11343788 61#endif /* USE_THREADS */
3280af22
NIS
62 for (i=0; i<PL_dlevel; i++)
63 PerlIO_printf(Perl_debug_log, "%c%c ",PL_debname[i],PL_debdelim[i]);
c5be433b 64 (void) PerlIO_vprintf(Perl_debug_log, pat, *args);
17c3b450 65#endif /* DEBUGGING */
79072805 66}
79072805
LW
67
68void
864dbfa3 69Perl_deb_growlevel(pTHX)
79072805 70{
17c3b450 71#ifdef DEBUGGING
3280af22
NIS
72 PL_dlmax += 128;
73 Renew(PL_debname, PL_dlmax, char);
74 Renew(PL_debdelim, PL_dlmax, char);
17c3b450 75#endif /* DEBUGGING */
79072805
LW
76}
77
78I32
864dbfa3 79Perl_debstackptrs(pTHX)
79072805 80{
17c3b450 81#ifdef DEBUGGING
11343788 82 dTHR;
760ac839 83 PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
3280af22
NIS
84 (unsigned long)PL_curstack, (unsigned long)PL_stack_base,
85 (long)*PL_markstack_ptr, (long)(PL_stack_sp-PL_stack_base),
86 (long)(PL_stack_max-PL_stack_base));
760ac839 87 PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
3280af22
NIS
88 (unsigned long)PL_mainstack, (unsigned long)AvARRAY(PL_curstack),
89 (long)PL_mainstack, (long)AvFILLp(PL_curstack), (long)AvMAX(PL_curstack));
17c3b450 90#endif /* DEBUGGING */
79072805
LW
91 return 0;
92}
93
94I32
864dbfa3 95Perl_debstack(pTHX)
79072805 96{
17c3b450 97#ifdef DEBUGGING
11343788 98 dTHR;
3280af22 99 I32 top = PL_stack_sp - PL_stack_base;
a0d0e21e 100 register I32 i = top - 30;
3280af22 101 I32 *markscan = PL_curstackinfo->si_markbase;
a0d0e21e
LW
102
103 if (i < 0)
104 i = 0;
105
3280af22 106 while (++markscan <= PL_markstack_ptr)
a0d0e21e
LW
107 if (*markscan >= i)
108 break;
79072805 109
11343788 110#ifdef USE_THREADS
5dc0d613
MB
111 PerlIO_printf(Perl_debug_log, i ? "0x%lx => ... " : "0x%lx => ",
112 (unsigned long) thr);
11343788 113#else
760ac839 114 PerlIO_printf(Perl_debug_log, i ? " => ... " : " => ");
11343788 115#endif /* USE_THREADS */
3280af22 116 if (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base)
760ac839 117 PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
a0d0e21e
LW
118 do {
119 ++i;
3280af22 120 if (markscan <= PL_markstack_ptr && *markscan < i) {
a0d0e21e
LW
121 do {
122 ++markscan;
760ac839 123 PerlIO_putc(Perl_debug_log, '*');
a0d0e21e 124 }
3280af22 125 while (markscan <= PL_markstack_ptr && *markscan < i);
760ac839 126 PerlIO_printf(Perl_debug_log, " ");
79072805 127 }
a0d0e21e
LW
128 if (i > top)
129 break;
3280af22 130 PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(PL_stack_base[i]));
79072805 131 }
a0d0e21e 132 while (1);
760ac839 133 PerlIO_printf(Perl_debug_log, "\n");
17c3b450 134#endif /* DEBUGGING */
79072805
LW
135 return 0;
136}