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