X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=86c56ce8c88fe5d8650aa79957d4219697f1e750;hb=e3acbfda4f677df31695d7b2b63b7e9e854a3514;hp=f2f75f0ca99f5acbbcb40255003ae37ad90d7952;hpb=1ae6be1c7649fa55b3105031a58ffe146fa4f2fd;p=p5sagit%2Fp5-mst-13.2.git diff --git a/dump.c b/dump.c index f2f75f0..86c56ce 100644 --- a/dump.c +++ b/dump.c @@ -1,6 +1,6 @@ /* dump.c * - * Copyright (c) 1991-1999, Larry Wall + * Copyright (c) 1991-2000, 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. @@ -30,7 +30,7 @@ void Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args) { dTHR; - PerlIO_printf(file, "%*s", level*PL_dumpindent, ""); + PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), ""); PerlIO_vprintf(file, pat, *args); } @@ -78,9 +78,9 @@ Perl_dump_sub(pTHX_ GV *gv) gv_fullname3(sv, gv, Nullch); Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX(sv)); if (CvXSUB(GvCV(gv))) - Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%x %d)\n", + Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%lx %d)\n", (long)CvXSUB(GvCV(gv)), - CvXSUBANY(GvCV(gv)).any_i32); + (int)CvXSUBANY(GvCV(gv)).any_i32); else if (CvROOT(GvCV(gv))) op_dump(CvROOT(GvCV(gv))); else @@ -131,9 +131,9 @@ Perl_pv_display(pTHX_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim) } else { if (cur && isDIGIT(*(pv+1))) - Perl_sv_catpvf(aTHX_ sv, "\\%03o", *pv); + Perl_sv_catpvf(aTHX_ sv, "\\%03o", (U8)*pv); else - Perl_sv_catpvf(aTHX_ sv, "\\%o", *pv); + Perl_sv_catpvf(aTHX_ sv, "\\%o", (U8)*pv); } } sv_catpvn(sv, "\"", 1); @@ -370,14 +370,15 @@ void Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) { dTHR; - STRLEN n_a; Perl_dump_indent(aTHX_ level, file, "{\n"); level++; if (o->op_seq) PerlIO_printf(file, "%-4d", o->op_seq); else PerlIO_printf(file, " "); - PerlIO_printf(file, "%*sTYPE = %s ===> ", PL_dumpindent*level-4, "", PL_op_name[o->op_type]); + PerlIO_printf(file, + "%*sTYPE = %s ===> ", + (int)(PL_dumpindent*level-4), "", PL_op_name[o->op_type]); if (o->op_next) { if (o->op_seq) PerlIO_printf(file, "%d\n", o->op_next->op_seq); @@ -390,7 +391,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) if (o->op_type == OP_NULL) Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]); else - Perl_dump_indent(aTHX_ level, file, "TARG = %d\n", o->op_targ); + Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ); } #ifdef DUMPADDR Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next); @@ -428,9 +429,15 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) } if (o->op_private) { SV *tmpsv = newSVpvn("", 0); + if (PL_opargs[o->op_type] & OA_TARGLEX) { + if (o->op_private & OPpTARGET_MY) + sv_catpv(tmpsv, ",TARGET_MY"); + } if (o->op_type == OP_AASSIGN) { if (o->op_private & OPpASSIGN_COMMON) sv_catpv(tmpsv, ",COMMON"); + if (o->op_private & OPpASSIGN_HASH) + sv_catpv(tmpsv, ",HASH"); } else if (o->op_type == OP_SASSIGN) { if (o->op_private & OPpASSIGN_BACKWARDS) @@ -483,6 +490,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) else { if (o->op_private & HINT_STRICT_REFS) sv_catpv(tmpsv, ",STRICT_REFS"); + if (o->op_private & OPpOUR_INTRO) + sv_catpv(tmpsv, ",OUR_INTRO"); } } else if (o->op_type == OP_CONST) { @@ -510,18 +519,24 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) } switch (o->op_type) { + case OP_AELEMFAST: case OP_GVSV: case OP_GV: - if (cGVOPo->op_gv) { +#ifdef USE_ITHREADS + Perl_dump_indent(aTHX_ level, file, "PADIX = %d\n", cPADOPo->op_padix); +#else + if (cSVOPo->op_sv) { SV *tmpsv = NEWSV(0,0); + STRLEN n_a; ENTER; SAVEFREESV(tmpsv); - gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch); + gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch); Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a)); LEAVE; } else Perl_dump_indent(aTHX_ level, file, "GV = NULL\n"); +#endif break; case OP_CONST: case OP_METHOD_NAMED: @@ -530,10 +545,14 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) case OP_SETSTATE: case OP_NEXTSTATE: case OP_DBSTATE: - if (cCOPo->cop_line) - Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",cCOPo->cop_line); + if (CopLINE(cCOPo)) + Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",CopLINE(cCOPo)); + if (CopSTASHPV(cCOPo)) + Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n", + CopSTASHPV(cCOPo)); if (cCOPo->cop_label) - Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",cCOPo->cop_label); + Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n", + cCOPo->cop_label); break; case OP_ENTERLOOP: Perl_dump_indent(aTHX_ level, file, "REDO ===> "); @@ -570,6 +589,15 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) case OP_SUBST: do_pmop_dump(level, file, cPMOPo); break; + case OP_LEAVE: + case OP_LEAVEEVAL: + case OP_LEAVESUB: + case OP_LEAVESUBLV: + case OP_LEAVEWRITE: + case OP_SCOPE: + if (o->op_private & OPpREFCOUNTED) + Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ); + break; default: break; } @@ -677,7 +705,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxne do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */ } if (mg->mg_len) - Perl_dump_indent(aTHX_ level, file, " MG_LEN = %d\n", mg->mg_len); + Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len); if (mg->mg_ptr) { Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr)); if (mg->mg_len >= 0) { @@ -758,8 +786,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_sv_setpvf(aTHX_ d, "(0x%"UVxf") at 0x%"UVxf"\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (", PTR2UV(SvANY(sv)), PTR2UV(sv), - PL_dumpindent*level, "", (IV)SvREFCNT(sv), - PL_dumpindent*level, ""); + (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv), + (int)(PL_dumpindent*level), ""); if (flags & SVs_PADBUSY) sv_catpv(d, "PADBUSY,"); if (flags & SVs_PADTMP) sv_catpv(d, "PADTMP,"); @@ -822,6 +850,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo default: if (SvEVALED(sv)) sv_catpv(d, "EVALED,"); if (SvIsUV(sv)) sv_catpv(d, "IsUV,"); + if (SvUTF8(sv)) sv_catpv(d, "UTF8"); break; case SVt_PVBM: if (SvTAIL(sv)) sv_catpv(d, "TAIL,"); @@ -885,7 +914,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo PerlIO_printf(file, "PVIO%s\n", s); break; default: - PerlIO_printf(file, "UNKNOWN(0x%x) %s\n", type, s); + PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s); return; } if (type >= SVt_PVIV || type == SVt_IV) { @@ -1007,7 +1036,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo for (i = max; i > 0; i--) { /* Precision: count down. */ sum += freq[i] * i * i; } - while (keys = keys >> 1) + while ((keys = keys >> 1)) pow2 = pow2 << 1; /* Approximate by Poisson distribution */ theoret = HvKEYS(sv); @@ -1059,13 +1088,13 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv))); Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n", (IV)CvXSUBANY(sv).any_i32); do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv)); - do_gv_dump(level, file, " FILEGV", CvFILEGV(sv)); + Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv)); Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv)); #ifdef USE_THREADS Perl_dump_indent(aTHX_ level, file, " MUTEXP = 0x%"UVxf"\n", PTR2UV(CvMUTEXP(sv))); Perl_dump_indent(aTHX_ level, file, " OWNER = 0x%"UVxf"\n", PTR2UV(CvOWNER(sv))); #endif /* USE_THREADS */ - Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", CvFLAGS(sv)); + Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv)); if (type == SVt_PVFM) Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)FmLINES(sv)); Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv))); @@ -1083,7 +1112,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo /* %5d below is enough whitespace. */ file, "%5d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n", - ix, PTR2UV(ppad[ix]), + (int)ix, PTR2UV(ppad[ix]), SvFAKE(pname[ix]) ? "FAKE " : "", SvPVX(pname[ix]), (IV)SvNVX(pname[ix]), @@ -1108,6 +1137,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv)); do_hv_dump (level, file, " GvSTASH", GvSTASH(sv)); Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv))); + if (!GvGP(sv)) + break; Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv))); Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv)); Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv))); @@ -1118,8 +1149,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv)); Perl_dump_indent(aTHX_ level, file, " GPFLAGS = 0x%"UVxf"\n", (UV)GvGPFLAGS(sv)); Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv)); + Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv)); Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv)); - do_gv_dump (level, file, " FILEGV", GvFILEGV(sv)); do_gv_dump (level, file, " EGV", GvEGV(sv)); break; case SVt_PVIO: