This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Allow redirection of debug messages
[perl5.git] / run.c
CommitLineData
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
19dEXT char **watchaddr = 0;
20dEXT char *watchok;
79072805
LW
21
22#ifndef DEBUGGING
23
a0d0e21e 24int
8da795c6 25runops() {
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
35static void debprof _((OP*op));
36
37int
8da795c6 38runops() {
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)
fd181c75 50 fprintf(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 60I32
79072805
LW
61debop(op)
62OP *op;
63{
64 SV *sv;
65 deb("%s", op_name[op->op_type]);
66 switch (op->op_type) {
67 case OP_CONST:
fd181c75 68 fprintf(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);
74 gv_fullname(sv, cGVOP->op_gv);
fd181c75 75 fprintf(Perl_debug_log, "(%s)", SvPV(sv, na));
8990e307 76 SvREFCNT_dec(sv);
79072805
LW
77 }
78 else
fd181c75 79 fprintf(Perl_debug_log, "(NULL)");
79072805 80 break;
a0d0e21e
LW
81 default:
82 break;
79072805 83 }
fd181c75 84 fprintf(Perl_debug_log, "\n");
79072805
LW
85 return 0;
86}
87
88void
89watch(addr)
90char **addr;
91{
92 watchaddr = addr;
93 watchok = *addr;
fd181c75 94 fprintf(Perl_debug_log, "WATCHING, %lx is currently %lx\n",
a0d0e21e 95 (long)watchaddr, (long)watchok);
79072805 96}
a0d0e21e
LW
97
98static void
99debprof(op)
100OP* op;
101{
102 if (!profiledata)
103 New(000, profiledata, MAXO, U32);
104 ++profiledata[op->op_type];
105}
106
107void
108debprofdump()
109{
110 U32 i;
111 if (!profiledata)
112 return;
113 for (i = 0; i < MAXO; i++) {
114 if (profiledata[i])
fd181c75 115 fprintf(Perl_debug_log, "%d\t%lu\n", i, profiledata[i]);
a0d0e21e
LW
116 }
117}
118
119#endif
120