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 void
  20 Perl_deb(pTHX_ const char *pat, ...)
  21 {
  22 #ifdef DEBUGGING
  23     dTHR;
  24     va_list args;
  25     register I32 i;
  26     GV* gv = PL_curcop->cop_filegv;
  27
  28 #ifdef USE_THREADS
  29     PerlIO_printf(Perl_debug_log, "0x%lx (%s:%ld)\t",
  30                   (unsigned long) thr,
  31                   SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
  32                   (long)PL_curcop->cop_line);
  33 #else
  34     PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
  35         SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
  36         (long)PL_curcop->cop_line);
  37 #endif /* USE_THREADS */
  38     for (i=0; i<PL_dlevel; i++)
  39         PerlIO_printf(Perl_debug_log, "%c%c ",PL_debname[i],PL_debdelim[i]);
  40
  41     va_start(args, pat);
  42     (void) PerlIO_vprintf(Perl_debug_log,pat,args);
  43     va_end( args );
  44 #endif /* DEBUGGING */
  45 }
  46
  47 void
  48 Perl_deb_growlevel(pTHX)
  49 {
  50 #ifdef DEBUGGING
  51     PL_dlmax += 128;
  52     Renew(PL_debname, PL_dlmax, char);
  53     Renew(PL_debdelim, PL_dlmax, char);
  54 #endif /* DEBUGGING */
  55 }
  56
  57 I32
  58 Perl_debstackptrs(pTHX)
  59 {
  60 #ifdef DEBUGGING
  61     dTHR;
  62     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
  63         (unsigned long)PL_curstack, (unsigned long)PL_stack_base,
  64         (long)*PL_markstack_ptr, (long)(PL_stack_sp-PL_stack_base),
  65         (long)(PL_stack_max-PL_stack_base));
  66     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
  67         (unsigned long)PL_mainstack, (unsigned long)AvARRAY(PL_curstack),
  68         (long)PL_mainstack, (long)AvFILLp(PL_curstack), (long)AvMAX(PL_curstack));
  69 #endif /* DEBUGGING */
  70     return 0;
  71 }
  72
  73 I32
  74 Perl_debstack(pTHX)
  75 {
  76 #ifdef DEBUGGING
  77     dTHR;
  78     I32 top = PL_stack_sp - PL_stack_base;
  79     register I32 i = top - 30;
  80     I32 *markscan = PL_curstackinfo->si_markbase;
  81
  82     if (i < 0)
  83         i = 0;
  84
  85     while (++markscan <= PL_markstack_ptr)
  86         if (*markscan >= i)
  87             break;
  88
  89 #ifdef USE_THREADS
  90     PerlIO_printf(Perl_debug_log, i ? "0x%lx    =>  ...  " : "0x%lx    =>  ",
  91                   (unsigned long) thr);
  92 #else
  93     PerlIO_printf(Perl_debug_log, i ? "    =>  ...  " : "    =>  ");
  94 #endif /* USE_THREADS */
  95     if (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base)
  96         PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
  97     do {
  98         ++i;
  99         if (markscan <= PL_markstack_ptr && *markscan < i) {
 100             do {
 101                 ++markscan;
 102                 PerlIO_putc(Perl_debug_log, '*');
 103             }
 104             while (markscan <= PL_markstack_ptr && *markscan < i);
 105             PerlIO_printf(Perl_debug_log, "  ");
 106         }
 107         if (i > top)
 108             break;
 109         PerlIO_printf(Perl_debug_log, "%-4s  ", SvPEEK(PL_stack_base[i]));
 110     }
 111     while (1);
 112     PerlIO_printf(Perl_debug_log, "\n");
 113 #endif /* DEBUGGING */
 114     return 0;
 115 }