Dethinko.
[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
fc0dc3b3 25 while ( PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX) ) ;
fd18d308 26
27 TAINT_NOT;
a0d0e21e 28 return 0;
79072805 29}
30
a0d0e21e 31int
864dbfa3 32Perl_runops_debug(pTHX)
35ff7856 33{
34#ifdef DEBUGGING
11343788 35 dTHR;
f248d071 36 if (!PL_op) {
37 if (ckWARN_d(WARN_DEBUGGING))
38 Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN");
a0d0e21e 39 return 0;
79072805 40 }
a0d0e21e 41
79072805 42 do {
3280af22 43 if (PL_debug) {
22c35a8c 44 if (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok)
760ac839 45 PerlIO_printf(Perl_debug_log, "WARNING: %lx changed from %lx to %lx\n",
22c35a8c 46 (long)PL_watchaddr, (long)PL_watchok, (long)*PL_watchaddr);
79072805 47 DEBUG_s(debstack());
533c011a 48 DEBUG_t(debop(PL_op));
49 DEBUG_P(debprof(PL_op));
79072805 50 }
fc0dc3b3 51 } while ( PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX) );
fd18d308 52
53 TAINT_NOT;
a0d0e21e 54 return 0;
35ff7856 55#else
56 return runops_standard();
17c3b450 57#endif /* DEBUGGING */
79072805 58}
59
79072805 60I32
864dbfa3 61Perl_debop(pTHX_ OP *o)
79072805 62{
35ff7856 63#ifdef DEBUGGING
79072805 64 SV *sv;
2d8e6c8d 65 STRLEN n_a;
cea2e8a9 66 Perl_deb(aTHX_ "%s", PL_op_name[o->op_type]);
11343788 67 switch (o->op_type) {
79072805 68 case OP_CONST:
5dc0d613 69 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv));
79072805 70 break;
71 case OP_GVSV:
72 case OP_GV:
11343788 73 if (cGVOPo->op_gv) {
79072805 74 sv = NEWSV(0,0);
5dc0d613 75 gv_fullname3(sv, cGVOPo->op_gv, Nullch);
2d8e6c8d 76 PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
8990e307 77 SvREFCNT_dec(sv);
79072805 78 }
79 else
760ac839 80 PerlIO_printf(Perl_debug_log, "(NULL)");
79072805 81 break;
a0d0e21e 82 default:
83 break;
79072805 84 }
760ac839 85 PerlIO_printf(Perl_debug_log, "\n");
17c3b450 86#endif /* DEBUGGING */
79072805 87 return 0;
88}
89
90void
864dbfa3 91Perl_watch(pTHX_ char **addr)
79072805 92{
35ff7856 93#ifdef DEBUGGING
22c35a8c 94 dTHR;
95 PL_watchaddr = addr;
96 PL_watchok = *addr;
760ac839 97 PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n",
22c35a8c 98 (long)PL_watchaddr, (long)PL_watchok);
17c3b450 99#endif /* DEBUGGING */
79072805 100}
a0d0e21e 101
76e3520e 102STATIC void
cea2e8a9 103S_debprof(pTHX_ OP *o)
a0d0e21e 104{
35ff7856 105#ifdef DEBUGGING
3280af22 106 if (!PL_profiledata)
107 Newz(000, PL_profiledata, MAXO, U32);
108 ++PL_profiledata[o->op_type];
35ff7856 109#endif /* DEBUGGING */
a0d0e21e 110}
111
112void
864dbfa3 113Perl_debprofdump(pTHX)
a0d0e21e 114{
35ff7856 115#ifdef DEBUGGING
9607fc9c 116 unsigned i;
3280af22 117 if (!PL_profiledata)
a0d0e21e 118 return;
119 for (i = 0; i < MAXO; i++) {
3280af22 120 if (PL_profiledata[i])
9607fc9c 121 PerlIO_printf(Perl_debug_log,
3280af22 122 "%5lu %s\n", (unsigned long)PL_profiledata[i],
22c35a8c 123 PL_op_name[i]);
a0d0e21e 124 }
17c3b450 125#endif /* DEBUGGING */
35ff7856 126}