This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Quote and indent %B::Concise::priv initialisation consistently
[perl5.git] / ext / B / B / Concise.pm
CommitLineData
c99ca59a 1package 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
12use strict; # use #2
13use warnings; # uses #3 and #4, since warnings uses Carp
78ad9108 14
8ec8fbef
SM
15use Exporter (); # use #5
16
8c1a7e35 17our $VERSION = "0.98";
78ad9108 18our @ISA = qw(Exporter);
cc02ea56
JC
19our @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 );
22our %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 29use 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 33my %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:
62our $stylename; # selects current style from %style
63my $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
68my ($format, $gotofmt, $treefmt);
69
70# lesser players:
71my $base = 36; # how <sequence#> is displayed
72my $big_endian = 1; # more <sequence#> display
73my $tree_style = 0; # tree-order details
74my $banner = 1; # print banner before optree is traversed
cc02ea56 75my $do_main = 0; # force printing of main routine
f18deeb9 76my $show_src; # show source code
724aa791 77
cc02ea56 78# another factor: can affect all styles!
724aa791
JC
79our @callbacks; # allow external management
80
81set_style_standard("concise");
82
c99ca59a 83my $curcv;
c27ea44e 84my $cop_seq_base;
78ad9108
PJ
85
86sub 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
92sub 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 101sub 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
107sub add_callback {
108 push @callbacks, @_;
109}
c99ca59a 110
f95e3c3c 111# output handle, used with all Concise-output printing
cc02ea56
JC
112our $walkHandle; # public for your convenience
113BEGIN { $walkHandle = \*STDOUT }
f95e3c3c
JC
114
115sub 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 134sub 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
143sub 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
163sub 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
207sub 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
224sub 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
239my $start_sym = "\e(0"; # "\cN" sometimes also works
240my $end_sym = "\e(B"; # "\cO" respectively
241
f95e3c3c 242my @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
249my @render_packs; # collect -stash=<packages>
250
cc02ea56
JC
251sub 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
326sub 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
397my %labels;
724aa791 398my $lastnext; # remembers op-chain, used to insert gotos
c99ca59a
SM
399
400my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|",
401 'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*",
051f02e9 402 'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#");
c99ca59a 403
8ec8fbef 404no warnings 'qw'; # "Possible attempt to put comments..."; use #7
35fc55f1
RH
405my @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
422my $chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
423
19e169bf 424sub 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
439sub 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
448my %sequence_num;
449my $seq_max = 1;
450
f95e3c3c
JC
451sub reset_sequence {
452 # reset the sequence
453 %sequence_num = ();
454 $seq_max = 1;
cc02ea56 455 $lastnext = 0;
f95e3c3c
JC
456}
457
c27ea44e
SM
458sub seq {
459 my($op) = @_;
460 return "-" if not exists $sequence_num{$$op};
461 return base_n($sequence_num{$$op});
462}
c99ca59a
SM
463
464sub 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
482sub 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
493sub 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()
522sub 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 557sub 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
594our %priv; # used to display each opcode's BASEOP.op_private values
595
c99ca59a 596$priv{$_}{128} = "LVINTRO"
8c1a7e35
DIM
597 for qw(pos substr vec threadsv gvsv rv2sv rv2hv rv2gv rv2av rv2arylen
598 aelem helem aslice hslice padsv padav padhv enteriter entersub
599 padrange pushmark);
600$priv{$_}{64} = "REFC" for qw(leave leavesub leavesublv leavewrite);
601@{$priv{aassign}}{32,64} = qw(STATE COMMON);
602@{$priv{sassign}}{32,64,128} = qw(STATE BKWARD CV2GV);
603$priv{$_}{64} = "RTIME" for qw(match subst substcont qr);
604@{$priv{$_}}{1,2,4,8,16,64} = qw(<UTF >UTF IDENT SQUASH DEL COMPL GROWS)
605 for qw(trans transr);
606$priv{repeat}{64} = "DOLIST";
607$priv{leaveloop}{64} = "CONT";
608$priv{$_}{4} = "DREFed" for qw(rv2sv rv2av rv2hv);
609@{$priv{$_}}{32,64,96} = qw(DREFAV DREFHV DREFSV)
610 for qw(rv2gv rv2sv padsv aelem helem);
611$priv{$_}{16} = "STATE" for qw(padav padhv padsv);
612@{$priv{rv2gv}}{4,16} = qw(NOINIT FAKE);
613@{$priv{entersub}}{1,4,16,32,64} = qw(INARGS TARG DBG DEREF);
614@{$priv{rv2cv}}{1,8,128} = qw(CONST AMPER NO());
615$priv{gv}{32} = "EARLYCV";
616$priv{$_}{16} = "LVDEFER" for qw(aelem helem);
617$priv{$_}{16} = "OURINTR" for qw(gvsv rv2sv rv2av rv2hv r2gv enteriter);
618$priv{$_}{8} = "LVSUB"
619 for qw(rv2av rv2gv rv2hv padav padhv aelem helem aslice hslice
620 av2arylen keys rkeys substr pos vec);
621@{$priv{$_}}{32,64} = qw(BOOL BOOL?) for qw(rv2hv padhv);
622$priv{substr}{16} = "REPL1ST";
c99ca59a 623$priv{$_}{16} = "TARGMY"
8c1a7e35
DIM
624 for map(($_,"s$_"), qw(chop chomp)),
625 map(($_,"i_$_"), qw(postinc postdec multiply divide modulo add
626 subtract negate)),
627 qw(pow concat stringify left_shift right_shift bit_and bit_xor
628 bit_or complement atan2 sin cos rand exp log sqrt int hex oct
629 abs length index rindex sprintf ord chr crypt quotemeta join
630 push unshift flock chdir chown chroot unlink chmod utime rename
631 link symlink mkdir rmdir wait waitpid system exec kill getppid
632 getpgrp setpgrp getpriority setpriority time sleep);
633$priv{$_}{4} = "REVERSED" for qw(enteriter iter);
634@{$priv{const}}{2,4,8,16,64,128} = qw(NOVER SHORT STRICT ENTERED BARE FOLD);
635$priv{$_}{64} = "LINENUM" for qw(flip flop);
636$priv{list}{64} = "GUESSED";
637$priv{delete}{64} = "SLICE";
638$priv{exists}{64} = "SUB";
639@{$priv{sort}}{1,2,4,8,16,32,64} = qw(NUM INT REV INPLACE DESC QSORT STABLE);
640$priv{reverse}{8} = "INPLACE";
641$priv{threadsv}{64} = "SVREFd";
642@{$priv{$_}}{16,32,64,128} = qw(INBIN INCR OUTBIN OUTCR)
643 for qw(open backtick);
644$priv{exit}{128} = "VMS";
feaeca78 645$priv{$_}{2} = "FTACCESS"
8c1a7e35
DIM
646 for qw(ftrread ftrwrite ftrexec fteread ftewrite fteexec);
647@{$priv{entereval}}{2,4,8,16} = qw(HAS_HH UNI BYTES COPHH);
648@{$priv{$_}}{4,8,16} = qw(FTSTACKED FTSTACKING FTAFTERt)
649 for qw(ftrread ftrwrite ftrexec fteread ftewrite fteexec ftis fteowned
650 ftrowned ftzero ftsize ftmtime ftatime ftctime ftsock ftchr
651 ftblk ftfile ftdir ftpipe ftlink ftsuid ftsgid ftsvtx fttty
652 fttext ftbinary);
35633035 653$priv{$_}{2} = "GREPLEX"
8c1a7e35
DIM
654 for qw(mapwhile mapstart grepwhile grepstart);
655$priv{$_}{128} = "+1" for qw(caller wantarray runcv);
656@{$priv{coreargs}}{1,2,64,128} = qw(DREF1 DREF2 $MOD MARK);
657$priv{$_}{128} = "UTF" for qw(last redo next goto dump);
658$priv{split}{128} = "IMPLIM";
c99ca59a 659
d5ec2987
NC
660our %hints; # used to display each COP's op_hints values
661
662# strict refs, subs, vars
894ea76b 663@hints{2,512,1024,32,64,128} = ('$', '&', '*', 'x$', 'x&', 'x*');
e1dccc0d
Z
664# integers, locale, bytes
665@hints{1,4,8,16} = ('i', 'l', 'b');
8b850bd5
NC
666# block scope, localise %^H, $^OPEN (in), $^OPEN (out)
667@hints{256,131072,262144,524288} = ('{','%','<','>');
d5ec2987
NC
668# overload new integer, float, binary, string, re
669@hints{4096,8192,16384,32768,65536} = ('I', 'F', 'B', 'S', 'R');
670# taint and eval
671@hints{1048576,2097152} = ('T', 'E');
584420f0
RGS
672# filetest access, UTF-8
673@hints{4194304,8388608} = ('X', 'U');
d5ec2987
NC
674
675sub _flags {
676 my($hash, $x) = @_;
c99ca59a 677 my @s;
d5ec2987
NC
678 for my $flag (sort {$b <=> $a} keys %$hash) {
679 if ($hash->{$flag} and $x & $flag and $x >= $flag) {
c99ca59a 680 $x -= $flag;
d5ec2987 681 push @s, $hash->{$flag};
c99ca59a
SM
682 }
683 }
684 push @s, $x if $x;
685 return join(",", @s);
686}
687
d5ec2987
NC
688sub private_flags {
689 my($name, $x) = @_;
690 _flags($priv{$name}, $x);
691}
692
693sub hints_flags {
694 my($x) = @_;
695 _flags(\%hints, $x);
696}
697
c27ea44e 698sub concise_sv {
2db5ca0a 699 my($sv, $hr, $preferpv) = @_;
c27ea44e 700 $hr->{svclass} = class($sv);
31b49ad4
SM
701 $hr->{svclass} = "UV"
702 if $hr->{svclass} eq "IV" and $sv->FLAGS & SVf_IVisUV;
5b493bdf 703 Carp::cluck("bad concise_sv: $sv") unless $sv and $$sv;
c27ea44e 704 $hr->{svaddr} = sprintf("%#x", $$sv);
50786ba8 705 if ($hr->{svclass} eq "GV" && $sv->isGV_with_GP()) {
c27ea44e 706 my $gv = $sv;
50786ba8 707 my $stash = $gv->STASH->NAME; if ($stash eq "main") {
c27ea44e
SM
708 $stash = "";
709 } else {
710 $stash = $stash . "::";
711 }
712 $hr->{svval} = "*$stash" . $gv->SAFENAME;
713 return "*$stash" . $gv->SAFENAME;
714 } else {
4df7f6af
NC
715 if ($] >= 5.011) {
716 while (class($sv) eq "IV" && $sv->FLAGS & SVf_ROK) {
717 $hr->{svval} .= "\\";
718 $sv = $sv->RV;
719 }
720 } else {
721 while (class($sv) eq "RV") {
722 $hr->{svval} .= "\\";
723 $sv = $sv->RV;
724 }
c27ea44e
SM
725 }
726 if (class($sv) eq "SPECIAL") {
40b5b14f 727 $hr->{svval} .= ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv];
8d919b0a
FC
728 } elsif ($preferpv
729 && ($sv->FLAGS & SVf_POK || class($sv) eq "REGEXP")) {
2db5ca0a 730 $hr->{svval} .= cstring($sv->PV);
c27ea44e 731 } elsif ($sv->FLAGS & SVf_NOK) {
40b5b14f 732 $hr->{svval} .= $sv->NV;
c27ea44e 733 } elsif ($sv->FLAGS & SVf_IOK) {
31b49ad4 734 $hr->{svval} .= $sv->int_value;
8d919b0a 735 } elsif ($sv->FLAGS & SVf_POK || class($sv) eq "REGEXP") {
40b5b14f 736 $hr->{svval} .= cstring($sv->PV);
31b49ad4
SM
737 } elsif (class($sv) eq "HV") {
738 $hr->{svval} .= 'HASH';
c27ea44e 739 }
cc02ea56
JC
740
741 $hr->{svval} = 'undef' unless defined $hr->{svval};
742 my $out = $hr->{svclass};
743 return $out .= " $hr->{svval}" ;
c27ea44e
SM
744 }
745}
746
f18deeb9
JC
747my %srclines;
748
749sub fill_srclines {
9e0f9750
JC
750 my $fullnm = shift;
751 if ($fullnm eq '-e') {
752 $srclines{$fullnm} = [ $fullnm, "-src not supported for -e" ];
753 return;
6cc5d258 754 }
9e0f9750 755 open (my $fh, '<', $fullnm)
6cc5d258 756 or warn "# $fullnm: $!, (chdirs not supported by this feature yet)\n"
f18deeb9
JC
757 and return;
758 my @l = <$fh>;
759 chomp @l;
9e0f9750
JC
760 unshift @l, $fullnm; # like @{_<$fullnm} in debug, array starts at 1
761 $srclines{$fullnm} = \@l;
f18deeb9
JC
762}
763
c99ca59a
SM
764sub concise_op {
765 my ($op, $level, $format) = @_;
766 my %h;
767 $h{exname} = $h{name} = $op->name;
768 $h{NAME} = uc $h{name};
769 $h{class} = class($op);
770 $h{extarg} = $h{targ} = $op->targ;
771 $h{extarg} = "" unless $h{extarg};
772 if ($h{name} eq "null" and $h{targ}) {
8ec8fbef 773 # targ holds the old type
c99ca59a
SM
774 $h{exname} = "ex-" . substr(ppname($h{targ}), 3);
775 $h{extarg} = "";
8ec8fbef
SM
776 } elsif ($op->name =~ /^leave(sub(lv)?|write)?$/) {
777 # targ potentially holds a reference count
778 if ($op->private & 64) {
779 my $refs = "ref" . ($h{targ} != 1 ? "s" : "");
780 $h{targarglife} = $h{targarg} = "$h{targ} $refs";
781 }
c99ca59a 782 } elsif ($h{targ}) {
a7fd8ef6
DM
783 my $count = $h{name} eq 'padrange' ? ($op->private & 127) : 1;
784 my (@targarg, @targarglife);
785 for my $i (0..$count-1) {
786 my ($targarg, $targarglife);
787 my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}+$i];
788 if (defined $padname and class($padname) ne "SPECIAL") {
789 $targarg = $padname->PVX;
790 if ($padname->FLAGS & SVf_FAKE) {
791 # These changes relate to the jumbo closure fix.
792 # See changes 19939 and 20005
793 my $fake = '';
794 $fake .= 'a'
795 if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_ANON;
796 $fake .= 'm'
797 if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_MULTI;
798 $fake .= ':' . $padname->PARENT_PAD_INDEX
799 if $curcv->CvFLAGS & CVf_ANON;
800 $targarglife = "$targarg:FAKE:$fake";
801 }
802 else {
803 my $intro = $padname->COP_SEQ_RANGE_LOW - $cop_seq_base;
804 my $finish = int($padname->COP_SEQ_RANGE_HIGH) - $cop_seq_base;
805 $finish = "end" if $finish == 999999999 - $cop_seq_base;
806 $targarglife = "$targarg:$intro,$finish";
807 }
808 } else {
809 $targarglife = $targarg = "t" . ($h{targ}+$i);
127212b2 810 }
a7fd8ef6
DM
811 push @targarg, $targarg;
812 push @targarglife, $targarglife;
c99ca59a 813 }
a7fd8ef6
DM
814 $h{targarg} = join '; ', @targarg;
815 $h{targarglife} = join '; ', @targarglife;
c99ca59a
SM
816 }
817 $h{arg} = "";
818 $h{svclass} = $h{svaddr} = $h{svval} = "";
819 if ($h{class} eq "PMOP") {
2721a2ca 820 my $extra = '';
c99ca59a 821 my $precomp = $op->precomp;
7a9b44b9 822 if (defined $precomp) {
c27ea44e
SM
823 $precomp = cstring($precomp); # Escape literal control sequences
824 $precomp = "/$precomp/";
825 } else {
826 $precomp = "";
7a9b44b9 827 }
2721a2ca
DM
828 if ($op->name eq 'subst') {
829 if (class($op->pmreplstart) ne "NULL") {
830 undef $lastnext;
831 $extra = " replstart->" . seq($op->pmreplstart);
832 }
833 }
834 elsif ($op->name eq 'pushre') {
b2a3cfdd 835 # with C<@stash_array = split(/pat/, str);>,
c6e79e55 836 # *stash_array is stored in /pat/'s pmreplroot.
2721a2ca
DM
837 my $gv = $op->pmreplroot;
838 if (!ref($gv)) {
839 # threaded: the value is actually a pad offset for where
840 # the GV is kept (op_pmtargetoff)
841 if ($gv) {
842 $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$gv]->NAME;
843 }
844 }
845 else {
846 # unthreaded: its a GV (if it exists)
847 $gv = (ref($gv) eq "B::GV") ? $gv->NAME : undef;
848 }
849 $extra = " => \@$gv" if $gv;
c99ca59a 850 }
2721a2ca 851 $h{arg} = "($precomp$extra)";
bb16bae8 852 } elsif ($h{class} eq "PVOP" and $h{name} !~ '^transr?\z') {
c99ca59a
SM
853 $h{arg} = '("' . $op->pv . '")';
854 $h{svval} = '"' . $op->pv . '"';
855 } elsif ($h{class} eq "COP") {
856 my $label = $op->label;
c3caa09d 857 $h{coplabel} = $label;
c99ca59a
SM
858 $label = $label ? "$label: " : "";
859 my $loc = $op->file;
9e0f9750 860 my $pathnm = $loc;
c99ca59a 861 $loc =~ s[.*/][];
9e0f9750
JC
862 my $ln = $op->line;
863 $loc .= ":$ln";
c99ca59a 864 my($stash, $cseq) = ($op->stash->NAME, $op->cop_seq - $cop_seq_base);
e1dccc0d 865 $h{arg} = "($label$stash $cseq $loc)";
f18deeb9 866 if ($show_src) {
9e0f9750 867 fill_srclines($pathnm) unless exists $srclines{$pathnm};
e9c69003
NC
868 # Would love to retain Jim's use of // but this code needs to be
869 # portable to 5.8.x
870 my $line = $srclines{$pathnm}[$ln];
871 $line = "-src unavailable under -e" unless defined $line;
872 $h{src} = "$ln: $line";
f18deeb9 873 }
c99ca59a
SM
874 } elsif ($h{class} eq "LOOP") {
875 $h{arg} = "(next->" . seq($op->nextop) . " last->" . seq($op->lastop)
876 . " redo->" . seq($op->redoop) . ")";
877 } elsif ($h{class} eq "LOGOP") {
878 undef $lastnext;
879 $h{arg} = "(other->" . seq($op->other) . ")";
5b493bdf
JC
880 }
881 elsif ($h{class} eq "SVOP" or $h{class} eq "PADOP") {
6a077020 882 unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) {
5b493bdf 883 my $idx = ($h{class} eq "SVOP") ? $op->targ : $op->padix;
2db5ca0a 884 my $preferpv = $h{name} eq "method_named";
5b493bdf
JC
885 if ($h{class} eq "PADOP" or !${$op->sv}) {
886 my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$idx];
2db5ca0a 887 $h{arg} = "[" . concise_sv($sv, \%h, $preferpv) . "]";
6a077020
DM
888 $h{targarglife} = $h{targarg} = "";
889 } else {
2db5ca0a 890 $h{arg} = "(" . concise_sv($op->sv, \%h, $preferpv) . ")";
6a077020 891 }
c99ca59a
SM
892 }
893 }
894 $h{seq} = $h{hyphseq} = seq($op);
895 $h{seq} = "" if $h{seq} eq "-";
35633035
DM
896 $h{opt} = $op->opt;
897 $h{label} = $labels{$$op};
c99ca59a
SM
898 $h{next} = $op->next;
899 $h{next} = (class($h{next}) eq "NULL") ? "(end)" : seq($h{next});
900 $h{nextaddr} = sprintf("%#x", $ {$op->next});
901 $h{sibaddr} = sprintf("%#x", $ {$op->sibling});
902 $h{firstaddr} = sprintf("%#x", $ {$op->first}) if $op->can("first");
903 $h{lastaddr} = sprintf("%#x", $ {$op->last}) if $op->can("last");
904
905 $h{classsym} = $opclass{$h{class}};
906 $h{flagval} = $op->flags;
907 $h{flags} = op_flags($op->flags);
908 $h{privval} = $op->private;
909 $h{private} = private_flags($h{name}, $op->private);
d5ec2987
NC
910 if ($op->can("hints")) {
911 $h{hintsval} = $op->hints;
912 $h{hints} = hints_flags($h{hintsval});
913 } else {
914 $h{hintsval} = $h{hints} = '';
915 }
c99ca59a 916 $h{addr} = sprintf("%#x", $$op);
c99ca59a
SM
917 $h{typenum} = $op->type;
918 $h{noise} = $linenoise[$op->type];
f95e3c3c 919
cc02ea56 920 return fmt_line(\%h, $op, $format, $level);
c99ca59a
SM
921}
922
923sub B::OP::concise {
924 my($op, $level) = @_;
925 if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
724aa791 926 # insert a 'goto' line
cc02ea56
JC
927 my $synth = {"seq" => seq($lastnext), "class" => class($lastnext),
928 "addr" => sprintf("%#x", $$lastnext),
929 "goto" => seq($lastnext), # simplify goto '-' removal
930 };
931 print $walkHandle fmt_line($synth, $op, $gotofmt, $level+1);
c99ca59a
SM
932 }
933 $lastnext = $op->next;
f95e3c3c 934 print $walkHandle concise_op($op, $level, $format);
c99ca59a
SM
935}
936
31b49ad4
SM
937# B::OP::terse (see Terse.pm) now just calls this
938sub b_terse {
939 my($op, $level) = @_;
940
941 # This isn't necessarily right, but there's no easy way to get
942 # from an OP to the right CV. This is a limitation of the
943 # ->terse() interface style, and there isn't much to do about
944 # it. In particular, we can die in concise_op if the main pad
945 # isn't long enough, or has the wrong kind of entries, compared to
946 # the pad a sub was compiled with. The fix for that would be to
947 # make a backwards compatible "terse" format that never even
948 # looked at the pad, just like the old B::Terse. I don't think
949 # that's worth the effort, though.
950 $curcv = main_cv unless $curcv;
951
952 if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
724aa791 953 # insert a 'goto'
31b49ad4
SM
954 my $h = {"seq" => seq($lastnext), "class" => class($lastnext),
955 "addr" => sprintf("%#x", $$lastnext)};
cc02ea56
JC
956 print # $walkHandle
957 fmt_line($h, $op, $style{"terse"}[1], $level+1);
31b49ad4
SM
958 }
959 $lastnext = $op->next;
cc02ea56
JC
960 print # $walkHandle
961 concise_op($op, $level, $style{"terse"}[0]);
31b49ad4
SM
962}
963
c99ca59a
SM
964sub tree {
965 my $op = shift;
966 my $level = shift;
967 my $style = $tree_decorations[$tree_style];
968 my($space, $single, $kids, $kid, $nokid, $last, $lead, $size) = @$style;
969 my $name = concise_op($op, $level, $treefmt);
970 if (not $op->flags & OPf_KIDS) {
971 return $name . "\n";
972 }
973 my @lines;
974 for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
975 push @lines, tree($kid, $level+1);
976 }
977 my $i;
978 for ($i = $#lines; substr($lines[$i], 0, 1) eq " "; $i--) {
979 $lines[$i] = $space . $lines[$i];
980 }
981 if ($i > 0) {
982 $lines[$i] = $last . $lines[$i];
983 while ($i-- > 1) {
984 if (substr($lines[$i], 0, 1) eq " ") {
985 $lines[$i] = $nokid . $lines[$i];
986 } else {
f95e3c3c 987 $lines[$i] = $kid . $lines[$i];
c99ca59a
SM
988 }
989 }
990 $lines[$i] = $kids . $lines[$i];
991 } else {
992 $lines[0] = $single . $lines[0];
993 }
994 return("$name$lead" . shift @lines,
995 map(" " x (length($name)+$size) . $_, @lines));
996}
997
213a1a26
SM
998# *** Warning: fragile kludge ahead ***
999# Because the B::* modules run in the same interpreter as the code
2814eb74
PJ
1000# they're compiling, their presence tends to distort the view we have of
1001# the code we're looking at. In particular, perl gives sequence numbers
1002# to COPs. If the program we're looking at were run on its own, this
1003# would start at 1. Because all of B::Concise and all the modules it
1004# uses are compiled first, though, by the time we get to the user's
1005# program the sequence number is already pretty high, which could be
1006# distracting if you're trying to tell OPs apart. Therefore we'd like to
1007# subtract an offset from all the sequence numbers we display, to
1008# restore the simpler view of the world. The trick is to know what that
1009# offset will be, when we're still compiling B::Concise! If we
213a1a26 1010# hardcoded a value, it would have to change every time B::Concise or
2814eb74
PJ
1011# other modules we use do. To help a little, what we do here is compile
1012# a little code at the end of the module, and compute the base sequence
1013# number for the user's program as being a small offset later, so all we
1014# have to worry about are changes in the offset.
7252851f
NC
1015
1016# [For 5.8.x and earlier perl is generating sequence numbers for all ops,
1017# and using them to reference labels]
1018
1019
213a1a26
SM
1020# When you say "perl -MO=Concise -e '$a'", the output should look like:
1021
1022# 4 <@> leave[t1] vKP/REFC ->(end)
1023# 1 <0> enter ->2
1024 #^ smallest OP sequence number should be 1
1025# 2 <;> nextstate(main 1 -e:1) v ->3
1026 # ^ smallest COP sequence number should be 1
1027# - <1> ex-rv2sv vK/1 ->4
1028# 3 <$> gvsv(*a) s ->4
1029
c27ea44e
SM
1030# If the second of the marked numbers there isn't 1, it means you need
1031# to update the corresponding magic number in the next line.
1032# Remember, this needs to stay the last things in the module.
e69a2255 1033
c27ea44e 1034# Why is this different for MacOS? Does it matter?
8ec8fbef 1035my $cop_seq_mnum = $^O eq 'MacOS' ? 12 : 11;
e69a2255 1036$cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum;
c99ca59a
SM
1037
10381;
1039
1040__END__
1041
1042=head1 NAME
1043
1044B::Concise - Walk Perl syntax tree, printing concise info about ops
1045
1046=head1 SYNOPSIS
1047
1048 perl -MO=Concise[,OPTIONS] foo.pl
1049
78ad9108
PJ
1050 use B::Concise qw(set_style add_callback);
1051
c99ca59a
SM
1052=head1 DESCRIPTION
1053
1054This compiler backend prints the internal OPs of a Perl program's syntax
1055tree in one of several space-efficient text formats suitable for debugging
1056the inner workings of perl or other compiler backends. It can print OPs in
1057the order they appear in the OP tree, in the order they will execute, or
1058in a text approximation to their tree structure, and the format of the
3c4b39be 1059information displayed is customizable. Its function is similar to that of
c99ca59a
SM
1060perl's B<-Dx> debugging flag or the B<B::Terse> module, but it is more
1061sophisticated and flexible.
1062
f8a679e6
RGS
1063=head1 EXAMPLE
1064
f9f861ec
JC
1065Here's two outputs (or 'renderings'), using the -exec and -basic
1066(i.e. default) formatting conventions on the same code snippet.
19e169bf
JC
1067
1068 % perl -MO=Concise,-exec -e '$a = $b + 42'
1069 1 <0> enter
1070 2 <;> nextstate(main 1 -e:1) v
1071 3 <#> gvsv[*b] s
1072 4 <$> const[IV 42] s
1073 * 5 <2> add[t3] sK/2
1074 6 <#> gvsv[*a] s
1075 7 <2> sassign vKS/2
1076 8 <@> leave[1 ref] vKP/REFC
1077
f9f861ec
JC
1078In this -exec rendering, each opcode is executed in the order shown.
1079The add opcode, marked with '*', is discussed in more detail.
19e169bf
JC
1080
1081The 1st column is the op's sequence number, starting at 1, and is
f9f861ec
JC
1082displayed in base 36 by default. Here they're purely linear; the
1083sequences are very helpful when looking at code with loops and
1084branches.
19e169bf
JC
1085
1086The symbol between angle brackets indicates the op's type, for
1087example; <2> is a BINOP, <@> a LISTOP, and <#> is a PADOP, which is
1088used in threaded perls. (see L</"OP class abbreviations">).
1089
f9f861ec 1090The opname, as in B<'add[t1]'>, may be followed by op-specific
19e169bf
JC
1091information in parentheses or brackets (ex B<'[t1]'>).
1092
f9f861ec 1093The op-flags (ex B<'sK/2'>) are described in (L</"OP flags
19e169bf 1094abbreviations">).
f8a679e6
RGS
1095
1096 % perl -MO=Concise -e '$a = $b + 42'
8ec8fbef 1097 8 <@> leave[1 ref] vKP/REFC ->(end)
f8a679e6
RGS
1098 1 <0> enter ->2
1099 2 <;> nextstate(main 1 -e:1) v ->3
1100 7 <2> sassign vKS/2 ->8
19e169bf 1101 * 5 <2> add[t1] sK/2 ->6
f8a679e6
RGS
1102 - <1> ex-rv2sv sK/1 ->4
1103 3 <$> gvsv(*b) s ->4
1104 4 <$> const(IV 42) s ->5
1105 - <1> ex-rv2sv sKRM*/1 ->7
1106 6 <$> gvsv(*a) s ->7
1107
19e169bf
JC
1108The default rendering is top-down, so they're not in execution order.
1109This form reflects the way the stack is used to parse and evaluate
1110expressions; the add operates on the two terms below it in the tree.
f8a679e6 1111
19e169bf
JC
1112Nullops appear as C<ex-opname>, where I<opname> is an op that has been
1113optimized away by perl. They're displayed with a sequence-number of
1114'-', because they are not executed (they don't appear in previous
1115example), they're printed here because they reflect the parse.
f8a679e6 1116
19e169bf
JC
1117The arrow points to the sequence number of the next op; they're not
1118displayed in -exec mode, for obvious reasons.
f8a679e6 1119
19e169bf
JC
1120Note that because this rendering was done on a non-threaded perl, the
1121PADOPs in the previous examples are now SVOPs, and some (but not all)
1122of the square brackets have been replaced by round ones. This is a
1123subtle feature to provide some visual distinction between renderings
1124on threaded and un-threaded perls.
f8a679e6 1125
f8a679e6 1126
c99ca59a
SM
1127=head1 OPTIONS
1128
1129Arguments that don't start with a hyphen are taken to be the names of
710ba574
FC
1130subroutines or formats to render; if no
1131such functions are specified, the main
9e0f9750
JC
1132body of the program (outside any subroutines, and not including use'd
1133or require'd files) is rendered. Passing C<BEGIN>, C<UNITCHECK>,
1134C<CHECK>, C<INIT>, or C<END> will cause all of the corresponding
1135special blocks to be printed. Arguments must follow options.
c99ca59a 1136
724aa791
JC
1137Options affect how things are rendered (ie printed). They're presented
1138here by their visual effect, 1st being strongest. They're grouped
1139according to how they interrelate; within each group the options are
1140mutually exclusive (unless otherwise stated).
1141
1142=head2 Options for Opcode Ordering
1143
1144These options control the 'vertical display' of opcodes. The display
1145'order' is also called 'mode' elsewhere in this document.
1146
c99ca59a
SM
1147=over 4
1148
1149=item B<-basic>
1150
1151Print OPs in the order they appear in the OP tree (a preorder
1152traversal, starting at the root). The indentation of each OP shows its
19e169bf
JC
1153level in the tree, and the '->' at the end of the line indicates the
1154next opcode in execution order. This mode is the default, so the flag
1155is included simply for completeness.
c99ca59a
SM
1156
1157=item B<-exec>
1158
1159Print OPs in the order they would normally execute (for the majority
1160of constructs this is a postorder traversal of the tree, ending at the
1161root). In most cases the OP that usually follows a given OP will
1162appear directly below it; alternate paths are shown by indentation. In
1163cases like loops when control jumps out of a linear path, a 'goto'
1164line is generated.
1165
1166=item B<-tree>
1167
1168Print OPs in a text approximation of a tree, with the root of the tree
1169at the left and 'left-to-right' order of children transformed into
1170'top-to-bottom'. Because this mode grows both to the right and down,
1171it isn't suitable for large programs (unless you have a very wide
1172terminal).
1173
724aa791
JC
1174=back
1175
1176=head2 Options for Line-Style
1177
1178These options select the line-style (or just style) used to render
1179each opcode, and dictates what info is actually printed into each line.
1180
1181=over 4
1182
1183=item B<-concise>
1184
1185Use the author's favorite set of formatting conventions. This is the
1186default, of course.
1187
1188=item B<-terse>
1189
1190Use formatting conventions that emulate the output of B<B::Terse>. The
1191basic mode is almost indistinguishable from the real B<B::Terse>, and the
1192exec mode looks very similar, but is in a more logical order and lacks
1193curly brackets. B<B::Terse> doesn't have a tree mode, so the tree mode
1194is only vaguely reminiscent of B<B::Terse>.
1195
1196=item B<-linenoise>
1197
1198Use formatting conventions in which the name of each OP, rather than being
1199written out in full, is represented by a one- or two-character abbreviation.
1200This is mainly a joke.
1201
1202=item B<-debug>
1203
1204Use formatting conventions reminiscent of B<B::Debug>; these aren't
1205very concise at all.
1206
1207=item B<-env>
1208
1209Use formatting conventions read from the environment variables
1210C<B_CONCISE_FORMAT>, C<B_CONCISE_GOTO_FORMAT>, and C<B_CONCISE_TREE_FORMAT>.
1211
1212=back
1213
1214=head2 Options for tree-specific formatting
1215
1216=over 4
1217
c99ca59a
SM
1218=item B<-compact>
1219
1220Use a tree format in which the minimum amount of space is used for the
1221lines connecting nodes (one character in most cases). This squeezes out
1222a few precious columns of screen real estate.
1223
1224=item B<-loose>
1225
1226Use a tree format that uses longer edges to separate OP nodes. This format
1227tends to look better than the compact one, especially in ASCII, and is
1228the default.
1229
1230=item B<-vt>
1231
1232Use tree connecting characters drawn from the VT100 line-drawing set.
1233This looks better if your terminal supports it.
1234
1235=item B<-ascii>
1236
1237Draw the tree with standard ASCII characters like C<+> and C<|>. These don't
1238look as clean as the VT100 characters, but they'll work with almost any
1239terminal (or the horizontal scrolling mode of less(1)) and are suitable
1240for text documentation or email. This is the default.
1241
724aa791 1242=back
c99ca59a 1243
724aa791
JC
1244These are pairwise exclusive, i.e. compact or loose, vt or ascii.
1245
1246=head2 Options controlling sequence numbering
1247
1248=over 4
c99ca59a
SM
1249
1250=item B<-base>I<n>
1251
1252Print OP sequence numbers in base I<n>. If I<n> is greater than 10, the
1253digit for 11 will be 'a', and so on. If I<n> is greater than 36, the digit
1254for 37 will be 'A', and so on until 62. Values greater than 62 are not
1255currently supported. The default is 36.
1256
1257=item B<-bigendian>
1258
1259Print sequence numbers with the most significant digit first. This is the
1260usual convention for Arabic numerals, and the default.
1261
1262=item B<-littleendian>
1263
1c2e8cca 1264Print sequence numbers with the least significant digit first. This is
724aa791 1265obviously mutually exclusive with bigendian.
c99ca59a 1266
724aa791 1267=back
c99ca59a 1268
724aa791 1269=head2 Other options
c99ca59a 1270
f18deeb9
JC
1271=over 4
1272
1273=item B<-src>
1274
e6665613
JC
1275With this option, the rendering of each statement (starting with the
1276nextstate OP) will be preceded by the 1st line of source code that
1277generates it. For example:
f18deeb9
JC
1278
1279 1 <0> enter
1280 # 1: my $i;
1281 2 <;> nextstate(main 1 junk.pl:1) v:{
1282 3 <0> padsv[$i:1,10] vM/LVINTRO
1283 # 3: for $i (0..9) {
1284 4 <;> nextstate(main 3 junk.pl:3) v:{
1285 5 <0> pushmark s
1286 6 <$> const[IV 0] s
1287 7 <$> const[IV 9] s
1288 8 <{> enteriter(next->j last->m redo->9)[$i:1,10] lKS
1289 k <0> iter s
1290 l <|> and(other->9) vK/1
1291 # 4: print "line ";
1292 9 <;> nextstate(main 2 junk.pl:4) v
1293 a <0> pushmark s
1294 b <$> const[PV "line "] s
1295 c <@> print vK
1296 # 5: print "$i\n";
e6665613 1297 ...
f18deeb9 1298
9e0f9750
JC
1299=item B<-stash="somepackage">
1300
1301With this, "somepackage" will be required, then the stash is
1302inspected, and each function is rendered.
1303
f18deeb9
JC
1304=back
1305
1306The following options are pairwise exclusive.
cc02ea56 1307
724aa791 1308=over 4
c99ca59a 1309
724aa791 1310=item B<-main>
c99ca59a 1311
724aa791 1312Include the main program in the output, even if subroutines were also
cc02ea56
JC
1313specified. This rendering is normally suppressed when a subroutine
1314name or reference is given.
1315
1316=item B<-nomain>
1317
1318This restores the default behavior after you've changed it with '-main'
1319(it's not normally needed). If no subroutine name/ref is given, main is
1320rendered, regardless of this flag.
1321
1322=item B<-nobanner>
1323
1324Renderings usually include a banner line identifying the function name
1325or stringified subref. This suppresses the printing of the banner.
1326
1327TBC: Remove the stringified coderef; while it provides a 'cookie' for
1328each function rendered, the cookies used should be 1,2,3.. not a
1329random hex-address. It also complicates string comparison of two
1330different trees.
c99ca59a 1331
724aa791 1332=item B<-banner>
c99ca59a 1333
cc02ea56
JC
1334restores default banner behavior.
1335
1336=item B<-banneris> => subref
1337
1338TBC: a hookpoint (and an option to set it) for a user-supplied
1339function to produce a banner appropriate for users needs. It's not
1340ideal, because the rendering-state variables, which are a natural
1341candidate for use in concise.t, are unavailable to the user.
c99ca59a 1342
724aa791 1343=back
c99ca59a 1344
724aa791 1345=head2 Option Stickiness
c99ca59a 1346
724aa791
JC
1347If you invoke Concise more than once in a program, you should know that
1348the options are 'sticky'. This means that the options you provide in
1349the first call will be remembered for the 2nd call, unless you
1350re-specify or change them.
c99ca59a 1351
cc02ea56
JC
1352=head1 ABBREVIATIONS
1353
1354The concise style uses symbols to convey maximum info with minimal
1355clutter (like hex addresses). With just a little practice, you can
1356start to see the flowers, not just the branches, in the trees.
1357
1358=head2 OP class abbreviations
1359
1360These symbols appear before the op-name, and indicate the
1361B:: namespace that represents the ops in your Perl code.
1362
1363 0 OP (aka BASEOP) An OP with no children
1364 1 UNOP An OP with one child
1365 2 BINOP An OP with two children
1366 | LOGOP A control branch OP
1367 @ LISTOP An OP that could have lots of children
1368 / PMOP An OP with a regular expression
1369 $ SVOP An OP with an SV
1370 " PVOP An OP with a string
1371 { LOOP An OP that holds pointers for a loop
1372 ; COP An OP that marks the start of a statement
1373 # PADOP An OP with a GV on the pad
1374
1375=head2 OP flags abbreviations
1376
19e169bf
JC
1377OP flags are either public or private. The public flags alter the
1378behavior of each opcode in consistent ways, and are represented by 0
1379or more single characters.
cc02ea56
JC
1380
1381 v OPf_WANT_VOID Want nothing (void context)
1382 s OPf_WANT_SCALAR Want single value (scalar context)
1383 l OPf_WANT_LIST Want list of any length (list context)
19e169bf 1384 Want is unknown
cc02ea56
JC
1385 K OPf_KIDS There is a firstborn child.
1386 P OPf_PARENS This operator was parenthesized.
1387 (Or block needs explicit scope entry.)
1388 R OPf_REF Certified reference.
1389 (Return container, not containee).
1390 M OPf_MOD Will modify (lvalue).
1391 S OPf_STACKED Some arg is arriving on the stack.
1392 * OPf_SPECIAL Do something weird for this op (see op.h)
1393
19e169bf
JC
1394Private flags, if any are set for an opcode, are displayed after a '/'
1395
1396 8 <@> leave[1 ref] vKP/REFC ->(end)
1397 7 <2> sassign vKS/2 ->8
1398
1399They're opcode specific, and occur less often than the public ones, so
1400they're represented by short mnemonics instead of single-chars; see
00baac8f 1401F<op.h> for gory details, or try this quick 2-liner:
19e169bf
JC
1402
1403 $> perl -MB::Concise -de 1
1404 DB<1> |x \%B::Concise::priv
1405
c99ca59a
SM
1406=head1 FORMATTING SPECIFICATIONS
1407
724aa791
JC
1408For each line-style ('concise', 'terse', 'linenoise', etc.) there are
14093 format-specs which control how OPs are rendered.
1410
1411The first is the 'default' format, which is used in both basic and exec
1412modes to print all opcodes. The 2nd, goto-format, is used in exec
1413mode when branches are encountered. They're not real opcodes, and are
1414inserted to look like a closing curly brace. The tree-format is tree
1415specific.
1416
cc02ea56
JC
1417When a line is rendered, the correct format-spec is copied and scanned
1418for the following items; data is substituted in, and other
1419manipulations like basic indenting are done, for each opcode rendered.
1420
1421There are 3 kinds of items that may be populated; special patterns,
1422#vars, and literal text, which is copied verbatim. (Yes, it's a set
1423of s///g steps.)
1424
1425=head2 Special Patterns
1426
1427These items are the primitives used to perform indenting, and to
1428select text from amongst alternatives.
c99ca59a
SM
1429
1430=over 4
1431
1432=item B<(x(>I<exec_text>B<;>I<basic_text>B<)x)>
1433
1434Generates I<exec_text> in exec mode, or I<basic_text> in basic mode.
1435
1436=item B<(*(>I<text>B<)*)>
1437
1438Generates one copy of I<text> for each indentation level.
1439
1440=item B<(*(>I<text1>B<;>I<text2>B<)*)>
1441
1442Generates one fewer copies of I<text1> than the indentation level, followed
1443by one copy of I<text2> if the indentation level is more than 0.
1444
1445=item B<(?(>I<text1>B<#>I<var>I<Text2>B<)?)>
1446
1447If the value of I<var> is true (not empty or zero), generates the
1448value of I<var> surrounded by I<text1> and I<Text2>, otherwise
1449nothing.
1450
cc02ea56
JC
1451=item B<~>
1452
1453Any number of tildes and surrounding whitespace will be collapsed to
1454a single space.
1455
1456=back
1457
1458=head2 # Variables
1459
1460These #vars represent opcode properties that you may want as part of
1461your rendering. The '#' is intended as a private sigil; a #var's
1462value is interpolated into the style-line, much like "read $this".
1463
1464These vars take 3 forms:
1465
1466=over 4
1467
c99ca59a
SM
1468=item B<#>I<var>
1469
cc02ea56
JC
1470A property named 'var' is assumed to exist for the opcodes, and is
1471interpolated into the rendering.
c99ca59a
SM
1472
1473=item B<#>I<var>I<N>
1474
cc02ea56
JC
1475Generates the value of I<var>, left justified to fill I<N> spaces.
1476Note that this means while you can have properties 'foo' and 'foo2',
1477you cannot render 'foo2', but you could with 'foo2a'. You would be
1478wise not to rely on this behavior going forward ;-)
c99ca59a 1479
cc02ea56 1480=item B<#>I<Var>
c99ca59a 1481
cc02ea56
JC
1482This ucfirst form of #var generates a tag-value form of itself for
1483display; it converts '#Var' into a 'Var => #var' style, which is then
1484handled as described above. (Imp-note: #Vars cannot be used for
1485conditional-fills, because the => #var transform is done after the check
1486for #Var's value).
c99ca59a
SM
1487
1488=back
1489
cc02ea56
JC
1490The following variables are 'defined' by B::Concise; when they are
1491used in a style, their respective values are plugged into the
1492rendering of each opcode.
1493
1494Only some of these are used by the standard styles, the others are
1495provided for you to delve into optree mechanics, should you wish to
1496add a new style (see L</add_style> below) that uses them. You can
00baac8f 1497also add new ones using L</add_callback>.
c99ca59a
SM
1498
1499=over 4
1500
1501=item B<#addr>
1502
cc02ea56 1503The address of the OP, in hexadecimal.
c99ca59a
SM
1504
1505=item B<#arg>
1506
1507The OP-specific information of the OP (such as the SV for an SVOP, the
cc02ea56 1508non-local exit pointers for a LOOP, etc.) enclosed in parentheses.
c99ca59a
SM
1509
1510=item B<#class>
1511
1512The B-determined class of the OP, in all caps.
1513
f8a679e6 1514=item B<#classsym>
c99ca59a
SM
1515
1516A single symbol abbreviating the class of the OP.
1517
c3caa09d
SM
1518=item B<#coplabel>
1519
1520The label of the statement or block the OP is the start of, if any.
1521
c99ca59a
SM
1522=item B<#exname>
1523
1524The name of the OP, or 'ex-foo' if the OP is a null that used to be a foo.
1525
1526=item B<#extarg>
1527
1528The target of the OP, or nothing for a nulled OP.
1529
1530=item B<#firstaddr>
1531
19e169bf 1532The address of the OP's first child, in hexadecimal.
c99ca59a
SM
1533
1534=item B<#flags>
1535
1536The OP's flags, abbreviated as a series of symbols.
1537
1538=item B<#flagval>
1539
1540The numeric value of the OP's flags.
1541
d5ec2987
NC
1542=item B<#hints>
1543
1544The COP's hint flags, rendered with abbreviated names if possible. An empty
4f948f3a
RGS
1545string if this is not a COP. Here are the symbols used:
1546
1547 $ strict refs
1548 & strict subs
1549 * strict vars
d1718a7c
FC
1550 x$ explicit use/no strict refs
1551 x& explicit use/no strict subs
1552 x* explicit use/no strict vars
4f948f3a
RGS
1553 i integers
1554 l locale
1555 b bytes
4f948f3a
RGS
1556 { block scope
1557 % localise %^H
1558 < open in
1559 > open out
1560 I overload int
1561 F overload float
1562 B overload binary
1563 S overload string
1564 R overload re
1565 T taint
1566 E eval
1567 X filetest access
1568 U utf-8
d5ec2987
NC
1569
1570=item B<#hintsval>
1571
1572The numeric value of the COP's hint flags, or an empty string if this is not
1573a COP.
1574
f8a679e6 1575=item B<#hyphseq>
c99ca59a
SM
1576
1577The sequence number of the OP, or a hyphen if it doesn't have one.
1578
1579=item B<#label>
1580
1581'NEXT', 'LAST', or 'REDO' if the OP is a target of one of those in exec
1582mode, or empty otherwise.
1583
1584=item B<#lastaddr>
1585
19e169bf 1586The address of the OP's last child, in hexadecimal.
c99ca59a
SM
1587
1588=item B<#name>
1589
1590The OP's name.
1591
1592=item B<#NAME>
1593
1594The OP's name, in all caps.
1595
1596=item B<#next>
1597
1598The sequence number of the OP's next OP.
1599
1600=item B<#nextaddr>
1601
19e169bf 1602The address of the OP's next OP, in hexadecimal.
c99ca59a
SM
1603
1604=item B<#noise>
1605
c27ea44e 1606A one- or two-character abbreviation for the OP's name.
c99ca59a
SM
1607
1608=item B<#private>
1609
1610The OP's private flags, rendered with abbreviated names if possible.
1611
1612=item B<#privval>
1613
1614The numeric value of the OP's private flags.
1615
1616=item B<#seq>
1617
2814eb74
PJ
1618The sequence number of the OP. Note that this is a sequence number
1619generated by B::Concise.
c99ca59a 1620
7252851f
NC
1621=item B<#seqnum>
1622
16235.8.x and earlier only. 5.9 and later do not provide this.
1624
1625The real sequence number of the OP, as a regular number and not adjusted
1626to be relative to the start of the real program. (This will generally be
1627a fairly large number because all of B<B::Concise> is compiled before
1628your program is).
1629
2814eb74 1630=item B<#opt>
c99ca59a 1631
b84c7839 1632Whether or not the op has been optimized by the peephole optimizer.
2814eb74 1633
7252851f
NC
1634Only available in 5.9 and later.
1635
c99ca59a
SM
1636=item B<#sibaddr>
1637
19e169bf 1638The address of the OP's next youngest sibling, in hexadecimal.
c99ca59a
SM
1639
1640=item B<#svaddr>
1641
19e169bf 1642The address of the OP's SV, if it has an SV, in hexadecimal.
c99ca59a
SM
1643
1644=item B<#svclass>
1645
1646The class of the OP's SV, if it has one, in all caps (e.g., 'IV').
1647
1648=item B<#svval>
1649
1650The value of the OP's SV, if it has one, in a short human-readable format.
1651
1652=item B<#targ>
1653
1654The numeric value of the OP's targ.
1655
1656=item B<#targarg>
1657
1658The name of the variable the OP's targ refers to, if any, otherwise the
1659letter t followed by the OP's targ in decimal.
1660
1661=item B<#targarglife>
1662
1663Same as B<#targarg>, but followed by the COP sequence numbers that delimit
1664the variable's lifetime (or 'end' for a variable in an open scope) for a
1665variable.
1666
1667=item B<#typenum>
1668
1669The numeric value of the OP's type, in decimal.
1670
1671=back
1672
f9f861ec
JC
1673=head1 One-Liner Command tips
1674
1675=over 4
1676
1677=item perl -MO=Concise,bar foo.pl
1678
1679Renders only bar() from foo.pl. To see main, drop the ',bar'. To see
1680both, add ',-main'
1681
1682=item perl -MDigest::MD5=md5 -MO=Concise,md5 -e1
1683
1684Identifies md5 as an XS function. The export is needed so that BC can
1685find it in main.
1686
1687=item perl -MPOSIX -MO=Concise,_POSIX_ARG_MAX -e1
1688
1689Identifies _POSIX_ARG_MAX as a constant sub, optimized to an IV.
1690Although POSIX isn't entirely consistent across platforms, this is
1691likely to be present in virtually all of them.
1692
1693=item perl -MPOSIX -MO=Concise,a -e 'print _POSIX_SAVED_IDS'
1694
1695This renders a print statement, which includes a call to the function.
1696It's identical to rendering a file with a use call and that single
1697statement, except for the filename which appears in the nextstate ops.
1698
1699=item perl -MPOSIX -MO=Concise,a -e 'sub a{_POSIX_SAVED_IDS}'
1700
1701This is B<very> similar to previous, only the first two ops differ. This
1702subroutine rendering is more representative, insofar as a single main
1703program will have many subs.
1704
6cc5d258
JC
1705=item perl -MB::Concise -e 'B::Concise::compile("-exec","-src", \%B::Concise::)->()'
1706
1707This renders all functions in the B::Concise package with the source
1708lines. It eschews the O framework so that the stashref can be passed
9e0f9750
JC
1709directly to B::Concise::compile(). See -stash option for a more
1710convenient way to render a package.
f9f861ec 1711
d5e42f17 1712=back
f9f861ec 1713
78ad9108
PJ
1714=head1 Using B::Concise outside of the O framework
1715
cc02ea56
JC
1716The common (and original) usage of B::Concise was for command-line
1717renderings of simple code, as given in EXAMPLE. But you can also use
1718B<B::Concise> from your code, and call compile() directly, and
724aa791 1719repeatedly. By doing so, you can avoid the compile-time only
cc02ea56
JC
1720operation of O.pm, and even use the debugger to step through
1721B::Concise::compile() itself.
f95e3c3c 1722
cc02ea56
JC
1723Once you're doing this, you may alter Concise output by adding new
1724rendering styles, and by optionally adding callback routines which
1725populate new variables, if such were referenced from those (just
1726added) styles.
f95e3c3c 1727
724aa791 1728=head2 Example: Altering Concise Renderings
78ad9108
PJ
1729
1730 use B::Concise qw(set_style add_callback);
cc02ea56 1731 add_style($yourStyleName => $defaultfmt, $gotofmt, $treefmt);
78ad9108 1732 add_callback
f95e3c3c
JC
1733 ( sub {
1734 my ($h, $op, $format, $level, $stylename) = @_;
78ad9108 1735 $h->{variable} = some_func($op);
cc02ea56
JC
1736 });
1737 $walker = B::Concise::compile(@options,@subnames,@subrefs);
1738 $walker->();
78ad9108 1739
f95e3c3c
JC
1740=head2 set_style()
1741
724aa791
JC
1742B<set_style> accepts 3 arguments, and updates the three format-specs
1743comprising a line-style (basic-exec, goto, tree). It has one minor
1744drawback though; it doesn't register the style under a new name. This
1745can become an issue if you render more than once and switch styles.
1746Thus you may prefer to use add_style() and/or set_style_standard()
1747instead.
1748
1749=head2 set_style_standard($name)
1750
1751This restores one of the standard line-styles: C<terse>, C<concise>,
1752C<linenoise>, C<debug>, C<env>, into effect. It also accepts style
1753names previously defined with add_style().
f95e3c3c 1754
345e2394 1755=head2 add_style ()
78ad9108 1756
f95e3c3c
JC
1757This subroutine accepts a new style name and three style arguments as
1758above, and creates, registers, and selects the newly named style. It is
1759an error to re-add a style; call set_style_standard() to switch between
1760several styles.
1761
345e2394 1762=head2 add_callback ()
f95e3c3c 1763
19e169bf
JC
1764If your newly minted styles refer to any new #variables, you'll need
1765to define a callback subroutine that will populate (or modify) those
1766variables. They are then available for use in the style you've
1767chosen.
f95e3c3c
JC
1768
1769The callbacks are called for each opcode visited by Concise, in the
1770same order as they are added. Each subroutine is passed five
1771parameters.
1772
1773 1. A hashref, containing the variable names and values which are
1774 populated into the report-line for the op
1775 2. the op, as a B<B::OP> object
1776 3. a reference to the format string
1777 4. the formatting (indent) level
1778 5. the selected stylename
78ad9108
PJ
1779
1780To define your own variables, simply add them to the hash, or change
1781existing values if you need to. The level and format are passed in as
1782references to scalars, but it is unlikely that they will need to be
1783changed or even used.
1784
724aa791 1785=head2 Running B::Concise::compile()
f95e3c3c
JC
1786
1787B<compile> accepts options as described above in L</OPTIONS>, and
1788arguments, which are either coderefs, or subroutine names.
1789
cc02ea56
JC
1790It constructs and returns a $treewalker coderef, which when invoked,
1791traverses, or walks, and renders the optrees of the given arguments to
1792STDOUT. You can reuse this, and can change the rendering style used
1793each time; thereafter the coderef renders in the new style.
f95e3c3c
JC
1794
1795B<walk_output> lets you change the print destination from STDOUT to
19e169bf
JC
1796another open filehandle, or into a string passed as a ref (unless
1797you've built perl with -Uuseperlio).
f95e3c3c 1798
555bd962
BG
1799 my $walker = B::Concise::compile('-terse','aFuncName', \&aSubRef); # 1
1800 walk_output(\my $buf);
1801 $walker->(); # 1 renders -terse
1802 set_style_standard('concise'); # 2
1803 $walker->(); # 2 renders -concise
1804 $walker->(@new); # 3 renders whatever
1805 print "3 different renderings: terse, concise, and @new: $buf\n";
cc02ea56
JC
1806
1807When $walker is called, it traverses the subroutines supplied when it
1808was created, and renders them using the current style. You can change
1809the style afterwards in several different ways:
1810
1811 1. call C<compile>, altering style or mode/order
1812 2. call C<set_style_standard>
1813 3. call $walker, passing @new options
1814
1815Passing new options to the $walker is the easiest way to change
1816amongst any pre-defined styles (the ones you add are automatically
1817recognized as options), and is the only way to alter rendering order
1818without calling compile again. Note however that rendering state is
1819still shared amongst multiple $walker objects, so they must still be
1820used in a coordinated manner.
f95e3c3c
JC
1821
1822=head2 B::Concise::reset_sequence()
1823
1824This function (not exported) lets you reset the sequence numbers (note
1825that they're numbered arbitrarily, their goal being to be human
1826readable). Its purpose is mostly to support testing, i.e. to compare
1827the concise output from two identical anonymous subroutines (but
1828different instances). Without the reset, B::Concise, seeing that
1829they're separate optrees, generates different sequence numbers in
1830the output.
1831
1832=head2 Errors
1833
9a3b3024
JC
1834Errors in rendering (non-existent function-name, non-existent coderef)
1835are written to the STDOUT, or wherever you've set it via
1836walk_output().
31b49ad4 1837
9a3b3024
JC
1838Errors using the various *style* calls, and bad args to walk_output(),
1839result in die(). Use an eval if you wish to catch these errors and
1840continue processing.
78ad9108 1841
c99ca59a
SM
1842=head1 AUTHOR
1843
31b49ad4 1844Stephen McCamant, E<lt>smcc@CSUA.Berkeley.EDUE<gt>.
c99ca59a
SM
1845
1846=cut