deb.c

   1 /*    deb.c
   2  *
   3  *    Copyright (c) 1991-1997, 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 #include "perl.h"
  17
  18 void
  19 deb(const char *pat, ...)
  20 {
  21 #ifdef DEBUGGING
  22     dTHR;
  23     va_list args;
  24     register I32 i;
  25     GV* gv = curcop->cop_filegv;
  26
  27 #ifdef USE_THREADS
  28     PerlIO_printf(Perl_debug_log, "0x%lx (%s:%ld)\t",
  29                   (unsigned long) thr,
  30                   SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
  31                   (long)curcop->cop_line);
  32 #else
  33     PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
  34         SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
  35         (long)curcop->cop_line);
  36 #endif /* USE_THREADS */
  37     for (i=0; i<dlevel; i++)
  38         PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]);
  39
  40     va_start(args, pat);
  41     (void) PerlIO_vprintf(Perl_debug_log,pat,args);
  42     va_end( args );
  43 #endif /* DEBUGGING */
  44 }
  45
  46 void
  47 deb_growlevel(void)
  48 {
  49 #ifdef DEBUGGING
  50     dlmax += 128;
  51     Renew(debname, dlmax, char);
  52     Renew(debdelim, dlmax, char);
  53 #endif /* DEBUGGING */
  54 }
  55
  56 I32
  57 debstackptrs(void)
  58 {
  59 #ifdef DEBUGGING
  60     dTHR;
  61     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
  62         (unsigned long)curstack, (unsigned long)stack_base,
  63         (long)*markstack_ptr, (long)(stack_sp-stack_base),
  64         (long)(stack_max-stack_base));
  65     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
  66         (unsigned long)mainstack, (unsigned long)AvARRAY(curstack),
  67         (long)mainstack, (long)AvFILLp(curstack), (long)AvMAX(curstack));
  68 #endif /* DEBUGGING */
  69     return 0;
  70 }
  71
  72 I32
  73 debstack(void)
  74 {
  75 #ifdef DEBUGGING
  76     dTHR;
  77     I32 top = stack_sp - stack_base;
  78     register I32 i = top - 30;
  79     I32 *markscan = curstackinfo->si_markbase;
  80
  81     if (i < 0)
  82         i = 0;
  83
  84     while (++markscan <= markstack_ptr)
  85         if (*markscan >= i)
  86             break;
  87
  88 #ifdef USE_THREADS
  89     PerlIO_printf(Perl_debug_log, i ? "0x%lx    =>  ...  " : "0x%lx    =>  ",
  90                   (unsigned long) thr);
  91 #else
  92     PerlIO_printf(Perl_debug_log, i ? "    =>  ...  " : "    =>  ");
  93 #endif /* USE_THREADS */
  94     if (stack_base[0] != &sv_undef || stack_sp < stack_base)
  95         PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
  96     do {
  97         ++i;
  98         if (markscan <= markstack_ptr && *markscan < i) {
  99             do {
 100                 ++markscan;
 101                 PerlIO_putc(Perl_debug_log, '*');
 102             }
 103             while (markscan <= markstack_ptr && *markscan < i);
 104             PerlIO_printf(Perl_debug_log, "  ");
 105         }
 106         if (i > top)
 107             break;
 108         PerlIO_printf(Perl_debug_log, "%-4s  ", SvPEEK(stack_base[i]));
 109     }
 110     while (1);
 111     PerlIO_printf(Perl_debug_log, "\n");
 112 #endif /* DEBUGGING */
 113     return 0;
 114 }