This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Initial (untested) integration of mainline changes.
[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(void) {
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(void) {
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(OP *o)
60 {
61     SV *sv;
62     deb("%s", op_name[o->op_type]);
63     switch (o->op_type) {
64     case OP_CONST:
65         PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv));
66         break;
67     case OP_GVSV:
68     case OP_GV:
69         if (cGVOPo->op_gv) {
70             sv = NEWSV(0,0);
71             gv_fullname3(sv, cGVOPo->op_gv, Nullch);
72             PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, na));
73             SvREFCNT_dec(sv);
74         }
75         else
76             PerlIO_printf(Perl_debug_log, "(NULL)");
77         break;
78     default:
79         break;
80     }
81     PerlIO_printf(Perl_debug_log, "\n");
82     return 0;
83 }
84
85 void
86 watch(char **addr)
87 {
88     watchaddr = addr;
89     watchok = *addr;
90     PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n",
91         (long)watchaddr, (long)watchok);
92 }
93
94 static void
95 debprof(OP *o)
96 {
97     if (!profiledata)
98         New(000, profiledata, MAXO, U32);
99     ++profiledata[o->op_type];
100 }
101
102 void
103 debprofdump(void)
104 {
105     unsigned i;
106     if (!profiledata)
107         return;
108     for (i = 0; i < MAXO; i++) {
109         if (profiledata[i])
110             PerlIO_printf(Perl_debug_log,
111                           "%u\t%lu\n", i, (unsigned long)profiledata[i]);
112     }
113 }
114
115 #endif
116