This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix problem pointer casts
[perl5.git] / run.c
CommitLineData
a0d0e21e
LW
1/* run.c
2 *
4eb8286e 3 * Copyright (c) 1991-1999, 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{
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
CS
28
29 TAINT_NOT;
a0d0e21e 30 return 0;
79072805
LW
31}
32
a0d0e21e 33int
864dbfa3 34Perl_runops_debug(pTHX)
35ff7856
GS
35{
36#ifdef DEBUGGING
11343788 37 dTHR;
f248d071
GS
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
JH
48 PerlIO_printf(Perl_debug_log,
49 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
4265b575
GS
50 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
51 PTR2UV(*PL_watchaddr));
79072805 52 DEBUG_s(debstack());
533c011a
NIS
53 DEBUG_t(debop(PL_op));
54 DEBUG_P(debprof(PL_op));
79072805 55 }
fc0dc3b3 56 } while ( PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX) );
fd18d308
CS
57
58 TAINT_NOT;
a0d0e21e 59 return 0;
35ff7856
GS
60#else
61 return runops_standard();
17c3b450 62#endif /* DEBUGGING */
79072805
LW
63}
64
79072805 65I32
864dbfa3 66Perl_debop(pTHX_ OP *o)
79072805 67{
35ff7856 68#ifdef DEBUGGING
79072805 69 SV *sv;
2d8e6c8d 70 STRLEN n_a;
cea2e8a9 71 Perl_deb(aTHX_ "%s", PL_op_name[o->op_type]);
11343788 72 switch (o->op_type) {
79072805 73 case OP_CONST:
5dc0d613 74 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv));
79072805
LW
75 break;
76 case OP_GVSV:
77 case OP_GV:
350de78d 78 if (cGVOPo) {
79072805 79 sv = NEWSV(0,0);
350de78d 80 gv_fullname3(sv, cGVOPo, Nullch);
2d8e6c8d 81 PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
8990e307 82 SvREFCNT_dec(sv);
79072805
LW
83 }
84 else
760ac839 85 PerlIO_printf(Perl_debug_log, "(NULL)");
79072805 86 break;
a0d0e21e
LW
87 default:
88 break;
79072805 89 }
760ac839 90 PerlIO_printf(Perl_debug_log, "\n");
17c3b450 91#endif /* DEBUGGING */
79072805
LW
92 return 0;
93}
94
95void
864dbfa3 96Perl_watch(pTHX_ char **addr)
79072805 97{
35ff7856 98#ifdef DEBUGGING
22c35a8c
GS
99 dTHR;
100 PL_watchaddr = addr;
101 PL_watchok = *addr;
b900a521
JH
102 PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
103 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
17c3b450 104#endif /* DEBUGGING */
79072805 105}
a0d0e21e 106
76e3520e 107STATIC void
cea2e8a9 108S_debprof(pTHX_ OP *o)
a0d0e21e 109{
35ff7856 110#ifdef DEBUGGING
3280af22
NIS
111 if (!PL_profiledata)
112 Newz(000, PL_profiledata, MAXO, U32);
113 ++PL_profiledata[o->op_type];
35ff7856 114#endif /* DEBUGGING */
a0d0e21e
LW
115}
116
117void
864dbfa3 118Perl_debprofdump(pTHX)
a0d0e21e 119{
35ff7856 120#ifdef DEBUGGING
9607fc9c 121 unsigned i;
3280af22 122 if (!PL_profiledata)
a0d0e21e
LW
123 return;
124 for (i = 0; i < MAXO; i++) {
3280af22 125 if (PL_profiledata[i])
9607fc9c 126 PerlIO_printf(Perl_debug_log,
3280af22 127 "%5lu %s\n", (unsigned long)PL_profiledata[i],
22c35a8c 128 PL_op_name[i]);
a0d0e21e 129 }
17c3b450 130#endif /* DEBUGGING */
35ff7856 131}