home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / run.c < prev    next >
C/C++ Source or Header  |  2000-03-04  |  3KB  |  132 lines
  1. /*    run.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. #include "EXTERN.h"
  11. #define PERL_IN_RUN_C
  12. #include "perl.h"
  13.  
  14. /*
  15.  * "Away now, Shadowfax!  Run, greatheart, run as you have never run before!
  16.  * Now we are come to the lands where you were foaled, and every stone you
  17.  * know.  Run now!  Hope is in speed!"  --Gandalf
  18.  */
  19.  
  20. int
  21. Perl_runops_standard(pTHX)
  22. {
  23.     dTHR;
  24.  
  25.     while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
  26.     PERL_ASYNC_CHECK();
  27.     }
  28.  
  29.     TAINT_NOT;
  30.     return 0;
  31. }
  32.  
  33. int
  34. Perl_runops_debug(pTHX)
  35. {
  36. #ifdef DEBUGGING
  37.     dTHR;
  38.     if (!PL_op) {
  39.     if (ckWARN_d(WARN_DEBUGGING))
  40.         Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN");
  41.     return 0;
  42.     }
  43.  
  44.     do {
  45.     PERL_ASYNC_CHECK();
  46.     if (PL_debug) {
  47.         if (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok)
  48.         PerlIO_printf(Perl_debug_log,
  49.                   "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
  50.                   PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
  51.                   PTR2UV(*PL_watchaddr));
  52.         DEBUG_s(debstack());
  53.         DEBUG_t(debop(PL_op));
  54.         DEBUG_P(debprof(PL_op));
  55.     }
  56.     } while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)));
  57.  
  58.     TAINT_NOT;
  59.     return 0;
  60. #else
  61.     return runops_standard();
  62. #endif    /* DEBUGGING */
  63. }
  64.  
  65. I32
  66. Perl_debop(pTHX_ OP *o)
  67. {
  68. #ifdef DEBUGGING
  69.     SV *sv;
  70.     STRLEN n_a;
  71.     Perl_deb(aTHX_ "%s", PL_op_name[o->op_type]);
  72.     switch (o->op_type) {
  73.     case OP_CONST:
  74.     PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
  75.     break;
  76.     case OP_GVSV:
  77.     case OP_GV:
  78.     if (cGVOPo_gv) {
  79.         sv = NEWSV(0,0);
  80.         gv_fullname3(sv, cGVOPo_gv, Nullch);
  81.         PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
  82.         SvREFCNT_dec(sv);
  83.     }
  84.     else
  85.         PerlIO_printf(Perl_debug_log, "(NULL)");
  86.     break;
  87.     default:
  88.     break;
  89.     }
  90.     PerlIO_printf(Perl_debug_log, "\n");
  91. #endif    /* DEBUGGING */
  92.     return 0;
  93. }
  94.  
  95. void
  96. Perl_watch(pTHX_ char **addr)
  97. {
  98. #ifdef DEBUGGING
  99.     dTHR;
  100.     PL_watchaddr = addr;
  101.     PL_watchok = *addr;
  102.     PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
  103.     PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
  104. #endif    /* DEBUGGING */
  105. }
  106.  
  107. STATIC void
  108. S_debprof(pTHX_ OP *o)
  109. {
  110. #ifdef DEBUGGING
  111.     if (!PL_profiledata)
  112.     Newz(000, PL_profiledata, MAXO, U32);
  113.     ++PL_profiledata[o->op_type];
  114. #endif /* DEBUGGING */
  115. }
  116.  
  117. void
  118. Perl_debprofdump(pTHX)
  119. {
  120. #ifdef DEBUGGING
  121.     unsigned i;
  122.     if (!PL_profiledata)
  123.     return;
  124.     for (i = 0; i < MAXO; i++) {
  125.     if (PL_profiledata[i])
  126.         PerlIO_printf(Perl_debug_log,
  127.               "%5lu %s\n", (unsigned long)PL_profiledata[i],
  128.                                        PL_op_name[i]);
  129.     }
  130. #endif    /* DEBUGGING */
  131. }
  132.