X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=b1e984bcadef4aba09fbdab8556619be365bb638;hb=7ee8c957e643df1e9e47d243c3269eb47c2da591;hp=94605607eba93a1f9d8cc26ab73193d80087e046;hpb=17c3b45099488fbc22dc1d4e0e4600c17bc12645;p=p5sagit%2Fp5-mst-13.2.git diff --git a/dump.c b/dump.c index 9460560..b1e984b 100644 --- a/dump.c +++ b/dump.c @@ -15,7 +15,9 @@ #include "EXTERN.h" #include "perl.h" +#ifndef PERL_OBJECT static void dump(char *pat, ...); +#endif /* PERL_OBJECT */ void dump_all(void) @@ -23,9 +25,9 @@ dump_all(void) #ifdef DEBUGGING dTHR; PerlIO_setlinebuf(Perl_debug_log); - if (main_root) - dump_op(main_root); - dump_packsubs(defstash); + if (PL_main_root) + dump_op(PL_main_root); + dump_packsubs(PL_defstash); #endif /* DEBUGGING */ } @@ -43,12 +45,14 @@ dump_packsubs(HV *stash) for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) { GV *gv = (GV*)HeVAL(entry); HV *hv; + if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv)) + continue; if (GvCVu(gv)) dump_sub(gv); if (GvFORM(gv)) dump_form(gv); if (HeKEY(entry)[HeKLEN(entry)-1] == ':' && - (hv = GvHV(gv)) && HvNAME(hv) && hv != defstash) + (hv = GvHV(gv)) && HvNAME(hv) && hv != PL_defstash) dump_packsubs(hv); /* nested package */ } } @@ -93,7 +97,7 @@ void dump_eval(void) { #ifdef DEBUGGING - dump_op(eval_root); + dump_op(PL_eval_root); #endif /* DEBUGGING */ } @@ -115,7 +119,7 @@ dump_op(OP *o) } else PerlIO_printf(Perl_debug_log, "DONE\n"); - dumplvl++; + PL_dumplvl++; if (o->op_targ) { if (o->op_type == OP_NULL) dump(" (was %s)\n", op_name[o->op_targ]); @@ -239,7 +243,7 @@ dump_op(OP *o) ENTER; SAVEFREESV(tmpsv); gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch); - dump("GV = %s\n", SvPV(tmpsv, na)); + dump("GV = %s\n", SvPV(tmpsv, PL_na)); LEAVE; } else @@ -296,6 +300,7 @@ dump_op(OP *o) break; case OP_PUSHRE: case OP_MATCH: + case OP_QR: case OP_SUBST: dump_pm(cPMOPo); break; @@ -307,7 +312,7 @@ dump_op(OP *o) for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) dump_op(kid); } - dumplvl--; + PL_dumplvl--; dump("}\n"); #endif /* DEBUGGING */ } @@ -323,7 +328,7 @@ dump_gv(GV *gv) return; } sv = sv_newmortal(); - dumplvl++; + PL_dumplvl++; PerlIO_printf(Perl_debug_log, "{\n"); gv_fullname3(sv, gv, Nullch); dump("GV_NAME = %s", SvPVX(sv)); @@ -332,7 +337,7 @@ dump_gv(GV *gv) dump("-> %s", SvPVX(sv)); } dump("\n"); - dumplvl--; + PL_dumplvl--; dump("}\n"); #endif /* DEBUGGING */ } @@ -348,7 +353,7 @@ dump_pm(PMOP *pm) return; } dump("{\n"); - dumplvl++; + PL_dumplvl++; if (pm->op_pmflags & PMf_ONCE) ch = '?'; else @@ -367,6 +372,8 @@ dump_pm(PMOP *pm) SV *tmpsv = newSVpv("", 0); if (pm->op_pmdynflags & PMdf_USED) sv_catpv(tmpsv, ",USED"); + if (pm->op_pmdynflags & PMdf_TAINTED) + sv_catpv(tmpsv, ",TAINTED"); if (pm->op_pmflags & PMf_ONCE) sv_catpv(tmpsv, ",ONCE"); if (pm->op_pmregexp && pm->op_pmregexp->check_substr @@ -385,21 +392,21 @@ dump_pm(PMOP *pm) sv_catpv(tmpsv, ",GLOBAL"); if (pm->op_pmflags & PMf_CONTINUE) sv_catpv(tmpsv, ",CONTINUE"); - if (pm->op_pmflags & PMf_TAINTMEM) - sv_catpv(tmpsv, ",TAINTMEM"); + if (pm->op_pmflags & PMf_RETAINT) + sv_catpv(tmpsv, ",RETAINT"); if (pm->op_pmflags & PMf_EVAL) sv_catpv(tmpsv, ",EVAL"); dump("PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); SvREFCNT_dec(tmpsv); } - dumplvl--; + PL_dumplvl--; dump("}\n"); #endif /* DEBUGGING */ } -static void +STATIC void dump(char *pat,...) { #ifdef DEBUGGING @@ -407,7 +414,7 @@ dump(char *pat,...) va_list args; va_start(args, pat); - for (i = dumplvl*4; i; i--) + for (i = PL_dumplvl*4; i; i--) (void)PerlIO_putc(Perl_debug_log,' '); PerlIO_vprintf(Perl_debug_log,pat,args); va_end(args);