X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=run.c;h=3d48139d8836620efbb2a58302fa9c2f6ba380d8;hb=ebc18564261e706c77f947245d26506241c40f11;hp=e218144b63546ad2876b4f1f28cf340b471ba60b;hpb=0453d815b8a74697ff1e5451c27aba2fe537b8e0;p=p5sagit%2Fp5-mst-13.2.git diff --git a/run.c b/run.c index e218144..3d48139 100644 --- a/run.c +++ b/run.c @@ -1,6 +1,7 @@ /* run.c * - * Copyright (c) 1991-1999, Larry Wall + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -17,115 +18,14 @@ * know. Run now! Hope is in speed!" --Gandalf */ -#ifdef PERL_OBJECT -#define CALLOP this->*PL_op -#else -#define CALLOP *PL_op -#endif - int Perl_runops_standard(pTHX) { - dTHR; - - while ( PL_op = (CALLOP->op_ppaddr)(aTHX) ) ; - - TAINT_NOT; - return 0; -} - -int -Perl_runops_debug(pTHX) -{ -#ifdef DEBUGGING - dTHR; - if (!PL_op && ckWARN_d(WARN_DEBUGGING)) { - Perl_warner(aTHX_ WARN_DEBUGGING, "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)(aTHX) ); - TAINT_NOT; return 0; -#else - return runops_standard(); -#endif /* DEBUGGING */ -} - -I32 -Perl_debop(pTHX_ OP *o) -{ -#ifdef DEBUGGING - SV *sv; - STRLEN n_a; - Perl_deb(aTHX_ "%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, n_a)); - SvREFCNT_dec(sv); - } - else - PerlIO_printf(Perl_debug_log, "(NULL)"); - break; - default: - break; - } - PerlIO_printf(Perl_debug_log, "\n"); -#endif /* DEBUGGING */ - return 0; -} - -void -Perl_watch(pTHX_ 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 -S_debprof(pTHX_ OP *o) -{ -#ifdef DEBUGGING - if (!PL_profiledata) - Newz(000, PL_profiledata, MAXO, U32); - ++PL_profiledata[o->op_type]; -#endif /* DEBUGGING */ -} - -void -Perl_debprofdump(pTHX) -{ -#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 */ -}