[win32] integrate mainline
[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 #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     dTHR;
31     register I32 i;
32     GV* gv = curcop->cop_filegv;
33
34 #ifdef USE_THREADS
35     PerlIO_printf(Perl_debug_log,"0x%lx (%s:%ld)\t",
36                   (unsigned long) thr,
37                   SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
38                   (long)curcop->cop_line);
39 #else
40     PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
41         SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
42         (long)curcop->cop_line);
43 #endif /* USE_THREADS */
44     for (i=0; i<dlevel; i++)
45         PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]);
46     PerlIO_printf(Perl_debug_log, pat,a1,a2,a3,a4,a5,a6,a7,a8);
47 }
48
49 #else /* !defined(I_STDARG) && !defined(I_VARARGS) */
50
51 #  ifdef I_STDARG
52 void
53 deb(const char *pat, ...)
54 #  else
55 /*VARARGS1*/
56 void
57 deb(pat, va_alist)
58     const char *pat;
59     va_dcl
60 #  endif
61 {
62     dTHR;
63     va_list args;
64     register I32 i;
65     GV* gv = curcop->cop_filegv;
66
67 #ifdef USE_THREADS
68     PerlIO_printf(Perl_debug_log, "0x%lx (%s:%ld)\t",
69                   (unsigned long) thr,
70                   SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
71                   (long)curcop->cop_line);
72 #else
73     PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
74         SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
75         (long)curcop->cop_line);
76 #endif /* USE_THREADS */
77     for (i=0; i<dlevel; i++)
78         PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]);
79
80 #  ifdef I_STDARG
81     va_start(args, pat);
82 #  else
83     va_start(args);
84 #  endif
85     (void) PerlIO_vprintf(Perl_debug_log,pat,args);
86     va_end( args );
87 }
88 #endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
89
90 void
91 deb_growlevel(void)
92 {
93     dlmax += 128;
94     Renew(debname, dlmax, char);
95     Renew(debdelim, dlmax, char);
96 }
97
98 I32
99 debstackptrs(void)
100 {
101     dTHR;
102     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
103         (unsigned long)curstack, (unsigned long)stack_base,
104         (long)*markstack_ptr, (long)(stack_sp-stack_base),
105         (long)(stack_max-stack_base));
106     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
107         (unsigned long)mainstack, (unsigned long)AvARRAY(curstack),
108         (long)mainstack, (long)AvFILLp(curstack), (long)AvMAX(curstack));
109     return 0;
110 }
111
112 I32
113 debstack(void)
114 {
115     dTHR;
116     I32 top = stack_sp - stack_base;
117     register I32 i = top - 30;
118     I32 *markscan = markstack;
119
120     if (i < 0)
121         i = 0;
122     
123     while (++markscan <= markstack_ptr)
124         if (*markscan >= i)
125             break;
126
127 #ifdef USE_THREADS
128     PerlIO_printf(Perl_debug_log, i ? "0x%lx    =>  ...  " : "0x%lx    =>  ",
129                   (unsigned long) thr);
130 #else
131     PerlIO_printf(Perl_debug_log, i ? "    =>  ...  " : "    =>  ");
132 #endif /* USE_THREADS */
133     if (stack_base[0] != &sv_undef || stack_sp < stack_base)
134         PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
135     do {
136         ++i;
137         if (markscan <= markstack_ptr && *markscan < i) {
138             do {
139                 ++markscan;
140                 PerlIO_putc(Perl_debug_log, '*');
141             }
142             while (markscan <= markstack_ptr && *markscan < i);
143             PerlIO_printf(Perl_debug_log, "  ");
144         }
145         if (i > top)
146             break;
147         PerlIO_printf(Perl_debug_log, "%-4s  ", SvPEEK(stack_base[i]));
148     }
149     while (1);
150     PerlIO_printf(Perl_debug_log, "\n");
151     return 0;
152 }
153 #else
154 static int dummy; /* avoid totally empty deb.o file */
155 #endif /* DEBUGGING */