run.c

   1 /*    run.c
   2  *
   3  *    Copyright (c) 1991-1997, 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
  20 int
  21 runops_standard(void)
  22 {
  23     dTHR;
  24
  25     while ( op = (*op->op_ppaddr)(ARGS) ) ;
  26
  27     TAINT_NOT;
  28     return 0;
  29 }
  30
  31 #ifdef DEBUGGING
  32
  33 dEXT char **watchaddr = 0;
  34 dEXT char *watchok;
  35
  36 static void debprof _((OP*o));
  37
  38 #endif  /* DEBUGGING */
  39
  40 int
  41 runops_debug(void)
  42 {
  43 #ifdef DEBUGGING
  44     dTHR;
  45     if (!op) {
  46         warn("NULL OP IN RUN");
  47         return 0;
  48     }
  49
  50     do {
  51         if (debug) {
  52             if (watchaddr != 0 && *watchaddr != watchok)
  53                 PerlIO_printf(Perl_debug_log, "WARNING: %lx changed from %lx to %lx\n",
  54                     (long)watchaddr, (long)watchok, (long)*watchaddr);
  55             DEBUG_s(debstack());
  56             DEBUG_t(debop(op));
  57             DEBUG_P(debprof(op));
  58         }
  59     } while ( op = (*op->op_ppaddr)(ARGS) );
  60
  61     TAINT_NOT;
  62     return 0;
  63 #else
  64     return runops_standard();
  65 #endif  /* DEBUGGING */
  66 }
  67
  68 I32
  69 debop(OP *o)
  70 {
  71 #ifdef DEBUGGING
  72     SV *sv;
  73     deb("%s", op_name[o->op_type]);
  74     switch (o->op_type) {
  75     case OP_CONST:
  76         PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv));
  77         break;
  78     case OP_GVSV:
  79     case OP_GV:
  80         if (cGVOPo->op_gv) {
  81             sv = NEWSV(0,0);
  82             gv_fullname3(sv, cGVOPo->op_gv, Nullch);
  83             PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, na));
  84             SvREFCNT_dec(sv);
  85         }
  86         else
  87             PerlIO_printf(Perl_debug_log, "(NULL)");
  88         break;
  89     default:
  90         break;
  91     }
  92     PerlIO_printf(Perl_debug_log, "\n");
  93 #endif  /* DEBUGGING */
  94     return 0;
  95 }
  96
  97 void
  98 watch(char **addr)
  99 {
 100 #ifdef DEBUGGING
 101     watchaddr = addr;
 102     watchok = *addr;
 103     PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n",
 104         (long)watchaddr, (long)watchok);
 105 #endif  /* DEBUGGING */
 106 }
 107
 108 #ifdef DEBUGGING
 109 static void
 110 debprof(OP *o)
 111 {
 112     if (!profiledata)
 113         New(000, profiledata, MAXO, U32);
 114     ++profiledata[o->op_type];
 115 }
 116 #endif  /* DEBUGGING */
 117
 118 void
 119 debprofdump(void)
 120 {
 121 #ifdef DEBUGGING
 122     unsigned i;
 123     if (!profiledata)
 124         return;
 125     for (i = 0; i < MAXO; i++) {
 126         if (profiledata[i])
 127             PerlIO_printf(Perl_debug_log,
 128                           "%u\t%lu\n", i, (unsigned long)profiledata[i]);
 129     }
 130 #endif  /* DEBUGGING */
 131 }