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