home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / deb.c < prev    next >
C/C++ Source or Header  |  2000-03-04  |  3KB  |  127 lines
  1. /*    deb.c
  2.  *
  3.  *    Copyright (c) 1991-2000, 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. #if defined(PERL_IMPLICIT_CONTEXT)
  20. void
  21. Perl_deb_nocontext(const char *pat, ...)
  22. {
  23. #ifdef DEBUGGING
  24.     dTHX;
  25.     va_list args;
  26.     va_start(args, pat);
  27.     vdeb(pat, &args);
  28.     va_end(args);
  29. #endif /* DEBUGGING */
  30. }
  31. #endif
  32.  
  33. void
  34. Perl_deb(pTHX_ const char *pat, ...)
  35. {
  36. #ifdef DEBUGGING
  37.     va_list args;
  38.     va_start(args, pat);
  39.     vdeb(pat, &args);
  40.     va_end(args);
  41. #endif /* DEBUGGING */
  42. }
  43.  
  44. void
  45. Perl_vdeb(pTHX_ const char *pat, va_list *args)
  46. {
  47. #ifdef DEBUGGING
  48.     dTHR;
  49.     char* file = CopFILE(PL_curcop);
  50.  
  51. #ifdef USE_THREADS
  52.     PerlIO_printf(Perl_debug_log, "0x%"UVxf" (%s:%ld)\t",
  53.           PTR2UV(thr),
  54.           (file ? file : "<free>"),
  55.           (long)CopLINE(PL_curcop));
  56. #else
  57.     PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", (file ? file : "<free>"),
  58.           (long)CopLINE(PL_curcop));
  59. #endif /* USE_THREADS */
  60.     (void) PerlIO_vprintf(Perl_debug_log, pat, *args);
  61. #endif /* DEBUGGING */
  62. }
  63.  
  64. I32
  65. Perl_debstackptrs(pTHX)
  66. {
  67. #ifdef DEBUGGING
  68.     dTHR;
  69.     PerlIO_printf(Perl_debug_log,
  70.           "%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n",
  71.           PTR2UV(PL_curstack), PTR2UV(PL_stack_base),
  72.           (IV)*PL_markstack_ptr, (IV)(PL_stack_sp-PL_stack_base),
  73.           (IV)(PL_stack_max-PL_stack_base));
  74.     PerlIO_printf(Perl_debug_log,
  75.           "%8"UVxf" %8"UVxf" %8"UVuf" %8"UVuf" %8"UVuf"\n",
  76.           PTR2UV(PL_mainstack), PTR2UV(AvARRAY(PL_curstack)),
  77.           PTR2UV(PL_mainstack), PTR2UV(AvFILLp(PL_curstack)),
  78.           PTR2UV(AvMAX(PL_curstack)));
  79. #endif /* DEBUGGING */
  80.     return 0;
  81. }
  82.  
  83. I32
  84. Perl_debstack(pTHX)
  85. {
  86. #ifdef DEBUGGING
  87.     dTHR;
  88.     I32 top = PL_stack_sp - PL_stack_base;
  89.     register I32 i = top - 30;
  90.     I32 *markscan = PL_markstack + PL_curstackinfo->si_markoff;
  91.  
  92.     if (i < 0)
  93.     i = 0;
  94.     
  95.     while (++markscan <= PL_markstack_ptr)
  96.     if (*markscan >= i)
  97.         break;
  98.  
  99. #ifdef USE_THREADS
  100.     PerlIO_printf(Perl_debug_log,
  101.           i ? "0x%"UVxf"    =>  ...  " : "0x%lx    =>  ",
  102.           PTR2UV(thr));
  103. #else
  104.     PerlIO_printf(Perl_debug_log, i ? "    =>  ...  " : "    =>  ");
  105. #endif /* USE_THREADS */
  106.     if (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base)
  107.     PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
  108.     do {
  109.     ++i;
  110.     if (markscan <= PL_markstack_ptr && *markscan < i) {
  111.         do {
  112.         ++markscan;
  113.         PerlIO_putc(Perl_debug_log, '*');
  114.         }
  115.         while (markscan <= PL_markstack_ptr && *markscan < i);
  116.         PerlIO_printf(Perl_debug_log, "  ");
  117.     }
  118.     if (i > top)
  119.         break;
  120.     PerlIO_printf(Perl_debug_log, "%-4s  ", SvPEEK(PL_stack_base[i]));
  121.     }
  122.     while (1);
  123.     PerlIO_printf(Perl_debug_log, "\n");
  124. #endif /* DEBUGGING */
  125.     return 0;
  126. }
  127.