This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
phase 1 of somewhat major rearrangement of PERL_OBJECT stuff
[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 #ifdef PERL_OBJECT
20 #define CALLOP this->*PL_op
21 #else
22 #define CALLOP *PL_op
23 #endif
24
25 int
26 runops_standard(void)
27 {
28     dTHR;
29
30     while ( PL_op = (CALLOP->op_ppaddr)(ARGS) ) ;
31
32     TAINT_NOT;
33     return 0;
34 }
35
36 #ifdef DEBUGGING
37 #ifndef PERL_OBJECT
38 static void debprof _((OP*o));
39 #endif
40
41 #endif  /* DEBUGGING */
42
43 int
44 runops_debug(void)
45 {
46 #ifdef DEBUGGING
47     dTHR;
48     if (!PL_op) {
49         warn("NULL OP IN RUN");
50         return 0;
51     }
52
53     do {
54         if (PL_debug) {
55             if (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok)
56                 PerlIO_printf(Perl_debug_log, "WARNING: %lx changed from %lx to %lx\n",
57                     (long)PL_watchaddr, (long)PL_watchok, (long)*PL_watchaddr);
58             DEBUG_s(debstack());
59             DEBUG_t(debop(PL_op));
60             DEBUG_P(debprof(PL_op));
61         }
62     } while ( PL_op = (CALLOP->op_ppaddr)(ARGS) );
63
64     TAINT_NOT;
65     return 0;
66 #else
67     return runops_standard();
68 #endif  /* DEBUGGING */
69 }
70
71 I32
72 debop(OP *o)
73 {
74 #ifdef DEBUGGING
75     SV *sv;
76     deb("%s", PL_op_name[o->op_type]);
77     switch (o->op_type) {
78     case OP_CONST:
79         PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv));
80         break;
81     case OP_GVSV:
82     case OP_GV:
83         if (cGVOPo->op_gv) {
84             sv = NEWSV(0,0);
85             gv_fullname3(sv, cGVOPo->op_gv, Nullch);
86             PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, PL_na));
87             SvREFCNT_dec(sv);
88         }
89         else
90             PerlIO_printf(Perl_debug_log, "(NULL)");
91         break;
92     default:
93         break;
94     }
95     PerlIO_printf(Perl_debug_log, "\n");
96 #endif  /* DEBUGGING */
97     return 0;
98 }
99
100 void
101 watch(char **addr)
102 {
103 #ifdef DEBUGGING
104     dTHR;
105     PL_watchaddr = addr;
106     PL_watchok = *addr;
107     PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n",
108         (long)PL_watchaddr, (long)PL_watchok);
109 #endif  /* DEBUGGING */
110 }
111
112 STATIC void
113 debprof(OP *o)
114 {
115 #ifdef DEBUGGING
116     if (!PL_profiledata)
117         Newz(000, PL_profiledata, MAXO, U32);
118     ++PL_profiledata[o->op_type];
119 #endif /* DEBUGGING */
120 }
121
122 void
123 debprofdump(void)
124 {
125 #ifdef DEBUGGING
126     unsigned i;
127     if (!PL_profiledata)
128         return;
129     for (i = 0; i < MAXO; i++) {
130         if (PL_profiledata[i])
131             PerlIO_printf(Perl_debug_log,
132                           "%5lu %s\n", (unsigned long)PL_profiledata[i],
133                                        PL_op_name[i]);
134     }
135 #endif  /* DEBUGGING */
136 }