052cd06995aa0c31c462324f52d0ac3b097ef266
[p5sagit/p5-mst-13.2.git] / deb.c
1 /*    deb.c
2  *
3  *    Copyright (c) 1991-1997, Larry Wall
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  *
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
13  */
14
15 #include "EXTERN.h"
16 #include "perl.h"
17
18 void
19 deb(const char *pat, ...)
20 {
21 #ifdef DEBUGGING
22     dTHR;
23     va_list args;
24     register I32 i;
25     GV* gv = PL_curcop->cop_filegv;
26
27 #ifdef USE_THREADS
28     PerlIO_printf(Perl_debug_log, "0x%lx (%s:%ld)\t",
29                   (unsigned long) thr,
30                   SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
31                   (long)curcop->cop_line);
32 #else
33     PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
34         SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
35         (long)PL_curcop->cop_line);
36 #endif /* USE_THREADS */
37     for (i=0; i<PL_dlevel; i++)
38         PerlIO_printf(Perl_debug_log, "%c%c ",PL_debname[i],PL_debdelim[i]);
39
40     va_start(args, pat);
41     (void) PerlIO_vprintf(Perl_debug_log,pat,args);
42     va_end( args );
43 #endif /* DEBUGGING */
44 }
45
46 void
47 deb_growlevel(void)
48 {
49 #ifdef DEBUGGING
50     PL_dlmax += 128;
51     Renew(PL_debname, PL_dlmax, char);
52     Renew(PL_debdelim, PL_dlmax, char);
53 #endif /* DEBUGGING */
54 }
55
56 I32
57 debstackptrs(void)
58 {
59 #ifdef DEBUGGING
60     dTHR;
61     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
62         (unsigned long)PL_curstack, (unsigned long)PL_stack_base,
63         (long)*PL_markstack_ptr, (long)(PL_stack_sp-PL_stack_base),
64         (long)(PL_stack_max-PL_stack_base));
65     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
66         (unsigned long)PL_mainstack, (unsigned long)AvARRAY(PL_curstack),
67         (long)PL_mainstack, (long)AvFILLp(PL_curstack), (long)AvMAX(PL_curstack));
68 #endif /* DEBUGGING */
69     return 0;
70 }
71
72 I32
73 debstack(void)
74 {
75 #ifdef DEBUGGING
76     dTHR;
77     I32 top = PL_stack_sp - PL_stack_base;
78     register I32 i = top - 30;
79     I32 *markscan = PL_curstackinfo->si_markbase;
80
81     if (i < 0)
82         i = 0;
83     
84     while (++markscan <= PL_markstack_ptr)
85         if (*markscan >= i)
86             break;
87
88 #ifdef USE_THREADS
89     PerlIO_printf(Perl_debug_log, i ? "0x%lx    =>  ...  " : "0x%lx    =>  ",
90                   (unsigned long) thr);
91 #else
92     PerlIO_printf(Perl_debug_log, i ? "    =>  ...  " : "    =>  ");
93 #endif /* USE_THREADS */
94     if (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base)
95         PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
96     do {
97         ++i;
98         if (markscan <= PL_markstack_ptr && *markscan < i) {
99             do {
100                 ++markscan;
101                 PerlIO_putc(Perl_debug_log, '*');
102             }
103             while (markscan <= PL_markstack_ptr && *markscan < i);
104             PerlIO_printf(Perl_debug_log, "  ");
105         }
106         if (i > top)
107             break;
108         PerlIO_printf(Perl_debug_log, "%-4s  ", SvPEEK(PL_stack_base[i]));
109     }
110     while (1);
111     PerlIO_printf(Perl_debug_log, "\n");
112 #endif /* DEBUGGING */
113     return 0;
114 }