Commit | Line | Data |
c99ca59a |
1 | package B::Concise; |
c27ea44e |
2 | # Copyright (C) 2000-2003 Stephen McCamant. All rights reserved. |
c99ca59a |
3 | # This program is free software; you can redistribute and/or modify it |
4 | # under the same terms as Perl itself. |
5 | |
8ec8fbef |
6 | # Note: we need to keep track of how many use declarations/BEGIN |
7 | # blocks this module uses, so we can avoid printing them when user |
8 | # asks for the BEGIN blocks in her program. Update the comments and |
9 | # the count in concise_specials if you add or delete one. The |
10 | # -MO=Concise counts as use #1. |
78ad9108 |
11 | |
8ec8fbef |
12 | use strict; # use #2 |
13 | use warnings; # uses #3 and #4, since warnings uses Carp |
78ad9108 |
14 | |
8ec8fbef |
15 | use Exporter (); # use #5 |
16 | |
c0939cee |
17 | our $VERSION = "0.66"; |
78ad9108 |
18 | our @ISA = qw(Exporter); |
cc02ea56 |
19 | our @EXPORT_OK = qw( set_style set_style_standard add_callback |
20 | concise_subref concise_cv concise_main |
21 | add_style walk_output compile reset_sequence ); |
22 | our %EXPORT_TAGS = |
23 | ( io => [qw( walk_output compile reset_sequence )], |
24 | style => [qw( add_style set_style_standard )], |
25 | cb => [qw( add_callback )], |
26 | mech => [qw( concise_subref concise_cv concise_main )], ); |
78ad9108 |
27 | |
8ec8fbef |
28 | # use #6 |
c99ca59a |
29 | use B qw(class ppname main_start main_root main_cv cstring svref_2object |
6a077020 |
30 | SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL |
31 | CVf_ANON); |
c99ca59a |
32 | |
f95e3c3c |
33 | my %style = |
c99ca59a |
34 | ("terse" => |
c3caa09d |
35 | ["(?(#label =>\n)?)(*( )*)#class (#addr) #name (?([#targ])?) " |
36 | . "#svclass~(?((#svaddr))?)~#svval~(?(label \"#coplabel\")?)\n", |
c99ca59a |
37 | "(*( )*)goto #class (#addr)\n", |
38 | "#class pp_#name"], |
39 | "concise" => |
40 | ["#hyphseq2 (*( (x( ;)x))*)<#classsym> " |
cc02ea56 |
41 | . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x)\n" |
42 | , " (*( )*) goto #seq\n", |
c99ca59a |
43 | "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"], |
44 | "linenoise" => |
45 | ["(x(;(*( )*))x)#noise#arg(?([#targarg])?)(x( ;\n)x)", |
46 | "gt_#seq ", |
47 | "(?(#seq)?)#noise#arg(?([#targarg])?)"], |
48 | "debug" => |
49 | ["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t" |
7252851f |
50 | . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n" . |
51 | ($] > 5.009 ? '' : "\top_seq\t\t#seqnum\n") |
2814eb74 |
52 | . "\top_flags\t#flagval\n\top_private\t#privval\n" |
c99ca59a |
53 | . "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)" |
54 | . "(?(\top_sv\t\t#svaddr\n)?)", |
55 | " GOTO #addr\n", |
56 | "#addr"], |
57 | "env" => [$ENV{B_CONCISE_FORMAT}, $ENV{B_CONCISE_GOTO_FORMAT}, |
58 | $ENV{B_CONCISE_TREE_FORMAT}], |
59 | ); |
60 | |
724aa791 |
61 | # Renderings, ie how Concise prints, is controlled by these vars |
62 | # primary: |
63 | our $stylename; # selects current style from %style |
64 | my $order = "basic"; # how optree is walked & printed: basic, exec, tree |
65 | |
66 | # rendering mechanics: |
67 | # these 'formats' are the line-rendering templates |
68 | # they're updated from %style when $stylename changes |
69 | my ($format, $gotofmt, $treefmt); |
70 | |
71 | # lesser players: |
72 | my $base = 36; # how <sequence#> is displayed |
73 | my $big_endian = 1; # more <sequence#> display |
74 | my $tree_style = 0; # tree-order details |
75 | my $banner = 1; # print banner before optree is traversed |
cc02ea56 |
76 | my $do_main = 0; # force printing of main routine |
724aa791 |
77 | |
cc02ea56 |
78 | # another factor: can affect all styles! |
724aa791 |
79 | our @callbacks; # allow external management |
80 | |
81 | set_style_standard("concise"); |
82 | |
c99ca59a |
83 | my $curcv; |
c27ea44e |
84 | my $cop_seq_base; |
78ad9108 |
85 | |
86 | sub set_style { |
87 | ($format, $gotofmt, $treefmt) = @_; |
724aa791 |
88 | #warn "set_style: deprecated, use set_style_standard instead\n"; # someday |
f95e3c3c |
89 | die "expecting 3 style-format args\n" unless @_ == 3; |
90 | } |
91 | |
92 | sub add_style { |
93 | my ($newstyle,@args) = @_; |
94 | die "style '$newstyle' already exists, choose a new name\n" |
95 | if exists $style{$newstyle}; |
96 | die "expecting 3 style-format args\n" unless @args == 3; |
97 | $style{$newstyle} = [@args]; |
724aa791 |
98 | $stylename = $newstyle; # update rendering state |
78ad9108 |
99 | } |
100 | |
31b49ad4 |
101 | sub set_style_standard { |
724aa791 |
102 | ($stylename) = @_; # update rendering state |
f95e3c3c |
103 | die "err: style '$stylename' unknown\n" unless exists $style{$stylename}; |
104 | set_style(@{$style{$stylename}}); |
31b49ad4 |
105 | } |
106 | |
78ad9108 |
107 | sub add_callback { |
108 | push @callbacks, @_; |
109 | } |
c99ca59a |
110 | |
f95e3c3c |
111 | # output handle, used with all Concise-output printing |
cc02ea56 |
112 | our $walkHandle; # public for your convenience |
113 | BEGIN { $walkHandle = \*STDOUT } |
f95e3c3c |
114 | |
115 | sub walk_output { # updates $walkHandle |
116 | my $handle = shift; |
cc02ea56 |
117 | return $walkHandle unless $handle; # allow use as accessor |
118 | |
f95e3c3c |
119 | if (ref $handle eq 'SCALAR') { |
2ce64696 |
120 | require Config; |
121 | die "no perlio in this build, can't call walk_output (\\\$scalar)\n" |
122 | unless $Config::Config{useperlio}; |
f95e3c3c |
123 | # in 5.8+, open(FILEHANDLE,MODE,REFERENCE) writes to string |
2ce64696 |
124 | open my $tmp, '>', $handle; # but cant re-set existing STDOUT |
f95e3c3c |
125 | $walkHandle = $tmp; # so use my $tmp as intermediate var |
cc02ea56 |
126 | return $walkHandle; |
f95e3c3c |
127 | } |
cc02ea56 |
128 | my $iotype = ref $handle; |
f95e3c3c |
129 | die "expecting argument/object that can print\n" |
cc02ea56 |
130 | unless $iotype eq 'GLOB' or $iotype and $handle->can('print'); |
131 | $walkHandle = $handle; |
f95e3c3c |
132 | } |
133 | |
8ec8fbef |
134 | sub concise_subref { |
c0939cee |
135 | my($order, $coderef, $name) = @_; |
f95e3c3c |
136 | my $codeobj = svref_2object($coderef); |
cc02ea56 |
137 | |
c0939cee |
138 | return concise_stashref(@_) |
cc02ea56 |
139 | unless ref $codeobj eq 'B::CV'; |
c0939cee |
140 | concise_cv_obj($order, $codeobj, $name); |
8ec8fbef |
141 | } |
142 | |
cc02ea56 |
143 | sub concise_stashref { |
144 | my($order, $h) = @_; |
145 | foreach my $k (sort keys %$h) { |
146 | local *s = $h->{$k}; |
147 | my $coderef = *s{CODE} or next; |
148 | reset_sequence(); |
149 | print "FUNC: ", *s, "\n"; |
150 | my $codeobj = svref_2object($coderef); |
151 | next unless ref $codeobj eq 'B::CV'; |
152 | eval { concise_cv_obj($order, $codeobj) } |
153 | or warn "err $@ on $codeobj"; |
154 | } |
155 | } |
156 | |
8ec8fbef |
157 | # This should have been called concise_subref, but it was exported |
158 | # under this name in versions before 0.56 |
c0939cee |
159 | *concise_cv = \&concise_subref; |
8ec8fbef |
160 | |
161 | sub concise_cv_obj { |
c0939cee |
162 | my ($order, $cv, $name) = @_; |
163 | # name is either a string, or a CODE ref (copy of $cv arg??) |
164 | |
c99ca59a |
165 | $curcv = $cv; |
c0939cee |
166 | if ($cv->XSUB) { |
167 | print $walkHandle "$name is XS code\n"; |
168 | return; |
169 | } |
170 | if (class($cv->START) eq "NULL") { |
171 | no strict 'refs'; |
172 | if (ref $name eq 'CODE') { |
173 | print $walkHandle "coderef $name has no START\n"; |
174 | } |
175 | elsif (exists &$name) { |
176 | print $walkHandle "subroutine $name exists\n"; |
177 | } |
178 | else { |
179 | print $walkHandle "$name not in symbol table\n"; |
180 | } |
181 | return; |
182 | } |
c27ea44e |
183 | sequence($cv->START); |
c99ca59a |
184 | if ($order eq "exec") { |
185 | walk_exec($cv->START); |
c0939cee |
186 | } |
187 | elsif ($order eq "basic") { |
188 | # walk_topdown($cv->ROOT, sub { $_[0]->concise($_[1]) }, 0); |
189 | my $root = $cv->ROOT; |
190 | unless (ref $root eq 'B::NULL') { |
191 | walk_topdown($root, sub { $_[0]->concise($_[1]) }, 0); |
192 | } else { |
193 | print $walkHandle "B::NULL encountered doing ROOT on $cv. avoiding disaster\n"; |
194 | } |
c99ca59a |
195 | } else { |
f95e3c3c |
196 | print $walkHandle tree($cv->ROOT, 0); |
c99ca59a |
197 | } |
198 | } |
199 | |
31b49ad4 |
200 | sub concise_main { |
201 | my($order) = @_; |
202 | sequence(main_start); |
203 | $curcv = main_cv; |
204 | if ($order eq "exec") { |
205 | return if class(main_start) eq "NULL"; |
206 | walk_exec(main_start); |
207 | } elsif ($order eq "tree") { |
208 | return if class(main_root) eq "NULL"; |
f95e3c3c |
209 | print $walkHandle tree(main_root, 0); |
31b49ad4 |
210 | } elsif ($order eq "basic") { |
211 | return if class(main_root) eq "NULL"; |
212 | walk_topdown(main_root, |
213 | sub { $_[0]->concise($_[1]) }, 0); |
214 | } |
215 | } |
216 | |
8ec8fbef |
217 | sub concise_specials { |
218 | my($name, $order, @cv_s) = @_; |
219 | my $i = 1; |
220 | if ($name eq "BEGIN") { |
c0939cee |
221 | splice(@cv_s, 0, 8); # skip 7 BEGIN blocks in this file. NOW 8 ?? |
8ec8fbef |
222 | } elsif ($name eq "CHECK") { |
223 | pop @cv_s; # skip the CHECK block that calls us |
224 | } |
f95e3c3c |
225 | for my $cv (@cv_s) { |
226 | print $walkHandle "$name $i:\n"; |
8ec8fbef |
227 | $i++; |
c0939cee |
228 | concise_cv_obj($order, $cv, $name); |
8ec8fbef |
229 | } |
230 | } |
231 | |
c99ca59a |
232 | my $start_sym = "\e(0"; # "\cN" sometimes also works |
233 | my $end_sym = "\e(B"; # "\cO" respectively |
234 | |
f95e3c3c |
235 | my @tree_decorations = |
c99ca59a |
236 | ([" ", "--", "+-", "|-", "| ", "`-", "-", 1], |
237 | [" ", "-", "+", "+", "|", "`", "", 0], |
238 | [" ", map("$start_sym$_$end_sym", "qq", "wq", "tq", "x ", "mq", "q"), 1], |
239 | [" ", map("$start_sym$_$end_sym", "q", "w", "t", "x", "m"), "", 0], |
240 | ); |
78ad9108 |
241 | |
cc02ea56 |
242 | |
243 | sub compileOpts { |
244 | # set rendering state from options and args |
c0939cee |
245 | my (@options,@args); |
246 | if (@_) { |
247 | @options = grep(/^-/, @_); |
248 | @args = grep(!/^-/, @_); |
249 | } |
c99ca59a |
250 | for my $o (@options) { |
cc02ea56 |
251 | # mode/order |
c99ca59a |
252 | if ($o eq "-basic") { |
253 | $order = "basic"; |
254 | } elsif ($o eq "-exec") { |
255 | $order = "exec"; |
256 | } elsif ($o eq "-tree") { |
257 | $order = "tree"; |
cc02ea56 |
258 | } |
259 | # tree-specific |
260 | elsif ($o eq "-compact") { |
c99ca59a |
261 | $tree_style |= 1; |
262 | } elsif ($o eq "-loose") { |
263 | $tree_style &= ~1; |
264 | } elsif ($o eq "-vt") { |
265 | $tree_style |= 2; |
266 | } elsif ($o eq "-ascii") { |
267 | $tree_style &= ~2; |
cc02ea56 |
268 | } |
269 | # sequence numbering |
270 | elsif ($o =~ /^-base(\d+)$/) { |
c99ca59a |
271 | $base = $1; |
272 | } elsif ($o eq "-bigendian") { |
273 | $big_endian = 1; |
274 | } elsif ($o eq "-littleendian") { |
275 | $big_endian = 0; |
cc02ea56 |
276 | } |
277 | elsif ($o eq "-nobanner") { |
724aa791 |
278 | $banner = 0; |
cc02ea56 |
279 | } elsif ($o eq "-banner") { |
280 | $banner = 1; |
281 | } |
282 | elsif ($o eq "-main") { |
283 | $do_main = 1; |
284 | } elsif ($o eq "-nomain") { |
285 | $do_main = 0; |
724aa791 |
286 | } |
cc02ea56 |
287 | # line-style options |
724aa791 |
288 | elsif (exists $style{substr($o, 1)}) { |
f95e3c3c |
289 | $stylename = substr($o, 1); |
724aa791 |
290 | set_style_standard($stylename); |
c99ca59a |
291 | } else { |
292 | warn "Option $o unrecognized"; |
293 | } |
294 | } |
cc02ea56 |
295 | return (@args); |
296 | } |
297 | |
298 | sub compile { |
299 | my (@args) = compileOpts(@_); |
c27ea44e |
300 | return sub { |
cc02ea56 |
301 | my @newargs = compileOpts(@_); # accept new rendering options |
302 | warn "disregarding non-options: @newargs\n" if @newargs; |
303 | |
304 | for my $objname (@args) { |
59910b6d |
305 | next unless $objname; # skip null args to avoid noisy responses |
306 | |
cc02ea56 |
307 | if ($objname eq "BEGIN") { |
308 | concise_specials("BEGIN", $order, |
c0939cee |
309 | B::begin_av->isa("B::AV") ? |
310 | B::begin_av->ARRAY : ()); |
cc02ea56 |
311 | } elsif ($objname eq "INIT") { |
312 | concise_specials("INIT", $order, |
c0939cee |
313 | B::init_av->isa("B::AV") ? |
314 | B::init_av->ARRAY : ()); |
cc02ea56 |
315 | } elsif ($objname eq "CHECK") { |
316 | concise_specials("CHECK", $order, |
c0939cee |
317 | B::check_av->isa("B::AV") ? |
318 | B::check_av->ARRAY : ()); |
cc02ea56 |
319 | } elsif ($objname eq "END") { |
320 | concise_specials("END", $order, |
c0939cee |
321 | B::end_av->isa("B::AV") ? |
322 | B::end_av->ARRAY : ()); |
cc02ea56 |
323 | } |
324 | else { |
325 | # convert function names to subrefs |
326 | my $objref; |
327 | if (ref $objname) { |
328 | print $walkHandle "B::Concise::compile($objname)\n" |
329 | if $banner; |
330 | $objref = $objname; |
8ec8fbef |
331 | } else { |
cc02ea56 |
332 | $objname = "main::" . $objname unless $objname =~ /::/; |
333 | print $walkHandle "$objname:\n"; |
334 | no strict 'refs'; |
c0939cee |
335 | unless (exists &$objname) { |
336 | print $walkHandle "err: unknown function ($objname)\n"; |
337 | return; |
338 | } |
cc02ea56 |
339 | $objref = \&$objname; |
8ec8fbef |
340 | } |
c0939cee |
341 | concise_subref($order, $objref, $objname); |
c99ca59a |
342 | } |
343 | } |
c27ea44e |
344 | if (!@args or $do_main) { |
f95e3c3c |
345 | print $walkHandle "main program:\n" if $do_main; |
31b49ad4 |
346 | concise_main($order); |
c99ca59a |
347 | } |
cc02ea56 |
348 | return @args; # something |
c99ca59a |
349 | } |
350 | } |
351 | |
352 | my %labels; |
724aa791 |
353 | my $lastnext; # remembers op-chain, used to insert gotos |
c99ca59a |
354 | |
355 | my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|", |
356 | 'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*", |
051f02e9 |
357 | 'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#"); |
c99ca59a |
358 | |
8ec8fbef |
359 | no warnings 'qw'; # "Possible attempt to put comments..."; use #7 |
35fc55f1 |
360 | my @linenoise = |
361 | qw'# () sc ( @? 1 $* gv *{ m$ m@ m% m? p/ *$ $ $# & a& pt \\ s\\ rf bl |
c99ca59a |
362 | ` *? <> ?? ?/ r/ c/ // qr s/ /c y/ = @= C sC Cp sp df un BM po +1 +I |
363 | -1 -I 1+ I+ 1- I- ** * i* / i/ %$ i% x + i+ - i- . " << >> < i< |
364 | > i> <= i, >= i. == i= != i! <? i? s< s> s, s. s= s! s? b& b^ b| -0 -i |
365 | ! ~ a2 si cs rd sr e^ lg sq in %x %o ab le ss ve ix ri sf FL od ch cy |
366 | uf lf uc lc qm @ [f [ @[ eh vl ky dl ex % ${ @{ uk pk st jn ) )[ a@ |
367 | a% sl +] -] [- [+ so rv GS GW MS MW .. f. .f && || ^^ ?: &= |= -> s{ s} |
368 | v} ca wa di rs ;; ; ;d }{ { } {} f{ it {l l} rt }l }n }r dm }g }e ^o |
369 | ^c ^| ^# um bm t~ u~ ~d DB db ^s se ^g ^r {w }w pf pr ^O ^K ^R ^W ^d ^v |
370 | ^e ^t ^k t. fc ic fl .s .p .b .c .l .a .h g1 s1 g2 s2 ?. l? -R -W -X -r |
371 | -w -x -e -o -O -z -s -M -A -C -S -c -b -f -d -p -l -u -g -k -t -T -B cd |
372 | co cr u. cm ut r. l@ s@ r@ mD uD oD rD tD sD wD cD f$ w$ p$ sh e$ k$ g3 |
373 | g4 s4 g5 s5 T@ C@ L@ G@ A@ S@ Hg Hc Hr Hw Mg Mc Ms Mr Sg Sc So rq do {e |
374 | e} {t t} g6 G6 6e g7 G7 7e g8 G8 8e g9 G9 9e 6s 7s 8s 9s 6E 7E 8E 9E Pn |
c27ea44e |
375 | Pu GP SP EP Gn Gg GG SG EG g0 c$ lk t$ ;s n> // /= CO'; |
c99ca59a |
376 | |
377 | my $chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; |
378 | |
19e169bf |
379 | sub op_flags { # common flags (see BASOP.op_flags in op.h) |
c99ca59a |
380 | my($x) = @_; |
381 | my(@v); |
382 | push @v, "v" if ($x & 3) == 1; |
383 | push @v, "s" if ($x & 3) == 2; |
384 | push @v, "l" if ($x & 3) == 3; |
385 | push @v, "K" if $x & 4; |
386 | push @v, "P" if $x & 8; |
387 | push @v, "R" if $x & 16; |
388 | push @v, "M" if $x & 32; |
389 | push @v, "S" if $x & 64; |
390 | push @v, "*" if $x & 128; |
391 | return join("", @v); |
392 | } |
393 | |
394 | sub base_n { |
395 | my $x = shift; |
396 | return "-" . base_n(-$x) if $x < 0; |
397 | my $str = ""; |
398 | do { $str .= substr($chars, $x % $base, 1) } while $x = int($x / $base); |
399 | $str = reverse $str if $big_endian; |
400 | return $str; |
401 | } |
402 | |
c27ea44e |
403 | my %sequence_num; |
404 | my $seq_max = 1; |
405 | |
f95e3c3c |
406 | sub reset_sequence { |
407 | # reset the sequence |
408 | %sequence_num = (); |
409 | $seq_max = 1; |
cc02ea56 |
410 | $lastnext = 0; |
f95e3c3c |
411 | } |
412 | |
c27ea44e |
413 | sub seq { |
414 | my($op) = @_; |
415 | return "-" if not exists $sequence_num{$$op}; |
416 | return base_n($sequence_num{$$op}); |
417 | } |
c99ca59a |
418 | |
419 | sub walk_topdown { |
420 | my($op, $sub, $level) = @_; |
421 | $sub->($op, $level); |
422 | if ($op->flags & OPf_KIDS) { |
423 | for (my $kid = $op->first; $$kid; $kid = $kid->sibling) { |
424 | walk_topdown($kid, $sub, $level + 1); |
425 | } |
426 | } |
c0939cee |
427 | elsif (class($op) eq "PMOP") { |
c6e79e55 |
428 | my $maybe_root = $op->pmreplroot; |
429 | if (ref($maybe_root) and $maybe_root->isa("B::OP")) { |
430 | # It really is the root of the replacement, not something |
431 | # else stored here for lack of space elsewhere |
432 | walk_topdown($maybe_root, $sub, $level + 1); |
433 | } |
c99ca59a |
434 | } |
435 | } |
436 | |
437 | sub walklines { |
438 | my($ar, $level) = @_; |
439 | for my $l (@$ar) { |
440 | if (ref($l) eq "ARRAY") { |
441 | walklines($l, $level + 1); |
442 | } else { |
443 | $l->concise($level); |
444 | } |
445 | } |
446 | } |
447 | |
448 | sub walk_exec { |
449 | my($top, $level) = @_; |
450 | my %opsseen; |
451 | my @lines; |
452 | my @todo = ([$top, \@lines]); |
453 | while (@todo and my($op, $targ) = @{shift @todo}) { |
454 | for (; $$op; $op = $op->next) { |
455 | last if $opsseen{$$op}++; |
456 | push @$targ, $op; |
457 | my $name = $op->name; |
62e36f8a |
458 | if (class($op) eq "LOGOP") { |
c99ca59a |
459 | my $ar = []; |
460 | push @$targ, $ar; |
461 | push @todo, [$op->other, $ar]; |
462 | } elsif ($name eq "subst" and $ {$op->pmreplstart}) { |
463 | my $ar = []; |
464 | push @$targ, $ar; |
465 | push @todo, [$op->pmreplstart, $ar]; |
466 | } elsif ($name =~ /^enter(loop|iter)$/) { |
7252851f |
467 | if ($] > 5.009) { |
468 | $labels{${$op->nextop}} = "NEXT"; |
469 | $labels{${$op->lastop}} = "LAST"; |
470 | $labels{${$op->redoop}} = "REDO"; |
471 | } else { |
472 | $labels{$op->nextop->seq} = "NEXT"; |
473 | $labels{$op->lastop->seq} = "LAST"; |
474 | $labels{$op->redoop->seq} = "REDO"; |
475 | } |
c99ca59a |
476 | } |
477 | } |
478 | } |
479 | walklines(\@lines, 0); |
480 | } |
481 | |
c27ea44e |
482 | # The structure of this routine is purposely modeled after op.c's peep() |
483 | sub sequence { |
484 | my($op) = @_; |
485 | my $oldop = 0; |
486 | return if class($op) eq "NULL" or exists $sequence_num{$$op}; |
487 | for (; $$op; $op = $op->next) { |
488 | last if exists $sequence_num{$$op}; |
489 | my $name = $op->name; |
490 | if ($name =~ /^(null|scalar|lineseq|scope)$/) { |
491 | next if $oldop and $ {$op->next}; |
492 | } else { |
493 | $sequence_num{$$op} = $seq_max++; |
494 | if (class($op) eq "LOGOP") { |
495 | my $other = $op->other; |
496 | $other = $other->next while $other->name eq "null"; |
497 | sequence($other); |
498 | } elsif (class($op) eq "LOOP") { |
499 | my $redoop = $op->redoop; |
500 | $redoop = $redoop->next while $redoop->name eq "null"; |
501 | sequence($redoop); |
502 | my $nextop = $op->nextop; |
503 | $nextop = $nextop->next while $nextop->name eq "null"; |
504 | sequence($nextop); |
505 | my $lastop = $op->lastop; |
506 | $lastop = $lastop->next while $lastop->name eq "null"; |
507 | sequence($lastop); |
508 | } elsif ($name eq "subst" and $ {$op->pmreplstart}) { |
509 | my $replstart = $op->pmreplstart; |
510 | $replstart = $replstart->next while $replstart->name eq "null"; |
511 | sequence($replstart); |
512 | } |
513 | } |
514 | $oldop = $op; |
515 | } |
516 | } |
517 | |
724aa791 |
518 | sub fmt_line { # generate text-line for op. |
cc02ea56 |
519 | my($hr, $op, $text, $level) = @_; |
520 | |
521 | $_->($hr, $op, \$text, \$level, $stylename) for @callbacks; |
522 | |
724aa791 |
523 | return '' if $hr->{SKIP}; # suppress line if a callback said so |
cc02ea56 |
524 | return '' if $hr->{goto} and $hr->{goto} eq '-'; # no goto nowhere |
f95e3c3c |
525 | |
cc02ea56 |
526 | # spec: (?(text1#varText2)?) |
c99ca59a |
527 | $text =~ s/\(\?\(([^\#]*?)\#(\w+)([^\#]*?)\)\?\)/ |
f95e3c3c |
528 | $hr->{$2} ? $1.$hr->{$2}.$3 : ""/eg; |
529 | |
cc02ea56 |
530 | # spec: (x(exec_text;basic_text)x) |
c99ca59a |
531 | $text =~ s/\(x\((.*?);(.*?)\)x\)/$order eq "exec" ? $1 : $2/egs; |
cc02ea56 |
532 | |
533 | # spec: (*(text)*) |
c99ca59a |
534 | $text =~ s/\(\*\(([^;]*?)\)\*\)/$1 x $level/egs; |
cc02ea56 |
535 | |
536 | # spec: (*(text1;text2)*) |
c99ca59a |
537 | $text =~ s/\(\*\((.*?);(.*?)\)\*\)/$1 x ($level - 1) . $2 x ($level>0)/egs; |
cc02ea56 |
538 | |
539 | # convert #Var to tag=>val form: Var\t#var |
540 | $text =~ s/\#([A-Z][a-z]+)(\d+)?/\t\u$1\t\L#$1$2/gs; |
541 | |
542 | # spec: #varN |
724aa791 |
543 | $text =~ s/\#([a-zA-Z]+)(\d+)/sprintf("%-$2s", $hr->{$1})/eg; |
544 | |
cc02ea56 |
545 | $text =~ s/\#([a-zA-Z]+)/$hr->{$1}/eg; # populate #var's |
546 | $text =~ s/[ \t]*~+[ \t]*/ /g; # squeeze tildes |
f95e3c3c |
547 | chomp $text; |
548 | return "$text\n" if $text ne ""; |
549 | return $text; # suppress empty lines |
c99ca59a |
550 | } |
551 | |
19e169bf |
552 | our %priv; # used to display each opcode's BASEOP.op_private values |
553 | |
c99ca59a |
554 | $priv{$_}{128} = "LVINTRO" |
555 | for ("pos", "substr", "vec", "threadsv", "gvsv", "rv2sv", "rv2hv", "rv2gv", |
556 | "rv2av", "rv2arylen", "aelem", "helem", "aslice", "hslice", "padsv", |
241416b8 |
557 | "padav", "padhv", "enteriter"); |
c99ca59a |
558 | $priv{$_}{64} = "REFC" for ("leave", "leavesub", "leavesublv", "leavewrite"); |
559 | $priv{"aassign"}{64} = "COMMON"; |
4ac6efe6 |
560 | $priv{"aassign"}{32} = "PHASH" if $] < 5.009; |
c99ca59a |
561 | $priv{"sassign"}{64} = "BKWARD"; |
562 | $priv{$_}{64} = "RTIME" for ("match", "subst", "substcont"); |
563 | @{$priv{"trans"}}{1,2,4,8,16,64} = ("<UTF", ">UTF", "IDENT", "SQUASH", "DEL", |
564 | "COMPL", "GROWS"); |
565 | $priv{"repeat"}{64} = "DOLIST"; |
566 | $priv{"leaveloop"}{64} = "CONT"; |
567 | @{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV") |
314d4778 |
568 | for (qw(rv2gv rv2sv padsv aelem helem)); |
d4797c1d |
569 | @{$priv{"entersub"}}{16,32,64} = ("DBG","TARG","NOMOD"); |
c99ca59a |
570 | @{$priv{$_}}{4,8,128} = ("INARGS","AMPER","NO()") for ("entersub", "rv2cv"); |
571 | $priv{"gv"}{32} = "EARLYCV"; |
572 | $priv{"aelem"}{16} = $priv{"helem"}{16} = "LVDEFER"; |
241416b8 |
573 | $priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv", |
574 | "enteriter"); |
c99ca59a |
575 | $priv{$_}{16} = "TARGMY" |
576 | for (map(($_,"s$_"),"chop", "chomp"), |
577 | map(($_,"i_$_"), "postinc", "postdec", "multiply", "divide", "modulo", |
578 | "add", "subtract", "negate"), "pow", "concat", "stringify", |
579 | "left_shift", "right_shift", "bit_and", "bit_xor", "bit_or", |
580 | "complement", "atan2", "sin", "cos", "rand", "exp", "log", "sqrt", |
581 | "int", "hex", "oct", "abs", "length", "index", "rindex", "sprintf", |
582 | "ord", "chr", "crypt", "quotemeta", "join", "push", "unshift", "flock", |
583 | "chdir", "chown", "chroot", "unlink", "chmod", "utime", "rename", |
584 | "link", "symlink", "mkdir", "rmdir", "wait", "waitpid", "system", |
585 | "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority", |
586 | "setpriority", "time", "sleep"); |
ef3e5ea9 |
587 | $priv{$_}{4} = "REVERSED" for ("enteriter", "iter"); |
d4797c1d |
588 | @{$priv{"const"}}{4,8,16,32,64,128} = ("SHORT","STRICT","ENTERED",'$[',"BARE","WARN"); |
c99ca59a |
589 | $priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM"; |
590 | $priv{"list"}{64} = "GUESSED"; |
591 | $priv{"delete"}{64} = "SLICE"; |
592 | $priv{"exists"}{64} = "SUB"; |
593 | $priv{$_}{64} = "LOCALE" |
594 | for ("sort", "prtf", "sprintf", "slt", "sle", "seq", "sne", "sgt", "sge", |
595 | "scmp", "lc", "uc", "lcfirst", "ucfirst"); |
6c3fb703 |
596 | @{$priv{"sort"}}{1,2,4,8,16} = ("NUM", "INT", "REV", "INPLACE","DESC"); |
c99ca59a |
597 | $priv{"threadsv"}{64} = "SVREFd"; |
c27ea44e |
598 | @{$priv{$_}}{16,32,64,128} = ("INBIN","INCR","OUTBIN","OUTCR") |
599 | for ("open", "backtick"); |
c99ca59a |
600 | $priv{"exit"}{128} = "VMS"; |
feaeca78 |
601 | $priv{$_}{2} = "FTACCESS" |
602 | for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec"); |
32454ac8 |
603 | if ($] >= 5.009) { |
604 | # Stacked filetests are post 5.8.x |
605 | $priv{$_}{4} = "FTSTACKED" |
606 | for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec", |
607 | "ftis", "fteowned", "ftrowned", "ftzero", "ftsize", "ftmtime", |
608 | "ftatime", "ftctime", "ftsock", "ftchr", "ftblk", "ftfile", "ftdir", |
609 | "ftpipe", "ftlink", "ftsuid", "ftsgid", "ftsvtx", "fttty", "fttext", |
610 | "ftbinary"); |
611 | # Lexical $_ is post 5.8.x |
612 | $priv{$_}{2} = "GREPLEX" |
613 | for ("mapwhile", "mapstart", "grepwhile", "grepstart"); |
614 | } |
c99ca59a |
615 | |
616 | sub private_flags { |
617 | my($name, $x) = @_; |
618 | my @s; |
619 | for my $flag (128, 96, 64, 32, 16, 8, 4, 2, 1) { |
620 | if ($priv{$name}{$flag} and $x & $flag and $x >= $flag) { |
621 | $x -= $flag; |
622 | push @s, $priv{$name}{$flag}; |
623 | } |
624 | } |
625 | push @s, $x if $x; |
626 | return join(",", @s); |
627 | } |
628 | |
c27ea44e |
629 | sub concise_sv { |
630 | my($sv, $hr) = @_; |
631 | $hr->{svclass} = class($sv); |
31b49ad4 |
632 | $hr->{svclass} = "UV" |
633 | if $hr->{svclass} eq "IV" and $sv->FLAGS & SVf_IVisUV; |
c27ea44e |
634 | $hr->{svaddr} = sprintf("%#x", $$sv); |
635 | if ($hr->{svclass} eq "GV") { |
636 | my $gv = $sv; |
637 | my $stash = $gv->STASH->NAME; |
638 | if ($stash eq "main") { |
639 | $stash = ""; |
640 | } else { |
641 | $stash = $stash . "::"; |
642 | } |
643 | $hr->{svval} = "*$stash" . $gv->SAFENAME; |
644 | return "*$stash" . $gv->SAFENAME; |
645 | } else { |
646 | while (class($sv) eq "RV") { |
647 | $hr->{svval} .= "\\"; |
648 | $sv = $sv->RV; |
649 | } |
650 | if (class($sv) eq "SPECIAL") { |
40b5b14f |
651 | $hr->{svval} .= ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv]; |
c27ea44e |
652 | } elsif ($sv->FLAGS & SVf_NOK) { |
40b5b14f |
653 | $hr->{svval} .= $sv->NV; |
c27ea44e |
654 | } elsif ($sv->FLAGS & SVf_IOK) { |
31b49ad4 |
655 | $hr->{svval} .= $sv->int_value; |
c27ea44e |
656 | } elsif ($sv->FLAGS & SVf_POK) { |
40b5b14f |
657 | $hr->{svval} .= cstring($sv->PV); |
31b49ad4 |
658 | } elsif (class($sv) eq "HV") { |
659 | $hr->{svval} .= 'HASH'; |
c27ea44e |
660 | } |
cc02ea56 |
661 | |
662 | $hr->{svval} = 'undef' unless defined $hr->{svval}; |
663 | my $out = $hr->{svclass}; |
664 | return $out .= " $hr->{svval}" ; |
c27ea44e |
665 | } |
666 | } |
667 | |
c99ca59a |
668 | sub concise_op { |
669 | my ($op, $level, $format) = @_; |
670 | my %h; |
671 | $h{exname} = $h{name} = $op->name; |
672 | $h{NAME} = uc $h{name}; |
673 | $h{class} = class($op); |
674 | $h{extarg} = $h{targ} = $op->targ; |
675 | $h{extarg} = "" unless $h{extarg}; |
676 | if ($h{name} eq "null" and $h{targ}) { |
8ec8fbef |
677 | # targ holds the old type |
c99ca59a |
678 | $h{exname} = "ex-" . substr(ppname($h{targ}), 3); |
679 | $h{extarg} = ""; |
8ec8fbef |
680 | } elsif ($op->name =~ /^leave(sub(lv)?|write)?$/) { |
681 | # targ potentially holds a reference count |
682 | if ($op->private & 64) { |
683 | my $refs = "ref" . ($h{targ} != 1 ? "s" : ""); |
684 | $h{targarglife} = $h{targarg} = "$h{targ} $refs"; |
685 | } |
c99ca59a |
686 | } elsif ($h{targ}) { |
687 | my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}]; |
688 | if (defined $padname and class($padname) ne "SPECIAL") { |
0b40bd6d |
689 | $h{targarg} = $padname->PVX; |
127212b2 |
690 | if ($padname->FLAGS & SVf_FAKE) { |
4ac6efe6 |
691 | if ($] < 5.009) { |
692 | $h{targarglife} = "$h{targarg}:FAKE"; |
693 | } else { |
694 | # These changes relate to the jumbo closure fix. |
695 | # See changes 19939 and 20005 |
696 | my $fake = ''; |
697 | $fake .= 'a' if $padname->IVX & 1; # PAD_FAKELEX_ANON |
698 | $fake .= 'm' if $padname->IVX & 2; # PAD_FAKELEX_MULTI |
699 | $fake .= ':' . $padname->NVX if $curcv->CvFLAGS & CVf_ANON; |
700 | $h{targarglife} = "$h{targarg}:FAKE:$fake"; |
701 | } |
127212b2 |
702 | } |
703 | else { |
704 | my $intro = $padname->NVX - $cop_seq_base; |
705 | my $finish = int($padname->IVX) - $cop_seq_base; |
706 | $finish = "end" if $finish == 999999999 - $cop_seq_base; |
707 | $h{targarglife} = "$h{targarg}:$intro,$finish"; |
708 | } |
c99ca59a |
709 | } else { |
710 | $h{targarglife} = $h{targarg} = "t" . $h{targ}; |
711 | } |
712 | } |
713 | $h{arg} = ""; |
714 | $h{svclass} = $h{svaddr} = $h{svval} = ""; |
715 | if ($h{class} eq "PMOP") { |
716 | my $precomp = $op->precomp; |
7a9b44b9 |
717 | if (defined $precomp) { |
c27ea44e |
718 | $precomp = cstring($precomp); # Escape literal control sequences |
719 | $precomp = "/$precomp/"; |
720 | } else { |
721 | $precomp = ""; |
7a9b44b9 |
722 | } |
b2a3cfdd |
723 | my $pmreplroot = $op->pmreplroot; |
34a48b4b |
724 | my $pmreplstart; |
c6e79e55 |
725 | if (ref($pmreplroot) eq "B::GV") { |
b2a3cfdd |
726 | # with C<@stash_array = split(/pat/, str);>, |
c6e79e55 |
727 | # *stash_array is stored in /pat/'s pmreplroot. |
b2a3cfdd |
728 | $h{arg} = "($precomp => \@" . $pmreplroot->NAME . ")"; |
c6e79e55 |
729 | } elsif (!ref($pmreplroot) and $pmreplroot) { |
730 | # same as the last case, except the value is actually a |
731 | # pad offset for where the GV is kept (this happens under |
732 | # ithreads) |
733 | my $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$pmreplroot]; |
734 | $h{arg} = "($precomp => \@" . $gv->NAME . ")"; |
b2a3cfdd |
735 | } elsif ($ {$op->pmreplstart}) { |
c99ca59a |
736 | undef $lastnext; |
737 | $pmreplstart = "replstart->" . seq($op->pmreplstart); |
738 | $h{arg} = "(" . join(" ", $precomp, $pmreplstart) . ")"; |
739 | } else { |
740 | $h{arg} = "($precomp)"; |
741 | } |
742 | } elsif ($h{class} eq "PVOP" and $h{name} ne "trans") { |
743 | $h{arg} = '("' . $op->pv . '")'; |
744 | $h{svval} = '"' . $op->pv . '"'; |
745 | } elsif ($h{class} eq "COP") { |
746 | my $label = $op->label; |
c3caa09d |
747 | $h{coplabel} = $label; |
c99ca59a |
748 | $label = $label ? "$label: " : ""; |
749 | my $loc = $op->file; |
750 | $loc =~ s[.*/][]; |
751 | $loc .= ":" . $op->line; |
752 | my($stash, $cseq) = ($op->stash->NAME, $op->cop_seq - $cop_seq_base); |
753 | my $arybase = $op->arybase; |
754 | $arybase = $arybase ? ' $[=' . $arybase : ""; |
755 | $h{arg} = "($label$stash $cseq $loc$arybase)"; |
756 | } elsif ($h{class} eq "LOOP") { |
757 | $h{arg} = "(next->" . seq($op->nextop) . " last->" . seq($op->lastop) |
758 | . " redo->" . seq($op->redoop) . ")"; |
759 | } elsif ($h{class} eq "LOGOP") { |
760 | undef $lastnext; |
761 | $h{arg} = "(other->" . seq($op->other) . ")"; |
762 | } elsif ($h{class} eq "SVOP") { |
6a077020 |
763 | unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) { |
764 | if (! ${$op->sv}) { |
765 | my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$op->targ]; |
766 | $h{arg} = "[" . concise_sv($sv, \%h) . "]"; |
767 | $h{targarglife} = $h{targarg} = ""; |
768 | } else { |
769 | $h{arg} = "(" . concise_sv($op->sv, \%h) . ")"; |
770 | } |
c99ca59a |
771 | } |
31b49ad4 |
772 | } elsif ($h{class} eq "PADOP") { |
773 | my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$op->padix]; |
774 | $h{arg} = "[" . concise_sv($sv, \%h) . "]"; |
c99ca59a |
775 | } |
776 | $h{seq} = $h{hyphseq} = seq($op); |
777 | $h{seq} = "" if $h{seq} eq "-"; |
7252851f |
778 | if ($] > 5.009) { |
779 | $h{opt} = $op->opt; |
780 | $h{static} = $op->static; |
781 | $h{label} = $labels{$$op}; |
782 | } else { |
783 | $h{seqnum} = $op->seq; |
784 | $h{label} = $labels{$op->seq}; |
785 | } |
c99ca59a |
786 | $h{next} = $op->next; |
787 | $h{next} = (class($h{next}) eq "NULL") ? "(end)" : seq($h{next}); |
788 | $h{nextaddr} = sprintf("%#x", $ {$op->next}); |
789 | $h{sibaddr} = sprintf("%#x", $ {$op->sibling}); |
790 | $h{firstaddr} = sprintf("%#x", $ {$op->first}) if $op->can("first"); |
791 | $h{lastaddr} = sprintf("%#x", $ {$op->last}) if $op->can("last"); |
792 | |
793 | $h{classsym} = $opclass{$h{class}}; |
794 | $h{flagval} = $op->flags; |
795 | $h{flags} = op_flags($op->flags); |
796 | $h{privval} = $op->private; |
797 | $h{private} = private_flags($h{name}, $op->private); |
798 | $h{addr} = sprintf("%#x", $$op); |
c99ca59a |
799 | $h{typenum} = $op->type; |
800 | $h{noise} = $linenoise[$op->type]; |
f95e3c3c |
801 | |
cc02ea56 |
802 | return fmt_line(\%h, $op, $format, $level); |
c99ca59a |
803 | } |
804 | |
805 | sub B::OP::concise { |
806 | my($op, $level) = @_; |
807 | if ($order eq "exec" and $lastnext and $$lastnext != $$op) { |
724aa791 |
808 | # insert a 'goto' line |
cc02ea56 |
809 | my $synth = {"seq" => seq($lastnext), "class" => class($lastnext), |
810 | "addr" => sprintf("%#x", $$lastnext), |
811 | "goto" => seq($lastnext), # simplify goto '-' removal |
812 | }; |
813 | print $walkHandle fmt_line($synth, $op, $gotofmt, $level+1); |
c99ca59a |
814 | } |
815 | $lastnext = $op->next; |
f95e3c3c |
816 | print $walkHandle concise_op($op, $level, $format); |
c99ca59a |
817 | } |
818 | |
31b49ad4 |
819 | # B::OP::terse (see Terse.pm) now just calls this |
820 | sub b_terse { |
821 | my($op, $level) = @_; |
822 | |
823 | # This isn't necessarily right, but there's no easy way to get |
824 | # from an OP to the right CV. This is a limitation of the |
825 | # ->terse() interface style, and there isn't much to do about |
826 | # it. In particular, we can die in concise_op if the main pad |
827 | # isn't long enough, or has the wrong kind of entries, compared to |
828 | # the pad a sub was compiled with. The fix for that would be to |
829 | # make a backwards compatible "terse" format that never even |
830 | # looked at the pad, just like the old B::Terse. I don't think |
831 | # that's worth the effort, though. |
832 | $curcv = main_cv unless $curcv; |
833 | |
834 | if ($order eq "exec" and $lastnext and $$lastnext != $$op) { |
724aa791 |
835 | # insert a 'goto' |
31b49ad4 |
836 | my $h = {"seq" => seq($lastnext), "class" => class($lastnext), |
837 | "addr" => sprintf("%#x", $$lastnext)}; |
cc02ea56 |
838 | print # $walkHandle |
839 | fmt_line($h, $op, $style{"terse"}[1], $level+1); |
31b49ad4 |
840 | } |
841 | $lastnext = $op->next; |
cc02ea56 |
842 | print # $walkHandle |
843 | concise_op($op, $level, $style{"terse"}[0]); |
31b49ad4 |
844 | } |
845 | |
c99ca59a |
846 | sub tree { |
847 | my $op = shift; |
848 | my $level = shift; |
849 | my $style = $tree_decorations[$tree_style]; |
850 | my($space, $single, $kids, $kid, $nokid, $last, $lead, $size) = @$style; |
851 | my $name = concise_op($op, $level, $treefmt); |
852 | if (not $op->flags & OPf_KIDS) { |
853 | return $name . "\n"; |
854 | } |
855 | my @lines; |
856 | for (my $kid = $op->first; $$kid; $kid = $kid->sibling) { |
857 | push @lines, tree($kid, $level+1); |
858 | } |
859 | my $i; |
860 | for ($i = $#lines; substr($lines[$i], 0, 1) eq " "; $i--) { |
861 | $lines[$i] = $space . $lines[$i]; |
862 | } |
863 | if ($i > 0) { |
864 | $lines[$i] = $last . $lines[$i]; |
865 | while ($i-- > 1) { |
866 | if (substr($lines[$i], 0, 1) eq " ") { |
867 | $lines[$i] = $nokid . $lines[$i]; |
868 | } else { |
f95e3c3c |
869 | $lines[$i] = $kid . $lines[$i]; |
c99ca59a |
870 | } |
871 | } |
872 | $lines[$i] = $kids . $lines[$i]; |
873 | } else { |
874 | $lines[0] = $single . $lines[0]; |
875 | } |
876 | return("$name$lead" . shift @lines, |
877 | map(" " x (length($name)+$size) . $_, @lines)); |
878 | } |
879 | |
213a1a26 |
880 | # *** Warning: fragile kludge ahead *** |
881 | # Because the B::* modules run in the same interpreter as the code |
2814eb74 |
882 | # they're compiling, their presence tends to distort the view we have of |
883 | # the code we're looking at. In particular, perl gives sequence numbers |
884 | # to COPs. If the program we're looking at were run on its own, this |
885 | # would start at 1. Because all of B::Concise and all the modules it |
886 | # uses are compiled first, though, by the time we get to the user's |
887 | # program the sequence number is already pretty high, which could be |
888 | # distracting if you're trying to tell OPs apart. Therefore we'd like to |
889 | # subtract an offset from all the sequence numbers we display, to |
890 | # restore the simpler view of the world. The trick is to know what that |
891 | # offset will be, when we're still compiling B::Concise! If we |
213a1a26 |
892 | # hardcoded a value, it would have to change every time B::Concise or |
2814eb74 |
893 | # other modules we use do. To help a little, what we do here is compile |
894 | # a little code at the end of the module, and compute the base sequence |
895 | # number for the user's program as being a small offset later, so all we |
896 | # have to worry about are changes in the offset. |
7252851f |
897 | |
898 | # [For 5.8.x and earlier perl is generating sequence numbers for all ops, |
899 | # and using them to reference labels] |
900 | |
901 | |
213a1a26 |
902 | # When you say "perl -MO=Concise -e '$a'", the output should look like: |
903 | |
904 | # 4 <@> leave[t1] vKP/REFC ->(end) |
905 | # 1 <0> enter ->2 |
906 | #^ smallest OP sequence number should be 1 |
907 | # 2 <;> nextstate(main 1 -e:1) v ->3 |
908 | # ^ smallest COP sequence number should be 1 |
909 | # - <1> ex-rv2sv vK/1 ->4 |
910 | # 3 <$> gvsv(*a) s ->4 |
911 | |
c27ea44e |
912 | # If the second of the marked numbers there isn't 1, it means you need |
913 | # to update the corresponding magic number in the next line. |
914 | # Remember, this needs to stay the last things in the module. |
e69a2255 |
915 | |
c27ea44e |
916 | # Why is this different for MacOS? Does it matter? |
8ec8fbef |
917 | my $cop_seq_mnum = $^O eq 'MacOS' ? 12 : 11; |
e69a2255 |
918 | $cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum; |
c99ca59a |
919 | |
920 | 1; |
921 | |
922 | __END__ |
923 | |
924 | =head1 NAME |
925 | |
926 | B::Concise - Walk Perl syntax tree, printing concise info about ops |
927 | |
928 | =head1 SYNOPSIS |
929 | |
930 | perl -MO=Concise[,OPTIONS] foo.pl |
931 | |
78ad9108 |
932 | use B::Concise qw(set_style add_callback); |
933 | |
c99ca59a |
934 | =head1 DESCRIPTION |
935 | |
936 | This compiler backend prints the internal OPs of a Perl program's syntax |
937 | tree in one of several space-efficient text formats suitable for debugging |
938 | the inner workings of perl or other compiler backends. It can print OPs in |
939 | the order they appear in the OP tree, in the order they will execute, or |
940 | in a text approximation to their tree structure, and the format of the |
941 | information displyed is customizable. Its function is similar to that of |
942 | perl's B<-Dx> debugging flag or the B<B::Terse> module, but it is more |
943 | sophisticated and flexible. |
944 | |
f8a679e6 |
945 | =head1 EXAMPLE |
946 | |
19e169bf |
947 | Here's an example of 2 outputs (aka 'renderings'), using the |
948 | -exec and -basic (i.e. default) formatting conventions on the same code |
949 | snippet. |
950 | |
951 | % perl -MO=Concise,-exec -e '$a = $b + 42' |
952 | 1 <0> enter |
953 | 2 <;> nextstate(main 1 -e:1) v |
954 | 3 <#> gvsv[*b] s |
955 | 4 <$> const[IV 42] s |
956 | * 5 <2> add[t3] sK/2 |
957 | 6 <#> gvsv[*a] s |
958 | 7 <2> sassign vKS/2 |
959 | 8 <@> leave[1 ref] vKP/REFC |
960 | |
961 | Each line corresponds to an opcode. The opcode marked with '*' is used |
962 | in a few examples below. |
963 | |
964 | The 1st column is the op's sequence number, starting at 1, and is |
965 | displayed in base 36 by default. This rendering is in -exec (i.e. |
966 | execution) order. |
967 | |
968 | The symbol between angle brackets indicates the op's type, for |
969 | example; <2> is a BINOP, <@> a LISTOP, and <#> is a PADOP, which is |
970 | used in threaded perls. (see L</"OP class abbreviations">). |
971 | |
972 | The opname, as in B<'add[t1]'>, which may be followed by op-specific |
973 | information in parentheses or brackets (ex B<'[t1]'>). |
974 | |
975 | The op-flags (ex B<'sK/2'>) follow, and are described in (L</"OP flags |
976 | abbreviations">). |
f8a679e6 |
977 | |
978 | % perl -MO=Concise -e '$a = $b + 42' |
8ec8fbef |
979 | 8 <@> leave[1 ref] vKP/REFC ->(end) |
f8a679e6 |
980 | 1 <0> enter ->2 |
981 | 2 <;> nextstate(main 1 -e:1) v ->3 |
982 | 7 <2> sassign vKS/2 ->8 |
19e169bf |
983 | * 5 <2> add[t1] sK/2 ->6 |
f8a679e6 |
984 | - <1> ex-rv2sv sK/1 ->4 |
985 | 3 <$> gvsv(*b) s ->4 |
986 | 4 <$> const(IV 42) s ->5 |
987 | - <1> ex-rv2sv sKRM*/1 ->7 |
988 | 6 <$> gvsv(*a) s ->7 |
989 | |
19e169bf |
990 | The default rendering is top-down, so they're not in execution order. |
991 | This form reflects the way the stack is used to parse and evaluate |
992 | expressions; the add operates on the two terms below it in the tree. |
f8a679e6 |
993 | |
19e169bf |
994 | Nullops appear as C<ex-opname>, where I<opname> is an op that has been |
995 | optimized away by perl. They're displayed with a sequence-number of |
996 | '-', because they are not executed (they don't appear in previous |
997 | example), they're printed here because they reflect the parse. |
f8a679e6 |
998 | |
19e169bf |
999 | The arrow points to the sequence number of the next op; they're not |
1000 | displayed in -exec mode, for obvious reasons. |
f8a679e6 |
1001 | |
19e169bf |
1002 | Note that because this rendering was done on a non-threaded perl, the |
1003 | PADOPs in the previous examples are now SVOPs, and some (but not all) |
1004 | of the square brackets have been replaced by round ones. This is a |
1005 | subtle feature to provide some visual distinction between renderings |
1006 | on threaded and un-threaded perls. |
f8a679e6 |
1007 | |
f8a679e6 |
1008 | |
c99ca59a |
1009 | =head1 OPTIONS |
1010 | |
1011 | Arguments that don't start with a hyphen are taken to be the names of |
8ec8fbef |
1012 | subroutines to print the OPs of; if no such functions are specified, |
1013 | the main body of the program (outside any subroutines, and not |
19e169bf |
1014 | including use'd or require'd files) is rendered. Passing C<BEGIN>, |
8ec8fbef |
1015 | C<CHECK>, C<INIT>, or C<END> will cause all of the corresponding |
1016 | special blocks to be printed. |
c99ca59a |
1017 | |
724aa791 |
1018 | Options affect how things are rendered (ie printed). They're presented |
1019 | here by their visual effect, 1st being strongest. They're grouped |
1020 | according to how they interrelate; within each group the options are |
1021 | mutually exclusive (unless otherwise stated). |
1022 | |
1023 | =head2 Options for Opcode Ordering |
1024 | |
1025 | These options control the 'vertical display' of opcodes. The display |
1026 | 'order' is also called 'mode' elsewhere in this document. |
1027 | |
c99ca59a |
1028 | =over 4 |
1029 | |
1030 | =item B<-basic> |
1031 | |
1032 | Print OPs in the order they appear in the OP tree (a preorder |
1033 | traversal, starting at the root). The indentation of each OP shows its |
19e169bf |
1034 | level in the tree, and the '->' at the end of the line indicates the |
1035 | next opcode in execution order. This mode is the default, so the flag |
1036 | is included simply for completeness. |
c99ca59a |
1037 | |
1038 | =item B<-exec> |
1039 | |
1040 | Print OPs in the order they would normally execute (for the majority |
1041 | of constructs this is a postorder traversal of the tree, ending at the |
1042 | root). In most cases the OP that usually follows a given OP will |
1043 | appear directly below it; alternate paths are shown by indentation. In |
1044 | cases like loops when control jumps out of a linear path, a 'goto' |
1045 | line is generated. |
1046 | |
1047 | =item B<-tree> |
1048 | |
1049 | Print OPs in a text approximation of a tree, with the root of the tree |
1050 | at the left and 'left-to-right' order of children transformed into |
1051 | 'top-to-bottom'. Because this mode grows both to the right and down, |
1052 | it isn't suitable for large programs (unless you have a very wide |
1053 | terminal). |
1054 | |
724aa791 |
1055 | =back |
1056 | |
1057 | =head2 Options for Line-Style |
1058 | |
1059 | These options select the line-style (or just style) used to render |
1060 | each opcode, and dictates what info is actually printed into each line. |
1061 | |
1062 | =over 4 |
1063 | |
1064 | =item B<-concise> |
1065 | |
1066 | Use the author's favorite set of formatting conventions. This is the |
1067 | default, of course. |
1068 | |
1069 | =item B<-terse> |
1070 | |
1071 | Use formatting conventions that emulate the output of B<B::Terse>. The |
1072 | basic mode is almost indistinguishable from the real B<B::Terse>, and the |
1073 | exec mode looks very similar, but is in a more logical order and lacks |
1074 | curly brackets. B<B::Terse> doesn't have a tree mode, so the tree mode |
1075 | is only vaguely reminiscent of B<B::Terse>. |
1076 | |
1077 | =item B<-linenoise> |
1078 | |
1079 | Use formatting conventions in which the name of each OP, rather than being |
1080 | written out in full, is represented by a one- or two-character abbreviation. |
1081 | This is mainly a joke. |
1082 | |
1083 | =item B<-debug> |
1084 | |
1085 | Use formatting conventions reminiscent of B<B::Debug>; these aren't |
1086 | very concise at all. |
1087 | |
1088 | =item B<-env> |
1089 | |
1090 | Use formatting conventions read from the environment variables |
1091 | C<B_CONCISE_FORMAT>, C<B_CONCISE_GOTO_FORMAT>, and C<B_CONCISE_TREE_FORMAT>. |
1092 | |
1093 | =back |
1094 | |
1095 | =head2 Options for tree-specific formatting |
1096 | |
1097 | =over 4 |
1098 | |
c99ca59a |
1099 | =item B<-compact> |
1100 | |
1101 | Use a tree format in which the minimum amount of space is used for the |
1102 | lines connecting nodes (one character in most cases). This squeezes out |
1103 | a few precious columns of screen real estate. |
1104 | |
1105 | =item B<-loose> |
1106 | |
1107 | Use a tree format that uses longer edges to separate OP nodes. This format |
1108 | tends to look better than the compact one, especially in ASCII, and is |
1109 | the default. |
1110 | |
1111 | =item B<-vt> |
1112 | |
1113 | Use tree connecting characters drawn from the VT100 line-drawing set. |
1114 | This looks better if your terminal supports it. |
1115 | |
1116 | =item B<-ascii> |
1117 | |
1118 | Draw the tree with standard ASCII characters like C<+> and C<|>. These don't |
1119 | look as clean as the VT100 characters, but they'll work with almost any |
1120 | terminal (or the horizontal scrolling mode of less(1)) and are suitable |
1121 | for text documentation or email. This is the default. |
1122 | |
724aa791 |
1123 | =back |
c99ca59a |
1124 | |
724aa791 |
1125 | These are pairwise exclusive, i.e. compact or loose, vt or ascii. |
1126 | |
1127 | =head2 Options controlling sequence numbering |
1128 | |
1129 | =over 4 |
c99ca59a |
1130 | |
1131 | =item B<-base>I<n> |
1132 | |
1133 | Print OP sequence numbers in base I<n>. If I<n> is greater than 10, the |
1134 | digit for 11 will be 'a', and so on. If I<n> is greater than 36, the digit |
1135 | for 37 will be 'A', and so on until 62. Values greater than 62 are not |
1136 | currently supported. The default is 36. |
1137 | |
1138 | =item B<-bigendian> |
1139 | |
1140 | Print sequence numbers with the most significant digit first. This is the |
1141 | usual convention for Arabic numerals, and the default. |
1142 | |
1143 | =item B<-littleendian> |
1144 | |
724aa791 |
1145 | Print seqence numbers with the least significant digit first. This is |
1146 | obviously mutually exclusive with bigendian. |
c99ca59a |
1147 | |
724aa791 |
1148 | =back |
c99ca59a |
1149 | |
724aa791 |
1150 | =head2 Other options |
c99ca59a |
1151 | |
cc02ea56 |
1152 | These are pairwise exclusive. |
1153 | |
724aa791 |
1154 | =over 4 |
c99ca59a |
1155 | |
724aa791 |
1156 | =item B<-main> |
c99ca59a |
1157 | |
724aa791 |
1158 | Include the main program in the output, even if subroutines were also |
cc02ea56 |
1159 | specified. This rendering is normally suppressed when a subroutine |
1160 | name or reference is given. |
1161 | |
1162 | =item B<-nomain> |
1163 | |
1164 | This restores the default behavior after you've changed it with '-main' |
1165 | (it's not normally needed). If no subroutine name/ref is given, main is |
1166 | rendered, regardless of this flag. |
1167 | |
1168 | =item B<-nobanner> |
1169 | |
1170 | Renderings usually include a banner line identifying the function name |
1171 | or stringified subref. This suppresses the printing of the banner. |
1172 | |
1173 | TBC: Remove the stringified coderef; while it provides a 'cookie' for |
1174 | each function rendered, the cookies used should be 1,2,3.. not a |
1175 | random hex-address. It also complicates string comparison of two |
1176 | different trees. |
c99ca59a |
1177 | |
724aa791 |
1178 | =item B<-banner> |
c99ca59a |
1179 | |
cc02ea56 |
1180 | restores default banner behavior. |
1181 | |
1182 | =item B<-banneris> => subref |
1183 | |
1184 | TBC: a hookpoint (and an option to set it) for a user-supplied |
1185 | function to produce a banner appropriate for users needs. It's not |
1186 | ideal, because the rendering-state variables, which are a natural |
1187 | candidate for use in concise.t, are unavailable to the user. |
c99ca59a |
1188 | |
724aa791 |
1189 | =back |
c99ca59a |
1190 | |
724aa791 |
1191 | =head2 Option Stickiness |
c99ca59a |
1192 | |
724aa791 |
1193 | If you invoke Concise more than once in a program, you should know that |
1194 | the options are 'sticky'. This means that the options you provide in |
1195 | the first call will be remembered for the 2nd call, unless you |
1196 | re-specify or change them. |
c99ca59a |
1197 | |
cc02ea56 |
1198 | =head1 ABBREVIATIONS |
1199 | |
1200 | The concise style uses symbols to convey maximum info with minimal |
1201 | clutter (like hex addresses). With just a little practice, you can |
1202 | start to see the flowers, not just the branches, in the trees. |
1203 | |
1204 | =head2 OP class abbreviations |
1205 | |
1206 | These symbols appear before the op-name, and indicate the |
1207 | B:: namespace that represents the ops in your Perl code. |
1208 | |
1209 | 0 OP (aka BASEOP) An OP with no children |
1210 | 1 UNOP An OP with one child |
1211 | 2 BINOP An OP with two children |
1212 | | LOGOP A control branch OP |
1213 | @ LISTOP An OP that could have lots of children |
1214 | / PMOP An OP with a regular expression |
1215 | $ SVOP An OP with an SV |
1216 | " PVOP An OP with a string |
1217 | { LOOP An OP that holds pointers for a loop |
1218 | ; COP An OP that marks the start of a statement |
1219 | # PADOP An OP with a GV on the pad |
1220 | |
1221 | =head2 OP flags abbreviations |
1222 | |
19e169bf |
1223 | OP flags are either public or private. The public flags alter the |
1224 | behavior of each opcode in consistent ways, and are represented by 0 |
1225 | or more single characters. |
cc02ea56 |
1226 | |
1227 | v OPf_WANT_VOID Want nothing (void context) |
1228 | s OPf_WANT_SCALAR Want single value (scalar context) |
1229 | l OPf_WANT_LIST Want list of any length (list context) |
19e169bf |
1230 | Want is unknown |
cc02ea56 |
1231 | K OPf_KIDS There is a firstborn child. |
1232 | P OPf_PARENS This operator was parenthesized. |
1233 | (Or block needs explicit scope entry.) |
1234 | R OPf_REF Certified reference. |
1235 | (Return container, not containee). |
1236 | M OPf_MOD Will modify (lvalue). |
1237 | S OPf_STACKED Some arg is arriving on the stack. |
1238 | * OPf_SPECIAL Do something weird for this op (see op.h) |
1239 | |
19e169bf |
1240 | Private flags, if any are set for an opcode, are displayed after a '/' |
1241 | |
1242 | 8 <@> leave[1 ref] vKP/REFC ->(end) |
1243 | 7 <2> sassign vKS/2 ->8 |
1244 | |
1245 | They're opcode specific, and occur less often than the public ones, so |
1246 | they're represented by short mnemonics instead of single-chars; see |
1247 | L<op.h> for gory details, or try this quick 2-liner: |
1248 | |
1249 | $> perl -MB::Concise -de 1 |
1250 | DB<1> |x \%B::Concise::priv |
1251 | |
c99ca59a |
1252 | =head1 FORMATTING SPECIFICATIONS |
1253 | |
724aa791 |
1254 | For each line-style ('concise', 'terse', 'linenoise', etc.) there are |
1255 | 3 format-specs which control how OPs are rendered. |
1256 | |
1257 | The first is the 'default' format, which is used in both basic and exec |
1258 | modes to print all opcodes. The 2nd, goto-format, is used in exec |
1259 | mode when branches are encountered. They're not real opcodes, and are |
1260 | inserted to look like a closing curly brace. The tree-format is tree |
1261 | specific. |
1262 | |
cc02ea56 |
1263 | When a line is rendered, the correct format-spec is copied and scanned |
1264 | for the following items; data is substituted in, and other |
1265 | manipulations like basic indenting are done, for each opcode rendered. |
1266 | |
1267 | There are 3 kinds of items that may be populated; special patterns, |
1268 | #vars, and literal text, which is copied verbatim. (Yes, it's a set |
1269 | of s///g steps.) |
1270 | |
1271 | =head2 Special Patterns |
1272 | |
1273 | These items are the primitives used to perform indenting, and to |
1274 | select text from amongst alternatives. |
c99ca59a |
1275 | |
1276 | =over 4 |
1277 | |
1278 | =item B<(x(>I<exec_text>B<;>I<basic_text>B<)x)> |
1279 | |
1280 | Generates I<exec_text> in exec mode, or I<basic_text> in basic mode. |
1281 | |
1282 | =item B<(*(>I<text>B<)*)> |
1283 | |
1284 | Generates one copy of I<text> for each indentation level. |
1285 | |
1286 | =item B<(*(>I<text1>B<;>I<text2>B<)*)> |
1287 | |
1288 | Generates one fewer copies of I<text1> than the indentation level, followed |
1289 | by one copy of I<text2> if the indentation level is more than 0. |
1290 | |
1291 | =item B<(?(>I<text1>B<#>I<var>I<Text2>B<)?)> |
1292 | |
1293 | If the value of I<var> is true (not empty or zero), generates the |
1294 | value of I<var> surrounded by I<text1> and I<Text2>, otherwise |
1295 | nothing. |
1296 | |
cc02ea56 |
1297 | =item B<~> |
1298 | |
1299 | Any number of tildes and surrounding whitespace will be collapsed to |
1300 | a single space. |
1301 | |
1302 | =back |
1303 | |
1304 | =head2 # Variables |
1305 | |
1306 | These #vars represent opcode properties that you may want as part of |
1307 | your rendering. The '#' is intended as a private sigil; a #var's |
1308 | value is interpolated into the style-line, much like "read $this". |
1309 | |
1310 | These vars take 3 forms: |
1311 | |
1312 | =over 4 |
1313 | |
c99ca59a |
1314 | =item B<#>I<var> |
1315 | |
cc02ea56 |
1316 | A property named 'var' is assumed to exist for the opcodes, and is |
1317 | interpolated into the rendering. |
c99ca59a |
1318 | |
1319 | =item B<#>I<var>I<N> |
1320 | |
cc02ea56 |
1321 | Generates the value of I<var>, left justified to fill I<N> spaces. |
1322 | Note that this means while you can have properties 'foo' and 'foo2', |
1323 | you cannot render 'foo2', but you could with 'foo2a'. You would be |
1324 | wise not to rely on this behavior going forward ;-) |
c99ca59a |
1325 | |
cc02ea56 |
1326 | =item B<#>I<Var> |
c99ca59a |
1327 | |
cc02ea56 |
1328 | This ucfirst form of #var generates a tag-value form of itself for |
1329 | display; it converts '#Var' into a 'Var => #var' style, which is then |
1330 | handled as described above. (Imp-note: #Vars cannot be used for |
1331 | conditional-fills, because the => #var transform is done after the check |
1332 | for #Var's value). |
c99ca59a |
1333 | |
1334 | =back |
1335 | |
cc02ea56 |
1336 | The following variables are 'defined' by B::Concise; when they are |
1337 | used in a style, their respective values are plugged into the |
1338 | rendering of each opcode. |
1339 | |
1340 | Only some of these are used by the standard styles, the others are |
1341 | provided for you to delve into optree mechanics, should you wish to |
1342 | add a new style (see L</add_style> below) that uses them. You can |
1343 | also add new ones using L<add_callback>. |
c99ca59a |
1344 | |
1345 | =over 4 |
1346 | |
1347 | =item B<#addr> |
1348 | |
cc02ea56 |
1349 | The address of the OP, in hexadecimal. |
c99ca59a |
1350 | |
1351 | =item B<#arg> |
1352 | |
1353 | The OP-specific information of the OP (such as the SV for an SVOP, the |
cc02ea56 |
1354 | non-local exit pointers for a LOOP, etc.) enclosed in parentheses. |
c99ca59a |
1355 | |
1356 | =item B<#class> |
1357 | |
1358 | The B-determined class of the OP, in all caps. |
1359 | |
f8a679e6 |
1360 | =item B<#classsym> |
c99ca59a |
1361 | |
1362 | A single symbol abbreviating the class of the OP. |
1363 | |
c3caa09d |
1364 | =item B<#coplabel> |
1365 | |
1366 | The label of the statement or block the OP is the start of, if any. |
1367 | |
c99ca59a |
1368 | =item B<#exname> |
1369 | |
1370 | The name of the OP, or 'ex-foo' if the OP is a null that used to be a foo. |
1371 | |
1372 | =item B<#extarg> |
1373 | |
1374 | The target of the OP, or nothing for a nulled OP. |
1375 | |
1376 | =item B<#firstaddr> |
1377 | |
19e169bf |
1378 | The address of the OP's first child, in hexadecimal. |
c99ca59a |
1379 | |
1380 | =item B<#flags> |
1381 | |
1382 | The OP's flags, abbreviated as a series of symbols. |
1383 | |
1384 | =item B<#flagval> |
1385 | |
1386 | The numeric value of the OP's flags. |
1387 | |
f8a679e6 |
1388 | =item B<#hyphseq> |
c99ca59a |
1389 | |
1390 | The sequence number of the OP, or a hyphen if it doesn't have one. |
1391 | |
1392 | =item B<#label> |
1393 | |
1394 | 'NEXT', 'LAST', or 'REDO' if the OP is a target of one of those in exec |
1395 | mode, or empty otherwise. |
1396 | |
1397 | =item B<#lastaddr> |
1398 | |
19e169bf |
1399 | The address of the OP's last child, in hexadecimal. |
c99ca59a |
1400 | |
1401 | =item B<#name> |
1402 | |
1403 | The OP's name. |
1404 | |
1405 | =item B<#NAME> |
1406 | |
1407 | The OP's name, in all caps. |
1408 | |
1409 | =item B<#next> |
1410 | |
1411 | The sequence number of the OP's next OP. |
1412 | |
1413 | =item B<#nextaddr> |
1414 | |
19e169bf |
1415 | The address of the OP's next OP, in hexadecimal. |
c99ca59a |
1416 | |
1417 | =item B<#noise> |
1418 | |
c27ea44e |
1419 | A one- or two-character abbreviation for the OP's name. |
c99ca59a |
1420 | |
1421 | =item B<#private> |
1422 | |
1423 | The OP's private flags, rendered with abbreviated names if possible. |
1424 | |
1425 | =item B<#privval> |
1426 | |
1427 | The numeric value of the OP's private flags. |
1428 | |
1429 | =item B<#seq> |
1430 | |
2814eb74 |
1431 | The sequence number of the OP. Note that this is a sequence number |
1432 | generated by B::Concise. |
c99ca59a |
1433 | |
7252851f |
1434 | =item B<#seqnum> |
1435 | |
1436 | 5.8.x and earlier only. 5.9 and later do not provide this. |
1437 | |
1438 | The real sequence number of the OP, as a regular number and not adjusted |
1439 | to be relative to the start of the real program. (This will generally be |
1440 | a fairly large number because all of B<B::Concise> is compiled before |
1441 | your program is). |
1442 | |
2814eb74 |
1443 | =item B<#opt> |
c99ca59a |
1444 | |
2814eb74 |
1445 | Whether or not the op has been optimised by the peephole optimiser. |
1446 | |
7252851f |
1447 | Only available in 5.9 and later. |
1448 | |
2814eb74 |
1449 | =item B<#static> |
1450 | |
1451 | Whether or not the op is statically defined. This flag is used by the |
1452 | B::C compiler backend and indicates that the op should not be freed. |
c99ca59a |
1453 | |
7252851f |
1454 | Only available in 5.9 and later. |
1455 | |
c99ca59a |
1456 | =item B<#sibaddr> |
1457 | |
19e169bf |
1458 | The address of the OP's next youngest sibling, in hexadecimal. |
c99ca59a |
1459 | |
1460 | =item B<#svaddr> |
1461 | |
19e169bf |
1462 | The address of the OP's SV, if it has an SV, in hexadecimal. |
c99ca59a |
1463 | |
1464 | =item B<#svclass> |
1465 | |
1466 | The class of the OP's SV, if it has one, in all caps (e.g., 'IV'). |
1467 | |
1468 | =item B<#svval> |
1469 | |
1470 | The value of the OP's SV, if it has one, in a short human-readable format. |
1471 | |
1472 | =item B<#targ> |
1473 | |
1474 | The numeric value of the OP's targ. |
1475 | |
1476 | =item B<#targarg> |
1477 | |
1478 | The name of the variable the OP's targ refers to, if any, otherwise the |
1479 | letter t followed by the OP's targ in decimal. |
1480 | |
1481 | =item B<#targarglife> |
1482 | |
1483 | Same as B<#targarg>, but followed by the COP sequence numbers that delimit |
1484 | the variable's lifetime (or 'end' for a variable in an open scope) for a |
1485 | variable. |
1486 | |
1487 | =item B<#typenum> |
1488 | |
1489 | The numeric value of the OP's type, in decimal. |
1490 | |
1491 | =back |
1492 | |
78ad9108 |
1493 | =head1 Using B::Concise outside of the O framework |
1494 | |
cc02ea56 |
1495 | The common (and original) usage of B::Concise was for command-line |
1496 | renderings of simple code, as given in EXAMPLE. But you can also use |
1497 | B<B::Concise> from your code, and call compile() directly, and |
724aa791 |
1498 | repeatedly. By doing so, you can avoid the compile-time only |
cc02ea56 |
1499 | operation of O.pm, and even use the debugger to step through |
1500 | B::Concise::compile() itself. |
f95e3c3c |
1501 | |
cc02ea56 |
1502 | Once you're doing this, you may alter Concise output by adding new |
1503 | rendering styles, and by optionally adding callback routines which |
1504 | populate new variables, if such were referenced from those (just |
1505 | added) styles. |
f95e3c3c |
1506 | |
724aa791 |
1507 | =head2 Example: Altering Concise Renderings |
78ad9108 |
1508 | |
1509 | use B::Concise qw(set_style add_callback); |
cc02ea56 |
1510 | add_style($yourStyleName => $defaultfmt, $gotofmt, $treefmt); |
78ad9108 |
1511 | add_callback |
f95e3c3c |
1512 | ( sub { |
1513 | my ($h, $op, $format, $level, $stylename) = @_; |
78ad9108 |
1514 | $h->{variable} = some_func($op); |
cc02ea56 |
1515 | }); |
1516 | $walker = B::Concise::compile(@options,@subnames,@subrefs); |
1517 | $walker->(); |
78ad9108 |
1518 | |
f95e3c3c |
1519 | =head2 set_style() |
1520 | |
724aa791 |
1521 | B<set_style> accepts 3 arguments, and updates the three format-specs |
1522 | comprising a line-style (basic-exec, goto, tree). It has one minor |
1523 | drawback though; it doesn't register the style under a new name. This |
1524 | can become an issue if you render more than once and switch styles. |
1525 | Thus you may prefer to use add_style() and/or set_style_standard() |
1526 | instead. |
1527 | |
1528 | =head2 set_style_standard($name) |
1529 | |
1530 | This restores one of the standard line-styles: C<terse>, C<concise>, |
1531 | C<linenoise>, C<debug>, C<env>, into effect. It also accepts style |
1532 | names previously defined with add_style(). |
f95e3c3c |
1533 | |
1534 | =head2 add_style() |
78ad9108 |
1535 | |
f95e3c3c |
1536 | This subroutine accepts a new style name and three style arguments as |
1537 | above, and creates, registers, and selects the newly named style. It is |
1538 | an error to re-add a style; call set_style_standard() to switch between |
1539 | several styles. |
1540 | |
f95e3c3c |
1541 | =head2 add_callback() |
1542 | |
19e169bf |
1543 | If your newly minted styles refer to any new #variables, you'll need |
1544 | to define a callback subroutine that will populate (or modify) those |
1545 | variables. They are then available for use in the style you've |
1546 | chosen. |
f95e3c3c |
1547 | |
1548 | The callbacks are called for each opcode visited by Concise, in the |
1549 | same order as they are added. Each subroutine is passed five |
1550 | parameters. |
1551 | |
1552 | 1. A hashref, containing the variable names and values which are |
1553 | populated into the report-line for the op |
1554 | 2. the op, as a B<B::OP> object |
1555 | 3. a reference to the format string |
1556 | 4. the formatting (indent) level |
1557 | 5. the selected stylename |
78ad9108 |
1558 | |
1559 | To define your own variables, simply add them to the hash, or change |
1560 | existing values if you need to. The level and format are passed in as |
1561 | references to scalars, but it is unlikely that they will need to be |
1562 | changed or even used. |
1563 | |
724aa791 |
1564 | =head2 Running B::Concise::compile() |
f95e3c3c |
1565 | |
1566 | B<compile> accepts options as described above in L</OPTIONS>, and |
1567 | arguments, which are either coderefs, or subroutine names. |
1568 | |
cc02ea56 |
1569 | It constructs and returns a $treewalker coderef, which when invoked, |
1570 | traverses, or walks, and renders the optrees of the given arguments to |
1571 | STDOUT. You can reuse this, and can change the rendering style used |
1572 | each time; thereafter the coderef renders in the new style. |
f95e3c3c |
1573 | |
1574 | B<walk_output> lets you change the print destination from STDOUT to |
19e169bf |
1575 | another open filehandle, or into a string passed as a ref (unless |
1576 | you've built perl with -Uuseperlio). |
f95e3c3c |
1577 | |
cc02ea56 |
1578 | my $walker = B::Concise::compile('-terse','aFuncName', \&aSubRef); # 1 |
f95e3c3c |
1579 | walk_output(\my $buf); |
cc02ea56 |
1580 | $walker->(); # 1 renders -terse |
1581 | set_style_standard('concise'); # 2 |
1582 | $walker->(); # 2 renders -concise |
1583 | $walker->(@new); # 3 renders whatever |
1584 | print "3 different renderings: terse, concise, and @new: $buf\n"; |
1585 | |
1586 | When $walker is called, it traverses the subroutines supplied when it |
1587 | was created, and renders them using the current style. You can change |
1588 | the style afterwards in several different ways: |
1589 | |
1590 | 1. call C<compile>, altering style or mode/order |
1591 | 2. call C<set_style_standard> |
1592 | 3. call $walker, passing @new options |
1593 | |
1594 | Passing new options to the $walker is the easiest way to change |
1595 | amongst any pre-defined styles (the ones you add are automatically |
1596 | recognized as options), and is the only way to alter rendering order |
1597 | without calling compile again. Note however that rendering state is |
1598 | still shared amongst multiple $walker objects, so they must still be |
1599 | used in a coordinated manner. |
f95e3c3c |
1600 | |
1601 | =head2 B::Concise::reset_sequence() |
1602 | |
1603 | This function (not exported) lets you reset the sequence numbers (note |
1604 | that they're numbered arbitrarily, their goal being to be human |
1605 | readable). Its purpose is mostly to support testing, i.e. to compare |
1606 | the concise output from two identical anonymous subroutines (but |
1607 | different instances). Without the reset, B::Concise, seeing that |
1608 | they're separate optrees, generates different sequence numbers in |
1609 | the output. |
1610 | |
1611 | =head2 Errors |
1612 | |
1613 | All detected errors, (invalid arguments, internal errors, etc.) are |
1614 | resolved with a die($message). Use an eval if you wish to catch these |
1615 | errors and continue processing. |
31b49ad4 |
1616 | |
724aa791 |
1617 | In particular, B<compile> will die if you've asked for a non-existent |
1618 | function-name, a non-existent coderef, or a non-CODE reference. |
78ad9108 |
1619 | |
c99ca59a |
1620 | =head1 AUTHOR |
1621 | |
31b49ad4 |
1622 | Stephen McCamant, E<lt>smcc@CSUA.Berkeley.EDUE<gt>. |
c99ca59a |
1623 | |
1624 | =cut |