home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / deb.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-01-15  |  2.8 KB  |  139 lines  |  [TEXT/MPS ]
  1. /*    deb.c
  2.  *
  3.  *    Copyright (c) 1991-1994, 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.  
  20. #ifdef macintosh
  21. #undef stderr
  22. #define stderr gPerlDbg
  23. #endif
  24.  
  25. #if !defined(I_STDARG) && !defined(I_VARARGS)
  26.  
  27. /*
  28.  * Fallback on the old hackers way of doing varargs
  29.  */
  30.  
  31. /*VARARGS1*/
  32. void
  33. deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
  34.     char *pat;
  35. {
  36.     register I32 i;
  37.     GV* gv = curcop->cop_filegv;
  38.  
  39.     fprintf(stderr,"(%s:%ld)\t",
  40.     SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
  41.     (long)curcop->cop_line);
  42.     for (i=0; i<dlevel; i++)
  43.     fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
  44.     fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8);
  45. }
  46.  
  47. #else /* !defined(I_STDARG) && !defined(I_VARARGS) */
  48.  
  49. #  ifdef STANDARD_C
  50. void
  51. deb(char *pat, ...)
  52. #  else
  53. /*VARARGS1*/
  54. void
  55. deb(pat, va_alist)
  56.     char *pat;
  57.     va_dcl
  58. #  endif
  59. {
  60.     va_list args;
  61.     register I32 i;
  62.     GV* gv = curcop->cop_filegv;
  63.  
  64.     fprintf(stderr,"(%s:%ld)\t",
  65.     SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
  66.     (long)curcop->cop_line);
  67.     for (i=0; i<dlevel; i++)
  68.     fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
  69.  
  70. #  ifdef I_STDARG
  71.     va_start(args, pat);
  72. #  else
  73.     va_start(args);
  74. #  endif
  75.     (void) vfprintf(stderr,pat,args);
  76.     va_end( args );
  77. }
  78. #endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
  79.  
  80. void
  81. deb_growlevel()
  82. {
  83.     dlmax += 128;
  84.     Renew(debname, dlmax, char);
  85.     Renew(debdelim, dlmax, char);
  86. }
  87.  
  88. I32
  89. debstackptrs()
  90. {
  91.     fprintf(stderr, "%8lx %8lx %8ld %8ld %8ld\n",
  92.     (unsigned long)stack, (unsigned long)stack_base,
  93.     (long)*markstack_ptr, (long)(stack_sp-stack_base),
  94.     (long)(stack_max-stack_base));
  95.     fprintf(stderr, "%8lx %8lx %8ld %8ld %8ld\n",
  96.     (unsigned long)mainstack, (unsigned long)AvARRAY(stack),
  97.     (long)mainstack, (long)AvFILL(stack), (long)AvMAX(stack));
  98.     return 0;
  99. }
  100.  
  101. I32
  102. debstack()
  103. {
  104.     I32 top = stack_sp - stack_base;
  105.     register I32 i = top - 30;
  106.     I32 *markscan = markstack;
  107.  
  108.     if (i < 0)
  109.     i = 0;
  110.     
  111.     while (++markscan <= markstack_ptr)
  112.     if (*markscan >= i)
  113.         break;
  114.  
  115.     fprintf(stderr, i ? "    =>  ...  " : "    =>  ");
  116.     if (stack_base[0] != &sv_undef || stack_sp < stack_base)
  117.     fprintf(stderr, " [STACK UNDERFLOW!!!]\n");
  118.     do {
  119.     ++i;
  120.     if (markscan <= markstack_ptr && *markscan < i) {
  121.         do {
  122.         ++markscan;
  123.         putc('*', stderr);
  124.         }
  125.         while (markscan <= markstack_ptr && *markscan < i);
  126.         fprintf(stderr, "  ");
  127.     }
  128.     if (i > top)
  129.         break;
  130.     fprintf(stderr, "%-4s  ", SvPEEK(stack_base[i]));
  131.     }
  132.     while (1);
  133.     fprintf(stderr, "\n");
  134.     return 0;
  135. }
  136. #else
  137. static int dummy; /* avoid totally empty deb.o file */
  138. #endif /* DEBUGGING */
  139.