run.c

   1 /*    run.c
   2  *
   3  *    Copyright (c) 1991-1999, 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
  27     TAINT_NOT;
  28     return 0;
  29 }
  30
  31 int
  32 Perl_runops_debug(pTHX)
  33 {
  34 #ifdef DEBUGGING
  35     dTHR;
  36     if (!PL_op) {
  37         if (ckWARN_d(WARN_DEBUGGING))
  38             Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN");
  39         return 0;
  40     }
  41
  42     do {
  43         if (PL_debug) {
  44             if (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok)
  45                 PerlIO_printf(Perl_debug_log,
  46                               "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
  47                               PTR2UV(PL_watchaddr), PTR2UV(PL_watchok), (UV)*PL_watchaddr);
  48             DEBUG_s(debstack());
  49             DEBUG_t(debop(PL_op));
  50             DEBUG_P(debprof(PL_op));
  51         }
  52     } while ( PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX) );
  53
  54     TAINT_NOT;
  55     return 0;
  56 #else
  57     return runops_standard();
  58 #endif  /* DEBUGGING */
  59 }
  60
  61 I32
  62 Perl_debop(pTHX_ OP *o)
  63 {
  64 #ifdef DEBUGGING
  65     SV *sv;
  66     STRLEN n_a;
  67     Perl_deb(aTHX_ "%s", PL_op_name[o->op_type]);
  68     switch (o->op_type) {
  69     case OP_CONST:
  70         PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv));
  71         break;
  72     case OP_GVSV:
  73     case OP_GV:
  74         if (cGVOPo) {
  75             sv = NEWSV(0,0);
  76             gv_fullname3(sv, cGVOPo, Nullch);
  77             PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
  78             SvREFCNT_dec(sv);
  79         }
  80         else
  81             PerlIO_printf(Perl_debug_log, "(NULL)");
  82         break;
  83     default:
  84         break;
  85     }
  86     PerlIO_printf(Perl_debug_log, "\n");
  87 #endif  /* DEBUGGING */
  88     return 0;
  89 }
  90
  91 void
  92 Perl_watch(pTHX_ char **addr)
  93 {
  94 #ifdef DEBUGGING
  95     dTHR;
  96     PL_watchaddr = addr;
  97     PL_watchok = *addr;
  98     PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
  99         PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
 100 #endif  /* DEBUGGING */
 101 }
 102
 103 STATIC void
 104 S_debprof(pTHX_ OP *o)
 105 {
 106 #ifdef DEBUGGING
 107     if (!PL_profiledata)
 108         Newz(000, PL_profiledata, MAXO, U32);
 109     ++PL_profiledata[o->op_type];
 110 #endif /* DEBUGGING */
 111 }
 112
 113 void
 114 Perl_debprofdump(pTHX)
 115 {
 116 #ifdef DEBUGGING
 117     unsigned i;
 118     if (!PL_profiledata)
 119         return;
 120     for (i = 0; i < MAXO; i++) {
 121         if (PL_profiledata[i])
 122             PerlIO_printf(Perl_debug_log,
 123                           "%5lu %s\n", (unsigned long)PL_profiledata[i],
 124                                        PL_op_name[i]);
 125     }
 126 #endif  /* DEBUGGING */
 127 }