X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=run.c;h=b4b9b903875de924b6d2dcb35e69336619b87749;hb=fd390a0081b7ca4842e417bfed4eeab4d479bd3d;hp=c38df7f0a4ca01ebd713b9311c8adaac5b7fe0a2;hpb=22c35a8c2392967a5ba6b5370695be464bd7012c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/run.c b/run.c index c38df7f..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,121 +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) +Perl_runops_standard(pTHX) { - dTHR; - - while ( PL_op = (CALLOP->op_ppaddr)(ARGS) ) ; - - TAINT_NOT; - return 0; -} - -#ifdef DEBUGGING -#ifndef PERL_OBJECT -static void debprof _((OP*o)); -#endif - -#endif /* DEBUGGING */ - -int -runops_debug(void) -{ -#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 (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok) - PerlIO_printf(Perl_debug_log, "WARNING: %lx changed from %lx to %lx\n", - (long)PL_watchaddr, (long)PL_watchok, (long)*PL_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", PL_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 - dTHR; - PL_watchaddr = addr; - PL_watchok = *addr; - PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n", - (long)PL_watchaddr, (long)PL_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], - PL_op_name[i]); - } -#endif /* DEBUGGING */ -}