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