deb.c

   1 /*    deb.c
   2  *
   3  *    Copyright (c) 1991-1999, 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     dTHR;
  49     register I32 i;
  50     GV* gv = PL_curcop->cop_filegv;
  51
  52 #ifdef USE_THREADS
  53     PerlIO_printf(Perl_debug_log, "0x%lx (%s:%ld)\t",
  54                   (unsigned long) thr,
  55                   SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
  56                   (long)PL_curcop->cop_line);
  57 #else
  58     PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
  59         SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
  60         (long)PL_curcop->cop_line);
  61 #endif /* USE_THREADS */
  62     for (i=0; i<PL_dlevel; i++)
  63         PerlIO_printf(Perl_debug_log, "%c%c ",PL_debname[i],PL_debdelim[i]);
  64     (void) PerlIO_vprintf(Perl_debug_log, pat, *args);
  65 #endif /* DEBUGGING */
  66 }
  67
  68 void
  69 Perl_deb_growlevel(pTHX)
  70 {
  71 #ifdef DEBUGGING
  72     PL_dlmax += 128;
  73     Renew(PL_debname, PL_dlmax, char);
  74     Renew(PL_debdelim, PL_dlmax, char);
  75 #endif /* DEBUGGING */
  76 }
  77
  78 I32
  79 Perl_debstackptrs(pTHX)
  80 {
  81 #ifdef DEBUGGING
  82     dTHR;
  83     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
  84         (unsigned long)PL_curstack, (unsigned long)PL_stack_base,
  85         (long)*PL_markstack_ptr, (long)(PL_stack_sp-PL_stack_base),
  86         (long)(PL_stack_max-PL_stack_base));
  87     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
  88         (unsigned long)PL_mainstack, (unsigned long)AvARRAY(PL_curstack),
  89         (long)PL_mainstack, (long)AvFILLp(PL_curstack), (long)AvMAX(PL_curstack));
  90 #endif /* DEBUGGING */
  91     return 0;
  92 }
  93
  94 I32
  95 Perl_debstack(pTHX)
  96 {
  97 #ifdef DEBUGGING
  98     dTHR;
  99     I32 top = PL_stack_sp - PL_stack_base;
 100     register I32 i = top - 30;
 101     I32 *markscan = PL_curstackinfo->si_markbase;
 102
 103     if (i < 0)
 104         i = 0;
 105
 106     while (++markscan <= PL_markstack_ptr)
 107         if (*markscan >= i)
 108             break;
 109
 110 #ifdef USE_THREADS
 111     PerlIO_printf(Perl_debug_log, i ? "0x%lx    =>  ...  " : "0x%lx    =>  ",
 112                   (unsigned long) thr);
 113 #else
 114     PerlIO_printf(Perl_debug_log, i ? "    =>  ...  " : "    =>  ");
 115 #endif /* USE_THREADS */
 116     if (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base)
 117         PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
 118     do {
 119         ++i;
 120         if (markscan <= PL_markstack_ptr && *markscan < i) {
 121             do {
 122                 ++markscan;
 123                 PerlIO_putc(Perl_debug_log, '*');
 124             }
 125             while (markscan <= PL_markstack_ptr && *markscan < i);
 126             PerlIO_printf(Perl_debug_log, "  ");
 127         }
 128         if (i > top)
 129             break;
 130         PerlIO_printf(Perl_debug_log, "%-4s  ", SvPEEK(PL_stack_base[i]));
 131     }
 132     while (1);
 133     PerlIO_printf(Perl_debug_log, "\n");
 134 #endif /* DEBUGGING */
 135     return 0;
 136 }