sundry cleanups for cloned interpreters (only known failure mode
[p5sagit/p5-mst-13.2.git] / run.c
CommitLineData
a0d0e21e 1/* run.c
2 *
4eb8286e 3 * Copyright (c) 1991-1999, 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{
11343788 23 dTHR;
a0d0e21e 24
cd39f2b6 25 while ( PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX) ) {
da927450 26 PERL_ASYNC_CHECK();
cd39f2b6 27 }
fd18d308 28
29 TAINT_NOT;
a0d0e21e 30 return 0;
79072805 31}
32
a0d0e21e 33int
864dbfa3 34Perl_runops_debug(pTHX)
35ff7856 35{
36#ifdef DEBUGGING
11343788 37 dTHR;
f248d071 38 if (!PL_op) {
39 if (ckWARN_d(WARN_DEBUGGING))
40 Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN");
a0d0e21e 41 return 0;
79072805 42 }
a0d0e21e 43
79072805 44 do {
da927450 45 PERL_ASYNC_CHECK();
3280af22 46 if (PL_debug) {
22c35a8c 47 if (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok)
b900a521 48 PerlIO_printf(Perl_debug_log,
49 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
50 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok), (UV)*PL_watchaddr);
79072805 51 DEBUG_s(debstack());
533c011a 52 DEBUG_t(debop(PL_op));
53 DEBUG_P(debprof(PL_op));
79072805 54 }
fc0dc3b3 55 } while ( PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX) );
fd18d308 56
57 TAINT_NOT;
a0d0e21e 58 return 0;
35ff7856 59#else
60 return runops_standard();
17c3b450 61#endif /* DEBUGGING */
79072805 62}
63
79072805 64I32
864dbfa3 65Perl_debop(pTHX_ OP *o)
79072805 66{
35ff7856 67#ifdef DEBUGGING
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:
5dc0d613 73 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv));
79072805 74 break;
75 case OP_GVSV:
76 case OP_GV:
350de78d 77 if (cGVOPo) {
79072805 78 sv = NEWSV(0,0);
350de78d 79 gv_fullname3(sv, cGVOPo, 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;
a0d0e21e 86 default:
87 break;
79072805 88 }
760ac839 89 PerlIO_printf(Perl_debug_log, "\n");
17c3b450 90#endif /* DEBUGGING */
79072805 91 return 0;
92}
93
94void
864dbfa3 95Perl_watch(pTHX_ char **addr)
79072805 96{
35ff7856 97#ifdef DEBUGGING
22c35a8c 98 dTHR;
99 PL_watchaddr = addr;
100 PL_watchok = *addr;
b900a521 101 PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
102 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
17c3b450 103#endif /* DEBUGGING */
79072805 104}
a0d0e21e 105
76e3520e 106STATIC void
cea2e8a9 107S_debprof(pTHX_ OP *o)
a0d0e21e 108{
35ff7856 109#ifdef DEBUGGING
3280af22 110 if (!PL_profiledata)
111 Newz(000, PL_profiledata, MAXO, U32);
112 ++PL_profiledata[o->op_type];
35ff7856 113#endif /* DEBUGGING */
a0d0e21e 114}
115
116void
864dbfa3 117Perl_debprofdump(pTHX)
a0d0e21e 118{
35ff7856 119#ifdef DEBUGGING
9607fc9c 120 unsigned i;
3280af22 121 if (!PL_profiledata)
a0d0e21e 122 return;
123 for (i = 0; i < MAXO; i++) {
3280af22 124 if (PL_profiledata[i])
9607fc9c 125 PerlIO_printf(Perl_debug_log,
3280af22 126 "%5lu %s\n", (unsigned long)PL_profiledata[i],
22c35a8c 127 PL_op_name[i]);
a0d0e21e 128 }
17c3b450 129#endif /* DEBUGGING */
35ff7856 130}