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