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