contrib/perl5/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 #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 = PL_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)PL_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)PL_curcop->cop_line);
  36 #endif /* USE_THREADS */
  37     for (i=0; i<PL_dlevel; i++)
  38         PerlIO_printf(Perl_debug_log, "%c%c ",PL_debname[i],PL_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     PL_dlmax += 128;
  51     Renew(PL_debname, PL_dlmax, char);
  52     Renew(PL_debdelim, PL_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)PL_curstack, (unsigned long)PL_stack_base,
  63         (long)*PL_markstack_ptr, (long)(PL_stack_sp-PL_stack_base),
  64         (long)(PL_stack_max-PL_stack_base));
  65     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
  66         (unsigned long)PL_mainstack, (unsigned long)AvARRAY(PL_curstack),
  67         (long)PL_mainstack, (long)AvFILLp(PL_curstack), (long)AvMAX(PL_curstack));
  68 #endif /* DEBUGGING */
  69     return 0;
  70 }
  71
  72 I32
  73 debstack(void)
  74 {
  75 #ifdef DEBUGGING
  76     dTHR;
  77     I32 top = PL_stack_sp - PL_stack_base;
  78     register I32 i = top - 30;
  79     I32 *markscan = PL_curstackinfo->si_markbase;
  80
  81     if (i < 0)
  82         i = 0;
  83
  84     while (++markscan <= PL_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 (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base)
  95         PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
  96     do {
  97         ++i;
  98         if (markscan <= PL_markstack_ptr && *markscan < i) {
  99             do {
 100                 ++markscan;
 101                 PerlIO_putc(Perl_debug_log, '*');
 102             }
 103             while (markscan <= PL_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(PL_stack_base[i]));
 109     }
 110     while (1);
 111     PerlIO_printf(Perl_debug_log, "\n");
 112 #endif /* DEBUGGING */
 113     return 0;
 114 }