Commit | Line | Data |
79ee8297 |
1 | package B::Debug; |
2 | use strict; |
f64a6365 |
3 | use B qw(peekop class walkoptree walkoptree_exec |
79ee8297 |
4 | main_start main_root cstring sv_undef); |
5 | use B::Asmdata qw(@specialsv_name); |
6 | |
f64a6365 |
7 | my %done_gv; |
8 | |
79ee8297 |
9 | sub B::OP::debug { |
10 | my ($op) = @_; |
f64a6365 |
11 | printf <<'EOT', class($op), $$op, ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type, $op->seq, $op->flags, $op->private; |
79ee8297 |
12 | %s (0x%lx) |
13 | op_next 0x%x |
14 | op_sibling 0x%x |
15 | op_ppaddr %s |
16 | op_targ %d |
17 | op_type %d |
18 | op_seq %d |
19 | op_flags %d |
20 | op_private %d |
21 | EOT |
22 | } |
23 | |
24 | sub B::UNOP::debug { |
25 | my ($op) = @_; |
26 | $op->B::OP::debug(); |
f64a6365 |
27 | printf "\top_first\t0x%x\n", ${$op->first}; |
79ee8297 |
28 | } |
29 | |
30 | sub B::BINOP::debug { |
31 | my ($op) = @_; |
32 | $op->B::UNOP::debug(); |
f64a6365 |
33 | printf "\top_last\t\t0x%x\n", ${$op->last}; |
79ee8297 |
34 | } |
35 | |
36 | sub B::LOGOP::debug { |
37 | my ($op) = @_; |
38 | $op->B::UNOP::debug(); |
f64a6365 |
39 | printf "\top_other\t0x%x\n", ${$op->other}; |
79ee8297 |
40 | } |
41 | |
42 | sub B::CONDOP::debug { |
43 | my ($op) = @_; |
44 | $op->B::UNOP::debug(); |
f64a6365 |
45 | printf "\top_true\t0x%x\n", ${$op->true}; |
46 | printf "\top_false\t0x%x\n", ${$op->false}; |
79ee8297 |
47 | } |
48 | |
49 | sub B::LISTOP::debug { |
50 | my ($op) = @_; |
51 | $op->B::BINOP::debug(); |
52 | printf "\top_children\t%d\n", $op->children; |
53 | } |
54 | |
55 | sub B::PMOP::debug { |
56 | my ($op) = @_; |
57 | $op->B::LISTOP::debug(); |
f64a6365 |
58 | printf "\top_pmreplroot\t0x%x\n", ${$op->pmreplroot}; |
59 | printf "\top_pmreplstart\t0x%x\n", ${$op->pmreplstart}; |
60 | printf "\top_pmnext\t0x%x\n", ${$op->pmnext}; |
79ee8297 |
61 | printf "\top_pmregexp->precomp\t%s\n", cstring($op->precomp); |
f64a6365 |
62 | printf "\top_pmshort\t0x%x\n", ${$op->pmshort}; |
79ee8297 |
63 | printf "\top_pmflags\t0x%x\n", $op->pmflags; |
64 | printf "\top_pmslen\t%d\n", $op->pmslen; |
65 | $op->pmshort->debug; |
66 | $op->pmreplroot->debug; |
67 | } |
68 | |
69 | sub B::COP::debug { |
70 | my ($op) = @_; |
71 | $op->B::OP::debug(); |
72 | my ($filegv) = $op->filegv; |
f64a6365 |
73 | printf <<'EOT', $op->label, ${$op->stash}, $$filegv, $op->seq, $op->arybase, $op->line; |
79ee8297 |
74 | cop_label %s |
75 | cop_stash 0x%x |
76 | cop_filegv 0x%x |
77 | cop_seq %d |
78 | cop_arybase %d |
79 | cop_line %d |
80 | EOT |
81 | $filegv->debug; |
82 | } |
83 | |
84 | sub B::SVOP::debug { |
85 | my ($op) = @_; |
86 | $op->B::OP::debug(); |
f64a6365 |
87 | printf "\top_sv\t\t0x%x\n", ${$op->sv}; |
79ee8297 |
88 | $op->sv->debug; |
89 | } |
90 | |
91 | sub B::PVOP::debug { |
92 | my ($op) = @_; |
93 | $op->B::OP::debug(); |
94 | printf "\top_pv\t\t0x%x\n", $op->pv; |
95 | } |
96 | |
97 | sub B::GVOP::debug { |
98 | my ($op) = @_; |
99 | $op->B::OP::debug(); |
f64a6365 |
100 | printf "\top_gv\t\t0x%x\n", ${$op->gv}; |
101 | $op->gv->debug; |
79ee8297 |
102 | } |
103 | |
104 | sub B::CVOP::debug { |
105 | my ($op) = @_; |
106 | $op->B::OP::debug(); |
f64a6365 |
107 | printf "\top_cv\t\t0x%x\n", ${$op->cv}; |
79ee8297 |
108 | } |
109 | |
110 | sub B::NULL::debug { |
111 | my ($sv) = @_; |
f64a6365 |
112 | if ($$sv == ${sv_undef()}) { |
79ee8297 |
113 | print "&sv_undef\n"; |
114 | } else { |
f64a6365 |
115 | printf "NULL (0x%x)\n", $$sv; |
79ee8297 |
116 | } |
117 | } |
118 | |
119 | sub B::SV::debug { |
120 | my ($sv) = @_; |
121 | if (!$$sv) { |
122 | print class($sv), " = NULL\n"; |
123 | return; |
124 | } |
f64a6365 |
125 | printf <<'EOT', class($sv), $$sv, $sv->REFCNT, $sv->FLAGS; |
79ee8297 |
126 | %s (0x%x) |
127 | REFCNT %d |
128 | FLAGS 0x%x |
129 | EOT |
130 | } |
131 | |
132 | sub B::PV::debug { |
133 | my ($sv) = @_; |
134 | $sv->B::SV::debug(); |
135 | my $pv = $sv->PV(); |
136 | printf <<'EOT', cstring($pv), length($pv); |
137 | xpv_pv %s |
138 | xpv_cur %d |
139 | EOT |
140 | } |
141 | |
142 | sub B::IV::debug { |
143 | my ($sv) = @_; |
144 | $sv->B::SV::debug(); |
145 | printf "\txiv_iv\t\t%d\n", $sv->IV; |
146 | } |
147 | |
148 | sub B::NV::debug { |
149 | my ($sv) = @_; |
150 | $sv->B::IV::debug(); |
151 | printf "\txnv_nv\t\t%s\n", $sv->NV; |
152 | } |
153 | |
154 | sub B::PVIV::debug { |
155 | my ($sv) = @_; |
156 | $sv->B::PV::debug(); |
157 | printf "\txiv_iv\t\t%d\n", $sv->IV; |
158 | } |
159 | |
160 | sub B::PVNV::debug { |
161 | my ($sv) = @_; |
162 | $sv->B::PVIV::debug(); |
163 | printf "\txnv_nv\t\t%s\n", $sv->NV; |
164 | } |
165 | |
166 | sub B::PVLV::debug { |
167 | my ($sv) = @_; |
168 | $sv->B::PVNV::debug(); |
169 | printf "\txlv_targoff\t%d\n", $sv->TARGOFF; |
170 | printf "\txlv_targlen\t%u\n", $sv->TARGLEN; |
171 | printf "\txlv_type\t%s\n", cstring(chr($sv->TYPE)); |
172 | } |
173 | |
174 | sub B::BM::debug { |
175 | my ($sv) = @_; |
176 | $sv->B::PVNV::debug(); |
177 | printf "\txbm_useful\t%d\n", $sv->USEFUL; |
178 | printf "\txbm_previous\t%u\n", $sv->PREVIOUS; |
179 | printf "\txbm_rare\t%s\n", cstring(chr($sv->RARE)); |
180 | } |
181 | |
182 | sub B::CV::debug { |
183 | my ($sv) = @_; |
184 | $sv->B::PVNV::debug(); |
185 | my ($stash) = $sv->STASH; |
186 | my ($start) = $sv->START; |
187 | my ($root) = $sv->ROOT; |
188 | my ($padlist) = $sv->PADLIST; |
189 | my ($gv) = $sv->GV; |
190 | my ($filegv) = $sv->FILEGV; |
f64a6365 |
191 | printf <<'EOT', $$stash, $$start, $$root, $$gv, $$filegv, $sv->DEPTH, $padlist, ${$sv->OUTSIDE}; |
79ee8297 |
192 | STASH 0x%x |
193 | START 0x%x |
194 | ROOT 0x%x |
195 | GV 0x%x |
196 | FILEGV 0x%x |
197 | DEPTH %d |
198 | PADLIST 0x%x |
199 | OUTSIDE 0x%x |
200 | EOT |
201 | $start->debug if $start; |
202 | $root->debug if $root; |
203 | $gv->debug if $gv; |
204 | $filegv->debug if $filegv; |
205 | $padlist->debug if $padlist; |
206 | } |
207 | |
208 | sub B::AV::debug { |
209 | my ($av) = @_; |
210 | $av->B::SV::debug; |
211 | my(@array) = $av->ARRAY; |
f64a6365 |
212 | print "\tARRAY\t\t(", join(", ", map("0x" . $$_, @array)), ")\n"; |
79ee8297 |
213 | printf <<'EOT', scalar(@array), $av->MAX, $av->OFF, $av->AvFLAGS; |
214 | FILL %d |
215 | MAX %d |
216 | OFF %d |
217 | AvFLAGS %d |
218 | EOT |
219 | } |
220 | |
221 | sub B::GV::debug { |
222 | my ($gv) = @_; |
f64a6365 |
223 | if ($done_gv{$$gv}++) { |
224 | printf "GV %s::%s\n", $gv->STASH->NAME, $gv->NAME; |
225 | return; |
226 | } |
79ee8297 |
227 | my ($sv) = $gv->SV; |
228 | my ($av) = $gv->AV; |
229 | my ($cv) = $gv->CV; |
230 | $gv->B::SV::debug; |
f64a6365 |
231 | printf <<'EOT', $gv->NAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILEGV, $gv->GvFLAGS; |
79ee8297 |
232 | NAME %s |
f64a6365 |
233 | STASH %s (0x%x) |
79ee8297 |
234 | SV 0x%x |
235 | GvREFCNT %d |
236 | FORM 0x%x |
237 | AV 0x%x |
238 | HV 0x%x |
239 | EGV 0x%x |
240 | CV 0x%x |
241 | CVGEN %d |
242 | LINE %d |
243 | FILEGV 0x%x |
244 | GvFLAGS 0x%x |
245 | EOT |
246 | $sv->debug if $sv; |
247 | $av->debug if $av; |
248 | $cv->debug if $cv; |
249 | } |
250 | |
251 | sub B::SPECIAL::debug { |
252 | my $sv = shift; |
253 | print $specialsv_name[$$sv], "\n"; |
254 | } |
255 | |
256 | sub compile { |
257 | my $order = shift; |
258 | if ($order eq "exec") { |
259 | return sub { walkoptree_exec(main_start, "debug") } |
260 | } else { |
261 | return sub { walkoptree(main_root, "debug") } |
262 | } |
263 | } |
264 | |
265 | 1; |