X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=7aed230c70771375bad8138b08be0597ebdf3050;hb=54f70fc60d33628464c2f1f4a555eb6764959916;hp=e461d69750b17e4af36e30e4e50b56f6b2a74f5d;hpb=4db585907a35b9a132de989dd48c7c1ba6504c62;p=p5sagit%2Fp5-mst-13.2.git diff --git a/dump.c b/dump.c index e461d69..7aed230 100644 --- a/dump.c +++ b/dump.c @@ -25,25 +25,13 @@ dump_all() #ifdef I_STDARG static void dump(char *pat, ...); #else -# if defined(I_VARARGS) -/*VARARGS0*/ -static void -dump(pat, va_alist) - char *pat; - va_dcl -# else static void dump(); -# endif #endif void dump_all() { -#ifdef HAS_SETLINEBUF - setlinebuf(Perl_debug_log); -#else - setvbuf(Perl_debug_log, Nullch, _IOLBF, 0); -#endif + PerlIO_setlinebuf(Perl_debug_log); if (main_root) dump_op(main_root); dump_packsubs(defstash); @@ -62,7 +50,7 @@ HV* stash; for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) { GV *gv = (GV*)HeVAL(entry); HV *hv; - if (GvCV(gv)) + if (GvCVu(gv)) dump_sub(gv); if (GvFORM(gv)) dump_form(gv); @@ -79,7 +67,7 @@ GV* gv; { SV *sv = sv_newmortal(); - gv_fullname(sv,gv); + gv_fullname3(sv, gv, Nullch); dump("\nSUB %s = ", SvPVX(sv)); if (CvXSUB(GvCV(gv))) dump("(xsub 0x%x %d)\n", @@ -97,7 +85,7 @@ GV* gv; { SV *sv = sv_newmortal(); - gv_fullname(sv,gv); + gv_fullname3(sv, gv, Nullch); dump("\nFORMAT %s = ", SvPVX(sv)); if (CvROOT(GvFORM(gv))) dump_op(CvROOT(GvFORM(gv))); @@ -119,18 +107,18 @@ register OP *op; dump("{\n"); if (op->op_seq) - fprintf(Perl_debug_log, "%-4d", op->op_seq); + PerlIO_printf(Perl_debug_log, "%-4d", op->op_seq); else - fprintf(Perl_debug_log, " "); + PerlIO_printf(Perl_debug_log, " "); dump("TYPE = %s ===> ", op_name[op->op_type]); if (op->op_next) { if (op->op_seq) - fprintf(Perl_debug_log, "%d\n", op->op_next->op_seq); + PerlIO_printf(Perl_debug_log, "%d\n", op->op_next->op_seq); else - fprintf(Perl_debug_log, "(%d)\n", op->op_next->op_seq); + PerlIO_printf(Perl_debug_log, "(%d)\n", op->op_next->op_seq); } else - fprintf(Perl_debug_log, "DONE\n"); + PerlIO_printf(Perl_debug_log, "DONE\n"); dumplvl++; if (op->op_targ) { if (op->op_type == OP_NULL) @@ -201,10 +189,17 @@ register OP *op; (void)strcat(buf,"AMPER,"); if (op->op_private & OPpENTERSUB_DB) (void)strcat(buf,"DB,"); - if (op->op_private & OPpDEREF_AV) - (void)strcat(buf,"AV,"); - if (op->op_private & OPpDEREF_HV) - (void)strcat(buf,"HV,"); + switch (op->op_private & OPpDEREF) { + case OPpDEREF_SV: + (void)strcat(buf, "SV,"); + break; + case OPpDEREF_AV: + (void)strcat(buf, "AV,"); + break; + case OPpDEREF_HV: + (void)strcat(buf, "HV,"); + break; + } if (op->op_private & HINT_STRICT_REFS) (void)strcat(buf,"STRICT_REFS,"); } @@ -235,7 +230,7 @@ register OP *op; ENTER; tmpsv = NEWSV(0,0); SAVEFREESV(tmpsv); - gv_fullname(tmpsv,cGVOP->op_gv); + gv_fullname3(tmpsv, cGVOP->op_gv, Nullch); dump("GV = %s\n", SvPV(tmpsv, na)); LEAVE; } @@ -255,31 +250,31 @@ register OP *op; case OP_ENTERLOOP: dump("REDO ===> "); if (cLOOP->op_redoop) - fprintf(Perl_debug_log, "%d\n", cLOOP->op_redoop->op_seq); + PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_redoop->op_seq); else - fprintf(Perl_debug_log, "DONE\n"); + PerlIO_printf(Perl_debug_log, "DONE\n"); dump("NEXT ===> "); if (cLOOP->op_nextop) - fprintf(Perl_debug_log, "%d\n", cLOOP->op_nextop->op_seq); + PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_nextop->op_seq); else - fprintf(Perl_debug_log, "DONE\n"); + PerlIO_printf(Perl_debug_log, "DONE\n"); dump("LAST ===> "); if (cLOOP->op_lastop) - fprintf(Perl_debug_log, "%d\n", cLOOP->op_lastop->op_seq); + PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_lastop->op_seq); else - fprintf(Perl_debug_log, "DONE\n"); + PerlIO_printf(Perl_debug_log, "DONE\n"); break; case OP_COND_EXPR: dump("TRUE ===> "); if (cCONDOP->op_true) - fprintf(Perl_debug_log, "%d\n", cCONDOP->op_true->op_seq); + PerlIO_printf(Perl_debug_log, "%d\n", cCONDOP->op_true->op_seq); else - fprintf(Perl_debug_log, "DONE\n"); + PerlIO_printf(Perl_debug_log, "DONE\n"); dump("FALSE ===> "); if (cCONDOP->op_false) - fprintf(Perl_debug_log, "%d\n", cCONDOP->op_false->op_seq); + PerlIO_printf(Perl_debug_log, "%d\n", cCONDOP->op_false->op_seq); else - fprintf(Perl_debug_log, "DONE\n"); + PerlIO_printf(Perl_debug_log, "DONE\n"); break; case OP_MAPWHILE: case OP_GREPWHILE: @@ -287,9 +282,9 @@ register OP *op; case OP_AND: dump("OTHER ===> "); if (cLOGOP->op_other) - fprintf(Perl_debug_log, "%d\n", cLOGOP->op_other->op_seq); + PerlIO_printf(Perl_debug_log, "%d\n", cLOGOP->op_other->op_seq); else - fprintf(Perl_debug_log, "DONE\n"); + PerlIO_printf(Perl_debug_log, "DONE\n"); break; case OP_PUSHRE: case OP_MATCH: @@ -315,16 +310,16 @@ register GV *gv; SV *sv; if (!gv) { - fprintf(Perl_debug_log,"{}\n"); + PerlIO_printf(Perl_debug_log, "{}\n"); return; } sv = sv_newmortal(); dumplvl++; - fprintf(Perl_debug_log,"{\n"); - gv_fullname(sv,gv); + PerlIO_printf(Perl_debug_log, "{\n"); + gv_fullname3(sv, gv, Nullch); dump("GV_NAME = %s", SvPVX(sv)); if (gv != GvEGV(gv)) { - gv_efullname(sv,GvEGV(gv)); + gv_efullname3(sv, GvEGV(gv), Nullch); dump("-> %s", SvPVX(sv)); } dump("\n"); @@ -369,8 +364,6 @@ register PMOP *pm; (void)strcat(buf,"ALL,"); if (pm->op_pmflags & PMf_SKIPWHITE) (void)strcat(buf,"SKIPWHITE,"); - if (pm->op_pmflags & PMf_FOLD) - (void)strcat(buf,"FOLD,"); if (pm->op_pmflags & PMf_CONST) (void)strcat(buf,"CONST,"); if (pm->op_pmflags & PMf_KEEP) @@ -400,8 +393,8 @@ long arg2, arg3, arg4, arg5; I32 i; for (i = dumplvl*4; i; i--) - (void)putc(' ',Perl_debug_log); - fprintf(Perl_debug_log,arg1, arg2, arg3, arg4, arg5); + (void)PerlIO_putc(Perl_debug_log,' '); + PerlIO_printf(Perl_debug_log, arg1, arg2, arg3, arg4, arg5); } #else @@ -419,9 +412,6 @@ dump(pat,va_alist) { I32 i; va_list args; -#ifndef HAS_VPRINTF - int vfprintf(); -#endif #ifdef I_STDARG va_start(args, pat); @@ -429,8 +419,8 @@ dump(pat,va_alist) va_start(args); #endif for (i = dumplvl*4; i; i--) - (void)putc(' ',stderr); - vfprintf(Perl_debug_log,pat,args); + (void)PerlIO_putc(Perl_debug_log,' '); + PerlIO_vprintf(Perl_debug_log,pat,args); va_end(args); } #endif