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