2 # Copyright (C) 2000-2003 Stephen McCamant. All rights reserved.
3 # This program is free software; you can redistribute and/or modify it
4 # under the same terms as Perl itself.
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.
13 use warnings; # uses #3 and #4, since warnings uses Carp
15 use Exporter (); # use #5
17 our $VERSION = "0.66";
18 our @ISA = qw(Exporter);
19 our @EXPORT_OK = qw( set_style set_style_standard add_callback
20 concise_subref concise_cv concise_main
21 add_style walk_output compile reset_sequence );
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 )], );
29 use B qw(class ppname main_start main_root main_cv cstring svref_2object
30 SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL
35 ["(?(#label =>\n)?)(*( )*)#class (#addr) #name (?([#targ])?) "
36 . "#svclass~(?((#svaddr))?)~#svval~(?(label \"#coplabel\")?)\n",
37 "(*( )*)goto #class (#addr)\n",
40 ["#hyphseq2 (*( (x( ;)x))*)<#classsym> "
41 . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x)\n"
42 , " (*( )*) goto #seq\n",
43 "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"],
45 ["(x(;(*( )*))x)#noise#arg(?([#targarg])?)(x( ;\n)x)",
47 "(?(#seq)?)#noise#arg(?([#targarg])?)"],
49 ["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t"
50 . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n" .
51 ($] > 5.009 ? '' : "\top_seq\t\t#seqnum\n")
52 . "\top_flags\t#flagval\n\top_private\t#privval\n"
53 . "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)"
54 . "(?(\top_sv\t\t#svaddr\n)?)",
57 "env" => [$ENV{B_CONCISE_FORMAT}, $ENV{B_CONCISE_GOTO_FORMAT},
58 $ENV{B_CONCISE_TREE_FORMAT}],
61 # Renderings, ie how Concise prints, is controlled by these vars
63 our $stylename; # selects current style from %style
64 my $order = "basic"; # how optree is walked & printed: basic, exec, tree
66 # rendering mechanics:
67 # these 'formats' are the line-rendering templates
68 # they're updated from %style when $stylename changes
69 my ($format, $gotofmt, $treefmt);
72 my $base = 36; # how <sequence#> is displayed
73 my $big_endian = 1; # more <sequence#> display
74 my $tree_style = 0; # tree-order details
75 my $banner = 1; # print banner before optree is traversed
76 my $do_main = 0; # force printing of main routine
78 # another factor: can affect all styles!
79 our @callbacks; # allow external management
81 set_style_standard("concise");
87 ($format, $gotofmt, $treefmt) = @_;
88 #warn "set_style: deprecated, use set_style_standard instead\n"; # someday
89 die "expecting 3 style-format args\n" unless @_ == 3;
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];
98 $stylename = $newstyle; # update rendering state
101 sub set_style_standard {
102 ($stylename) = @_; # update rendering state
103 die "err: style '$stylename' unknown\n" unless exists $style{$stylename};
104 set_style(@{$style{$stylename}});
111 # output handle, used with all Concise-output printing
112 our $walkHandle; # public for your convenience
113 BEGIN { $walkHandle = \*STDOUT }
115 sub walk_output { # updates $walkHandle
117 return $walkHandle unless $handle; # allow use as accessor
119 if (ref $handle eq 'SCALAR') {
121 die "no perlio in this build, can't call walk_output (\\\$scalar)\n"
122 unless $Config::Config{useperlio};
123 # in 5.8+, open(FILEHANDLE,MODE,REFERENCE) writes to string
124 open my $tmp, '>', $handle; # but cant re-set existing STDOUT
125 $walkHandle = $tmp; # so use my $tmp as intermediate var
128 my $iotype = ref $handle;
129 die "expecting argument/object that can print\n"
130 unless $iotype eq 'GLOB' or $iotype and $handle->can('print');
131 $walkHandle = $handle;
135 my($order, $coderef, $name) = @_;
136 my $codeobj = svref_2object($coderef);
138 return concise_stashref(@_)
139 unless ref $codeobj eq 'B::CV';
140 concise_cv_obj($order, $codeobj, $name);
143 sub concise_stashref {
145 foreach my $k (sort keys %$h) {
147 my $coderef = *s{CODE} or next;
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";
157 # This should have been called concise_subref, but it was exported
158 # under this name in versions before 0.56
159 *concise_cv = \&concise_subref;
162 my ($order, $cv, $name) = @_;
163 # name is either a string, or a CODE ref (copy of $cv arg??)
167 print $walkHandle "$name is XS code\n";
170 if (class($cv->START) eq "NULL") {
172 if (ref $name eq 'CODE') {
173 print $walkHandle "coderef $name has no START\n";
175 elsif (exists &$name) {
176 print $walkHandle "$name exists in stash, but has no START\n";
179 print $walkHandle "$name not in symbol table\n";
183 sequence($cv->START);
184 if ($order eq "exec") {
185 walk_exec($cv->START);
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);
193 print $walkHandle "B::NULL encountered doing ROOT on $cv. avoiding disaster\n";
196 print $walkHandle tree($cv->ROOT, 0);
202 sequence(main_start);
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";
209 print $walkHandle tree(main_root, 0);
210 } elsif ($order eq "basic") {
211 return if class(main_root) eq "NULL";
212 walk_topdown(main_root,
213 sub { $_[0]->concise($_[1]) }, 0);
217 sub concise_specials {
218 my($name, $order, @cv_s) = @_;
220 if ($name eq "BEGIN") {
221 splice(@cv_s, 0, 8); # skip 7 BEGIN blocks in this file. NOW 8 ??
222 } elsif ($name eq "CHECK") {
223 pop @cv_s; # skip the CHECK block that calls us
226 print $walkHandle "$name $i:\n";
228 concise_cv_obj($order, $cv, $name);
232 my $start_sym = "\e(0"; # "\cN" sometimes also works
233 my $end_sym = "\e(B"; # "\cO" respectively
235 my @tree_decorations =
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],
244 # set rendering state from options and args
247 @options = grep(/^-/, @_);
248 @args = grep(!/^-/, @_);
250 for my $o (@options) {
252 if ($o eq "-basic") {
254 } elsif ($o eq "-exec") {
256 } elsif ($o eq "-tree") {
260 elsif ($o eq "-compact") {
262 } elsif ($o eq "-loose") {
264 } elsif ($o eq "-vt") {
266 } elsif ($o eq "-ascii") {
270 elsif ($o =~ /^-base(\d+)$/) {
272 } elsif ($o eq "-bigendian") {
274 } elsif ($o eq "-littleendian") {
277 elsif ($o eq "-nobanner") {
279 } elsif ($o eq "-banner") {
282 elsif ($o eq "-main") {
284 } elsif ($o eq "-nomain") {
288 elsif (exists $style{substr($o, 1)}) {
289 $stylename = substr($o, 1);
290 set_style_standard($stylename);
292 warn "Option $o unrecognized";
299 my (@args) = compileOpts(@_);
301 my @newargs = compileOpts(@_); # accept new rendering options
302 warn "disregarding non-options: @newargs\n" if @newargs;
304 for my $objname (@args) {
305 next unless $objname; # skip null args to avoid noisy responses
307 if ($objname eq "BEGIN") {
308 concise_specials("BEGIN", $order,
309 B::begin_av->isa("B::AV") ?
310 B::begin_av->ARRAY : ());
311 } elsif ($objname eq "INIT") {
312 concise_specials("INIT", $order,
313 B::init_av->isa("B::AV") ?
314 B::init_av->ARRAY : ());
315 } elsif ($objname eq "CHECK") {
316 concise_specials("CHECK", $order,
317 B::check_av->isa("B::AV") ?
318 B::check_av->ARRAY : ());
319 } elsif ($objname eq "END") {
320 concise_specials("END", $order,
321 B::end_av->isa("B::AV") ?
322 B::end_av->ARRAY : ());
325 # convert function names to subrefs
328 print $walkHandle "B::Concise::compile($objname)\n"
332 $objname = "main::" . $objname unless $objname =~ /::/;
333 print $walkHandle "$objname:\n";
335 unless (exists &$objname) {
336 print $walkHandle "err: unknown function ($objname)\n";
339 $objref = \&$objname;
341 concise_subref($order, $objref, $objname);
344 if (!@args or $do_main) {
345 print $walkHandle "main program:\n" if $do_main;
346 concise_main($order);
348 return @args; # something
353 my $lastnext; # remembers op-chain, used to insert gotos
355 my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|",
356 'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*",
357 'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#");
359 no warnings 'qw'; # "Possible attempt to put comments..."; use #7
361 qw'# () sc ( @? 1 $* gv *{ m$ m@ m% m? p/ *$ $ $# & a& pt \\ s\\ rf bl
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
375 Pu GP SP EP Gn Gg GG SG EG g0 c$ lk t$ ;s n> // /= CO';
377 my $chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
379 sub op_flags { # common flags (see BASOP.op_flags in op.h)
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;
396 return "-" . base_n(-$x) if $x < 0;
398 do { $str .= substr($chars, $x % $base, 1) } while $x = int($x / $base);
399 $str = reverse $str if $big_endian;
415 return "-" if not exists $sequence_num{$$op};
416 return base_n($sequence_num{$$op});
420 my($op, $sub, $level) = @_;
422 if ($op->flags & OPf_KIDS) {
423 for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
424 walk_topdown($kid, $sub, $level + 1);
427 elsif (class($op) eq "PMOP") {
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);
438 my($ar, $level) = @_;
440 if (ref($l) eq "ARRAY") {
441 walklines($l, $level + 1);
449 my($top, $level) = @_;
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}++;
457 my $name = $op->name;
458 if (class($op) eq "LOGOP") {
461 push @todo, [$op->other, $ar];
462 } elsif ($name eq "subst" and $ {$op->pmreplstart}) {
465 push @todo, [$op->pmreplstart, $ar];
466 } elsif ($name =~ /^enter(loop|iter)$/) {
468 $labels{${$op->nextop}} = "NEXT";
469 $labels{${$op->lastop}} = "LAST";
470 $labels{${$op->redoop}} = "REDO";
472 $labels{$op->nextop->seq} = "NEXT";
473 $labels{$op->lastop->seq} = "LAST";
474 $labels{$op->redoop->seq} = "REDO";
479 walklines(\@lines, 0);
482 # The structure of this routine is purposely modeled after op.c's peep()
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};
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";
498 } elsif (class($op) eq "LOOP") {
499 my $redoop = $op->redoop;
500 $redoop = $redoop->next while $redoop->name eq "null";
502 my $nextop = $op->nextop;
503 $nextop = $nextop->next while $nextop->name eq "null";
505 my $lastop = $op->lastop;
506 $lastop = $lastop->next while $lastop->name eq "null";
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);
518 sub fmt_line { # generate text-line for op.
519 my($hr, $op, $text, $level) = @_;
521 $_->($hr, $op, \$text, \$level, $stylename) for @callbacks;
523 return '' if $hr->{SKIP}; # suppress line if a callback said so
524 return '' if $hr->{goto} and $hr->{goto} eq '-'; # no goto nowhere
526 # spec: (?(text1#varText2)?)
527 $text =~ s/\(\?\(([^\#]*?)\#(\w+)([^\#]*?)\)\?\)/
528 $hr->{$2} ? $1.$hr->{$2}.$3 : ""/eg;
530 # spec: (x(exec_text;basic_text)x)
531 $text =~ s/\(x\((.*?);(.*?)\)x\)/$order eq "exec" ? $1 : $2/egs;
534 $text =~ s/\(\*\(([^;]*?)\)\*\)/$1 x $level/egs;
536 # spec: (*(text1;text2)*)
537 $text =~ s/\(\*\((.*?);(.*?)\)\*\)/$1 x ($level - 1) . $2 x ($level>0)/egs;
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;
543 $text =~ s/\#([a-zA-Z]+)(\d+)/sprintf("%-$2s", $hr->{$1})/eg;
545 $text =~ s/\#([a-zA-Z]+)/$hr->{$1}/eg; # populate #var's
546 $text =~ s/[ \t]*~+[ \t]*/ /g; # squeeze tildes
548 return "$text\n" if $text ne "";
549 return $text; # suppress empty lines
552 our %priv; # used to display each opcode's BASEOP.op_private values
554 $priv{$_}{128} = "LVINTRO"
555 for ("pos", "substr", "vec", "threadsv", "gvsv", "rv2sv", "rv2hv", "rv2gv",
556 "rv2av", "rv2arylen", "aelem", "helem", "aslice", "hslice", "padsv",
557 "padav", "padhv", "enteriter");
558 $priv{$_}{64} = "REFC" for ("leave", "leavesub", "leavesublv", "leavewrite");
559 $priv{"aassign"}{64} = "COMMON";
560 $priv{"aassign"}{32} = "PHASH" if $] < 5.009;
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",
565 $priv{"repeat"}{64} = "DOLIST";
566 $priv{"leaveloop"}{64} = "CONT";
567 @{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV")
568 for (qw(rv2gv rv2sv padsv aelem helem));
569 @{$priv{"entersub"}}{16,32,64} = ("DBG","TARG","NOMOD");
570 @{$priv{$_}}{4,8,128} = ("INARGS","AMPER","NO()") for ("entersub", "rv2cv");
571 $priv{"gv"}{32} = "EARLYCV";
572 $priv{"aelem"}{16} = $priv{"helem"}{16} = "LVDEFER";
573 $priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv",
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");
587 $priv{$_}{4} = "REVERSED" for ("enteriter", "iter");
588 @{$priv{"const"}}{4,8,16,32,64,128} = ("SHORT","STRICT","ENTERED",'$[',"BARE","WARN");
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");
596 @{$priv{"sort"}}{1,2,4,8,16} = ("NUM", "INT", "REV", "INPLACE","DESC");
597 $priv{"threadsv"}{64} = "SVREFd";
598 @{$priv{$_}}{16,32,64,128} = ("INBIN","INCR","OUTBIN","OUTCR")
599 for ("open", "backtick");
600 $priv{"exit"}{128} = "VMS";
601 $priv{$_}{2} = "FTACCESS"
602 for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec");
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",
611 # Lexical $_ is post 5.8.x
612 $priv{$_}{2} = "GREPLEX"
613 for ("mapwhile", "mapstart", "grepwhile", "grepstart");
619 for my $flag (128, 96, 64, 32, 16, 8, 4, 2, 1) {
620 if ($priv{$name}{$flag} and $x & $flag and $x >= $flag) {
622 push @s, $priv{$name}{$flag};
626 return join(",", @s);
630 my($sv, $hr, $preferpv) = @_;
631 $hr->{svclass} = class($sv);
632 $hr->{svclass} = "UV"
633 if $hr->{svclass} eq "IV" and $sv->FLAGS & SVf_IVisUV;
634 Carp::cluck("bad concise_sv: $sv") unless $sv and $$sv;
635 $hr->{svaddr} = sprintf("%#x", $$sv);
636 if ($hr->{svclass} eq "GV") {
638 my $stash = $gv->STASH->NAME;
639 if ($stash eq "main") {
642 $stash = $stash . "::";
644 $hr->{svval} = "*$stash" . $gv->SAFENAME;
645 return "*$stash" . $gv->SAFENAME;
647 while (class($sv) eq "RV") {
648 $hr->{svval} .= "\\";
651 if (class($sv) eq "SPECIAL") {
652 $hr->{svval} .= ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv];
653 } elsif ($preferpv && $sv->FLAGS & SVf_POK) {
654 $hr->{svval} .= cstring($sv->PV);
655 } elsif ($sv->FLAGS & SVf_NOK) {
656 $hr->{svval} .= $sv->NV;
657 } elsif ($sv->FLAGS & SVf_IOK) {
658 $hr->{svval} .= $sv->int_value;
659 } elsif ($sv->FLAGS & SVf_POK) {
660 $hr->{svval} .= cstring($sv->PV);
661 } elsif (class($sv) eq "HV") {
662 $hr->{svval} .= 'HASH';
665 $hr->{svval} = 'undef' unless defined $hr->{svval};
666 my $out = $hr->{svclass};
667 return $out .= " $hr->{svval}" ;
672 my ($op, $level, $format) = @_;
674 $h{exname} = $h{name} = $op->name;
675 $h{NAME} = uc $h{name};
676 $h{class} = class($op);
677 $h{extarg} = $h{targ} = $op->targ;
678 $h{extarg} = "" unless $h{extarg};
679 if ($h{name} eq "null" and $h{targ}) {
680 # targ holds the old type
681 $h{exname} = "ex-" . substr(ppname($h{targ}), 3);
683 } elsif ($op->name =~ /^leave(sub(lv)?|write)?$/) {
684 # targ potentially holds a reference count
685 if ($op->private & 64) {
686 my $refs = "ref" . ($h{targ} != 1 ? "s" : "");
687 $h{targarglife} = $h{targarg} = "$h{targ} $refs";
690 my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}];
691 if (defined $padname and class($padname) ne "SPECIAL") {
692 $h{targarg} = $padname->PVX;
693 if ($padname->FLAGS & SVf_FAKE) {
695 $h{targarglife} = "$h{targarg}:FAKE";
697 # These changes relate to the jumbo closure fix.
698 # See changes 19939 and 20005
700 $fake .= 'a' if $padname->IVX & 1; # PAD_FAKELEX_ANON
701 $fake .= 'm' if $padname->IVX & 2; # PAD_FAKELEX_MULTI
702 $fake .= ':' . $padname->NVX if $curcv->CvFLAGS & CVf_ANON;
703 $h{targarglife} = "$h{targarg}:FAKE:$fake";
707 my $intro = $padname->NVX - $cop_seq_base;
708 my $finish = int($padname->IVX) - $cop_seq_base;
709 $finish = "end" if $finish == 999999999 - $cop_seq_base;
710 $h{targarglife} = "$h{targarg}:$intro,$finish";
713 $h{targarglife} = $h{targarg} = "t" . $h{targ};
717 $h{svclass} = $h{svaddr} = $h{svval} = "";
718 if ($h{class} eq "PMOP") {
719 my $precomp = $op->precomp;
720 if (defined $precomp) {
721 $precomp = cstring($precomp); # Escape literal control sequences
722 $precomp = "/$precomp/";
726 my $pmreplroot = $op->pmreplroot;
728 if (ref($pmreplroot) eq "B::GV") {
729 # with C<@stash_array = split(/pat/, str);>,
730 # *stash_array is stored in /pat/'s pmreplroot.
731 $h{arg} = "($precomp => \@" . $pmreplroot->NAME . ")";
732 } elsif (!ref($pmreplroot) and $pmreplroot) {
733 # same as the last case, except the value is actually a
734 # pad offset for where the GV is kept (this happens under
736 my $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$pmreplroot];
737 $h{arg} = "($precomp => \@" . $gv->NAME . ")";
738 } elsif ($ {$op->pmreplstart}) {
740 $pmreplstart = "replstart->" . seq($op->pmreplstart);
741 $h{arg} = "(" . join(" ", $precomp, $pmreplstart) . ")";
743 $h{arg} = "($precomp)";
745 } elsif ($h{class} eq "PVOP" and $h{name} ne "trans") {
746 $h{arg} = '("' . $op->pv . '")';
747 $h{svval} = '"' . $op->pv . '"';
748 } elsif ($h{class} eq "COP") {
749 my $label = $op->label;
750 $h{coplabel} = $label;
751 $label = $label ? "$label: " : "";
754 $loc .= ":" . $op->line;
755 my($stash, $cseq) = ($op->stash->NAME, $op->cop_seq - $cop_seq_base);
756 my $arybase = $op->arybase;
757 $arybase = $arybase ? ' $[=' . $arybase : "";
758 $h{arg} = "($label$stash $cseq $loc$arybase)";
759 } elsif ($h{class} eq "LOOP") {
760 $h{arg} = "(next->" . seq($op->nextop) . " last->" . seq($op->lastop)
761 . " redo->" . seq($op->redoop) . ")";
762 } elsif ($h{class} eq "LOGOP") {
764 $h{arg} = "(other->" . seq($op->other) . ")";
766 elsif ($h{class} eq "SVOP" or $h{class} eq "PADOP") {
767 unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) {
768 my $idx = ($h{class} eq "SVOP") ? $op->targ : $op->padix;
769 my $preferpv = $h{name} eq "method_named";
770 if ($h{class} eq "PADOP" or !${$op->sv}) {
771 my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$idx];
772 $h{arg} = "[" . concise_sv($sv, \%h, $preferpv) . "]";
773 $h{targarglife} = $h{targarg} = "";
775 $h{arg} = "(" . concise_sv($op->sv, \%h, $preferpv) . ")";
779 $h{seq} = $h{hyphseq} = seq($op);
780 $h{seq} = "" if $h{seq} eq "-";
783 $h{static} = $op->static;
784 $h{label} = $labels{$$op};
786 $h{seqnum} = $op->seq;
787 $h{label} = $labels{$op->seq};
789 $h{next} = $op->next;
790 $h{next} = (class($h{next}) eq "NULL") ? "(end)" : seq($h{next});
791 $h{nextaddr} = sprintf("%#x", $ {$op->next});
792 $h{sibaddr} = sprintf("%#x", $ {$op->sibling});
793 $h{firstaddr} = sprintf("%#x", $ {$op->first}) if $op->can("first");
794 $h{lastaddr} = sprintf("%#x", $ {$op->last}) if $op->can("last");
796 $h{classsym} = $opclass{$h{class}};
797 $h{flagval} = $op->flags;
798 $h{flags} = op_flags($op->flags);
799 $h{privval} = $op->private;
800 $h{private} = private_flags($h{name}, $op->private);
801 $h{addr} = sprintf("%#x", $$op);
802 $h{typenum} = $op->type;
803 $h{noise} = $linenoise[$op->type];
805 return fmt_line(\%h, $op, $format, $level);
809 my($op, $level) = @_;
810 if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
811 # insert a 'goto' line
812 my $synth = {"seq" => seq($lastnext), "class" => class($lastnext),
813 "addr" => sprintf("%#x", $$lastnext),
814 "goto" => seq($lastnext), # simplify goto '-' removal
816 print $walkHandle fmt_line($synth, $op, $gotofmt, $level+1);
818 $lastnext = $op->next;
819 print $walkHandle concise_op($op, $level, $format);
822 # B::OP::terse (see Terse.pm) now just calls this
824 my($op, $level) = @_;
826 # This isn't necessarily right, but there's no easy way to get
827 # from an OP to the right CV. This is a limitation of the
828 # ->terse() interface style, and there isn't much to do about
829 # it. In particular, we can die in concise_op if the main pad
830 # isn't long enough, or has the wrong kind of entries, compared to
831 # the pad a sub was compiled with. The fix for that would be to
832 # make a backwards compatible "terse" format that never even
833 # looked at the pad, just like the old B::Terse. I don't think
834 # that's worth the effort, though.
835 $curcv = main_cv unless $curcv;
837 if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
839 my $h = {"seq" => seq($lastnext), "class" => class($lastnext),
840 "addr" => sprintf("%#x", $$lastnext)};
842 fmt_line($h, $op, $style{"terse"}[1], $level+1);
844 $lastnext = $op->next;
846 concise_op($op, $level, $style{"terse"}[0]);
852 my $style = $tree_decorations[$tree_style];
853 my($space, $single, $kids, $kid, $nokid, $last, $lead, $size) = @$style;
854 my $name = concise_op($op, $level, $treefmt);
855 if (not $op->flags & OPf_KIDS) {
859 for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
860 push @lines, tree($kid, $level+1);
863 for ($i = $#lines; substr($lines[$i], 0, 1) eq " "; $i--) {
864 $lines[$i] = $space . $lines[$i];
867 $lines[$i] = $last . $lines[$i];
869 if (substr($lines[$i], 0, 1) eq " ") {
870 $lines[$i] = $nokid . $lines[$i];
872 $lines[$i] = $kid . $lines[$i];
875 $lines[$i] = $kids . $lines[$i];
877 $lines[0] = $single . $lines[0];
879 return("$name$lead" . shift @lines,
880 map(" " x (length($name)+$size) . $_, @lines));
883 # *** Warning: fragile kludge ahead ***
884 # Because the B::* modules run in the same interpreter as the code
885 # they're compiling, their presence tends to distort the view we have of
886 # the code we're looking at. In particular, perl gives sequence numbers
887 # to COPs. If the program we're looking at were run on its own, this
888 # would start at 1. Because all of B::Concise and all the modules it
889 # uses are compiled first, though, by the time we get to the user's
890 # program the sequence number is already pretty high, which could be
891 # distracting if you're trying to tell OPs apart. Therefore we'd like to
892 # subtract an offset from all the sequence numbers we display, to
893 # restore the simpler view of the world. The trick is to know what that
894 # offset will be, when we're still compiling B::Concise! If we
895 # hardcoded a value, it would have to change every time B::Concise or
896 # other modules we use do. To help a little, what we do here is compile
897 # a little code at the end of the module, and compute the base sequence
898 # number for the user's program as being a small offset later, so all we
899 # have to worry about are changes in the offset.
901 # [For 5.8.x and earlier perl is generating sequence numbers for all ops,
902 # and using them to reference labels]
905 # When you say "perl -MO=Concise -e '$a'", the output should look like:
907 # 4 <@> leave[t1] vKP/REFC ->(end)
909 #^ smallest OP sequence number should be 1
910 # 2 <;> nextstate(main 1 -e:1) v ->3
911 # ^ smallest COP sequence number should be 1
912 # - <1> ex-rv2sv vK/1 ->4
913 # 3 <$> gvsv(*a) s ->4
915 # If the second of the marked numbers there isn't 1, it means you need
916 # to update the corresponding magic number in the next line.
917 # Remember, this needs to stay the last things in the module.
919 # Why is this different for MacOS? Does it matter?
920 my $cop_seq_mnum = $^O eq 'MacOS' ? 12 : 11;
921 $cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum;
929 B::Concise - Walk Perl syntax tree, printing concise info about ops
933 perl -MO=Concise[,OPTIONS] foo.pl
935 use B::Concise qw(set_style add_callback);
939 This compiler backend prints the internal OPs of a Perl program's syntax
940 tree in one of several space-efficient text formats suitable for debugging
941 the inner workings of perl or other compiler backends. It can print OPs in
942 the order they appear in the OP tree, in the order they will execute, or
943 in a text approximation to their tree structure, and the format of the
944 information displayed is customizable. Its function is similar to that of
945 perl's B<-Dx> debugging flag or the B<B::Terse> module, but it is more
946 sophisticated and flexible.
950 Here's an example of 2 outputs (aka 'renderings'), using the
951 -exec and -basic (i.e. default) formatting conventions on the same code
954 % perl -MO=Concise,-exec -e '$a = $b + 42'
956 2 <;> nextstate(main 1 -e:1) v
962 8 <@> leave[1 ref] vKP/REFC
964 Each line corresponds to an opcode. The opcode marked with '*' is used
965 in a few examples below.
967 The 1st column is the op's sequence number, starting at 1, and is
968 displayed in base 36 by default. This rendering is in -exec (i.e.
971 The symbol between angle brackets indicates the op's type, for
972 example; <2> is a BINOP, <@> a LISTOP, and <#> is a PADOP, which is
973 used in threaded perls. (see L</"OP class abbreviations">).
975 The opname, as in B<'add[t1]'>, which may be followed by op-specific
976 information in parentheses or brackets (ex B<'[t1]'>).
978 The op-flags (ex B<'sK/2'>) follow, and are described in (L</"OP flags
981 % perl -MO=Concise -e '$a = $b + 42'
982 8 <@> leave[1 ref] vKP/REFC ->(end)
984 2 <;> nextstate(main 1 -e:1) v ->3
985 7 <2> sassign vKS/2 ->8
986 * 5 <2> add[t1] sK/2 ->6
987 - <1> ex-rv2sv sK/1 ->4
989 4 <$> const(IV 42) s ->5
990 - <1> ex-rv2sv sKRM*/1 ->7
993 The default rendering is top-down, so they're not in execution order.
994 This form reflects the way the stack is used to parse and evaluate
995 expressions; the add operates on the two terms below it in the tree.
997 Nullops appear as C<ex-opname>, where I<opname> is an op that has been
998 optimized away by perl. They're displayed with a sequence-number of
999 '-', because they are not executed (they don't appear in previous
1000 example), they're printed here because they reflect the parse.
1002 The arrow points to the sequence number of the next op; they're not
1003 displayed in -exec mode, for obvious reasons.
1005 Note that because this rendering was done on a non-threaded perl, the
1006 PADOPs in the previous examples are now SVOPs, and some (but not all)
1007 of the square brackets have been replaced by round ones. This is a
1008 subtle feature to provide some visual distinction between renderings
1009 on threaded and un-threaded perls.
1014 Arguments that don't start with a hyphen are taken to be the names of
1015 subroutines to print the OPs of; if no such functions are specified,
1016 the main body of the program (outside any subroutines, and not
1017 including use'd or require'd files) is rendered. Passing C<BEGIN>,
1018 C<CHECK>, C<INIT>, or C<END> will cause all of the corresponding
1019 special blocks to be printed.
1021 Options affect how things are rendered (ie printed). They're presented
1022 here by their visual effect, 1st being strongest. They're grouped
1023 according to how they interrelate; within each group the options are
1024 mutually exclusive (unless otherwise stated).
1026 =head2 Options for Opcode Ordering
1028 These options control the 'vertical display' of opcodes. The display
1029 'order' is also called 'mode' elsewhere in this document.
1035 Print OPs in the order they appear in the OP tree (a preorder
1036 traversal, starting at the root). The indentation of each OP shows its
1037 level in the tree, and the '->' at the end of the line indicates the
1038 next opcode in execution order. This mode is the default, so the flag
1039 is included simply for completeness.
1043 Print OPs in the order they would normally execute (for the majority
1044 of constructs this is a postorder traversal of the tree, ending at the
1045 root). In most cases the OP that usually follows a given OP will
1046 appear directly below it; alternate paths are shown by indentation. In
1047 cases like loops when control jumps out of a linear path, a 'goto'
1052 Print OPs in a text approximation of a tree, with the root of the tree
1053 at the left and 'left-to-right' order of children transformed into
1054 'top-to-bottom'. Because this mode grows both to the right and down,
1055 it isn't suitable for large programs (unless you have a very wide
1060 =head2 Options for Line-Style
1062 These options select the line-style (or just style) used to render
1063 each opcode, and dictates what info is actually printed into each line.
1069 Use the author's favorite set of formatting conventions. This is the
1074 Use formatting conventions that emulate the output of B<B::Terse>. The
1075 basic mode is almost indistinguishable from the real B<B::Terse>, and the
1076 exec mode looks very similar, but is in a more logical order and lacks
1077 curly brackets. B<B::Terse> doesn't have a tree mode, so the tree mode
1078 is only vaguely reminiscent of B<B::Terse>.
1082 Use formatting conventions in which the name of each OP, rather than being
1083 written out in full, is represented by a one- or two-character abbreviation.
1084 This is mainly a joke.
1088 Use formatting conventions reminiscent of B<B::Debug>; these aren't
1089 very concise at all.
1093 Use formatting conventions read from the environment variables
1094 C<B_CONCISE_FORMAT>, C<B_CONCISE_GOTO_FORMAT>, and C<B_CONCISE_TREE_FORMAT>.
1098 =head2 Options for tree-specific formatting
1104 Use a tree format in which the minimum amount of space is used for the
1105 lines connecting nodes (one character in most cases). This squeezes out
1106 a few precious columns of screen real estate.
1110 Use a tree format that uses longer edges to separate OP nodes. This format
1111 tends to look better than the compact one, especially in ASCII, and is
1116 Use tree connecting characters drawn from the VT100 line-drawing set.
1117 This looks better if your terminal supports it.
1121 Draw the tree with standard ASCII characters like C<+> and C<|>. These don't
1122 look as clean as the VT100 characters, but they'll work with almost any
1123 terminal (or the horizontal scrolling mode of less(1)) and are suitable
1124 for text documentation or email. This is the default.
1128 These are pairwise exclusive, i.e. compact or loose, vt or ascii.
1130 =head2 Options controlling sequence numbering
1136 Print OP sequence numbers in base I<n>. If I<n> is greater than 10, the
1137 digit for 11 will be 'a', and so on. If I<n> is greater than 36, the digit
1138 for 37 will be 'A', and so on until 62. Values greater than 62 are not
1139 currently supported. The default is 36.
1143 Print sequence numbers with the most significant digit first. This is the
1144 usual convention for Arabic numerals, and the default.
1146 =item B<-littleendian>
1148 Print seqence numbers with the least significant digit first. This is
1149 obviously mutually exclusive with bigendian.
1153 =head2 Other options
1155 These are pairwise exclusive.
1161 Include the main program in the output, even if subroutines were also
1162 specified. This rendering is normally suppressed when a subroutine
1163 name or reference is given.
1167 This restores the default behavior after you've changed it with '-main'
1168 (it's not normally needed). If no subroutine name/ref is given, main is
1169 rendered, regardless of this flag.
1173 Renderings usually include a banner line identifying the function name
1174 or stringified subref. This suppresses the printing of the banner.
1176 TBC: Remove the stringified coderef; while it provides a 'cookie' for
1177 each function rendered, the cookies used should be 1,2,3.. not a
1178 random hex-address. It also complicates string comparison of two
1183 restores default banner behavior.
1185 =item B<-banneris> => subref
1187 TBC: a hookpoint (and an option to set it) for a user-supplied
1188 function to produce a banner appropriate for users needs. It's not
1189 ideal, because the rendering-state variables, which are a natural
1190 candidate for use in concise.t, are unavailable to the user.
1194 =head2 Option Stickiness
1196 If you invoke Concise more than once in a program, you should know that
1197 the options are 'sticky'. This means that the options you provide in
1198 the first call will be remembered for the 2nd call, unless you
1199 re-specify or change them.
1201 =head1 ABBREVIATIONS
1203 The concise style uses symbols to convey maximum info with minimal
1204 clutter (like hex addresses). With just a little practice, you can
1205 start to see the flowers, not just the branches, in the trees.
1207 =head2 OP class abbreviations
1209 These symbols appear before the op-name, and indicate the
1210 B:: namespace that represents the ops in your Perl code.
1212 0 OP (aka BASEOP) An OP with no children
1213 1 UNOP An OP with one child
1214 2 BINOP An OP with two children
1215 | LOGOP A control branch OP
1216 @ LISTOP An OP that could have lots of children
1217 / PMOP An OP with a regular expression
1218 $ SVOP An OP with an SV
1219 " PVOP An OP with a string
1220 { LOOP An OP that holds pointers for a loop
1221 ; COP An OP that marks the start of a statement
1222 # PADOP An OP with a GV on the pad
1224 =head2 OP flags abbreviations
1226 OP flags are either public or private. The public flags alter the
1227 behavior of each opcode in consistent ways, and are represented by 0
1228 or more single characters.
1230 v OPf_WANT_VOID Want nothing (void context)
1231 s OPf_WANT_SCALAR Want single value (scalar context)
1232 l OPf_WANT_LIST Want list of any length (list context)
1234 K OPf_KIDS There is a firstborn child.
1235 P OPf_PARENS This operator was parenthesized.
1236 (Or block needs explicit scope entry.)
1237 R OPf_REF Certified reference.
1238 (Return container, not containee).
1239 M OPf_MOD Will modify (lvalue).
1240 S OPf_STACKED Some arg is arriving on the stack.
1241 * OPf_SPECIAL Do something weird for this op (see op.h)
1243 Private flags, if any are set for an opcode, are displayed after a '/'
1245 8 <@> leave[1 ref] vKP/REFC ->(end)
1246 7 <2> sassign vKS/2 ->8
1248 They're opcode specific, and occur less often than the public ones, so
1249 they're represented by short mnemonics instead of single-chars; see
1250 F<op.h> for gory details, or try this quick 2-liner:
1252 $> perl -MB::Concise -de 1
1253 DB<1> |x \%B::Concise::priv
1255 =head1 FORMATTING SPECIFICATIONS
1257 For each line-style ('concise', 'terse', 'linenoise', etc.) there are
1258 3 format-specs which control how OPs are rendered.
1260 The first is the 'default' format, which is used in both basic and exec
1261 modes to print all opcodes. The 2nd, goto-format, is used in exec
1262 mode when branches are encountered. They're not real opcodes, and are
1263 inserted to look like a closing curly brace. The tree-format is tree
1266 When a line is rendered, the correct format-spec is copied and scanned
1267 for the following items; data is substituted in, and other
1268 manipulations like basic indenting are done, for each opcode rendered.
1270 There are 3 kinds of items that may be populated; special patterns,
1271 #vars, and literal text, which is copied verbatim. (Yes, it's a set
1274 =head2 Special Patterns
1276 These items are the primitives used to perform indenting, and to
1277 select text from amongst alternatives.
1281 =item B<(x(>I<exec_text>B<;>I<basic_text>B<)x)>
1283 Generates I<exec_text> in exec mode, or I<basic_text> in basic mode.
1285 =item B<(*(>I<text>B<)*)>
1287 Generates one copy of I<text> for each indentation level.
1289 =item B<(*(>I<text1>B<;>I<text2>B<)*)>
1291 Generates one fewer copies of I<text1> than the indentation level, followed
1292 by one copy of I<text2> if the indentation level is more than 0.
1294 =item B<(?(>I<text1>B<#>I<var>I<Text2>B<)?)>
1296 If the value of I<var> is true (not empty or zero), generates the
1297 value of I<var> surrounded by I<text1> and I<Text2>, otherwise
1302 Any number of tildes and surrounding whitespace will be collapsed to
1309 These #vars represent opcode properties that you may want as part of
1310 your rendering. The '#' is intended as a private sigil; a #var's
1311 value is interpolated into the style-line, much like "read $this".
1313 These vars take 3 forms:
1319 A property named 'var' is assumed to exist for the opcodes, and is
1320 interpolated into the rendering.
1322 =item B<#>I<var>I<N>
1324 Generates the value of I<var>, left justified to fill I<N> spaces.
1325 Note that this means while you can have properties 'foo' and 'foo2',
1326 you cannot render 'foo2', but you could with 'foo2a'. You would be
1327 wise not to rely on this behavior going forward ;-)
1331 This ucfirst form of #var generates a tag-value form of itself for
1332 display; it converts '#Var' into a 'Var => #var' style, which is then
1333 handled as described above. (Imp-note: #Vars cannot be used for
1334 conditional-fills, because the => #var transform is done after the check
1339 The following variables are 'defined' by B::Concise; when they are
1340 used in a style, their respective values are plugged into the
1341 rendering of each opcode.
1343 Only some of these are used by the standard styles, the others are
1344 provided for you to delve into optree mechanics, should you wish to
1345 add a new style (see L</add_style> below) that uses them. You can
1346 also add new ones using L</add_callback>.
1352 The address of the OP, in hexadecimal.
1356 The OP-specific information of the OP (such as the SV for an SVOP, the
1357 non-local exit pointers for a LOOP, etc.) enclosed in parentheses.
1361 The B-determined class of the OP, in all caps.
1365 A single symbol abbreviating the class of the OP.
1369 The label of the statement or block the OP is the start of, if any.
1373 The name of the OP, or 'ex-foo' if the OP is a null that used to be a foo.
1377 The target of the OP, or nothing for a nulled OP.
1381 The address of the OP's first child, in hexadecimal.
1385 The OP's flags, abbreviated as a series of symbols.
1389 The numeric value of the OP's flags.
1393 The sequence number of the OP, or a hyphen if it doesn't have one.
1397 'NEXT', 'LAST', or 'REDO' if the OP is a target of one of those in exec
1398 mode, or empty otherwise.
1402 The address of the OP's last child, in hexadecimal.
1410 The OP's name, in all caps.
1414 The sequence number of the OP's next OP.
1418 The address of the OP's next OP, in hexadecimal.
1422 A one- or two-character abbreviation for the OP's name.
1426 The OP's private flags, rendered with abbreviated names if possible.
1430 The numeric value of the OP's private flags.
1434 The sequence number of the OP. Note that this is a sequence number
1435 generated by B::Concise.
1439 5.8.x and earlier only. 5.9 and later do not provide this.
1441 The real sequence number of the OP, as a regular number and not adjusted
1442 to be relative to the start of the real program. (This will generally be
1443 a fairly large number because all of B<B::Concise> is compiled before
1448 Whether or not the op has been optimised by the peephole optimiser.
1450 Only available in 5.9 and later.
1454 Whether or not the op is statically defined. This flag is used by the
1455 B::C compiler backend and indicates that the op should not be freed.
1457 Only available in 5.9 and later.
1461 The address of the OP's next youngest sibling, in hexadecimal.
1465 The address of the OP's SV, if it has an SV, in hexadecimal.
1469 The class of the OP's SV, if it has one, in all caps (e.g., 'IV').
1473 The value of the OP's SV, if it has one, in a short human-readable format.
1477 The numeric value of the OP's targ.
1481 The name of the variable the OP's targ refers to, if any, otherwise the
1482 letter t followed by the OP's targ in decimal.
1484 =item B<#targarglife>
1486 Same as B<#targarg>, but followed by the COP sequence numbers that delimit
1487 the variable's lifetime (or 'end' for a variable in an open scope) for a
1492 The numeric value of the OP's type, in decimal.
1496 =head1 Using B::Concise outside of the O framework
1498 The common (and original) usage of B::Concise was for command-line
1499 renderings of simple code, as given in EXAMPLE. But you can also use
1500 B<B::Concise> from your code, and call compile() directly, and
1501 repeatedly. By doing so, you can avoid the compile-time only
1502 operation of O.pm, and even use the debugger to step through
1503 B::Concise::compile() itself.
1505 Once you're doing this, you may alter Concise output by adding new
1506 rendering styles, and by optionally adding callback routines which
1507 populate new variables, if such were referenced from those (just
1510 =head2 Example: Altering Concise Renderings
1512 use B::Concise qw(set_style add_callback);
1513 add_style($yourStyleName => $defaultfmt, $gotofmt, $treefmt);
1516 my ($h, $op, $format, $level, $stylename) = @_;
1517 $h->{variable} = some_func($op);
1519 $walker = B::Concise::compile(@options,@subnames,@subrefs);
1524 B<set_style> accepts 3 arguments, and updates the three format-specs
1525 comprising a line-style (basic-exec, goto, tree). It has one minor
1526 drawback though; it doesn't register the style under a new name. This
1527 can become an issue if you render more than once and switch styles.
1528 Thus you may prefer to use add_style() and/or set_style_standard()
1531 =head2 set_style_standard($name)
1533 This restores one of the standard line-styles: C<terse>, C<concise>,
1534 C<linenoise>, C<debug>, C<env>, into effect. It also accepts style
1535 names previously defined with add_style().
1539 This subroutine accepts a new style name and three style arguments as
1540 above, and creates, registers, and selects the newly named style. It is
1541 an error to re-add a style; call set_style_standard() to switch between
1544 =head2 add_callback()
1546 If your newly minted styles refer to any new #variables, you'll need
1547 to define a callback subroutine that will populate (or modify) those
1548 variables. They are then available for use in the style you've
1551 The callbacks are called for each opcode visited by Concise, in the
1552 same order as they are added. Each subroutine is passed five
1555 1. A hashref, containing the variable names and values which are
1556 populated into the report-line for the op
1557 2. the op, as a B<B::OP> object
1558 3. a reference to the format string
1559 4. the formatting (indent) level
1560 5. the selected stylename
1562 To define your own variables, simply add them to the hash, or change
1563 existing values if you need to. The level and format are passed in as
1564 references to scalars, but it is unlikely that they will need to be
1565 changed or even used.
1567 =head2 Running B::Concise::compile()
1569 B<compile> accepts options as described above in L</OPTIONS>, and
1570 arguments, which are either coderefs, or subroutine names.
1572 It constructs and returns a $treewalker coderef, which when invoked,
1573 traverses, or walks, and renders the optrees of the given arguments to
1574 STDOUT. You can reuse this, and can change the rendering style used
1575 each time; thereafter the coderef renders in the new style.
1577 B<walk_output> lets you change the print destination from STDOUT to
1578 another open filehandle, or into a string passed as a ref (unless
1579 you've built perl with -Uuseperlio).
1581 my $walker = B::Concise::compile('-terse','aFuncName', \&aSubRef); # 1
1582 walk_output(\my $buf);
1583 $walker->(); # 1 renders -terse
1584 set_style_standard('concise'); # 2
1585 $walker->(); # 2 renders -concise
1586 $walker->(@new); # 3 renders whatever
1587 print "3 different renderings: terse, concise, and @new: $buf\n";
1589 When $walker is called, it traverses the subroutines supplied when it
1590 was created, and renders them using the current style. You can change
1591 the style afterwards in several different ways:
1593 1. call C<compile>, altering style or mode/order
1594 2. call C<set_style_standard>
1595 3. call $walker, passing @new options
1597 Passing new options to the $walker is the easiest way to change
1598 amongst any pre-defined styles (the ones you add are automatically
1599 recognized as options), and is the only way to alter rendering order
1600 without calling compile again. Note however that rendering state is
1601 still shared amongst multiple $walker objects, so they must still be
1602 used in a coordinated manner.
1604 =head2 B::Concise::reset_sequence()
1606 This function (not exported) lets you reset the sequence numbers (note
1607 that they're numbered arbitrarily, their goal being to be human
1608 readable). Its purpose is mostly to support testing, i.e. to compare
1609 the concise output from two identical anonymous subroutines (but
1610 different instances). Without the reset, B::Concise, seeing that
1611 they're separate optrees, generates different sequence numbers in
1616 Errors in rendering (non-existent function-name, non-existent coderef)
1617 are written to the STDOUT, or wherever you've set it via
1620 Errors using the various *style* calls, and bad args to walk_output(),
1621 result in die(). Use an eval if you wish to catch these errors and
1622 continue processing.
1626 Stephen McCamant, E<lt>smcc@CSUA.Berkeley.EDUE<gt>.