+ if (*(SvEND(d) - 1) == ',')
+ SvPVX(d)[--SvCUR(d)] = '\0';
+ sv_catpv(d, ")");
+ s = SvPVX(d);
+
+ Perl_dump_indent(aTHX_ level, file, "SV = ");
+ switch (type) {
+ case SVt_NULL:
+ PerlIO_printf(file, "NULL%s\n", s);
+ return;
+ case SVt_IV:
+ PerlIO_printf(file, "IV%s\n", s);
+ break;
+ case SVt_NV:
+ PerlIO_printf(file, "NV%s\n", s);
+ break;
+ case SVt_RV:
+ PerlIO_printf(file, "RV%s\n", s);
+ break;
+ case SVt_PV:
+ PerlIO_printf(file, "PV%s\n", s);
+ break;
+ case SVt_PVIV:
+ PerlIO_printf(file, "PVIV%s\n", s);
+ break;
+ case SVt_PVNV:
+ PerlIO_printf(file, "PVNV%s\n", s);
+ break;
+ case SVt_PVBM:
+ PerlIO_printf(file, "PVBM%s\n", s);
+ break;
+ case SVt_PVMG:
+ PerlIO_printf(file, "PVMG%s\n", s);
+ break;
+ case SVt_PVLV:
+ PerlIO_printf(file, "PVLV%s\n", s);
+ break;
+ case SVt_PVAV:
+ PerlIO_printf(file, "PVAV%s\n", s);
+ break;
+ case SVt_PVHV:
+ PerlIO_printf(file, "PVHV%s\n", s);
+ break;
+ case SVt_PVCV:
+ PerlIO_printf(file, "PVCV%s\n", s);
+ break;
+ case SVt_PVGV:
+ PerlIO_printf(file, "PVGV%s\n", s);
+ break;
+ case SVt_PVFM:
+ PerlIO_printf(file, "PVFM%s\n", s);
+ break;
+ case SVt_PVIO:
+ PerlIO_printf(file, "PVIO%s\n", s);
+ break;
+ default:
+ PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
+ return;
+ }
+ if (type >= SVt_PVIV || type == SVt_IV) {
+ if (SvIsUV(sv))
+ Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
+ else
+ Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
+ if (SvOOK(sv))
+ PerlIO_printf(file, " (OFFSET)");
+ PerlIO_putc(file, '\n');
+ }
+ if (type >= SVt_PVNV || type == SVt_NV) {
+ RESTORE_NUMERIC_STANDARD();
+ /* %Vg doesn't work? --jhi */
+#ifdef USE_LONG_DOUBLE
+ Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
+#else
+ Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv));
+#endif
+ RESTORE_NUMERIC_LOCAL();
+ }
+ if (SvROK(sv)) {
+ Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
+ if (nest < maxnest)
+ do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
+ return;
+ }
+ if (type < SVt_PV)
+ return;
+ if (type <= SVt_PVLV) {
+ if (SvPVX(sv)) {
+ Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv)));
+ if (SvOOK(sv))
+ PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
+ PerlIO_printf(file, "%s\n", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim));
+ Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
+ Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n", (IV)SvLEN(sv));
+ }
+ else
+ Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
+ }
+ if (type >= SVt_PVMG) {
+ if (SvMAGIC(sv))
+ do_magic_dump(level, file, SvMAGIC(sv), nest, maxnest, dumpops, pvlim);
+ if (SvSTASH(sv))
+ do_hv_dump(level, file, " STASH", SvSTASH(sv));
+ }
+ switch (type) {
+ case SVt_PVLV:
+ Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
+ Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
+ Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
+ Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
+ /* XXX level+1 ??? */
+ do_sv_dump(level, file, LvTARG(sv), nest+1, maxnest, dumpops, pvlim);
+ break;
+ case SVt_PVAV:
+ Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
+ if (AvARRAY(sv) != AvALLOC(sv)) {
+ PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
+ Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
+ }
+ else
+ PerlIO_putc(file, '\n');
+ Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
+ Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
+ Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", PTR2UV(AvARYLEN(sv)));
+ flags = AvFLAGS(sv);
+ sv_setpv(d, "");
+ if (flags & AVf_REAL) sv_catpv(d, ",REAL");
+ if (flags & AVf_REIFY) sv_catpv(d, ",REIFY");
+ if (flags & AVf_REUSED) sv_catpv(d, ",REUSED");
+ Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n", SvCUR(d) ? SvPVX(d) + 1 : "");
+ if (nest < maxnest && av_len((AV*)sv) >= 0) {
+ int count;
+ for (count = 0; count <= av_len((AV*)sv) && count < maxnest; count++) {
+ SV** elt = av_fetch((AV*)sv,count,0);
+
+ Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
+ if (elt)
+ do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
+ }
+ }
+ break;
+ case SVt_PVHV:
+ Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
+ if (HvARRAY(sv) && HvKEYS(sv)) {
+ /* Show distribution of HEs in the ARRAY */
+ int freq[200];
+#define FREQ_MAX (sizeof freq / sizeof freq[0] - 1)
+ int i;
+ int max = 0;
+ U32 pow2 = 2, keys = HvKEYS(sv);
+ NV theoret, sum = 0;
+
+ PerlIO_printf(file, " (");
+ Zero(freq, FREQ_MAX + 1, int);
+ for (i = 0; i <= HvMAX(sv); i++) {
+ HE* h; int count = 0;
+ for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
+ count++;
+ if (count > FREQ_MAX)
+ count = FREQ_MAX;
+ freq[count]++;
+ if (max < count)
+ max = count;
+ }
+ for (i = 0; i <= max; i++) {
+ if (freq[i]) {
+ PerlIO_printf(file, "%d%s:%d", i,
+ (i == FREQ_MAX) ? "+" : "",
+ freq[i]);
+ if (i != max)
+ PerlIO_printf(file, ", ");
+ }
+ }
+ PerlIO_putc(file, ')');
+ /* Now calculate quality wrt theoretical value */
+ for (i = max; i > 0; i--) { /* Precision: count down. */
+ sum += freq[i] * i * i;
+ }
+ while (keys = keys >> 1)
+ pow2 = pow2 << 1;
+ /* Approximate by Poisson distribution */
+ theoret = HvKEYS(sv);
+ theoret += theoret * theoret/pow2;
+ PerlIO_putc(file, '\n');
+ Perl_dump_indent(aTHX_ level, file, " hash quality = %.1f%%", theoret/sum*100);
+ }
+ PerlIO_putc(file, '\n');
+ Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvKEYS(sv));
+ Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)HvFILL(sv));
+ Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
+ Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER(sv));
+ Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER(sv)));
+ if (HvPMROOT(sv))
+ Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(HvPMROOT(sv)));
+ if (HvNAME(sv))
+ Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", HvNAME(sv));
+ if (nest < maxnest && !HvEITER(sv)) { /* Try to preserve iterator */
+ HE *he;
+ HV *hv = (HV*)sv;
+ int count = maxnest - nest;
+
+ hv_iterinit(hv);
+ while ((he = hv_iternext(hv)) && count--) {
+ SV *elt;
+ char *key;
+ I32 len;
+ U32 hash = HeHASH(he);
+
+ key = hv_iterkey(he, &len);
+ elt = hv_iterval(hv, he);
+ Perl_dump_indent(aTHX_ level+1, file, "Elt %s HASH = 0x%"UVxf"\n", pv_display(d, key, len, 0, pvlim), (UV)hash);
+ do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
+ }
+ hv_iterinit(hv); /* Return to status quo */
+ }
+ break;
+ case SVt_PVCV:
+ if (SvPOK(sv))
+ Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n", SvPV(sv,n_a));
+ /* FALL THROUGH */
+ case SVt_PVFM:
+ do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
+ if (CvSTART(sv))
+ Perl_dump_indent(aTHX_ level, file, " START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)CvSTART(sv)->op_seq);
+ Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n", PTR2UV(CvROOT(sv)));
+ if (CvROOT(sv) && dumpops)
+ do_op_dump(level+1, file, CvROOT(sv));
+ 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));
+ 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", (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)));
+ if (nest < maxnest && CvPADLIST(sv)) {
+ AV* padlist = CvPADLIST(sv);
+ AV* pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
+ AV* pad = (AV*)*av_fetch(padlist, 1, FALSE);
+ SV** pname = AvARRAY(pad_name);
+ SV** ppad = AvARRAY(pad);
+ I32 ix;
+
+ for (ix = 1; ix <= AvFILL(pad_name); ix++) {
+ if (SvPOK(pname[ix]))
+ Perl_dump_indent(aTHX_ level,
+ /* %5d below is enough whitespace. */
+ file,
+ "%5d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n",
+ (int)ix, PTR2UV(ppad[ix]),
+ SvFAKE(pname[ix]) ? "FAKE " : "",
+ SvPVX(pname[ix]),
+ (IV)SvNVX(pname[ix]),
+ (IV)SvIVX(pname[ix]));
+ }
+ }
+ {
+ CV *outside = CvOUTSIDE(sv);
+ Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
+ PTR2UV(outside),
+ (!outside ? "null"
+ : CvANON(outside) ? "ANON"
+ : (outside == PL_main_cv) ? "MAIN"
+ : CvUNIQUE(outside) ? "UNIQUE"
+ : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
+ }
+ if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
+ do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim);
+ break;
+ case SVt_PVGV:
+ Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv));
+ 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)));
+ Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
+ Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
+ Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
+ Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
+ 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, " EGV", GvEGV(sv));
+ break;
+ case SVt_PVIO:
+ Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
+ Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
+ Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
+ Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
+ Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
+ Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
+ Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
+ if (IoTOP_NAME(sv))
+ Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
+ do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
+ if (IoFMT_NAME(sv))
+ Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
+ do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
+ if (IoBOTTOM_NAME(sv))
+ Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
+ do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
+ Perl_dump_indent(aTHX_ level, file, " SUBPROCESS = %"IVdf"\n", (IV)IoSUBPROCESS(sv));
+ if (isPRINT(IoTYPE(sv)))
+ Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
+ else
+ Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
+ Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
+ break;
+ }