home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-base.tgz / perl-5.003-base.tar / fsf / perl / run.c < prev    next >
C/C++ Source or Header  |  1996-03-25  |  2KB  |  121 lines
  1. /*    run.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. #include "EXTERN.h"
  11. #include "perl.h"
  12.  
  13. /*
  14.  * "Away now, Shadowfax!  Run, greatheart, run as you have never run before!
  15.  * Now we are come to the lands where you were foaled, and every stone you
  16.  * know.  Run now!  Hope is in speed!"  --Gandalf
  17.  */
  18.  
  19. dEXT char **watchaddr = 0;
  20. dEXT char *watchok;
  21.  
  22. #ifndef DEBUGGING
  23.  
  24. int
  25. runops() {
  26.     SAVEI32(runlevel);
  27.     runlevel++;
  28.  
  29.     while ( op = (*op->op_ppaddr)() ) ;
  30.     return 0;
  31. }
  32.  
  33. #else
  34.  
  35. static void debprof _((OP*op));
  36.  
  37. int
  38. runops() {
  39.     if (!op) {
  40.     warn("NULL OP IN RUN");
  41.     return 0;
  42.     }
  43.  
  44.     SAVEI32(runlevel);
  45.     runlevel++;
  46.  
  47.     do {
  48.     if (debug) {
  49.         if (watchaddr != 0 && *watchaddr != watchok)
  50.         fprintf(stderr, "WARNING: %lx changed from %lx to %lx\n",
  51.             (long)watchaddr, (long)watchok, (long)*watchaddr);
  52.         DEBUG_s(debstack());
  53.         DEBUG_t(debop(op));
  54.         DEBUG_P(debprof(op));
  55.     }
  56.     } while ( op = (*op->op_ppaddr)() );
  57.     return 0;
  58. }
  59.  
  60. I32
  61. debop(op)
  62. OP *op;
  63. {
  64.     SV *sv;
  65.     deb("%s", op_name[op->op_type]);
  66.     switch (op->op_type) {
  67.     case OP_CONST:
  68.     fprintf(stderr, "(%s)", SvPEEK(cSVOP->op_sv));
  69.     break;
  70.     case OP_GVSV:
  71.     case OP_GV:
  72.     if (cGVOP->op_gv) {
  73.         sv = NEWSV(0,0);
  74.         gv_fullname(sv, cGVOP->op_gv);
  75.         fprintf(stderr, "(%s)", SvPV(sv, na));
  76.         SvREFCNT_dec(sv);
  77.     }
  78.     else
  79.         fprintf(stderr, "(NULL)");
  80.     break;
  81.     default:
  82.     break;
  83.     }
  84.     fprintf(stderr, "\n");
  85.     return 0;
  86. }
  87.  
  88. void
  89. watch(addr)
  90. char **addr;
  91. {
  92.     watchaddr = addr;
  93.     watchok = *addr;
  94.     fprintf(stderr, "WATCHING, %lx is currently %lx\n",
  95.     (long)watchaddr, (long)watchok);
  96. }
  97.  
  98. static void
  99. debprof(op)
  100. OP* op;
  101. {
  102.     if (!profiledata)
  103.     New(000, profiledata, MAXO, U32);
  104.     ++profiledata[op->op_type];
  105. }
  106.  
  107. void
  108. debprofdump()
  109. {
  110.     U32 i;
  111.     if (!profiledata)
  112.     return;
  113.     for (i = 0; i < MAXO; i++) {
  114.     if (profiledata[i])
  115.         fprintf(stderr, "%d\t%lu\n", i, profiledata[i]);
  116.     }
  117. }
  118.  
  119. #endif
  120.  
  121.