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 #if !defined(I_STDARG) && !defined(I_VARARGS)
  19
  20 /*
  21  * Fallback on the old hackers way of doing varargs
  22  */
  23
  24 /*VARARGS1*/
  25 void
  26 deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
  27     char *pat;
  28 {
  29 #ifdef DEBUGGING
  30     dTHR;
  31     register I32 i;
  32     GV* gv = curcop->cop_filegv;
  33
  34 #ifdef USE_THREADS
  35     PerlIO_printf(Perl_debug_log,"0x%lx (%s:%ld)\t",
  36                   (unsigned long) thr,
  37                   SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
  38                   (long)curcop->cop_line);
  39 #else
  40     PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
  41         SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
  42         (long)curcop->cop_line);
  43 #endif /* USE_THREADS */
  44     for (i=0; i<dlevel; i++)
  45         PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]);
  46     PerlIO_printf(Perl_debug_log, pat,a1,a2,a3,a4,a5,a6,a7,a8);
  47 #endif /* DEBUGGING */
  48 }
  49
  50 #else /* !defined(I_STDARG) && !defined(I_VARARGS) */
  51
  52 #  ifdef I_STDARG
  53 void
  54 deb(const char *pat, ...)
  55 #  else
  56 /*VARARGS1*/
  57 void
  58 deb(pat, va_alist)
  59     const char *pat;
  60     va_dcl
  61 #  endif
  62 {
  63 #ifdef DEBUGGING
  64     dTHR;
  65     va_list args;
  66     register I32 i;
  67     GV* gv = curcop->cop_filegv;
  68
  69 #ifdef USE_THREADS
  70     PerlIO_printf(Perl_debug_log, "0x%lx (%s:%ld)\t",
  71                   (unsigned long) thr,
  72                   SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
  73                   (long)curcop->cop_line);
  74 #else
  75     PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
  76         SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
  77         (long)curcop->cop_line);
  78 #endif /* USE_THREADS */
  79     for (i=0; i<dlevel; i++)
  80         PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]);
  81
  82 #  ifdef I_STDARG
  83     va_start(args, pat);
  84 #  else
  85     va_start(args);
  86 #  endif
  87     (void) PerlIO_vprintf(Perl_debug_log,pat,args);
  88     va_end( args );
  89 #endif /* DEBUGGING */
  90 }
  91 #endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
  92
  93 void
  94 deb_growlevel(void)
  95 {
  96 #ifdef DEBUGGING
  97     dlmax += 128;
  98     Renew(debname, dlmax, char);
  99     Renew(debdelim, dlmax, char);
 100 #endif /* DEBUGGING */
 101 }
 102
 103 I32
 104 debstackptrs(void)
 105 {
 106 #ifdef DEBUGGING
 107     dTHR;
 108     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
 109         (unsigned long)curstack, (unsigned long)stack_base,
 110         (long)*markstack_ptr, (long)(stack_sp-stack_base),
 111         (long)(stack_max-stack_base));
 112     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
 113         (unsigned long)mainstack, (unsigned long)AvARRAY(curstack),
 114         (long)mainstack, (long)AvFILLp(curstack), (long)AvMAX(curstack));
 115 #endif /* DEBUGGING */
 116     return 0;
 117 }
 118
 119 I32
 120 debstack(void)
 121 {
 122 #ifdef DEBUGGING
 123     dTHR;
 124     I32 top = stack_sp - stack_base;
 125     register I32 i = top - 30;
 126     I32 *markscan = curstackinfo->si_markbase;
 127
 128     if (i < 0)
 129         i = 0;
 130
 131     while (++markscan <= markstack_ptr)
 132         if (*markscan >= i)
 133             break;
 134
 135 #ifdef USE_THREADS
 136     PerlIO_printf(Perl_debug_log, i ? "0x%lx    =>  ...  " : "0x%lx    =>  ",
 137                   (unsigned long) thr);
 138 #else
 139     PerlIO_printf(Perl_debug_log, i ? "    =>  ...  " : "    =>  ");
 140 #endif /* USE_THREADS */
 141     if (stack_base[0] != &sv_undef || stack_sp < stack_base)
 142         PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
 143     do {
 144         ++i;
 145         if (markscan <= markstack_ptr && *markscan < i) {
 146             do {
 147                 ++markscan;
 148                 PerlIO_putc(Perl_debug_log, '*');
 149             }
 150             while (markscan <= markstack_ptr && *markscan < i);
 151             PerlIO_printf(Perl_debug_log, "  ");
 152         }
 153         if (i > top)
 154             break;
 155         PerlIO_printf(Perl_debug_log, "%-4s  ", SvPEEK(stack_base[i]));
 156     }
 157     while (1);
 158     PerlIO_printf(Perl_debug_log, "\n");
 159 #endif /* DEBUGGING */
 160     return 0;
 161 }