Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | /* run.c |
2 | * | |
3 | * Copyright (c) 1991-1994, 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 | ||
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 | ||
4633a7c4 LW |
19 | dEXT char **watchaddr = 0; |
20 | dEXT char *watchok; | |
79072805 LW |
21 | |
22 | #ifndef DEBUGGING | |
23 | ||
a0d0e21e | 24 | int |
8da795c6 | 25 | runops() { |
a0d0e21e LW |
26 | SAVEI32(runlevel); |
27 | runlevel++; | |
28 | ||
79072805 | 29 | while ( op = (*op->op_ppaddr)() ) ; |
fd18d308 CS |
30 | |
31 | TAINT_NOT; | |
a0d0e21e | 32 | return 0; |
79072805 LW |
33 | } |
34 | ||
35 | #else | |
36 | ||
a0d0e21e LW |
37 | static void debprof _((OP*op)); |
38 | ||
39 | int | |
8da795c6 | 40 | runops() { |
79072805 LW |
41 | if (!op) { |
42 | warn("NULL OP IN RUN"); | |
a0d0e21e | 43 | return 0; |
79072805 | 44 | } |
a0d0e21e LW |
45 | |
46 | SAVEI32(runlevel); | |
47 | runlevel++; | |
48 | ||
79072805 LW |
49 | do { |
50 | if (debug) { | |
51 | if (watchaddr != 0 && *watchaddr != watchok) | |
760ac839 | 52 | PerlIO_printf(Perl_debug_log, "WARNING: %lx changed from %lx to %lx\n", |
a0d0e21e | 53 | (long)watchaddr, (long)watchok, (long)*watchaddr); |
79072805 LW |
54 | DEBUG_s(debstack()); |
55 | DEBUG_t(debop(op)); | |
a0d0e21e | 56 | DEBUG_P(debprof(op)); |
79072805 LW |
57 | } |
58 | } while ( op = (*op->op_ppaddr)() ); | |
fd18d308 CS |
59 | |
60 | TAINT_NOT; | |
a0d0e21e | 61 | return 0; |
79072805 LW |
62 | } |
63 | ||
79072805 | 64 | I32 |
79072805 LW |
65 | debop(op) |
66 | OP *op; | |
67 | { | |
68 | SV *sv; | |
69 | deb("%s", op_name[op->op_type]); | |
70 | switch (op->op_type) { | |
71 | case OP_CONST: | |
760ac839 | 72 | PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOP->op_sv)); |
79072805 LW |
73 | break; |
74 | case OP_GVSV: | |
75 | case OP_GV: | |
76 | if (cGVOP->op_gv) { | |
77 | sv = NEWSV(0,0); | |
f6aff53a | 78 | gv_fullname3(sv, cGVOP->op_gv, Nullch); |
760ac839 | 79 | PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, na)); |
8990e307 | 80 | SvREFCNT_dec(sv); |
79072805 LW |
81 | } |
82 | else | |
760ac839 | 83 | PerlIO_printf(Perl_debug_log, "(NULL)"); |
79072805 | 84 | break; |
a0d0e21e LW |
85 | default: |
86 | break; | |
79072805 | 87 | } |
760ac839 | 88 | PerlIO_printf(Perl_debug_log, "\n"); |
79072805 LW |
89 | return 0; |
90 | } | |
91 | ||
92 | void | |
93 | watch(addr) | |
94 | char **addr; | |
95 | { | |
96 | watchaddr = addr; | |
97 | watchok = *addr; | |
760ac839 | 98 | PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n", |
a0d0e21e | 99 | (long)watchaddr, (long)watchok); |
79072805 | 100 | } |
a0d0e21e LW |
101 | |
102 | static void | |
103 | debprof(op) | |
104 | OP* op; | |
105 | { | |
106 | if (!profiledata) | |
107 | New(000, profiledata, MAXO, U32); | |
108 | ++profiledata[op->op_type]; | |
109 | } | |
110 | ||
111 | void | |
112 | debprofdump() | |
113 | { | |
114 | U32 i; | |
115 | if (!profiledata) | |
116 | return; | |
117 | for (i = 0; i < MAXO; i++) { | |
118 | if (profiledata[i]) | |
760ac839 | 119 | PerlIO_printf(Perl_debug_log, "%d\t%lu\n", i, profiledata[i]); |
a0d0e21e LW |
120 | } |
121 | } | |
122 | ||
123 | #endif | |
124 |