source: trunk/third/perl/dump.c @ 17035

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