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