Commit | Line | Data |
---|---|---|
a0d0e21e | 1 | /* deb.c |
79072805 | 2 | * |
9607fc9c | 3 | * Copyright (c) 1991-1997, 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" | |
16 | #include "perl.h" | |
17 | ||
a0d0e21e LW |
18 | #ifdef DEBUGGING |
19 | #if !defined(I_STDARG) && !defined(I_VARARGS) | |
8990e307 LW |
20 | |
21 | /* | |
22 | * Fallback on the old hackers way of doing varargs | |
23 | */ | |
24 | ||
79072805 | 25 | /*VARARGS1*/ |
8990e307 LW |
26 | void |
27 | deb(pat,a1,a2,a3,a4,a5,a6,a7,a8) | |
28 | char *pat; | |
79072805 | 29 | { |
11343788 | 30 | dTHR; |
79072805 | 31 | register I32 i; |
a0d0e21e | 32 | GV* gv = curcop->cop_filegv; |
79072805 | 33 | |
11343788 | 34 | #ifdef USE_THREADS |
5dc0d613 MB |
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); | |
11343788 | 39 | #else |
760ac839 | 40 | PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", |
a0d0e21e LW |
41 | SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>", |
42 | (long)curcop->cop_line); | |
11343788 | 43 | #endif /* USE_THREADS */ |
79072805 | 44 | for (i=0; i<dlevel; i++) |
760ac839 LW |
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); | |
79072805 | 47 | } |
8990e307 | 48 | |
a0d0e21e | 49 | #else /* !defined(I_STDARG) && !defined(I_VARARGS) */ |
8990e307 | 50 | |
ecfc5424 | 51 | # ifdef I_STDARG |
8990e307 | 52 | void |
71be2cbc | 53 | deb(const char *pat, ...) |
79072805 LW |
54 | # else |
55 | /*VARARGS1*/ | |
8990e307 LW |
56 | void |
57 | deb(pat, va_alist) | |
71be2cbc | 58 | const char *pat; |
8990e307 LW |
59 | va_dcl |
60 | # endif | |
79072805 | 61 | { |
11343788 | 62 | dTHR; |
79072805 | 63 | va_list args; |
79072805 | 64 | register I32 i; |
a0d0e21e | 65 | GV* gv = curcop->cop_filegv; |
79072805 | 66 | |
11343788 | 67 | #ifdef USE_THREADS |
5dc0d613 MB |
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); | |
11343788 | 72 | #else |
760ac839 | 73 | PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", |
a0d0e21e LW |
74 | SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>", |
75 | (long)curcop->cop_line); | |
11343788 | 76 | #endif /* USE_THREADS */ |
79072805 | 77 | for (i=0; i<dlevel; i++) |
760ac839 | 78 | PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]); |
79072805 | 79 | |
a0d0e21e | 80 | # ifdef I_STDARG |
8990e307 LW |
81 | va_start(args, pat); |
82 | # else | |
83 | va_start(args); | |
84 | # endif | |
760ac839 | 85 | (void) PerlIO_vprintf(Perl_debug_log,pat,args); |
79072805 LW |
86 | va_end( args ); |
87 | } | |
a0d0e21e | 88 | #endif /* !defined(I_STDARG) && !defined(I_VARARGS) */ |
79072805 LW |
89 | |
90 | void | |
8ac85365 | 91 | deb_growlevel(void) |
79072805 LW |
92 | { |
93 | dlmax += 128; | |
94 | Renew(debname, dlmax, char); | |
95 | Renew(debdelim, dlmax, char); | |
96 | } | |
97 | ||
98 | I32 | |
8ac85365 | 99 | debstackptrs(void) |
79072805 | 100 | { |
11343788 | 101 | dTHR; |
760ac839 | 102 | PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n", |
0c2634fc | 103 | (unsigned long)curstack, (unsigned long)stack_base, |
a0d0e21e LW |
104 | (long)*markstack_ptr, (long)(stack_sp-stack_base), |
105 | (long)(stack_max-stack_base)); | |
760ac839 | 106 | PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n", |
0c2634fc | 107 | (unsigned long)mainstack, (unsigned long)AvARRAY(curstack), |
93965878 | 108 | (long)mainstack, (long)AvFILLp(curstack), (long)AvMAX(curstack)); |
79072805 LW |
109 | return 0; |
110 | } | |
111 | ||
112 | I32 | |
8ac85365 | 113 | debstack(void) |
79072805 | 114 | { |
11343788 | 115 | dTHR; |
a0d0e21e LW |
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; | |
79072805 | 126 | |
11343788 | 127 | #ifdef USE_THREADS |
5dc0d613 MB |
128 | PerlIO_printf(Perl_debug_log, i ? "0x%lx => ... " : "0x%lx => ", |
129 | (unsigned long) thr); | |
11343788 | 130 | #else |
760ac839 | 131 | PerlIO_printf(Perl_debug_log, i ? " => ... " : " => "); |
11343788 | 132 | #endif /* USE_THREADS */ |
a0d0e21e | 133 | if (stack_base[0] != &sv_undef || stack_sp < stack_base) |
760ac839 | 134 | PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n"); |
a0d0e21e LW |
135 | do { |
136 | ++i; | |
137 | if (markscan <= markstack_ptr && *markscan < i) { | |
138 | do { | |
139 | ++markscan; | |
760ac839 | 140 | PerlIO_putc(Perl_debug_log, '*'); |
a0d0e21e LW |
141 | } |
142 | while (markscan <= markstack_ptr && *markscan < i); | |
760ac839 | 143 | PerlIO_printf(Perl_debug_log, " "); |
79072805 | 144 | } |
a0d0e21e LW |
145 | if (i > top) |
146 | break; | |
760ac839 | 147 | PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(stack_base[i])); |
79072805 | 148 | } |
a0d0e21e | 149 | while (1); |
760ac839 | 150 | PerlIO_printf(Perl_debug_log, "\n"); |
79072805 LW |
151 | return 0; |
152 | } | |
a0d0e21e LW |
153 | #else |
154 | static int dummy; /* avoid totally empty deb.o file */ | |
155 | #endif /* DEBUGGING */ |