6 #define DeadCode() NULL
13 SV* ret = newRV_noinc((SV*)newAV());
15 int tm = 0, tref = 0, ts = 0, ta = 0, tas = 0;
17 for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
18 svend = &sva[SvREFCNT(sva)];
19 for (sv = sva + 1; sv < svend; ++sv) {
20 if (SvTYPE(sv) == SVt_PVCV) {
22 AV* padlist = CvPADLIST(cv), *argav;
25 int i = 0, j, levelm, totm = 0, levelref, totref = 0;
26 int levels, tots = 0, levela, tota = 0, levelas, totas = 0;
33 continue; /* file-level scope. */
36 /* PerlIO_printf(PerlIO_stderr(), " no root?!\n"); */
37 continue; /* autoloading stub. */
39 do_gvgv_dump(0, PerlIO_stderr(), "GVGV::GV", CvGV(sv));
41 PerlIO_printf(PerlIO_stderr(), " busy\n");
44 svp = AvARRAY(padlist);
45 while (++i <= AvFILL(padlist)) { /* Depth. */
48 pad = AvARRAY((AV*)svp[i]);
50 if (!argav || (SV*)argav == &PL_sv_undef) {
51 PerlIO_printf(PerlIO_stderr(), " closure-template\n");
54 args = AvARRAY(argav);
55 levelm = levels = levelref = levelas = 0;
56 levela = sizeof(SV*) * (AvMAX(argav) + 1);
58 for (j = 0; j < AvFILL(argav); j++) {
60 PerlIO_printf(PerlIO_stderr(), " ref in args!\n");
63 /* else if (SvPOK(args[j]) && SvPVX(args[j])) { */
64 else if (SvTYPE(args[j]) >= SVt_PV && SvLEN(args[j])) {
65 levelas += SvLEN(args[j])/SvREFCNT(args[j]);
69 for (j = 1; j < AvFILL((AV*)svp[1]); j++) { /* Vars. */
72 do_sv_dump(0, PerlIO_stderr(), pad[j], 0, 4, 0, 0);
75 /* else if (SvPOK(pad[j]) && SvPVX(pad[j])) { */
76 else if (SvTYPE(pad[j]) >= SVt_PVAV) {
77 if (!SvPADMY(pad[j])) {
79 do_sv_dump(0, PerlIO_stderr(), pad[j], 0, 4, 0, 0);
83 else if (SvTYPE(pad[j]) >= SVt_PV && SvLEN(pad[j])) {
84 int db_len = SvLEN(pad[j]);
87 levelm += SvLEN(pad[j])/SvREFCNT(pad[j]);
91 PerlIO_printf(PerlIO_stderr(), " level %i: refs: %i, strings: %i in %i,\targsarray: %i, argsstrings: %i\n",
92 i, levelref, levelm, levels, levela, levelas);
99 do_sv_dump(0, PerlIO_stderr(), (SV*)cv, 0, 2, 0, 0);
101 if (AvFILL(padlist) > 1) {
102 PerlIO_printf(PerlIO_stderr(), " total: refs: %i, strings: %i in %i,\targsarrays: %i, argsstrings: %i\n",
103 totref, totm, tots, tota, totas);
113 PerlIO_printf(PerlIO_stderr(), "total: refs: %i, strings: %i in %i\targsarray: %i, argsstrings: %i\n", tref, tm, ts, ta, tas);
119 #if defined(PERL_DEBUGGING_MSTATS) || defined(DEBUGGING_MSTATS) \
120 || (defined(MYMALLOC) && !defined(PLAIN_MALLOC))
121 # define mstat(str) dump_mstats(str)
123 # define mstat(str) \
124 PerlIO_printf(PerlIO_stderr(), "%s: perl not compiled with DEBUGGING_MSTATS\n",str);
127 MODULE = Devel::Peek PACKAGE = Devel::Peek
130 mstat(str="Devel::Peek::mstat: ")
139 SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", FALSE);
140 STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0;
141 SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", FALSE);
142 I32 save_dumpindent = PL_dumpindent;
144 do_sv_dump(0, PerlIO_stderr(), sv, 0, 4, dumpop && SvTRUE(dumpop), pv_lim);
145 PL_dumpindent = save_dumpindent;
154 SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", FALSE);
155 STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0;
156 SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", FALSE);
157 I32 save_dumpindent = PL_dumpindent;
160 for (i=1; i<items; i++) {
161 PerlIO_printf(PerlIO_stderr(), "Elt No. %ld 0x%lx\n", i - 1, ST(i));
162 do_sv_dump(0, PerlIO_stderr(), ST(i), 0, lim, dumpop && SvTRUE(dumpop), pv_lim);
164 PL_dumpindent = save_dumpindent;
171 warn("dumpindent is %d", PL_dumpindent);
173 op_dump(PL_main_root);
180 # PPCODE needed since otherwise sv_2mortal is inserted that will kill the value.
187 RETVAL = SvREFCNT_inc(sv);
191 # PPCODE needed since by default it is void
205 RETVAL = DeadCode(aTHX);