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