This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
change#3612 was buggy and failed to build Tk; applied Ilya's
[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
8990e307 19void
864dbfa3 20Perl_deb(pTHX_ const char *pat, ...)
79072805 21{
17c3b450 22#ifdef DEBUGGING
11343788 23 dTHR;
79072805 24 va_list args;
79072805 25 register I32 i;
3280af22 26 GV* gv = PL_curcop->cop_filegv;
79072805 27
11343788 28#ifdef USE_THREADS
5dc0d613
MB
29 PerlIO_printf(Perl_debug_log, "0x%lx (%s:%ld)\t",
30 (unsigned long) thr,
31 SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
533c011a 32 (long)PL_curcop->cop_line);
11343788 33#else
760ac839 34 PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
a0d0e21e 35 SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
3280af22 36 (long)PL_curcop->cop_line);
11343788 37#endif /* USE_THREADS */
3280af22
NIS
38 for (i=0; i<PL_dlevel; i++)
39 PerlIO_printf(Perl_debug_log, "%c%c ",PL_debname[i],PL_debdelim[i]);
79072805 40
8990e307 41 va_start(args, pat);
760ac839 42 (void) PerlIO_vprintf(Perl_debug_log,pat,args);
79072805 43 va_end( args );
17c3b450 44#endif /* DEBUGGING */
79072805 45}
79072805
LW
46
47void
864dbfa3 48Perl_deb_growlevel(pTHX)
79072805 49{
17c3b450 50#ifdef DEBUGGING
3280af22
NIS
51 PL_dlmax += 128;
52 Renew(PL_debname, PL_dlmax, char);
53 Renew(PL_debdelim, PL_dlmax, char);
17c3b450 54#endif /* DEBUGGING */
79072805
LW
55}
56
57I32
864dbfa3 58Perl_debstackptrs(pTHX)
79072805 59{
17c3b450 60#ifdef DEBUGGING
11343788 61 dTHR;
760ac839 62 PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
3280af22
NIS
63 (unsigned long)PL_curstack, (unsigned long)PL_stack_base,
64 (long)*PL_markstack_ptr, (long)(PL_stack_sp-PL_stack_base),
65 (long)(PL_stack_max-PL_stack_base));
760ac839 66 PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
3280af22
NIS
67 (unsigned long)PL_mainstack, (unsigned long)AvARRAY(PL_curstack),
68 (long)PL_mainstack, (long)AvFILLp(PL_curstack), (long)AvMAX(PL_curstack));
17c3b450 69#endif /* DEBUGGING */
79072805
LW
70 return 0;
71}
72
73I32
864dbfa3 74Perl_debstack(pTHX)
79072805 75{
17c3b450 76#ifdef DEBUGGING
11343788 77 dTHR;
3280af22 78 I32 top = PL_stack_sp - PL_stack_base;
a0d0e21e 79 register I32 i = top - 30;
3280af22 80 I32 *markscan = PL_curstackinfo->si_markbase;
a0d0e21e
LW
81
82 if (i < 0)
83 i = 0;
84
3280af22 85 while (++markscan <= PL_markstack_ptr)
a0d0e21e
LW
86 if (*markscan >= i)
87 break;
79072805 88
11343788 89#ifdef USE_THREADS
5dc0d613
MB
90 PerlIO_printf(Perl_debug_log, i ? "0x%lx => ... " : "0x%lx => ",
91 (unsigned long) thr);
11343788 92#else
760ac839 93 PerlIO_printf(Perl_debug_log, i ? " => ... " : " => ");
11343788 94#endif /* USE_THREADS */
3280af22 95 if (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base)
760ac839 96 PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
a0d0e21e
LW
97 do {
98 ++i;
3280af22 99 if (markscan <= PL_markstack_ptr && *markscan < i) {
a0d0e21e
LW
100 do {
101 ++markscan;
760ac839 102 PerlIO_putc(Perl_debug_log, '*');
a0d0e21e 103 }
3280af22 104 while (markscan <= PL_markstack_ptr && *markscan < i);
760ac839 105 PerlIO_printf(Perl_debug_log, " ");
79072805 106 }
a0d0e21e
LW
107 if (i > top)
108 break;
3280af22 109 PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(PL_stack_base[i]));
79072805 110 }
a0d0e21e 111 while (1);
760ac839 112 PerlIO_printf(Perl_debug_log, "\n");
17c3b450 113#endif /* DEBUGGING */
79072805
LW
114 return 0;
115}