home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / MacPerl 5.1.3 / Mac_Perl_513_src / perl5.002 / run.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-01-05  |  2.4 KB  |  137 lines  |  [TEXT/MPS ]
  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. #ifdef macintosh
  27.     static long needsSpin = 0;
  28. #endif
  29.     SAVEI32(runlevel);
  30.     runlevel++;
  31.  
  32.     while ( op = (*op->op_ppaddr)() )
  33. #ifdef macintosh
  34.     if (!(needsSpin++ & 0x00FFF))
  35.             SpinMacCursor();
  36. #else
  37.     ;
  38. #endif
  39.     return 0;
  40. }
  41.  
  42. #else
  43.  
  44. static void debprof _((OP*op));
  45.  
  46. int
  47. runops() {
  48. #ifdef macintosh
  49.     static long needsSpin = 0;
  50. #endif
  51.     if (!op) {
  52.     warn("NULL OP IN RUN");
  53.     return 0;
  54.     }
  55.  
  56.     SAVEI32(runlevel);
  57.     runlevel++;
  58.  
  59.     do {
  60. #ifdef macintosh
  61.     if (!(needsSpin++ & 0x00FFF))
  62.             SpinMacCursor();
  63. #endif
  64.     if (debug) {
  65.         if (watchaddr != 0 && *watchaddr != watchok)
  66.         fprintf(Perl_debug_log, "WARNING: %lx changed from %lx to %lx\n",
  67.             (long)watchaddr, (long)watchok, (long)*watchaddr);
  68.         DEBUG_s(debstack());
  69.         DEBUG_t(debop(op));
  70.         DEBUG_P(debprof(op));
  71.     }
  72.     } while ( op = (*op->op_ppaddr)() );
  73.     return 0;
  74. }
  75.  
  76. I32
  77. debop(op)
  78. OP *op;
  79. {
  80.     SV *sv;
  81.     deb("%s", op_name[op->op_type]);
  82.     switch (op->op_type) {
  83.     case OP_CONST:
  84.     fprintf(Perl_debug_log, "(%s)", SvPEEK(cSVOP->op_sv));
  85.     break;
  86.     case OP_GVSV:
  87.     case OP_GV:
  88.     if (cGVOP->op_gv) {
  89.         sv = NEWSV(0,0);
  90.         gv_fullname(sv, cGVOP->op_gv);
  91.         fprintf(Perl_debug_log, "(%s)", SvPV(sv, na));
  92.         SvREFCNT_dec(sv);
  93.     }
  94.     else
  95.         fprintf(Perl_debug_log, "(NULL)");
  96.     break;
  97.     default:
  98.     break;
  99.     }
  100.     fprintf(Perl_debug_log, "\n");
  101.     return 0;
  102. }
  103.  
  104. void
  105. watch(addr)
  106. char **addr;
  107. {
  108.     watchaddr = addr;
  109.     watchok = *addr;
  110.     fprintf(Perl_debug_log, "WATCHING, %lx is currently %lx\n",
  111.     (long)watchaddr, (long)watchok);
  112. }
  113.  
  114. static void
  115. debprof(op)
  116. OP* op;
  117. {
  118.     if (!profiledata)
  119.     New(000, profiledata, MAXO, U32);
  120.     ++profiledata[op->op_type];
  121. }
  122.  
  123. void
  124. debprofdump()
  125. {
  126.     U32 i;
  127.     if (!profiledata)
  128.     return;
  129.     for (i = 0; i < MAXO; i++) {
  130.     if (profiledata[i])
  131.         fprintf(Perl_debug_log, "%d\t%lu\n", i, profiledata[i]);
  132.     }
  133. }
  134.  
  135. #endif
  136.  
  137.