This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
remove _() non-ansism
[perl5.git] / 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 #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     STRLEN n_a;
77     deb("%s", PL_op_name[o->op_type]);
78     switch (o->op_type) {
79     case OP_CONST:
80         PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv));
81         break;
82     case OP_GVSV:
83     case OP_GV:
84         if (cGVOPo->op_gv) {
85             sv = NEWSV(0,0);
86             gv_fullname3(sv, cGVOPo->op_gv, Nullch);
87             PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
88             SvREFCNT_dec(sv);
89         }
90         else
91             PerlIO_printf(Perl_debug_log, "(NULL)");
92         break;
93     default:
94         break;
95     }
96     PerlIO_printf(Perl_debug_log, "\n");
97 #endif  /* DEBUGGING */
98     return 0;
99 }
100
101 void
102 watch(char **addr)
103 {
104 #ifdef DEBUGGING
105     dTHR;
106     PL_watchaddr = addr;
107     PL_watchok = *addr;
108     PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n",
109         (long)PL_watchaddr, (long)PL_watchok);
110 #endif  /* DEBUGGING */
111 }
112
113 STATIC void
114 debprof(OP *o)
115 {
116 #ifdef DEBUGGING
117     if (!PL_profiledata)
118         Newz(000, PL_profiledata, MAXO, U32);
119     ++PL_profiledata[o->op_type];
120 #endif /* DEBUGGING */
121 }
122
123 void
124 debprofdump(void)
125 {
126 #ifdef DEBUGGING
127     unsigned i;
128     if (!PL_profiledata)
129         return;
130     for (i = 0; i < MAXO; i++) {
131         if (PL_profiledata[i])
132             PerlIO_printf(Perl_debug_log,
133                           "%5lu %s\n", (unsigned long)PL_profiledata[i],
134                                        PL_op_name[i]);
135     }
136 #endif  /* DEBUGGING */
137 }