Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | /* run.c |
2 | * | |
9607fc9c | 3 | * Copyright (c) 1991-1997, Larry Wall |
a0d0e21e LW |
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 | ||
79072805 LW |
10 | #include "EXTERN.h" |
11 | #include "perl.h" | |
12 | ||
a0d0e21e LW |
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 | ||
76e3520e GS |
19 | #ifdef PERL_OBJECT |
20 | #define CALLOP this->*op | |
21 | #else | |
22 | #define CALLOP *op | |
23 | #endif | |
79072805 | 24 | |
a0d0e21e | 25 | int |
17c3b450 GS |
26 | runops_standard(void) |
27 | { | |
11343788 | 28 | dTHR; |
a0d0e21e | 29 | |
76e3520e | 30 | while ( op = (CALLOP->op_ppaddr)(ARGS) ) ; |
fd18d308 CS |
31 | |
32 | TAINT_NOT; | |
a0d0e21e | 33 | return 0; |
79072805 LW |
34 | } |
35 | ||
2ddcc7aa | 36 | #ifdef DEBUGGING |
22239a37 NIS |
37 | |
38 | dEXT char **watchaddr = 0; | |
39 | dEXT char *watchok; | |
40 | ||
76e3520e | 41 | #ifndef PERL_OBJECT |
11343788 | 42 | static void debprof _((OP*o)); |
76e3520e | 43 | #endif |
a0d0e21e | 44 | |
17c3b450 GS |
45 | #endif /* DEBUGGING */ |
46 | ||
a0d0e21e | 47 | int |
35ff7856 GS |
48 | runops_debug(void) |
49 | { | |
50 | #ifdef DEBUGGING | |
11343788 | 51 | dTHR; |
79072805 LW |
52 | if (!op) { |
53 | warn("NULL OP IN RUN"); | |
a0d0e21e | 54 | return 0; |
79072805 | 55 | } |
a0d0e21e | 56 | |
79072805 LW |
57 | do { |
58 | if (debug) { | |
59 | if (watchaddr != 0 && *watchaddr != watchok) | |
760ac839 | 60 | PerlIO_printf(Perl_debug_log, "WARNING: %lx changed from %lx to %lx\n", |
a0d0e21e | 61 | (long)watchaddr, (long)watchok, (long)*watchaddr); |
79072805 LW |
62 | DEBUG_s(debstack()); |
63 | DEBUG_t(debop(op)); | |
a0d0e21e | 64 | DEBUG_P(debprof(op)); |
79072805 | 65 | } |
76e3520e | 66 | } while ( op = (CALLOP->op_ppaddr)(ARGS) ); |
fd18d308 CS |
67 | |
68 | TAINT_NOT; | |
a0d0e21e | 69 | return 0; |
35ff7856 GS |
70 | #else |
71 | return runops_standard(); | |
17c3b450 | 72 | #endif /* DEBUGGING */ |
79072805 LW |
73 | } |
74 | ||
79072805 | 75 | I32 |
8ac85365 | 76 | debop(OP *o) |
79072805 | 77 | { |
35ff7856 | 78 | #ifdef DEBUGGING |
79072805 | 79 | SV *sv; |
11343788 MB |
80 | deb("%s", op_name[o->op_type]); |
81 | switch (o->op_type) { | |
79072805 | 82 | case OP_CONST: |
5dc0d613 | 83 | PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv)); |
79072805 LW |
84 | break; |
85 | case OP_GVSV: | |
86 | case OP_GV: | |
11343788 | 87 | if (cGVOPo->op_gv) { |
79072805 | 88 | sv = NEWSV(0,0); |
5dc0d613 | 89 | gv_fullname3(sv, cGVOPo->op_gv, Nullch); |
760ac839 | 90 | PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, na)); |
8990e307 | 91 | SvREFCNT_dec(sv); |
79072805 LW |
92 | } |
93 | else | |
760ac839 | 94 | PerlIO_printf(Perl_debug_log, "(NULL)"); |
79072805 | 95 | break; |
a0d0e21e LW |
96 | default: |
97 | break; | |
79072805 | 98 | } |
760ac839 | 99 | PerlIO_printf(Perl_debug_log, "\n"); |
17c3b450 | 100 | #endif /* DEBUGGING */ |
79072805 LW |
101 | return 0; |
102 | } | |
103 | ||
104 | void | |
8ac85365 | 105 | watch(char **addr) |
79072805 | 106 | { |
35ff7856 | 107 | #ifdef DEBUGGING |
79072805 LW |
108 | watchaddr = addr; |
109 | watchok = *addr; | |
760ac839 | 110 | PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n", |
a0d0e21e | 111 | (long)watchaddr, (long)watchok); |
17c3b450 | 112 | #endif /* DEBUGGING */ |
79072805 | 113 | } |
a0d0e21e | 114 | |
76e3520e | 115 | STATIC void |
8ac85365 | 116 | debprof(OP *o) |
a0d0e21e | 117 | { |
35ff7856 | 118 | #ifdef DEBUGGING |
a0d0e21e | 119 | if (!profiledata) |
d7f63761 | 120 | Newz(000, profiledata, MAXO, U32); |
11343788 | 121 | ++profiledata[o->op_type]; |
35ff7856 | 122 | #endif /* DEBUGGING */ |
a0d0e21e LW |
123 | } |
124 | ||
125 | void | |
8ac85365 | 126 | debprofdump(void) |
a0d0e21e | 127 | { |
35ff7856 | 128 | #ifdef DEBUGGING |
9607fc9c | 129 | unsigned i; |
a0d0e21e LW |
130 | if (!profiledata) |
131 | return; | |
132 | for (i = 0; i < MAXO; i++) { | |
133 | if (profiledata[i]) | |
9607fc9c | 134 | PerlIO_printf(Perl_debug_log, |
d7f63761 GA |
135 | "%5lu %s\n", (unsigned long)profiledata[i], |
136 | op_name[i]); | |
a0d0e21e | 137 | } |
17c3b450 | 138 | #endif /* DEBUGGING */ |
35ff7856 | 139 | } |