1 /* deb.c 2 * 3 * Copyright (c) 1991-2001, 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 #define PERL_IN_DEB_C 17 #include "perl.h" 18 19 #if defined(PERL_IMPLICIT_CONTEXT) 20 void 21 Perl_deb_nocontext(const char *pat, ...) 22 { 23 #ifdef DEBUGGING 24 dTHX; 25 va_list args; 26 va_start(args, pat); 27 vdeb(pat, &args); 28 va_end(args); 29 #endif /* DEBUGGING */ 30 } 31 #endif 32 33 void 34 Perl_deb(pTHX_ const char *pat, ...) 35 { 36 #ifdef DEBUGGING 37 va_list args; 38 va_start(args, pat); 39 vdeb(pat, &args); 40 va_end(args); 41 #endif /* DEBUGGING */ 42 } 43 44 void 45 Perl_vdeb(pTHX_ const char *pat, va_list *args) 46 { 47 #ifdef DEBUGGING 48 char* file = CopFILE(PL_curcop); 49 50 #ifdef USE_THREADS 51 PerlIO_printf(Perl_debug_log, "0x%"UVxf" (%s:%ld)\t", 52 PTR2UV(thr), 53 (file ? file : "<free>"), 54 (long)CopLINE(PL_curcop)); 55 #else 56 PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", (file ? file : "<free>"), 57 (long)CopLINE(PL_curcop)); 58 #endif /* USE_THREADS */ 59 (void) PerlIO_vprintf(Perl_debug_log, pat, *args); 60 #endif /* DEBUGGING */ 61 } 62 63 I32 64 Perl_debstackptrs(pTHX) 65 { 66 #ifdef DEBUGGING 67 PerlIO_printf(Perl_debug_log, 68 "%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n", 69 PTR2UV(PL_curstack), PTR2UV(PL_stack_base), 70 (IV)*PL_markstack_ptr, (IV)(PL_stack_sp-PL_stack_base), 71 (IV)(PL_stack_max-PL_stack_base)); 72 PerlIO_printf(Perl_debug_log, 73 "%8"UVxf" %8"UVxf" %8"UVuf" %8"UVuf" %8"UVuf"\n", 74 PTR2UV(PL_mainstack), PTR2UV(AvARRAY(PL_curstack)), 75 PTR2UV(PL_mainstack), PTR2UV(AvFILLp(PL_curstack)), 76 PTR2UV(AvMAX(PL_curstack))); 77 #endif /* DEBUGGING */ 78 return 0; 79 } 80 81 I32 82 Perl_debstack(pTHX) 83 { 84 #ifdef DEBUGGING 85 I32 top = PL_stack_sp - PL_stack_base; 86 register I32 i = top - 30; 87 I32 *markscan = PL_markstack + PL_curstackinfo->si_markoff; 88 89 if (i < 0) 90 i = 0; 91 92 while (++markscan <= PL_markstack_ptr) 93 if (*markscan >= i) 94 break; 95 96 #ifdef USE_THREADS 97 PerlIO_printf(Perl_debug_log, 98 i ? "0x%"UVxf" => ... " : "0x%lx => ", 99 PTR2UV(thr)); 100 #else 101 PerlIO_printf(Perl_debug_log, i ? " => ... " : " => "); 102 #endif /* USE_THREADS */ 103 if (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base) 104 PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n"); 105 do { 106 ++i; 107 if (markscan <= PL_markstack_ptr && *markscan < i) { 108 do { 109 ++markscan; 110 PerlIO_putc(Perl_debug_log, '*'); 111 } 112 while (markscan <= PL_markstack_ptr && *markscan < i); 113 PerlIO_printf(Perl_debug_log, " "); 114 } 115 if (i > top) 116 break; 117 PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(PL_stack_base[i])); 118 } 119 while (1); 120 PerlIO_printf(Perl_debug_log, "\n"); 121 #endif /* DEBUGGING */ 122 return 0; 123 } 124