X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=run.c;h=b4b9b903875de924b6d2dcb35e69336619b87749;hb=a7b657eec5c9a956f5411ffb5c1dacbd8d5b6c1b;hp=ac9752ba5d88eeb5a1a73a7c81cf46f16f231bbc;hpb=76e3520e1f6b7df33cd381a2cf4f1fce3d69c8a4;p=p5sagit%2Fp5-mst-13.2.git diff --git a/run.c b/run.c index ac9752b..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,110 +17,14 @@ * know. Run now! Hope is in speed!" --Gandalf */ -#ifdef PERL_OBJECT -#define CALLOP this->*op -#else -#define CALLOP *op -#endif - int -runops_standard(void) { - dTHR; - - while ( 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 - -int -runops_debug(void) { - dTHR; - if (!op) { - warn("NULL OP IN RUN"); - return 0; +Perl_runops_standard(pTHX) +{ + while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) { + PERL_ASYNC_CHECK(); } - do { - if (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(op)); - DEBUG_P(debprof(op)); - } - } while ( op = (CALLOP->op_ppaddr)(ARGS) ); - TAINT_NOT; return 0; } -I32 -debop(OP *o) -{ - 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, na)); - SvREFCNT_dec(sv); - } - else - PerlIO_printf(Perl_debug_log, "(NULL)"); - break; - default: - break; - } - PerlIO_printf(Perl_debug_log, "\n"); - return 0; -} - -void -watch(char **addr) -{ - watchaddr = addr; - watchok = *addr; - PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n", - (long)watchaddr, (long)watchok); -} - -STATIC void -debprof(OP *o) -{ - if (!profiledata) - New(000, profiledata, MAXO, U32); - ++profiledata[o->op_type]; -} - -void -debprofdump(void) -{ - unsigned i; - if (!profiledata) - return; - for (i = 0; i < MAXO; i++) { - if (profiledata[i]) - PerlIO_printf(Perl_debug_log, - "%u\t%lu\n", i, (unsigned long)profiledata[i]); - } -} - -#endif /* DEBUGGING */ -