Commit | Line | Data |
c5be433b |
1 | #define PERL_NO_GET_CONTEXT |
3967c732 |
2 | #include "EXTERN.h" |
3 | #include "perl.h" |
4 | #include "XSUB.h" |
5 | |
3967c732 |
6 | SV * |
cea2e8a9 |
7 | DeadCode(pTHX) |
3967c732 |
8 | { |
8ecf7187 |
9 | #ifdef PURIFY |
10 | return Nullsv; |
11 | #else |
3967c732 |
12 | SV* sva; |
13 | SV* sv, *dbg; |
14 | SV* ret = newRV_noinc((SV*)newAV()); |
15 | register SV* svend; |
16 | int tm = 0, tref = 0, ts = 0, ta = 0, tas = 0; |
17 | |
18 | for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) { |
19 | svend = &sva[SvREFCNT(sva)]; |
20 | for (sv = sva + 1; sv < svend; ++sv) { |
21 | if (SvTYPE(sv) == SVt_PVCV) { |
22 | CV *cv = (CV*)sv; |
23 | AV* padlist = CvPADLIST(cv), *argav; |
24 | SV** svp; |
25 | SV** pad; |
26 | int i = 0, j, levelm, totm = 0, levelref, totref = 0; |
27 | int levels, tots = 0, levela, tota = 0, levelas, totas = 0; |
28 | int dumpit = 0; |
29 | |
30 | if (CvXSUB(sv)) { |
31 | continue; /* XSUB */ |
32 | } |
33 | if (!CvGV(sv)) { |
34 | continue; /* file-level scope. */ |
35 | } |
36 | if (!CvROOT(cv)) { |
bf49b057 |
37 | /* PerlIO_printf(Perl_debug_log, " no root?!\n"); */ |
3967c732 |
38 | continue; /* autoloading stub. */ |
39 | } |
bf49b057 |
40 | do_gvgv_dump(0, Perl_debug_log, "GVGV::GV", CvGV(sv)); |
3967c732 |
41 | if (CvDEPTH(cv)) { |
bf49b057 |
42 | PerlIO_printf(Perl_debug_log, " busy\n"); |
3967c732 |
43 | continue; |
44 | } |
45 | svp = AvARRAY(padlist); |
46 | while (++i <= AvFILL(padlist)) { /* Depth. */ |
47 | SV **args; |
48 | |
49 | pad = AvARRAY((AV*)svp[i]); |
50 | argav = (AV*)pad[0]; |
51 | if (!argav || (SV*)argav == &PL_sv_undef) { |
bf49b057 |
52 | PerlIO_printf(Perl_debug_log, " closure-template\n"); |
3967c732 |
53 | continue; |
54 | } |
55 | args = AvARRAY(argav); |
56 | levelm = levels = levelref = levelas = 0; |
57 | levela = sizeof(SV*) * (AvMAX(argav) + 1); |
58 | if (AvREAL(argav)) { |
59 | for (j = 0; j < AvFILL(argav); j++) { |
60 | if (SvROK(args[j])) { |
bf49b057 |
61 | PerlIO_printf(Perl_debug_log, " ref in args!\n"); |
3967c732 |
62 | levelref++; |
63 | } |
64 | /* else if (SvPOK(args[j]) && SvPVX(args[j])) { */ |
65 | else if (SvTYPE(args[j]) >= SVt_PV && SvLEN(args[j])) { |
66 | levelas += SvLEN(args[j])/SvREFCNT(args[j]); |
67 | } |
68 | } |
69 | } |
70 | for (j = 1; j < AvFILL((AV*)svp[1]); j++) { /* Vars. */ |
71 | if (SvROK(pad[j])) { |
72 | levelref++; |
bf49b057 |
73 | do_sv_dump(0, Perl_debug_log, pad[j], 0, 4, 0, 0); |
3967c732 |
74 | dumpit = 1; |
75 | } |
76 | /* else if (SvPOK(pad[j]) && SvPVX(pad[j])) { */ |
77 | else if (SvTYPE(pad[j]) >= SVt_PVAV) { |
78 | if (!SvPADMY(pad[j])) { |
79 | levelref++; |
bf49b057 |
80 | do_sv_dump(0, Perl_debug_log, pad[j], 0, 4, 0, 0); |
3967c732 |
81 | dumpit = 1; |
82 | } |
83 | } |
84 | else if (SvTYPE(pad[j]) >= SVt_PV && SvLEN(pad[j])) { |
85 | int db_len = SvLEN(pad[j]); |
86 | SV *db_sv = pad[j]; |
87 | levels++; |
88 | levelm += SvLEN(pad[j])/SvREFCNT(pad[j]); |
89 | /* Dump(pad[j],4); */ |
90 | } |
91 | } |
bf49b057 |
92 | PerlIO_printf(Perl_debug_log, " level %i: refs: %i, strings: %i in %i,\targsarray: %i, argsstrings: %i\n", |
3967c732 |
93 | i, levelref, levelm, levels, levela, levelas); |
94 | totm += levelm; |
95 | tota += levela; |
96 | totas += levelas; |
97 | tots += levels; |
98 | totref += levelref; |
99 | if (dumpit) |
bf49b057 |
100 | do_sv_dump(0, Perl_debug_log, (SV*)cv, 0, 2, 0, 0); |
3967c732 |
101 | } |
102 | if (AvFILL(padlist) > 1) { |
bf49b057 |
103 | PerlIO_printf(Perl_debug_log, " total: refs: %i, strings: %i in %i,\targsarrays: %i, argsstrings: %i\n", |
3967c732 |
104 | totref, totm, tots, tota, totas); |
105 | } |
106 | tref += totref; |
107 | tm += totm; |
108 | ts += tots; |
109 | ta += tota; |
110 | tas += totas; |
111 | } |
112 | } |
113 | } |
bf49b057 |
114 | PerlIO_printf(Perl_debug_log, "total: refs: %i, strings: %i in %i\targsarray: %i, argsstrings: %i\n", tref, tm, ts, ta, tas); |
3967c732 |
115 | |
116 | return ret; |
3967c732 |
117 | #endif /* !PURIFY */ |
8ecf7187 |
118 | } |
3967c732 |
119 | |
df1e65fb |
120 | #if defined(PERL_DEBUGGING_MSTATS) || defined(DEBUGGING_MSTATS) \ |
121 | || (defined(MYMALLOC) && !defined(PLAIN_MALLOC)) |
3967c732 |
122 | # define mstat(str) dump_mstats(str) |
123 | #else |
124 | # define mstat(str) \ |
bf49b057 |
125 | PerlIO_printf(Perl_debug_log, "%s: perl not compiled with DEBUGGING_MSTATS\n",str); |
3967c732 |
126 | #endif |
127 | |
83ee9e09 |
128 | #define _CvGV(cv) \ |
129 | (SvROK(cv) && (SvTYPE(SvRV(cv))==SVt_PVCV) \ |
15bcf759 |
130 | ? SvREFCNT_inc(CvGV((CV*)SvRV(cv))) : &PL_sv_undef) |
83ee9e09 |
131 | |
3967c732 |
132 | MODULE = Devel::Peek PACKAGE = Devel::Peek |
133 | |
134 | void |
135 | mstat(str="Devel::Peek::mstat: ") |
136 | char *str |
137 | |
138 | void |
139 | Dump(sv,lim=4) |
140 | SV * sv |
141 | I32 lim |
142 | PPCODE: |
143 | { |
144 | SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", FALSE); |
145 | STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0; |
146 | SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", FALSE); |
147 | I32 save_dumpindent = PL_dumpindent; |
148 | PL_dumpindent = 2; |
bf49b057 |
149 | do_sv_dump(0, Perl_debug_log, sv, 0, lim, dumpop && SvTRUE(dumpop), pv_lim); |
3967c732 |
150 | PL_dumpindent = save_dumpindent; |
151 | } |
152 | |
153 | void |
154 | DumpArray(lim,...) |
155 | I32 lim |
156 | PPCODE: |
157 | { |
158 | long i; |
159 | SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", FALSE); |
160 | STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0; |
161 | SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", FALSE); |
162 | I32 save_dumpindent = PL_dumpindent; |
163 | PL_dumpindent = 2; |
164 | |
165 | for (i=1; i<items; i++) { |
7b0972df |
166 | PerlIO_printf(Perl_debug_log, "Elt No. %ld 0x%"UVxf"\n", i - 1, PTR2UV(ST(i))); |
bf49b057 |
167 | do_sv_dump(0, Perl_debug_log, ST(i), 0, lim, dumpop && SvTRUE(dumpop), pv_lim); |
3967c732 |
168 | } |
169 | PL_dumpindent = save_dumpindent; |
170 | } |
171 | |
172 | void |
173 | DumpProg() |
174 | PPCODE: |
175 | { |
176 | warn("dumpindent is %d", PL_dumpindent); |
177 | if (PL_main_root) |
178 | op_dump(PL_main_root); |
179 | } |
180 | |
181 | I32 |
182 | SvREFCNT(sv) |
183 | SV * sv |
184 | |
185 | # PPCODE needed since otherwise sv_2mortal is inserted that will kill the value. |
186 | |
187 | SV * |
188 | SvREFCNT_inc(sv) |
189 | SV * sv |
190 | PPCODE: |
191 | { |
192 | RETVAL = SvREFCNT_inc(sv); |
193 | PUSHs(RETVAL); |
194 | } |
195 | |
196 | # PPCODE needed since by default it is void |
197 | |
198 | SV * |
199 | SvREFCNT_dec(sv) |
200 | SV * sv |
201 | PPCODE: |
202 | { |
203 | SvREFCNT_dec(sv); |
204 | PUSHs(sv); |
205 | } |
206 | |
207 | SV * |
208 | DeadCode() |
cea2e8a9 |
209 | CODE: |
210 | RETVAL = DeadCode(aTHX); |
211 | OUTPUT: |
212 | RETVAL |
83ee9e09 |
213 | |
214 | MODULE = Devel::Peek PACKAGE = Devel::Peek PREFIX = _ |
215 | |
216 | SV * |
217 | _CvGV(cv) |
218 | SV *cv |