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