perl 5.003_07: lib/ExtUtils/xsubpp
[perl.git] / deb.c
1 /*    deb.c
2  *
3  *    Copyright (c) 1991-1994, 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 #ifdef DEBUGGING
19 #if !defined(I_STDARG) && !defined(I_VARARGS)
20
21 /*
22  * Fallback on the old hackers way of doing varargs
23  */
24
25 /*VARARGS1*/
26 void
27 deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
28     char *pat;
29 {
30     register I32 i;
31     GV* gv = curcop->cop_filegv;
32
33     PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
34         SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
35         (long)curcop->cop_line);
36     for (i=0; i<dlevel; i++)
37         PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]);
38     PerlIO_printf(Perl_debug_log, pat,a1,a2,a3,a4,a5,a6,a7,a8);
39 }
40
41 #else /* !defined(I_STDARG) && !defined(I_VARARGS) */
42
43 #  ifdef I_STDARG
44 void
45 deb(char *pat, ...)
46 #  else
47 /*VARARGS1*/
48 void
49 deb(pat, va_alist)
50     char *pat;
51     va_dcl
52 #  endif
53 {
54     va_list args;
55     register I32 i;
56     GV* gv = curcop->cop_filegv;
57
58     PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
59         SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
60         (long)curcop->cop_line);
61     for (i=0; i<dlevel; i++)
62         PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]);
63
64 #  ifdef I_STDARG
65     va_start(args, pat);
66 #  else
67     va_start(args);
68 #  endif
69     (void) PerlIO_vprintf(Perl_debug_log,pat,args);
70     va_end( args );
71 }
72 #endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
73
74 void
75 deb_growlevel()
76 {
77     dlmax += 128;
78     Renew(debname, dlmax, char);
79     Renew(debdelim, dlmax, char);
80 }
81
82 I32
83 debstackptrs()
84 {
85     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
86         (unsigned long)curstack, (unsigned long)stack_base,
87         (long)*markstack_ptr, (long)(stack_sp-stack_base),
88         (long)(stack_max-stack_base));
89     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
90         (unsigned long)mainstack, (unsigned long)AvARRAY(curstack),
91         (long)mainstack, (long)AvFILL(curstack), (long)AvMAX(curstack));
92     return 0;
93 }
94
95 I32
96 debstack()
97 {
98     I32 top = stack_sp - stack_base;
99     register I32 i = top - 30;
100     I32 *markscan = markstack;
101
102     if (i < 0)
103         i = 0;
104     
105     while (++markscan <= markstack_ptr)
106         if (*markscan >= i)
107             break;
108
109     PerlIO_printf(Perl_debug_log, i ? "    =>  ...  " : "    =>  ");
110     if (stack_base[0] != &sv_undef || stack_sp < stack_base)
111         PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
112     do {
113         ++i;
114         if (markscan <= markstack_ptr && *markscan < i) {
115             do {
116                 ++markscan;
117                 PerlIO_putc(Perl_debug_log, '*');
118             }
119             while (markscan <= markstack_ptr && *markscan < i);
120             PerlIO_printf(Perl_debug_log, "  ");
121         }
122         if (i > top)
123             break;
124         PerlIO_printf(Perl_debug_log, "%-4s  ", SvPEEK(stack_base[i]));
125     }
126     while (1);
127     PerlIO_printf(Perl_debug_log, "\n");
128     return 0;
129 }
130 #else
131 static int dummy; /* avoid totally empty deb.o file */
132 #endif /* DEBUGGING */