home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / dump.c < prev    next >
C/C++ Source or Header  |  2000-03-12  |  36KB  |  1,188 lines
  1. /*    dump.c
  2.  *
  3.  *    Copyright (c) 1991-2000, 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. /*
  11.  * "'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and
  12.  * it has not been hard for me to read your mind and memory.'"
  13.  */
  14.  
  15. #include "EXTERN.h"
  16. #define PERL_IN_DUMP_C
  17. #include "perl.h"
  18. #include "regcomp.h"
  19.  
  20. void
  21. Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
  22. {
  23.     va_list args;
  24.     va_start(args, pat);
  25.     dump_vindent(level, file, pat, &args);
  26.     va_end(args);
  27. }
  28.  
  29. void
  30. Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
  31. {
  32.     dTHR;
  33.     PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
  34.     PerlIO_vprintf(file, pat, *args);
  35. }
  36.  
  37. void
  38. Perl_dump_all(pTHX)
  39. {
  40.     dTHR;
  41.     PerlIO_setlinebuf(Perl_debug_log);
  42.     if (PL_main_root)
  43.     op_dump(PL_main_root);
  44.     dump_packsubs(PL_defstash);
  45. }
  46.  
  47. void
  48. Perl_dump_packsubs(pTHX_ HV *stash)
  49. {
  50.     dTHR;
  51.     I32    i;
  52.     HE    *entry;
  53.  
  54.     if (!HvARRAY(stash))
  55.     return;
  56.     for (i = 0; i <= (I32) HvMAX(stash); i++) {
  57.     for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
  58.         GV *gv = (GV*)HeVAL(entry);
  59.         HV *hv;
  60.         if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
  61.         continue;
  62.         if (GvCVu(gv))
  63.         dump_sub(gv);
  64.         if (GvFORM(gv))
  65.         dump_form(gv);
  66.         if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
  67.           (hv = GvHV(gv)) && HvNAME(hv) && hv != PL_defstash)
  68.         dump_packsubs(hv);        /* nested package */
  69.     }
  70.     }
  71. }
  72.  
  73. void
  74. Perl_dump_sub(pTHX_ GV *gv)
  75. {
  76.     SV *sv = sv_newmortal();
  77.  
  78.     gv_fullname3(sv, gv, Nullch);
  79.     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX(sv));
  80.     if (CvXSUB(GvCV(gv)))
  81.     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%lx %d)\n",
  82.         (long)CvXSUB(GvCV(gv)),
  83.         (int)CvXSUBANY(GvCV(gv)).any_i32);
  84.     else if (CvROOT(GvCV(gv)))
  85.     op_dump(CvROOT(GvCV(gv)));
  86.     else
  87.     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
  88. }
  89.  
  90. void
  91. Perl_dump_form(pTHX_ GV *gv)
  92. {
  93.     SV *sv = sv_newmortal();
  94.  
  95.     gv_fullname3(sv, gv, Nullch);
  96.     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX(sv));
  97.     if (CvROOT(GvFORM(gv)))
  98.     op_dump(CvROOT(GvFORM(gv)));
  99.     else
  100.     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
  101. }
  102.  
  103. void
  104. Perl_dump_eval(pTHX)
  105. {
  106.     op_dump(PL_eval_root);
  107. }
  108.  
  109. char *
  110. Perl_pv_display(pTHX_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
  111. {
  112.     int truncated = 0;
  113.     int nul_terminated = len > cur && pv[cur] == '\0';
  114.  
  115.     sv_setpvn(sv, "\"", 1);
  116.     for (; cur--; pv++) {
  117.     if (pvlim && SvCUR(sv) >= pvlim) {
  118.             truncated++;
  119.         break;
  120.         }
  121.         if (isPRINT(*pv)) {
  122.             switch (*pv) {
  123.         case '\t': sv_catpvn(sv, "\\t", 2);  break;
  124.         case '\n': sv_catpvn(sv, "\\n", 2);  break;
  125.         case '\r': sv_catpvn(sv, "\\r", 2);  break;
  126.         case '\f': sv_catpvn(sv, "\\f", 2);  break;
  127.         case '"':  sv_catpvn(sv, "\\\"", 2); break;
  128.         case '\\': sv_catpvn(sv, "\\\\", 2); break;
  129.         default:   sv_catpvn(sv, pv, 1);     break;
  130.             }
  131.         }
  132.     else {
  133.         if (cur && isDIGIT(*(pv+1)))
  134.         Perl_sv_catpvf(aTHX_ sv, "\\%03o", (U8)*pv);
  135.         else
  136.         Perl_sv_catpvf(aTHX_ sv, "\\%o", (U8)*pv);
  137.         }
  138.     }
  139.     sv_catpvn(sv, "\"", 1);
  140.     if (truncated)
  141.     sv_catpvn(sv, "...", 3);
  142.     if (nul_terminated)
  143.     sv_catpvn(sv, "\\0", 2);
  144.  
  145.     return SvPVX(sv);
  146. }
  147.  
  148. char *
  149. Perl_sv_peek(pTHX_ SV *sv)
  150. {
  151.     SV *t = sv_newmortal();
  152.     STRLEN n_a;
  153.     int unref = 0;
  154.  
  155.     sv_setpvn(t, "", 0);
  156.   retry:
  157.     if (!sv) {
  158.     sv_catpv(t, "VOID");
  159.     goto finish;
  160.     }
  161.     else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
  162.     sv_catpv(t, "WILD");
  163.     goto finish;
  164.     }
  165.     else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes) {
  166.     if (sv == &PL_sv_undef) {
  167.         sv_catpv(t, "SV_UNDEF");
  168.         if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
  169.                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
  170.         SvREADONLY(sv))
  171.         goto finish;
  172.     }
  173.     else if (sv == &PL_sv_no) {
  174.         sv_catpv(t, "SV_NO");
  175.         if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
  176.                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
  177.         !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
  178.                   SVp_POK|SVp_NOK)) &&
  179.         SvCUR(sv) == 0 &&
  180.         SvNVX(sv) == 0.0)
  181.         goto finish;
  182.     }
  183.     else {
  184.         sv_catpv(t, "SV_YES");
  185.         if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
  186.                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
  187.         !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
  188.                   SVp_POK|SVp_NOK)) &&
  189.         SvCUR(sv) == 1 &&
  190.         SvPVX(sv) && *SvPVX(sv) == '1' &&
  191.         SvNVX(sv) == 1.0)
  192.         goto finish;
  193.     }
  194.     sv_catpv(t, ":");
  195.     }
  196.     else if (SvREFCNT(sv) == 0) {
  197.     sv_catpv(t, "(");
  198.     unref++;
  199.     }
  200.     if (SvROK(sv)) {
  201.     sv_catpv(t, "\\");
  202.     if (SvCUR(t) + unref > 10) {
  203.         SvCUR(t) = unref + 3;
  204.         *SvEND(t) = '\0';
  205.         sv_catpv(t, "...");
  206.         goto finish;
  207.     }
  208.     sv = (SV*)SvRV(sv);
  209.     goto retry;
  210.     }
  211.     switch (SvTYPE(sv)) {
  212.     default:
  213.     sv_catpv(t, "FREED");
  214.     goto finish;
  215.  
  216.     case SVt_NULL:
  217.     sv_catpv(t, "UNDEF");
  218.     goto finish;
  219.     case SVt_IV:
  220.     sv_catpv(t, "IV");
  221.     break;
  222.     case SVt_NV:
  223.     sv_catpv(t, "NV");
  224.     break;
  225.     case SVt_RV:
  226.     sv_catpv(t, "RV");
  227.     break;
  228.     case SVt_PV:
  229.     sv_catpv(t, "PV");
  230.     break;
  231.     case SVt_PVIV:
  232.     sv_catpv(t, "PVIV");
  233.     break;
  234.     case SVt_PVNV:
  235.     sv_catpv(t, "PVNV");
  236.     break;
  237.     case SVt_PVMG:
  238.     sv_catpv(t, "PVMG");
  239.     break;
  240.     case SVt_PVLV:
  241.     sv_catpv(t, "PVLV");
  242.     break;
  243.     case SVt_PVAV:
  244.     sv_catpv(t, "AV");
  245.     break;
  246.     case SVt_PVHV:
  247.     sv_catpv(t, "HV");
  248.     break;
  249.     case SVt_PVCV:
  250.     if (CvGV(sv))
  251.         Perl_sv_catpvf(aTHX_ t, "CV(%s)", GvNAME(CvGV(sv)));
  252.     else
  253.         sv_catpv(t, "CV()");
  254.     goto finish;
  255.     case SVt_PVGV:
  256.     sv_catpv(t, "GV");
  257.     break;
  258.     case SVt_PVBM:
  259.     sv_catpv(t, "BM");
  260.     break;
  261.     case SVt_PVFM:
  262.     sv_catpv(t, "FM");
  263.     break;
  264.     case SVt_PVIO:
  265.     sv_catpv(t, "IO");
  266.     break;
  267.     }
  268.  
  269.     if (SvPOKp(sv)) {
  270.     if (!SvPVX(sv))
  271.         sv_catpv(t, "(null)");
  272.     else {
  273.         SV *tmp = newSVpvn("", 0);
  274.         sv_catpv(t, "(");
  275.         if (SvOOK(sv))
  276.         Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, 127));
  277.         Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX(sv), SvCUR(sv), SvLEN(sv), 127));
  278.         SvREFCNT_dec(tmp);
  279.     }
  280.     }
  281.     else if (SvNOKp(sv)) {
  282.      RESTORE_NUMERIC_STANDARD();
  283.     Perl_sv_catpvf(aTHX_ t, "(%g)",SvNVX(sv));
  284.      RESTORE_NUMERIC_LOCAL();
  285.     }
  286.     else if (SvIOKp(sv)) {
  287.     if (SvIsUV(sv))
  288.         Perl_sv_catpvf(aTHX_ t, "(%"UVuf")", (UV)SvUVX(sv));
  289.     else
  290.             Perl_sv_catpvf(aTHX_ t, "(%"IVdf")", (IV)SvIVX(sv));
  291.     }
  292.     else
  293.     sv_catpv(t, "()");
  294.     
  295.   finish:
  296.     if (unref) {
  297.     while (unref--)
  298.         sv_catpv(t, ")");
  299.     }
  300.     return SvPV(t, n_a);
  301. }
  302.  
  303. void
  304. Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm)
  305. {
  306.     char ch;
  307.  
  308.     if (!pm) {
  309.     Perl_dump_indent(aTHX_ level, file, "{}\n");
  310.     return;
  311.     }
  312.     Perl_dump_indent(aTHX_ level, file, "{\n");
  313.     level++;
  314.     if (pm->op_pmflags & PMf_ONCE)
  315.     ch = '?';
  316.     else
  317.     ch = '/';
  318.     if (pm->op_pmregexp)
  319.     Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n",
  320.          ch, pm->op_pmregexp->precomp, ch,
  321.          (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
  322.     else
  323.     Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
  324.     if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
  325.     Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
  326.     op_dump(pm->op_pmreplroot);
  327.     }
  328.     if (pm->op_pmflags || (pm->op_pmregexp && pm->op_pmregexp->check_substr)) {
  329.     SV *tmpsv = newSVpvn("", 0);
  330.     if (pm->op_pmdynflags & PMdf_USED)
  331.         sv_catpv(tmpsv, ",USED");
  332.     if (pm->op_pmdynflags & PMdf_TAINTED)
  333.         sv_catpv(tmpsv, ",TAINTED");
  334.     if (pm->op_pmflags & PMf_ONCE)
  335.         sv_catpv(tmpsv, ",ONCE");
  336.     if (pm->op_pmregexp && pm->op_pmregexp->check_substr
  337.         && !(pm->op_pmregexp->reganch & ROPT_NOSCAN))
  338.         sv_catpv(tmpsv, ",SCANFIRST");
  339.     if (pm->op_pmregexp && pm->op_pmregexp->check_substr
  340.         && pm->op_pmregexp->reganch & ROPT_CHECK_ALL)
  341.         sv_catpv(tmpsv, ",ALL");
  342.     if (pm->op_pmflags & PMf_SKIPWHITE)
  343.         sv_catpv(tmpsv, ",SKIPWHITE");
  344.     if (pm->op_pmflags & PMf_CONST)
  345.         sv_catpv(tmpsv, ",CONST");
  346.     if (pm->op_pmflags & PMf_KEEP)
  347.         sv_catpv(tmpsv, ",KEEP");
  348.     if (pm->op_pmflags & PMf_GLOBAL)
  349.         sv_catpv(tmpsv, ",GLOBAL");
  350.     if (pm->op_pmflags & PMf_CONTINUE)
  351.         sv_catpv(tmpsv, ",CONTINUE");
  352.     if (pm->op_pmflags & PMf_RETAINT)
  353.         sv_catpv(tmpsv, ",RETAINT");
  354.     if (pm->op_pmflags & PMf_EVAL)
  355.         sv_catpv(tmpsv, ",EVAL");
  356.     Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
  357.     SvREFCNT_dec(tmpsv);
  358.     }
  359.  
  360.     Perl_dump_indent(aTHX_ level-1, file, "}\n");
  361. }
  362.  
  363. void
  364. Perl_pmop_dump(pTHX_ PMOP *pm)
  365. {
  366.     do_pmop_dump(0, Perl_debug_log, pm);
  367. }
  368.  
  369. void
  370. Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
  371. {
  372.     dTHR;
  373.     Perl_dump_indent(aTHX_ level, file, "{\n");
  374.     level++;
  375.     if (o->op_seq)
  376.     PerlIO_printf(file, "%-4d", o->op_seq);
  377.     else
  378.     PerlIO_printf(file, "    ");
  379.     PerlIO_printf(file,
  380.           "%*sTYPE = %s  ===> ",
  381.           (int)(PL_dumpindent*level-4), "", PL_op_name[o->op_type]);
  382.     if (o->op_next) {
  383.     if (o->op_seq)
  384.         PerlIO_printf(file, "%d\n", o->op_next->op_seq);
  385.     else
  386.         PerlIO_printf(file, "(%d)\n", o->op_next->op_seq);
  387.     }
  388.     else
  389.     PerlIO_printf(file, "DONE\n");
  390.     if (o->op_targ) {
  391.     if (o->op_type == OP_NULL)
  392.         Perl_dump_indent(aTHX_ level, file, "  (was %s)\n", PL_op_name[o->op_targ]);
  393.     else
  394.         Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
  395.     }
  396. #ifdef DUMPADDR
  397.     Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
  398. #endif
  399.     if (o->op_flags) {
  400.     SV *tmpsv = newSVpvn("", 0);
  401.     switch (o->op_flags & OPf_WANT) {
  402.     case OPf_WANT_VOID:
  403.         sv_catpv(tmpsv, ",VOID");
  404.         break;
  405.     case OPf_WANT_SCALAR:
  406.         sv_catpv(tmpsv, ",SCALAR");
  407.         break;
  408.     case OPf_WANT_LIST:
  409.         sv_catpv(tmpsv, ",LIST");
  410.         break;
  411.     default:
  412.         sv_catpv(tmpsv, ",UNKNOWN");
  413.         break;
  414.     }
  415.     if (o->op_flags & OPf_KIDS)
  416.         sv_catpv(tmpsv, ",KIDS");
  417.     if (o->op_flags & OPf_PARENS)
  418.         sv_catpv(tmpsv, ",PARENS");
  419.     if (o->op_flags & OPf_STACKED)
  420.         sv_catpv(tmpsv, ",STACKED");
  421.     if (o->op_flags & OPf_REF)
  422.         sv_catpv(tmpsv, ",REF");
  423.     if (o->op_flags & OPf_MOD)
  424.         sv_catpv(tmpsv, ",MOD");
  425.     if (o->op_flags & OPf_SPECIAL)
  426.         sv_catpv(tmpsv, ",SPECIAL");
  427.     Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
  428.     SvREFCNT_dec(tmpsv);
  429.     }
  430.     if (o->op_private) {
  431.     SV *tmpsv = newSVpvn("", 0);
  432.     if (PL_opargs[o->op_type] & OA_TARGLEX) {
  433.         if (o->op_private & OPpTARGET_MY)
  434.         sv_catpv(tmpsv, ",TARGET_MY");
  435.     }
  436.     if (o->op_type == OP_AASSIGN) {
  437.         if (o->op_private & OPpASSIGN_COMMON)
  438.         sv_catpv(tmpsv, ",COMMON");
  439.         if (o->op_private & OPpASSIGN_HASH)
  440.         sv_catpv(tmpsv, ",HASH");
  441.     }
  442.     else if (o->op_type == OP_SASSIGN) {
  443.         if (o->op_private & OPpASSIGN_BACKWARDS)
  444.         sv_catpv(tmpsv, ",BACKWARDS");
  445.     }
  446.     else if (o->op_type == OP_TRANS) {
  447.         if (o->op_private & OPpTRANS_SQUASH)
  448.         sv_catpv(tmpsv, ",SQUASH");
  449.         if (o->op_private & OPpTRANS_DELETE)
  450.         sv_catpv(tmpsv, ",DELETE");
  451.         if (o->op_private & OPpTRANS_COMPLEMENT)
  452.         sv_catpv(tmpsv, ",COMPLEMENT");
  453.     }
  454.     else if (o->op_type == OP_REPEAT) {
  455.         if (o->op_private & OPpREPEAT_DOLIST)
  456.         sv_catpv(tmpsv, ",DOLIST");
  457.     }
  458.     else if (o->op_type == OP_ENTERSUB ||
  459.          o->op_type == OP_RV2SV ||
  460.          o->op_type == OP_RV2AV ||
  461.          o->op_type == OP_RV2HV ||
  462.          o->op_type == OP_RV2GV ||
  463.          o->op_type == OP_AELEM ||
  464.          o->op_type == OP_HELEM )
  465.     {
  466.         if (o->op_type == OP_ENTERSUB) {
  467.         if (o->op_private & OPpENTERSUB_AMPER)
  468.             sv_catpv(tmpsv, ",AMPER");
  469.         if (o->op_private & OPpENTERSUB_DB)
  470.             sv_catpv(tmpsv, ",DB");
  471.         if (o->op_private & OPpENTERSUB_HASTARG)
  472.             sv_catpv(tmpsv, ",HASTARG");
  473.         }
  474.         else 
  475.         switch (o->op_private & OPpDEREF) {
  476.         case OPpDEREF_SV:
  477.         sv_catpv(tmpsv, ",SV");
  478.         break;
  479.         case OPpDEREF_AV:
  480.         sv_catpv(tmpsv, ",AV");
  481.         break;
  482.         case OPpDEREF_HV:
  483.         sv_catpv(tmpsv, ",HV");
  484.         break;
  485.         }
  486.         if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) {
  487.         if (o->op_private & OPpLVAL_DEFER)
  488.             sv_catpv(tmpsv, ",LVAL_DEFER");
  489.         }
  490.         else {
  491.         if (o->op_private & HINT_STRICT_REFS)
  492.             sv_catpv(tmpsv, ",STRICT_REFS");
  493.         if (o->op_private & OPpOUR_INTRO)
  494.             sv_catpv(tmpsv, ",OUR_INTRO");
  495.         }
  496.     }
  497.     else if (o->op_type == OP_CONST) {
  498.         if (o->op_private & OPpCONST_BARE)
  499.         sv_catpv(tmpsv, ",BARE");
  500.         if (o->op_private & OPpCONST_STRICT)
  501.         sv_catpv(tmpsv, ",STRICT");
  502.     }
  503.     else if (o->op_type == OP_FLIP) {
  504.         if (o->op_private & OPpFLIP_LINENUM)
  505.         sv_catpv(tmpsv, ",LINENUM");
  506.     }
  507.     else if (o->op_type == OP_FLOP) {
  508.         if (o->op_private & OPpFLIP_LINENUM)
  509.         sv_catpv(tmpsv, ",LINENUM");
  510.     } else if (o->op_type == OP_RV2CV) {
  511.         if (o->op_private & OPpLVAL_INTRO)
  512.         sv_catpv(tmpsv, ",INTRO");
  513.     }
  514.     if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
  515.         sv_catpv(tmpsv, ",INTRO");
  516.     if (SvCUR(tmpsv))
  517.         Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX(tmpsv) + 1);
  518.     SvREFCNT_dec(tmpsv);
  519.     }
  520.  
  521.     switch (o->op_type) {
  522.     case OP_AELEMFAST:
  523.     case OP_GVSV:
  524.     case OP_GV:
  525. #ifdef USE_ITHREADS
  526.     Perl_dump_indent(aTHX_ level, file, "PADIX = %d\n", cPADOPo->op_padix);
  527. #else
  528.     if (cSVOPo->op_sv) {
  529.         SV *tmpsv = NEWSV(0,0);
  530.         STRLEN n_a;
  531.         ENTER;
  532.         SAVEFREESV(tmpsv);
  533.         gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch);
  534.         Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a));
  535.         LEAVE;
  536.     }
  537.     else
  538.         Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
  539. #endif
  540.     break;
  541.     case OP_CONST:
  542.     case OP_METHOD_NAMED:
  543.     Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo->op_sv));
  544.     break;
  545.     case OP_SETSTATE:
  546.     case OP_NEXTSTATE:
  547.     case OP_DBSTATE:
  548.     if (CopLINE(cCOPo))
  549.         Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",CopLINE(cCOPo));
  550.     if (CopSTASHPV(cCOPo))
  551.         Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
  552.                  CopSTASHPV(cCOPo));
  553.     if (cCOPo->cop_label)
  554.         Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
  555.                  cCOPo->cop_label);
  556.     break;
  557.     case OP_ENTERLOOP:
  558.     Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
  559.     if (cLOOPo->op_redoop)
  560.         PerlIO_printf(file, "%d\n", cLOOPo->op_redoop->op_seq);
  561.     else
  562.         PerlIO_printf(file, "DONE\n");
  563.     Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
  564.     if (cLOOPo->op_nextop)
  565.         PerlIO_printf(file, "%d\n", cLOOPo->op_nextop->op_seq);
  566.     else
  567.         PerlIO_printf(file, "DONE\n");
  568.     Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
  569.     if (cLOOPo->op_lastop)
  570.         PerlIO_printf(file, "%d\n", cLOOPo->op_lastop->op_seq);
  571.     else
  572.         PerlIO_printf(file, "DONE\n");
  573.     break;
  574.     case OP_COND_EXPR:
  575.     case OP_RANGE:
  576.     case OP_MAPWHILE:
  577.     case OP_GREPWHILE:
  578.     case OP_OR:
  579.     case OP_AND:
  580.     Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
  581.     if (cLOGOPo->op_other)
  582.         PerlIO_printf(file, "%d\n", cLOGOPo->op_other->op_seq);
  583.     else
  584.         PerlIO_printf(file, "DONE\n");
  585.     break;
  586.     case OP_PUSHRE:
  587.     case OP_MATCH:
  588.     case OP_QR:
  589.     case OP_SUBST:
  590.     do_pmop_dump(level, file, cPMOPo);
  591.     break;
  592.     case OP_LEAVE:
  593.     case OP_LEAVEEVAL:
  594.     case OP_LEAVESUB:
  595.     case OP_LEAVESUBLV:
  596.     case OP_LEAVEWRITE:
  597.     case OP_SCOPE:
  598.     if (o->op_private & OPpREFCOUNTED)
  599.         Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
  600.     break;
  601.     default:
  602.     break;
  603.     }
  604.     if (o->op_flags & OPf_KIDS) {
  605.     OP *kid;
  606.     for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
  607.         do_op_dump(level, file, kid);
  608.     }
  609.     Perl_dump_indent(aTHX_ level-1, file, "}\n");
  610. }
  611.  
  612. void
  613. Perl_op_dump(pTHX_ OP *o)
  614. {
  615.     do_op_dump(0, Perl_debug_log, o);
  616. }
  617.  
  618. void
  619. Perl_gv_dump(pTHX_ GV *gv)
  620. {
  621.     SV *sv;
  622.  
  623.     if (!gv) {
  624.     PerlIO_printf(Perl_debug_log, "{}\n");
  625.     return;
  626.     }
  627.     sv = sv_newmortal();
  628.     PerlIO_printf(Perl_debug_log, "{\n");
  629.     gv_fullname3(sv, gv, Nullch);
  630.     Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX(sv));
  631.     if (gv != GvEGV(gv)) {
  632.     gv_efullname3(sv, GvEGV(gv), Nullch);
  633.     Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX(sv));
  634.     }
  635.     PerlIO_putc(Perl_debug_log, '\n');
  636.     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
  637. }
  638.  
  639. void
  640. Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
  641. {
  642.     for (; mg; mg = mg->mg_moremagic) {
  643.      Perl_dump_indent(aTHX_ level, file,
  644.              "  MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
  645.      if (mg->mg_virtual) {
  646.             MGVTBL *v = mg->mg_virtual;
  647.          char *s = 0;
  648.          if      (v == &PL_vtbl_sv)         s = "sv";
  649.             else if (v == &PL_vtbl_env)        s = "env";
  650.             else if (v == &PL_vtbl_envelem)    s = "envelem";
  651.             else if (v == &PL_vtbl_sig)        s = "sig";
  652.             else if (v == &PL_vtbl_sigelem)    s = "sigelem";
  653.             else if (v == &PL_vtbl_pack)       s = "pack";
  654.             else if (v == &PL_vtbl_packelem)   s = "packelem";
  655.             else if (v == &PL_vtbl_dbline)     s = "dbline";
  656.             else if (v == &PL_vtbl_isa)        s = "isa";
  657.             else if (v == &PL_vtbl_arylen)     s = "arylen";
  658.             else if (v == &PL_vtbl_glob)       s = "glob";
  659.             else if (v == &PL_vtbl_mglob)      s = "mglob";
  660.             else if (v == &PL_vtbl_nkeys)      s = "nkeys";
  661.             else if (v == &PL_vtbl_taint)      s = "taint";
  662.             else if (v == &PL_vtbl_substr)     s = "substr";
  663.             else if (v == &PL_vtbl_vec)        s = "vec";
  664.             else if (v == &PL_vtbl_pos)        s = "pos";
  665.             else if (v == &PL_vtbl_bm)         s = "bm";
  666.             else if (v == &PL_vtbl_fm)         s = "fm";
  667.             else if (v == &PL_vtbl_uvar)       s = "uvar";
  668.             else if (v == &PL_vtbl_defelem)    s = "defelem";
  669. #ifdef USE_LOCALE_COLLATE
  670.         else if (v == &PL_vtbl_collxfrm)   s = "collxfrm";
  671. #endif
  672.         else if (v == &PL_vtbl_amagic)     s = "amagic";
  673.         else if (v == &PL_vtbl_amagicelem) s = "amagicelem";
  674.         else if (v == &PL_vtbl_backref)    s = "backref";
  675.         if (s)
  676.             Perl_dump_indent(aTHX_ level, file, "    MG_VIRTUAL = &PL_vtbl_%s\n", s);
  677.         else
  678.             Perl_dump_indent(aTHX_ level, file, "    MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
  679.         }
  680.     else
  681.         Perl_dump_indent(aTHX_ level, file, "    MG_VIRTUAL = 0\n");
  682.  
  683.     if (mg->mg_private)
  684.         Perl_dump_indent(aTHX_ level, file, "    MG_PRIVATE = %d\n", mg->mg_private);
  685.  
  686.     if (isPRINT(mg->mg_type))
  687.         Perl_dump_indent(aTHX_ level, file, "    MG_TYPE = '%c'\n", mg->mg_type);
  688.     else
  689.         Perl_dump_indent(aTHX_ level, file, "    MG_TYPE = '\\%o'\n", mg->mg_type);
  690.  
  691.         if (mg->mg_flags) {
  692.             Perl_dump_indent(aTHX_ level, file, "    MG_FLAGS = 0x%02X\n", mg->mg_flags);
  693.         if (mg->mg_flags & MGf_TAINTEDDIR)
  694.             Perl_dump_indent(aTHX_ level, file, "      TAINTEDDIR\n");
  695.         if (mg->mg_flags & MGf_REFCOUNTED)
  696.             Perl_dump_indent(aTHX_ level, file, "      REFCOUNTED\n");
  697.             if (mg->mg_flags & MGf_GSKIP)
  698.             Perl_dump_indent(aTHX_ level, file, "      GSKIP\n");
  699.         if (mg->mg_flags & MGf_MINMATCH)
  700.             Perl_dump_indent(aTHX_ level, file, "      MINMATCH\n");
  701.         }
  702.     if (mg->mg_obj) {
  703.         Perl_dump_indent(aTHX_ level, file, "    MG_OBJ = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
  704.         if (mg->mg_flags & MGf_REFCOUNTED)
  705.         do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
  706.     }
  707.         if (mg->mg_len)
  708.         Perl_dump_indent(aTHX_ level, file, "    MG_LEN = %ld\n", (long)mg->mg_len);
  709.         if (mg->mg_ptr) {
  710.         Perl_dump_indent(aTHX_ level, file, "    MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
  711.         if (mg->mg_len >= 0) {
  712.         SV *sv = newSVpvn("", 0);
  713.                 PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
  714.         SvREFCNT_dec(sv);
  715.             }
  716.         else if (mg->mg_len == HEf_SVKEY) {
  717.         PerlIO_puts(file, " => HEf_SVKEY\n");
  718.         do_sv_dump(level+2, file, (SV*)((mg)->mg_ptr), nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
  719.         continue;
  720.         }
  721.         else
  722.         PerlIO_puts(file, " ???? - please notify IZ");
  723.             PerlIO_putc(file, '\n');
  724.         }
  725.     }
  726. }
  727.  
  728. void
  729. Perl_magic_dump(pTHX_ MAGIC *mg)
  730. {
  731.     do_magic_dump(0, Perl_debug_log, mg, 0, 0, 0, 0);
  732. }
  733.  
  734. void
  735. Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, char *name, HV *sv)
  736. {
  737.     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
  738.     if (sv && HvNAME(sv))
  739.     PerlIO_printf(file, "\t\"%s\"\n", HvNAME(sv));
  740.     else
  741.     PerlIO_putc(file, '\n');
  742. }
  743.  
  744. void
  745. Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv)
  746. {
  747.     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
  748.     if (sv && GvNAME(sv))
  749.     PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv));
  750.     else
  751.     PerlIO_putc(file, '\n');
  752. }
  753.  
  754. void
  755. Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv)
  756. {
  757.     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
  758.     if (sv && GvNAME(sv)) {
  759.     PerlIO_printf(file, "\t\"");
  760.     if (GvSTASH(sv) && HvNAME(GvSTASH(sv)))
  761.         PerlIO_printf(file, "%s\" :: \"", HvNAME(GvSTASH(sv)));
  762.     PerlIO_printf(file, "%s\"\n", GvNAME(sv));
  763.     }
  764.     else
  765.     PerlIO_putc(file, '\n');
  766. }
  767.  
  768. void
  769. Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
  770. {
  771.     dTHR;
  772.     SV *d = sv_newmortal();
  773.     char *s;
  774.     U32 flags;
  775.     U32 type;
  776.     STRLEN n_a;
  777.  
  778.     if (!sv) {
  779.     Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
  780.     return;
  781.     }
  782.     
  783.     flags = SvFLAGS(sv);
  784.     type = SvTYPE(sv);
  785.  
  786.     Perl_sv_setpvf(aTHX_ d,
  787.            "(0x%"UVxf") at 0x%"UVxf"\n%*s  REFCNT = %"IVdf"\n%*s  FLAGS = (",
  788.            PTR2UV(SvANY(sv)), PTR2UV(sv),
  789.            (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
  790.            (int)(PL_dumpindent*level), "");
  791.  
  792.     if (flags & SVs_PADBUSY)    sv_catpv(d, "PADBUSY,");
  793.     if (flags & SVs_PADTMP)    sv_catpv(d, "PADTMP,");
  794.     if (flags & SVs_PADMY)    sv_catpv(d, "PADMY,");
  795.     if (flags & SVs_TEMP)    sv_catpv(d, "TEMP,");
  796.     if (flags & SVs_OBJECT)    sv_catpv(d, "OBJECT,");
  797.     if (flags & SVs_GMG)    sv_catpv(d, "GMG,");
  798.     if (flags & SVs_SMG)    sv_catpv(d, "SMG,");
  799.     if (flags & SVs_RMG)    sv_catpv(d, "RMG,");
  800.  
  801.     if (flags & SVf_IOK)    sv_catpv(d, "IOK,");
  802.     if (flags & SVf_NOK)    sv_catpv(d, "NOK,");
  803.     if (flags & SVf_POK)    sv_catpv(d, "POK,");
  804.     if (flags & SVf_ROK)  {    
  805.                     sv_catpv(d, "ROK,");
  806.     if (SvWEAKREF(sv))    sv_catpv(d, "WEAKREF,");
  807.     }
  808.     if (flags & SVf_OOK)    sv_catpv(d, "OOK,");
  809.     if (flags & SVf_FAKE)    sv_catpv(d, "FAKE,");
  810.     if (flags & SVf_READONLY)    sv_catpv(d, "READONLY,");
  811.  
  812.     if (flags & SVf_AMAGIC)    sv_catpv(d, "OVERLOAD,");
  813.     if (flags & SVp_IOK)    sv_catpv(d, "pIOK,");
  814.     if (flags & SVp_NOK)    sv_catpv(d, "pNOK,");
  815.     if (flags & SVp_POK)    sv_catpv(d, "pPOK,");
  816.     if (flags & SVp_SCREAM)    sv_catpv(d, "SCREAM,");
  817.  
  818.     switch (type) {
  819.     case SVt_PVCV:
  820.     case SVt_PVFM:
  821.     if (CvANON(sv))        sv_catpv(d, "ANON,");
  822.     if (CvUNIQUE(sv))    sv_catpv(d, "UNIQUE,");
  823.     if (CvCLONE(sv))    sv_catpv(d, "CLONE,");
  824.     if (CvCLONED(sv))    sv_catpv(d, "CLONED,");
  825.     if (CvNODEBUG(sv))    sv_catpv(d, "NODEBUG,");
  826.     if (SvCOMPILED(sv))    sv_catpv(d, "COMPILED,");
  827.     break;
  828.     case SVt_PVHV:
  829.     if (HvSHAREKEYS(sv))    sv_catpv(d, "SHAREKEYS,");
  830.     if (HvLAZYDEL(sv))    sv_catpv(d, "LAZYDEL,");
  831.     break;
  832.     case SVt_PVGV:
  833.     if (GvINTRO(sv))    sv_catpv(d, "INTRO,");
  834.     if (GvMULTI(sv))    sv_catpv(d, "MULTI,");
  835.     if (GvASSUMECV(sv))    sv_catpv(d, "ASSUMECV,");
  836.     if (GvIMPORTED(sv)) {
  837.         sv_catpv(d, "IMPORT");
  838.         if (GvIMPORTED(sv) == GVf_IMPORTED)
  839.         sv_catpv(d, "ALL,");
  840.         else {
  841.         sv_catpv(d, "(");
  842.         if (GvIMPORTED_SV(sv))    sv_catpv(d, " SV");
  843.         if (GvIMPORTED_AV(sv))    sv_catpv(d, " AV");
  844.         if (GvIMPORTED_HV(sv))    sv_catpv(d, " HV");
  845.         if (GvIMPORTED_CV(sv))    sv_catpv(d, " CV");
  846.         sv_catpv(d, " ),");
  847.         }
  848.     }
  849.     /* FALL THROGH */
  850.     default:
  851.     if (SvEVALED(sv))    sv_catpv(d, "EVALED,");
  852.     if (SvIsUV(sv))        sv_catpv(d, "IsUV,");
  853.     if (SvUTF8(sv))         sv_catpv(d, "UTF8");
  854.     break;
  855.     case SVt_PVBM:
  856.     if (SvTAIL(sv))        sv_catpv(d, "TAIL,");
  857.     if (SvVALID(sv))    sv_catpv(d, "VALID,");
  858.     break;
  859.     }
  860.  
  861.     if (*(SvEND(d) - 1) == ',')
  862.     SvPVX(d)[--SvCUR(d)] = '\0';
  863.     sv_catpv(d, ")");
  864.     s = SvPVX(d);
  865.  
  866.     Perl_dump_indent(aTHX_ level, file, "SV = ");
  867.     switch (type) {
  868.     case SVt_NULL:
  869.     PerlIO_printf(file, "NULL%s\n", s);
  870.     return;
  871.     case SVt_IV:
  872.     PerlIO_printf(file, "IV%s\n", s);
  873.     break;
  874.     case SVt_NV:
  875.     PerlIO_printf(file, "NV%s\n", s);
  876.     break;
  877.     case SVt_RV:
  878.     PerlIO_printf(file, "RV%s\n", s);
  879.     break;
  880.     case SVt_PV:
  881.     PerlIO_printf(file, "PV%s\n", s);
  882.     break;
  883.     case SVt_PVIV:
  884.     PerlIO_printf(file, "PVIV%s\n", s);
  885.     break;
  886.     case SVt_PVNV:
  887.     PerlIO_printf(file, "PVNV%s\n", s);
  888.     break;
  889.     case SVt_PVBM:
  890.     PerlIO_printf(file, "PVBM%s\n", s);
  891.     break;
  892.     case SVt_PVMG:
  893.     PerlIO_printf(file, "PVMG%s\n", s);
  894.     break;
  895.     case SVt_PVLV:
  896.     PerlIO_printf(file, "PVLV%s\n", s);
  897.     break;
  898.     case SVt_PVAV:
  899.     PerlIO_printf(file, "PVAV%s\n", s);
  900.     break;
  901.     case SVt_PVHV:
  902.     PerlIO_printf(file, "PVHV%s\n", s);
  903.     break;
  904.     case SVt_PVCV:
  905.     PerlIO_printf(file, "PVCV%s\n", s);
  906.     break;
  907.     case SVt_PVGV:
  908.     PerlIO_printf(file, "PVGV%s\n", s);
  909.     break;
  910.     case SVt_PVFM:
  911.     PerlIO_printf(file, "PVFM%s\n", s);
  912.     break;
  913.     case SVt_PVIO:
  914.     PerlIO_printf(file, "PVIO%s\n", s);
  915.     break;
  916.     default:
  917.     PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
  918.     return;
  919.     }
  920.     if (type >= SVt_PVIV || type == SVt_IV) {
  921.     if (SvIsUV(sv))
  922.         Perl_dump_indent(aTHX_ level, file, "  UV = %"UVuf, (UV)SvUVX(sv));
  923.     else
  924.         Perl_dump_indent(aTHX_ level, file, "  IV = %"IVdf, (IV)SvIVX(sv));
  925.     if (SvOOK(sv))
  926.         PerlIO_printf(file, "  (OFFSET)");
  927.     PerlIO_putc(file, '\n');
  928.     }
  929.     if (type >= SVt_PVNV || type == SVt_NV) {
  930.     RESTORE_NUMERIC_STANDARD();
  931.     /* %Vg doesn't work? --jhi */
  932. #ifdef USE_LONG_DOUBLE
  933.     Perl_dump_indent(aTHX_ level, file, "  NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
  934. #else
  935.     Perl_dump_indent(aTHX_ level, file, "  NV = %.*g\n", DBL_DIG, SvNVX(sv));
  936. #endif
  937.     RESTORE_NUMERIC_LOCAL();
  938.     }
  939.     if (SvROK(sv)) {
  940.     Perl_dump_indent(aTHX_ level, file, "  RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
  941.     if (nest < maxnest)
  942.         do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
  943.     return;
  944.     }
  945.     if (type < SVt_PV)
  946.     return;
  947.     if (type <= SVt_PVLV) {
  948.     if (SvPVX(sv)) {
  949.         Perl_dump_indent(aTHX_ level, file,"  PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv)));
  950.         if (SvOOK(sv))
  951.         PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
  952.         PerlIO_printf(file, "%s\n", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim));
  953.         Perl_dump_indent(aTHX_ level, file, "  CUR = %"IVdf"\n", (IV)SvCUR(sv));
  954.         Perl_dump_indent(aTHX_ level, file, "  LEN = %"IVdf"\n", (IV)SvLEN(sv));
  955.     }
  956.     else
  957.         Perl_dump_indent(aTHX_ level, file, "  PV = 0\n");
  958.     }
  959.     if (type >= SVt_PVMG) {
  960.     if (SvMAGIC(sv))
  961.             do_magic_dump(level, file, SvMAGIC(sv), nest, maxnest, dumpops, pvlim);
  962.     if (SvSTASH(sv))
  963.         do_hv_dump(level, file, "  STASH", SvSTASH(sv));
  964.     }
  965.     switch (type) {
  966.     case SVt_PVLV:
  967.     Perl_dump_indent(aTHX_ level, file, "  TYPE = %c\n", LvTYPE(sv));
  968.     Perl_dump_indent(aTHX_ level, file, "  TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
  969.     Perl_dump_indent(aTHX_ level, file, "  TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
  970.     Perl_dump_indent(aTHX_ level, file, "  TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
  971.     /* XXX level+1 ??? */
  972.     do_sv_dump(level, file, LvTARG(sv), nest+1, maxnest, dumpops, pvlim);
  973.     break;
  974.     case SVt_PVAV:
  975.     Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
  976.     if (AvARRAY(sv) != AvALLOC(sv)) {
  977.         PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
  978.         Perl_dump_indent(aTHX_ level, file, "  ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
  979.     }
  980.     else
  981.         PerlIO_putc(file, '\n');
  982.     Perl_dump_indent(aTHX_ level, file, "  FILL = %"IVdf"\n", (IV)AvFILLp(sv));
  983.     Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)AvMAX(sv));
  984.     Perl_dump_indent(aTHX_ level, file, "  ARYLEN = 0x%"UVxf"\n", PTR2UV(AvARYLEN(sv)));
  985.     flags = AvFLAGS(sv);
  986.     sv_setpv(d, "");
  987.     if (flags & AVf_REAL)    sv_catpv(d, ",REAL");
  988.     if (flags & AVf_REIFY)    sv_catpv(d, ",REIFY");
  989.     if (flags & AVf_REUSED)    sv_catpv(d, ",REUSED");
  990.     Perl_dump_indent(aTHX_ level, file, "  FLAGS = (%s)\n", SvCUR(d) ? SvPVX(d) + 1 : "");
  991.     if (nest < maxnest && av_len((AV*)sv) >= 0) {
  992.         int count;
  993.         for (count = 0; count <=  av_len((AV*)sv) && count < maxnest; count++) {
  994.         SV** elt = av_fetch((AV*)sv,count,0);
  995.  
  996.         Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
  997.         if (elt) 
  998.             do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
  999.         }
  1000.     }
  1001.     break;
  1002.     case SVt_PVHV:
  1003.     Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
  1004.     if (HvARRAY(sv) && HvKEYS(sv)) {
  1005.         /* Show distribution of HEs in the ARRAY */
  1006.         int freq[200];
  1007. #define FREQ_MAX (sizeof freq / sizeof freq[0] - 1)
  1008.         int i;
  1009.         int max = 0;
  1010.         U32 pow2 = 2, keys = HvKEYS(sv);
  1011.         NV theoret, sum = 0;
  1012.  
  1013.         PerlIO_printf(file, "  (");
  1014.         Zero(freq, FREQ_MAX + 1, int);
  1015.         for (i = 0; i <= HvMAX(sv); i++) {
  1016.         HE* h; int count = 0;
  1017.                 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
  1018.             count++;
  1019.         if (count > FREQ_MAX)
  1020.             count = FREQ_MAX;
  1021.             freq[count]++;
  1022.             if (max < count)
  1023.             max = count;
  1024.         }
  1025.         for (i = 0; i <= max; i++) {
  1026.         if (freq[i]) {
  1027.             PerlIO_printf(file, "%d%s:%d", i,
  1028.                   (i == FREQ_MAX) ? "+" : "",
  1029.                   freq[i]);
  1030.             if (i != max)
  1031.             PerlIO_printf(file, ", ");
  1032.         }
  1033.             }
  1034.         PerlIO_putc(file, ')');
  1035.         /* Now calculate quality wrt theoretical value */
  1036.         for (i = max; i > 0; i--) { /* Precision: count down. */
  1037.         sum += freq[i] * i * i;
  1038.             }
  1039.         while ((keys = keys >> 1))
  1040.         pow2 = pow2 << 1;
  1041.         /* Approximate by Poisson distribution */
  1042.         theoret = HvKEYS(sv);
  1043.         theoret += theoret * theoret/pow2;
  1044.         PerlIO_putc(file, '\n');
  1045.         Perl_dump_indent(aTHX_ level, file, "  hash quality = %.1f%%", theoret/sum*100);
  1046.     }
  1047.     PerlIO_putc(file, '\n');
  1048.     Perl_dump_indent(aTHX_ level, file, "  KEYS = %"IVdf"\n", (IV)HvKEYS(sv));
  1049.     Perl_dump_indent(aTHX_ level, file, "  FILL = %"IVdf"\n", (IV)HvFILL(sv));
  1050.     Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)HvMAX(sv));
  1051.     Perl_dump_indent(aTHX_ level, file, "  RITER = %"IVdf"\n", (IV)HvRITER(sv));
  1052.     Perl_dump_indent(aTHX_ level, file, "  EITER = 0x%"UVxf"\n", PTR2UV(HvEITER(sv)));
  1053.     if (HvPMROOT(sv))
  1054.         Perl_dump_indent(aTHX_ level, file, "  PMROOT = 0x%"UVxf"\n", PTR2UV(HvPMROOT(sv)));
  1055.     if (HvNAME(sv))
  1056.         Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", HvNAME(sv));
  1057.     if (nest < maxnest && !HvEITER(sv)) { /* Try to preserve iterator */
  1058.         HE *he;
  1059.         HV *hv = (HV*)sv;
  1060.         int count = maxnest - nest;
  1061.  
  1062.         hv_iterinit(hv);
  1063.         while ((he = hv_iternext(hv)) && count--) {
  1064.         SV *elt;
  1065.         char *key;
  1066.         I32 len;
  1067.         U32 hash = HeHASH(he);
  1068.  
  1069.         key = hv_iterkey(he, &len);
  1070.         elt = hv_iterval(hv, he);
  1071.         Perl_dump_indent(aTHX_ level+1, file, "Elt %s HASH = 0x%"UVxf"\n", pv_display(d, key, len, 0, pvlim), (UV)hash);
  1072.         do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
  1073.         }
  1074.         hv_iterinit(hv);        /* Return to status quo */
  1075.     }
  1076.     break;
  1077.     case SVt_PVCV:
  1078.     if (SvPOK(sv))
  1079.         Perl_dump_indent(aTHX_ level, file, "  PROTOTYPE = \"%s\"\n", SvPV(sv,n_a));
  1080.     /* FALL THROUGH */
  1081.     case SVt_PVFM:
  1082.     do_hv_dump(level, file, "  COMP_STASH", CvSTASH(sv));
  1083.     if (CvSTART(sv))
  1084.         Perl_dump_indent(aTHX_ level, file, "  START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)CvSTART(sv)->op_seq);
  1085.     Perl_dump_indent(aTHX_ level, file, "  ROOT = 0x%"UVxf"\n", PTR2UV(CvROOT(sv)));
  1086.         if (CvROOT(sv) && dumpops)
  1087.         do_op_dump(level+1, file, CvROOT(sv));
  1088.     Perl_dump_indent(aTHX_ level, file, "  XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
  1089.     Perl_dump_indent(aTHX_ level, file, "  XSUBANY = %"IVdf"\n", (IV)CvXSUBANY(sv).any_i32);
  1090.      do_gvgv_dump(level, file, "  GVGV::GV", CvGV(sv));
  1091.     Perl_dump_indent(aTHX_ level, file, "  FILE = \"%s\"\n", CvFILE(sv));
  1092.     Perl_dump_indent(aTHX_ level, file, "  DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
  1093. #ifdef USE_THREADS
  1094.     Perl_dump_indent(aTHX_ level, file, "  MUTEXP = 0x%"UVxf"\n", PTR2UV(CvMUTEXP(sv)));
  1095.     Perl_dump_indent(aTHX_ level, file, "  OWNER = 0x%"UVxf"\n",  PTR2UV(CvOWNER(sv)));
  1096. #endif /* USE_THREADS */
  1097.     Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
  1098.     if (type == SVt_PVFM)
  1099.         Perl_dump_indent(aTHX_ level, file, "  LINES = %"IVdf"\n", (IV)FmLINES(sv));
  1100.     Perl_dump_indent(aTHX_ level, file, "  PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
  1101.     if (nest < maxnest && CvPADLIST(sv)) {
  1102.         AV* padlist = CvPADLIST(sv);
  1103.         AV* pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
  1104.         AV* pad = (AV*)*av_fetch(padlist, 1, FALSE);
  1105.         SV** pname = AvARRAY(pad_name);
  1106.         SV** ppad = AvARRAY(pad);
  1107.         I32 ix;
  1108.  
  1109.         for (ix = 1; ix <= AvFILL(pad_name); ix++) {
  1110.         if (SvPOK(pname[ix]))
  1111.             Perl_dump_indent(aTHX_ level,
  1112.                 /* %5d below is enough whitespace. */
  1113.                 file, 
  1114.                 "%5d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n",
  1115.                 (int)ix, PTR2UV(ppad[ix]),
  1116.                 SvFAKE(pname[ix]) ? "FAKE " : "",
  1117.                 SvPVX(pname[ix]),
  1118.                 (IV)SvNVX(pname[ix]),
  1119.                 (IV)SvIVX(pname[ix]));
  1120.         }
  1121.     }
  1122.     {
  1123.         CV *outside = CvOUTSIDE(sv);
  1124.         Perl_dump_indent(aTHX_ level, file, "  OUTSIDE = 0x%"UVxf" (%s)\n", 
  1125.             PTR2UV(outside),
  1126.             (!outside ? "null"
  1127.              : CvANON(outside) ? "ANON"
  1128.              : (outside == PL_main_cv) ? "MAIN"
  1129.              : CvUNIQUE(outside) ? "UNIQUE"
  1130.              : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
  1131.     }
  1132.     if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
  1133.         do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim);
  1134.     break;
  1135.     case SVt_PVGV:
  1136.     Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", GvNAME(sv));
  1137.     Perl_dump_indent(aTHX_ level, file, "  NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
  1138.     do_hv_dump (level, file, "  GvSTASH", GvSTASH(sv));
  1139.     Perl_dump_indent(aTHX_ level, file, "  GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
  1140.     if (!GvGP(sv))
  1141.         break;
  1142.     Perl_dump_indent(aTHX_ level, file, "    SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
  1143.     Perl_dump_indent(aTHX_ level, file, "    REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
  1144.     Perl_dump_indent(aTHX_ level, file, "    IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
  1145.     Perl_dump_indent(aTHX_ level, file, "    FORM = 0x%"UVxf"  \n", PTR2UV(GvFORM(sv)));
  1146.     Perl_dump_indent(aTHX_ level, file, "    AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
  1147.     Perl_dump_indent(aTHX_ level, file, "    HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
  1148.     Perl_dump_indent(aTHX_ level, file, "    CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
  1149.     Perl_dump_indent(aTHX_ level, file, "    CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
  1150.     Perl_dump_indent(aTHX_ level, file, "    GPFLAGS = 0x%"UVxf"\n", (UV)GvGPFLAGS(sv));
  1151.     Perl_dump_indent(aTHX_ level, file, "    LINE = %"IVdf"\n", (IV)GvLINE(sv));
  1152.     Perl_dump_indent(aTHX_ level, file, "    FILE = \"%s\"\n", GvFILE(sv));
  1153.     Perl_dump_indent(aTHX_ level, file, "    FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
  1154.     do_gv_dump (level, file, "    EGV", GvEGV(sv));
  1155.     break;
  1156.     case SVt_PVIO:
  1157.     Perl_dump_indent(aTHX_ level, file, "  IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
  1158.     Perl_dump_indent(aTHX_ level, file, "  OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
  1159.     Perl_dump_indent(aTHX_ level, file, "  DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
  1160.     Perl_dump_indent(aTHX_ level, file, "  LINES = %"IVdf"\n", (IV)IoLINES(sv));
  1161.     Perl_dump_indent(aTHX_ level, file, "  PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
  1162.     Perl_dump_indent(aTHX_ level, file, "  PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
  1163.     Perl_dump_indent(aTHX_ level, file, "  LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
  1164.         if (IoTOP_NAME(sv))
  1165.             Perl_dump_indent(aTHX_ level, file, "  TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
  1166.     do_gv_dump (level, file, "  TOP_GV", IoTOP_GV(sv));
  1167.         if (IoFMT_NAME(sv))
  1168.             Perl_dump_indent(aTHX_ level, file, "  FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
  1169.     do_gv_dump (level, file, "  FMT_GV", IoFMT_GV(sv));
  1170.         if (IoBOTTOM_NAME(sv))
  1171.             Perl_dump_indent(aTHX_ level, file, "  BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
  1172.     do_gv_dump (level, file, "  BOTTOM_GV", IoBOTTOM_GV(sv));
  1173.     Perl_dump_indent(aTHX_ level, file, "  SUBPROCESS = %"IVdf"\n", (IV)IoSUBPROCESS(sv));
  1174.     if (isPRINT(IoTYPE(sv)))
  1175.             Perl_dump_indent(aTHX_ level, file, "  TYPE = '%c'\n", IoTYPE(sv));
  1176.     else
  1177.             Perl_dump_indent(aTHX_ level, file, "  TYPE = '\\%o'\n", IoTYPE(sv));
  1178.     Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
  1179.     break;
  1180.     }
  1181. }
  1182.  
  1183. void
  1184. Perl_sv_dump(pTHX_ SV *sv)
  1185. {
  1186.     do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
  1187. }
  1188.