This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate changes #9259,9260 from maintperl into mainline.
[perl5.git] / run.c
CommitLineData
a0d0e21e
LW
1/* run.c
2 *
bc89e66f 3 * Copyright (c) 1991-2001, 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 10#include "EXTERN.h"
864dbfa3 11#define PERL_IN_RUN_C
79072805
LW
12#include "perl.h"
13
a0d0e21e
LW
14/*
15 * "Away now, Shadowfax! Run, greatheart, run as you have never run before!
16 * Now we are come to the lands where you were foaled, and every stone you
17 * know. Run now! Hope is in speed!" --Gandalf
18 */
19
a0d0e21e 20int
864dbfa3 21Perl_runops_standard(pTHX)
17c3b450 22{
155aba94 23 while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
da927450 24 PERL_ASYNC_CHECK();
cd39f2b6 25 }
fd18d308
CS
26
27 TAINT_NOT;
a0d0e21e 28 return 0;
79072805
LW
29}
30
a0d0e21e 31int
864dbfa3 32Perl_runops_debug(pTHX)
35ff7856
GS
33{
34#ifdef DEBUGGING
f248d071
GS
35 if (!PL_op) {
36 if (ckWARN_d(WARN_DEBUGGING))
37 Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN");
a0d0e21e 38 return 0;
79072805 39 }
a0d0e21e 40
79072805 41 do {
da927450 42 PERL_ASYNC_CHECK();
3280af22 43 if (PL_debug) {
22c35a8c 44 if (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok)
b900a521
JH
45 PerlIO_printf(Perl_debug_log,
46 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
4265b575
GS
47 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
48 PTR2UV(*PL_watchaddr));
79072805 49 DEBUG_s(debstack());
533c011a
NIS
50 DEBUG_t(debop(PL_op));
51 DEBUG_P(debprof(PL_op));
79072805 52 }
155aba94 53 } while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)));
fd18d308
CS
54
55 TAINT_NOT;
a0d0e21e 56 return 0;
35ff7856
GS
57#else
58 return runops_standard();
17c3b450 59#endif /* DEBUGGING */
79072805
LW
60}
61
79072805 62I32
864dbfa3 63Perl_debop(pTHX_ OP *o)
79072805 64{
35ff7856 65#ifdef DEBUGGING
79072805 66 SV *sv;
d6179d6f 67 SV **svp;
2d8e6c8d 68 STRLEN n_a;
cea2e8a9 69 Perl_deb(aTHX_ "%s", PL_op_name[o->op_type]);
11343788 70 switch (o->op_type) {
79072805 71 case OP_CONST:
7766f137 72 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
79072805
LW
73 break;
74 case OP_GVSV:
75 case OP_GV:
638eceb6 76 if (cGVOPo_gv) {
79072805 77 sv = NEWSV(0,0);
638eceb6 78 gv_fullname3(sv, cGVOPo_gv, Nullch);
2d8e6c8d 79 PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
8990e307 80 SvREFCNT_dec(sv);
79072805
LW
81 }
82 else
760ac839 83 PerlIO_printf(Perl_debug_log, "(NULL)");
79072805 84 break;
d6179d6f
DM
85 case OP_PADSV:
86 case OP_PADAV:
87 case OP_PADHV:
88 /* print the lexical's name */
89 svp = av_fetch(PL_comppad_name, o->op_targ, FALSE);
90 if (svp)
91 PerlIO_printf(Perl_debug_log, "(%s)", SvPV(*svp,n_a));
92 else
ffb9ee5f 93 PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
d6179d6f 94 break;
a0d0e21e
LW
95 default:
96 break;
79072805 97 }
760ac839 98 PerlIO_printf(Perl_debug_log, "\n");
17c3b450 99#endif /* DEBUGGING */
79072805
LW
100 return 0;
101}
102
103void
864dbfa3 104Perl_watch(pTHX_ char **addr)
79072805 105{
35ff7856 106#ifdef DEBUGGING
22c35a8c
GS
107 PL_watchaddr = addr;
108 PL_watchok = *addr;
b900a521
JH
109 PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
110 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
17c3b450 111#endif /* DEBUGGING */
79072805 112}
a0d0e21e 113
76e3520e 114STATIC void
cea2e8a9 115S_debprof(pTHX_ OP *o)
a0d0e21e 116{
35ff7856 117#ifdef DEBUGGING
3280af22
NIS
118 if (!PL_profiledata)
119 Newz(000, PL_profiledata, MAXO, U32);
120 ++PL_profiledata[o->op_type];
35ff7856 121#endif /* DEBUGGING */
a0d0e21e
LW
122}
123
124void
864dbfa3 125Perl_debprofdump(pTHX)
a0d0e21e 126{
35ff7856 127#ifdef DEBUGGING
9607fc9c 128 unsigned i;
3280af22 129 if (!PL_profiledata)
a0d0e21e
LW
130 return;
131 for (i = 0; i < MAXO; i++) {
3280af22 132 if (PL_profiledata[i])
9607fc9c 133 PerlIO_printf(Perl_debug_log,
3280af22 134 "%5lu %s\n", (unsigned long)PL_profiledata[i],
22c35a8c 135 PL_op_name[i]);
a0d0e21e 136 }
17c3b450 137#endif /* DEBUGGING */
35ff7856 138}