Test case for #10433/#10424.
[p5sagit/p5-mst-13.2.git] / run.c
CommitLineData
a0d0e21e 1/* run.c
2 *
bc89e66f 3 * Copyright (c) 1991-2001, Larry Wall
a0d0e21e 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 12#include "perl.h"
13
a0d0e21e 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 26
27 TAINT_NOT;
a0d0e21e 28 return 0;
79072805 29}
30
a0d0e21e 31int
864dbfa3 32Perl_runops_debug(pTHX)
35ff7856 33{
34#ifdef DEBUGGING
f248d071 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 45 PerlIO_printf(Perl_debug_log,
46 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
4265b575 47 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
48 PTR2UV(*PL_watchaddr));
79072805 49 DEBUG_s(debstack());
533c011a 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 54
55 TAINT_NOT;
a0d0e21e 56 return 0;
35ff7856 57#else
58 return runops_standard();
17c3b450 59#endif /* DEBUGGING */
79072805 60}
61
79072805 62I32
864dbfa3 63Perl_debop(pTHX_ OP *o)
79072805 64{
35ff7856 65#ifdef DEBUGGING
53a2efa2 66 AV *padlist, *comppad;
67 CV *cv;
79072805 68 SV *sv;
2d8e6c8d 69 STRLEN n_a;
cea2e8a9 70 Perl_deb(aTHX_ "%s", PL_op_name[o->op_type]);
11343788 71 switch (o->op_type) {
79072805 72 case OP_CONST:
7766f137 73 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
79072805 74 break;
75 case OP_GVSV:
76 case OP_GV:
638eceb6 77 if (cGVOPo_gv) {
79072805 78 sv = NEWSV(0,0);
638eceb6 79 gv_fullname3(sv, cGVOPo_gv, Nullch);
2d8e6c8d 80 PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
8990e307 81 SvREFCNT_dec(sv);
79072805 82 }
83 else
760ac839 84 PerlIO_printf(Perl_debug_log, "(NULL)");
79072805 85 break;
d6179d6f 86 case OP_PADSV:
87 case OP_PADAV:
88 case OP_PADHV:
89 /* print the lexical's name */
53a2efa2 90 cv = deb_curcv(cxstack_ix);
91 if (cv) {
92 padlist = CvPADLIST(cv);
93 comppad = (AV*)(*av_fetch(padlist, 0, FALSE));
94 sv = *av_fetch(comppad, o->op_targ, FALSE);
95 } else
96 sv = Nullsv;
97 if (sv)
98 PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv));
99 else
ffb9ee5f 100 PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
53a2efa2 101 break;
a0d0e21e 102 default:
103 break;
79072805 104 }
760ac839 105 PerlIO_printf(Perl_debug_log, "\n");
17c3b450 106#endif /* DEBUGGING */
79072805 107 return 0;
108}
109
8fa7f367 110#ifdef DEBUGGING
111
53a2efa2 112STATIC CV*
7e78a3dd 113S_deb_curcv(pTHX_ I32 ix)
53a2efa2 114{
53a2efa2 115 PERL_CONTEXT *cx = &cxstack[ix];
116 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
117 return cx->blk_sub.cv;
0c51317d 118 else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
119 return PL_compcv;
53a2efa2 120 else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
121 return PL_main_cv;
122 else if (ix <= 0)
123 return Nullcv;
124 else
125 return deb_curcv(ix - 1);
53a2efa2 126}
127
8fa7f367 128#endif /* DEBUGGING */
129
79072805 130void
864dbfa3 131Perl_watch(pTHX_ char **addr)
79072805 132{
35ff7856 133#ifdef DEBUGGING
22c35a8c 134 PL_watchaddr = addr;
135 PL_watchok = *addr;
b900a521 136 PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
137 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
17c3b450 138#endif /* DEBUGGING */
79072805 139}
a0d0e21e 140
8fa7f367 141#ifdef DEBUGGING
142
76e3520e 143STATIC void
cea2e8a9 144S_debprof(pTHX_ OP *o)
a0d0e21e 145{
3280af22 146 if (!PL_profiledata)
147 Newz(000, PL_profiledata, MAXO, U32);
148 ++PL_profiledata[o->op_type];
a0d0e21e 149}
150
8fa7f367 151#endif /* DEBUGGING */
152
a0d0e21e 153void
864dbfa3 154Perl_debprofdump(pTHX)
a0d0e21e 155{
35ff7856 156#ifdef DEBUGGING
9607fc9c 157 unsigned i;
3280af22 158 if (!PL_profiledata)
a0d0e21e 159 return;
160 for (i = 0; i < MAXO; i++) {
3280af22 161 if (PL_profiledata[i])
9607fc9c 162 PerlIO_printf(Perl_debug_log,
3280af22 163 "%5lu %s\n", (unsigned long)PL_profiledata[i],
22c35a8c 164 PL_op_name[i]);
a0d0e21e 165 }
17c3b450 166#endif /* DEBUGGING */
35ff7856 167}