[win32] integrate mainline
[p5sagit/p5-mst-13.2.git] / deb.c
CommitLineData
a0d0e21e 1/* deb.c
79072805 2 *
9607fc9c 3 * Copyright (c) 1991-1997, Larry Wall
79072805 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 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 13 */
14
15#include "EXTERN.h"
16#include "perl.h"
17
a0d0e21e 18#ifdef DEBUGGING
19#if !defined(I_STDARG) && !defined(I_VARARGS)
8990e307 20
21/*
22 * Fallback on the old hackers way of doing varargs
23 */
24
79072805 25/*VARARGS1*/
8990e307 26void
27deb(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 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 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 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 52void
71be2cbc 53deb(const char *pat, ...)
79072805 54# else
55/*VARARGS1*/
8990e307 56void
57deb(pat, va_alist)
71be2cbc 58 const char *pat;
8990e307 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 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 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 81 va_start(args, pat);
82# else
83 va_start(args);
84# endif
760ac839 85 (void) PerlIO_vprintf(Perl_debug_log,pat,args);
79072805 86 va_end( args );
87}
a0d0e21e 88#endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
79072805 89
90void
8ac85365 91deb_growlevel(void)
79072805 92{
93 dlmax += 128;
94 Renew(debname, dlmax, char);
95 Renew(debdelim, dlmax, char);
96}
97
98I32
8ac85365 99debstackptrs(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 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 109 return 0;
110}
111
112I32
8ac85365 113debstack(void)
79072805 114{
11343788 115 dTHR;
a0d0e21e 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 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 135 do {
136 ++i;
137 if (markscan <= markstack_ptr && *markscan < i) {
138 do {
139 ++markscan;
760ac839 140 PerlIO_putc(Perl_debug_log, '*');
a0d0e21e 141 }
142 while (markscan <= markstack_ptr && *markscan < i);
760ac839 143 PerlIO_printf(Perl_debug_log, " ");
79072805 144 }
a0d0e21e 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 151 return 0;
152}
a0d0e21e 153#else
154static int dummy; /* avoid totally empty deb.o file */
155#endif /* DEBUGGING */