X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=run.c;h=b4b9b903875de924b6d2dcb35e69336619b87749;hb=24a7a40d02cc0ea4a7e6fc143f53dd60b2d0d047;hp=97444ec58e8994d673ef1d3ecf4528f3c078d599;hpb=4c2891ed1c6b8a97b3d1318b04ed56b17dd4de31;p=p5sagit%2Fp5-mst-13.2.git diff --git a/run.c b/run.c index 97444ec..b4b9b90 100644 --- a/run.c +++ b/run.c @@ -1,6 +1,6 @@ /* run.c * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-2002, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -8,6 +8,7 @@ */ #include "EXTERN.h" +#define PERL_IN_RUN_C #include "perl.h" /* @@ -16,124 +17,14 @@ * know. Run now! Hope is in speed!" --Gandalf */ -#ifdef PERL_OBJECT -#define CALLOP this->*PL_op -#else -#define CALLOP *PL_op -#endif - -int -runops_standard(void) -{ - dTHR; - - while ( PL_op = (CALLOP->op_ppaddr)(ARGS) ) ; - - TAINT_NOT; - return 0; -} - -#ifdef DEBUGGING - -dEXT char **watchaddr = 0; -dEXT char *watchok; - -#ifndef PERL_OBJECT -static void debprof _((OP*o)); -#endif - -#endif /* DEBUGGING */ - int -runops_debug(void) +Perl_runops_standard(pTHX) { -#ifdef DEBUGGING - dTHR; - if (!PL_op) { - warn("NULL OP IN RUN"); - return 0; + while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) { + PERL_ASYNC_CHECK(); } - do { - if (PL_debug) { - if (watchaddr != 0 && *watchaddr != watchok) - PerlIO_printf(Perl_debug_log, "WARNING: %lx changed from %lx to %lx\n", - (long)watchaddr, (long)watchok, (long)*watchaddr); - DEBUG_s(debstack()); - DEBUG_t(debop(PL_op)); - DEBUG_P(debprof(PL_op)); - } - } while ( PL_op = (CALLOP->op_ppaddr)(ARGS) ); - TAINT_NOT; return 0; -#else - return runops_standard(); -#endif /* DEBUGGING */ } -I32 -debop(OP *o) -{ -#ifdef DEBUGGING - SV *sv; - deb("%s", op_name[o->op_type]); - switch (o->op_type) { - case OP_CONST: - PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv)); - break; - case OP_GVSV: - case OP_GV: - if (cGVOPo->op_gv) { - sv = NEWSV(0,0); - gv_fullname3(sv, cGVOPo->op_gv, Nullch); - PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, PL_na)); - SvREFCNT_dec(sv); - } - else - PerlIO_printf(Perl_debug_log, "(NULL)"); - break; - default: - break; - } - PerlIO_printf(Perl_debug_log, "\n"); -#endif /* DEBUGGING */ - return 0; -} - -void -watch(char **addr) -{ -#ifdef DEBUGGING - watchaddr = addr; - watchok = *addr; - PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n", - (long)watchaddr, (long)watchok); -#endif /* DEBUGGING */ -} - -STATIC void -debprof(OP *o) -{ -#ifdef DEBUGGING - if (!PL_profiledata) - Newz(000, PL_profiledata, MAXO, U32); - ++PL_profiledata[o->op_type]; -#endif /* DEBUGGING */ -} - -void -debprofdump(void) -{ -#ifdef DEBUGGING - unsigned i; - if (!PL_profiledata) - return; - for (i = 0; i < MAXO; i++) { - if (PL_profiledata[i]) - PerlIO_printf(Perl_debug_log, - "%5lu %s\n", (unsigned long)PL_profiledata[i], - op_name[i]); - } -#endif /* DEBUGGING */ -}