1 /* run.c 2 * 3 * Copyright (c) 1991-2001, Larry Wall 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 10 #include "EXTERN.h" 11 #define PERL_IN_RUN_C 12 #include "perl.h" 13 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 20 int 21 Perl_runops_standard(pTHX) 22 { 23 while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) { 24 PERL_ASYNC_CHECK(); 25 } 26 27 TAINT_NOT; 28 return 0; 29 } 30 31 int 32 Perl_runops_debug(pTHX) 33 { 34 #ifdef DEBUGGING 35 if (!PL_op) { 36 if (ckWARN_d(WARN_DEBUGGING)) 37 Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN"); 38 return 0; 39 } 40 41 do { 42 PERL_ASYNC_CHECK(); 43 if (PL_debug) { 44 if (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok) 45 PerlIO_printf(Perl_debug_log, 46 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n", 47 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok), 48 PTR2UV(*PL_watchaddr)); 49 DEBUG_s(debstack()); 50 DEBUG_t(debop(PL_op)); 51 DEBUG_P(debprof(PL_op)); 52 } 53 } while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))); 54 55 TAINT_NOT; 56 return 0; 57 #else 58 return runops_standard(); 59 #endif /* DEBUGGING */ 60 } 61 62 I32 63 Perl_debop(pTHX_ OP *o) 64 { 65 #ifdef DEBUGGING 66 SV *sv; 67 SV **svp; 68 STRLEN n_a; 69 Perl_deb(aTHX_ "%s", PL_op_name[o->op_type]); 70 switch (o->op_type) { 71 case OP_CONST: 72 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv)); 73 break; 74 case OP_GVSV: 75 case OP_GV: 76 if (cGVOPo_gv) { 77 sv = NEWSV(0,0); 78 gv_fullname3(sv, cGVOPo_gv, Nullch); 79 PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a)); 80 SvREFCNT_dec(sv); 81 } 82 else 83 PerlIO_printf(Perl_debug_log, "(NULL)"); 84 break; 85 case OP_PADSV: 86 case OP_PADAV: 87 case OP_PADHV: 88 /* print the lexical's name */ 89 svp = av_fetch(PL_comppad_name, o->op_targ, FALSE); 90 if (svp) 91 PerlIO_printf(Perl_debug_log, "(%s)", SvPV(*svp,n_a)); 92 else 93 PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ); 94 break; 95 default: 96 break; 97 } 98 PerlIO_printf(Perl_debug_log, "\n"); 99 #endif /* DEBUGGING */ 100 return 0; 101 } 102 103 void 104 Perl_watch(pTHX_ char **addr) 105 { 106 #ifdef DEBUGGING 107 PL_watchaddr = addr; 108 PL_watchok = *addr; 109 PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n", 110 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok)); 111 #endif /* DEBUGGING */ 112 } 113 114 STATIC void 115 S_debprof(pTHX_ OP *o) 116 { 117 #ifdef DEBUGGING 118 if (!PL_profiledata) 119 Newz(000, PL_profiledata, MAXO, U32); 120 ++PL_profiledata[o->op_type]; 121 #endif /* DEBUGGING */ 122 } 123 124 void 125 Perl_debprofdump(pTHX) 126 { 127 #ifdef DEBUGGING 128 unsigned i; 129 if (!PL_profiledata) 130 return; 131 for (i = 0; i < MAXO; i++) { 132 if (PL_profiledata[i]) 133 PerlIO_printf(Perl_debug_log, 134 "%5lu %s\n", (unsigned long)PL_profiledata[i], 135 PL_op_name[i]); 136 } 137 #endif /* DEBUGGING */ 138 } 139