1 /* deb.c 2 * 3 * Copyright (c) 1991-2002, 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 = OutCopFILE(PL_curcop); 49 50 #ifdef USE_5005THREADS 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_5005THREADS */ 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 #ifndef SKIP_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 (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_) 90 return 0; 91 92 if (i < 0) 93 i = 0; 94 95 while (++markscan <= PL_markstack_ptr) 96 if (*markscan >= i) 97 break; 98 99 #ifdef USE_5005THREADS 100 PerlIO_printf(Perl_debug_log, 101 i ? "0x%"UVxf" => ... " : "0x%lx => ", 102 PTR2UV(thr)); 103 #else 104 PerlIO_printf(Perl_debug_log, i ? " => ... " : " => "); 105 #endif /* USE_5005THREADS */ 106 if (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base) 107 PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n"); 108 do { 109 ++i; 110 if (markscan <= PL_markstack_ptr && *markscan < i) { 111 do { 112 ++markscan; 113 PerlIO_putc(Perl_debug_log, '*'); 114 } 115 while (markscan <= PL_markstack_ptr && *markscan < i); 116 PerlIO_printf(Perl_debug_log, " "); 117 } 118 if (i > top) 119 break; 120 PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(PL_stack_base[i])); 121 } 122 while (1); 123 PerlIO_printf(Perl_debug_log, "\n"); 124 #endif /* SKIP_DEBUGGING */ 125 return 0; 126 } 127