This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
B::Concise -- an improved replacement for B::Terse
[perl5.git] / ext / B / B / Concise.pm
CommitLineData
c99ca59a
SM
1package B::Concise;
2# Copyright (C) 2000, 2001 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
6our $VERSION = "0.50";
7use strict;
8use B qw(class ppname main_start main_root main_cv cstring svref_2object
9 SVf_IOK SVf_NOK SVf_POK OPf_KIDS);
10
11my %style =
12 ("terse" =>
13 ["(?(#label =>\n)?)(*( )*)#class (#addr) pp_#name "
14 . "(?([#targ])?) #svclass~(?((#svaddr))?)~#svval\n",
15 "(*( )*)goto #class (#addr)\n",
16 "#class pp_#name"],
17 "concise" =>
18 ["#hyphseq2 (*( (x( ;)x))*)<#classsym> "
19 . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x)\n",
20 " (*( )*) goto #seq\n",
21 "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"],
22 "linenoise" =>
23 ["(x(;(*( )*))x)#noise#arg(?([#targarg])?)(x( ;\n)x)",
24 "gt_#seq ",
25 "(?(#seq)?)#noise#arg(?([#targarg])?)"],
26 "debug" =>
27 ["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t"
28 . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n\top_seq\t\t"
29 . "#seqnum\n\top_flags\t#flagval\n\top_private\t#privval\n"
30 . "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)"
31 . "(?(\top_sv\t\t#svaddr\n)?)",
32 " GOTO #addr\n",
33 "#addr"],
34 "env" => [$ENV{B_CONCISE_FORMAT}, $ENV{B_CONCISE_GOTO_FORMAT},
35 $ENV{B_CONCISE_TREE_FORMAT}],
36 );
37
38my($format, $gotofmt, $treefmt);
39my $curcv;
40my($seq_base, $cop_seq_base);
41
42sub concise_cv {
43 my ($order, $cvref) = @_;
44 my $cv = svref_2object($cvref);
45 $curcv = $cv;
46 if ($order eq "exec") {
47 walk_exec($cv->START);
48 } elsif ($order eq "basic") {
49 walk_topdown($cv->ROOT, sub { $_[0]->concise($_[1]) }, 0);
50 } else {
51 print tree($cv->ROOT, 0)
52 }
53}
54
55my $start_sym = "\e(0"; # "\cN" sometimes also works
56my $end_sym = "\e(B"; # "\cO" respectively
57
58my @tree_decorations =
59 ([" ", "--", "+-", "|-", "| ", "`-", "-", 1],
60 [" ", "-", "+", "+", "|", "`", "", 0],
61 [" ", map("$start_sym$_$end_sym", "qq", "wq", "tq", "x ", "mq", "q"), 1],
62 [" ", map("$start_sym$_$end_sym", "q", "w", "t", "x", "m"), "", 0],
63 );
64my $tree_style = 0;
65
66my $base = 36;
67my $big_endian = 1;
68
69my $order = "basic";
70
71sub compile {
72 my @options = grep(/^-/, @_);
73 my @args = grep(!/^-/, @_);
74 my $do_main = 0;
75 ($format, $gotofmt, $treefmt) = @{$style{"concise"}};
76 for my $o (@options) {
77 if ($o eq "-basic") {
78 $order = "basic";
79 } elsif ($o eq "-exec") {
80 $order = "exec";
81 } elsif ($o eq "-tree") {
82 $order = "tree";
83 } elsif ($o eq "-compact") {
84 $tree_style |= 1;
85 } elsif ($o eq "-loose") {
86 $tree_style &= ~1;
87 } elsif ($o eq "-vt") {
88 $tree_style |= 2;
89 } elsif ($o eq "-ascii") {
90 $tree_style &= ~2;
91 } elsif ($o eq "-main") {
92 $do_main = 1;
93 } elsif ($o =~ /^-base(\d+)$/) {
94 $base = $1;
95 } elsif ($o eq "-bigendian") {
96 $big_endian = 1;
97 } elsif ($o eq "-littleendian") {
98 $big_endian = 0;
99 } elsif (exists $style{substr($o, 1)}) {
100 ($format, $gotofmt, $treefmt) = @{$style{substr($o, 1)}};
101 } else {
102 warn "Option $o unrecognized";
103 }
104 }
105 if (@args) {
106 return sub {
107 for my $objname (@args) {
108 $objname = "main::" . $objname unless $objname =~ /::/;
109 eval "concise_cv(\$order, \\&$objname)";
110 die "concise_cv($order, \\&$objname) failed: $@" if $@;
111 }
112 }
113 }
114 if (!@args or $do_main) {
115 if ($order eq "exec") {
116 return sub { return if class(main_start) eq "NULL";
117 $curcv = main_cv;
118 walk_exec(main_start) }
119 } elsif ($order eq "tree") {
120 return sub { return if class(main_root) eq "NULL";
121 $curcv = main_cv;
122 print tree(main_root, 0) }
123 } elsif ($order eq "basic") {
124 return sub { return if class(main_root) eq "NULL";
125 $curcv = main_cv;
126 walk_topdown(main_root,
127 sub { $_[0]->concise($_[1]) }, 0); }
128 }
129 }
130}
131
132my %labels;
133my $lastnext;
134
135my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|",
136 'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*",
137 'PVOP' => '"', 'LOOP' => "{", 'COP' => ";");
138
139my @linenoise =
140 qw'# () sc ( @? 1 $* gv *{ m$ m@ m% m? p/ *$ $ $# & a& pt \\ s\\ rf bl
141 ` *? <> ?? ?/ r/ c/ // qr s/ /c y/ = @= C sC Cp sp df un BM po +1 +I
142 -1 -I 1+ I+ 1- I- ** * i* / i/ %$ i% x + i+ - i- . " << >> < i<
143 > i> <= i, >= i. == i= != i! <? i? s< s> s, s. s= s! s? b& b^ b| -0 -i
144 ! ~ a2 si cs rd sr e^ lg sq in %x %o ab le ss ve ix ri sf FL od ch cy
145 uf lf uc lc qm @ [f [ @[ eh vl ky dl ex % ${ @{ uk pk st jn ) )[ a@
146 a% sl +] -] [- [+ so rv GS GW MS MW .. f. .f && || ^^ ?: &= |= -> s{ s}
147 v} ca wa di rs ;; ; ;d }{ { } {} f{ it {l l} rt }l }n }r dm }g }e ^o
148 ^c ^| ^# um bm t~ u~ ~d DB db ^s se ^g ^r {w }w pf pr ^O ^K ^R ^W ^d ^v
149 ^e ^t ^k t. fc ic fl .s .p .b .c .l .a .h g1 s1 g2 s2 ?. l? -R -W -X -r
150 -w -x -e -o -O -z -s -M -A -C -S -c -b -f -d -p -l -u -g -k -t -T -B cd
151 co cr u. cm ut r. l@ s@ r@ mD uD oD rD tD sD wD cD f$ w$ p$ sh e$ k$ g3
152 g4 s4 g5 s5 T@ C@ L@ G@ A@ S@ Hg Hc Hr Hw Mg Mc Ms Mr Sg Sc So rq do {e
153 e} {t t} g6 G6 6e g7 G7 7e g8 G8 8e g9 G9 9e 6s 7s 8s 9s 6E 7E 8E 9E Pn
154 Pu GP SP EP Gn Gg GG SG EG g0 c$ lk t$ ;s n>';
155
156my $chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
157
158sub op_flags {
159 my($x) = @_;
160 my(@v);
161 push @v, "v" if ($x & 3) == 1;
162 push @v, "s" if ($x & 3) == 2;
163 push @v, "l" if ($x & 3) == 3;
164 push @v, "K" if $x & 4;
165 push @v, "P" if $x & 8;
166 push @v, "R" if $x & 16;
167 push @v, "M" if $x & 32;
168 push @v, "S" if $x & 64;
169 push @v, "*" if $x & 128;
170 return join("", @v);
171}
172
173sub base_n {
174 my $x = shift;
175 return "-" . base_n(-$x) if $x < 0;
176 my $str = "";
177 do { $str .= substr($chars, $x % $base, 1) } while $x = int($x / $base);
178 $str = reverse $str if $big_endian;
179 return $str;
180}
181
182sub seq { return $_[0]->seq ? base_n($_[0]->seq - $seq_base) : "-" }
183
184sub walk_topdown {
185 my($op, $sub, $level) = @_;
186 $sub->($op, $level);
187 if ($op->flags & OPf_KIDS) {
188 for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
189 walk_topdown($kid, $sub, $level + 1);
190 }
191 }
192 if (class($op) eq "PMOP" and $ {$op->pmreplroot}) {
193 walk_topdown($op->pmreplroot, $sub, $level + 1);
194 }
195}
196
197sub walklines {
198 my($ar, $level) = @_;
199 for my $l (@$ar) {
200 if (ref($l) eq "ARRAY") {
201 walklines($l, $level + 1);
202 } else {
203 $l->concise($level);
204 }
205 }
206}
207
208sub walk_exec {
209 my($top, $level) = @_;
210 my %opsseen;
211 my @lines;
212 my @todo = ([$top, \@lines]);
213 while (@todo and my($op, $targ) = @{shift @todo}) {
214 for (; $$op; $op = $op->next) {
215 last if $opsseen{$$op}++;
216 push @$targ, $op;
217 my $name = $op->name;
218 if ($name
219 =~ /^(or|and|(map|grep)while|entertry|range|cond_expr)$/) {
220 my $ar = [];
221 push @$targ, $ar;
222 push @todo, [$op->other, $ar];
223 } elsif ($name eq "subst" and $ {$op->pmreplstart}) {
224 my $ar = [];
225 push @$targ, $ar;
226 push @todo, [$op->pmreplstart, $ar];
227 } elsif ($name =~ /^enter(loop|iter)$/) {
228 $labels{$op->nextop->seq} = "NEXT";
229 $labels{$op->lastop->seq} = "LAST";
230 $labels{$op->redoop->seq} = "REDO";
231 }
232 }
233 }
234 walklines(\@lines, 0);
235}
236
237sub fmt_line {
238 my($hr, $fmt, $level) = @_;
239 my $text = $fmt;
240 $text =~ s/\(\?\(([^\#]*?)\#(\w+)([^\#]*?)\)\?\)/
241 $hr->{$2} ? $1.$hr->{$2}.$3 : ""/eg;
242 $text =~ s/\(x\((.*?);(.*?)\)x\)/$order eq "exec" ? $1 : $2/egs;
243 $text =~ s/\(\*\(([^;]*?)\)\*\)/$1 x $level/egs;
244 $text =~ s/\(\*\((.*?);(.*?)\)\*\)/$1 x ($level - 1) . $2 x ($level>0)/egs;
245 $text =~ s/#([a-zA-Z]+)(\d+)/sprintf("%-$2s", $hr->{$1})/eg;
246 $text =~ s/#([a-zA-Z]+)/$hr->{$1}/eg;
247 $text =~ s/[ \t]*~+[ \t]*/ /g;
248 return $text;
249}
250
251my %priv;
252$priv{$_}{128} = "LVINTRO"
253 for ("pos", "substr", "vec", "threadsv", "gvsv", "rv2sv", "rv2hv", "rv2gv",
254 "rv2av", "rv2arylen", "aelem", "helem", "aslice", "hslice", "padsv",
255 "padav", "padhv");
256$priv{$_}{64} = "REFC" for ("leave", "leavesub", "leavesublv", "leavewrite");
257$priv{"aassign"}{64} = "COMMON";
258$priv{"aassign"}{32} = "PHASH";
259$priv{"sassign"}{64} = "BKWARD";
260$priv{$_}{64} = "RTIME" for ("match", "subst", "substcont");
261@{$priv{"trans"}}{1,2,4,8,16,64} = ("<UTF", ">UTF", "IDENT", "SQUASH", "DEL",
262 "COMPL", "GROWS");
263$priv{"repeat"}{64} = "DOLIST";
264$priv{"leaveloop"}{64} = "CONT";
265@{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV")
266 for ("entersub", map("rv2${_}v", "a", "s", "h", "g"), "aelem", "helem");
267$priv{"entersub"}{16} = "DBG";
268$priv{"entersub"}{32} = "TARG";
269@{$priv{$_}}{4,8,128} = ("INARGS","AMPER","NO()") for ("entersub", "rv2cv");
270$priv{"gv"}{32} = "EARLYCV";
271$priv{"aelem"}{16} = $priv{"helem"}{16} = "LVDEFER";
272$priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv");
273$priv{$_}{16} = "TARGMY"
274 for (map(($_,"s$_"),"chop", "chomp"),
275 map(($_,"i_$_"), "postinc", "postdec", "multiply", "divide", "modulo",
276 "add", "subtract", "negate"), "pow", "concat", "stringify",
277 "left_shift", "right_shift", "bit_and", "bit_xor", "bit_or",
278 "complement", "atan2", "sin", "cos", "rand", "exp", "log", "sqrt",
279 "int", "hex", "oct", "abs", "length", "index", "rindex", "sprintf",
280 "ord", "chr", "crypt", "quotemeta", "join", "push", "unshift", "flock",
281 "chdir", "chown", "chroot", "unlink", "chmod", "utime", "rename",
282 "link", "symlink", "mkdir", "rmdir", "wait", "waitpid", "system",
283 "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority",
284 "setpriority", "time", "sleep");
285@{$priv{"const"}}{8,16,32,64,128} = ("STRICT","ENTERED", "$[", "BARE", "WARN");
286$priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM";
287$priv{"list"}{64} = "GUESSED";
288$priv{"delete"}{64} = "SLICE";
289$priv{"exists"}{64} = "SUB";
290$priv{$_}{64} = "LOCALE"
291 for ("sort", "prtf", "sprintf", "slt", "sle", "seq", "sne", "sgt", "sge",
292 "scmp", "lc", "uc", "lcfirst", "ucfirst");
293@{$priv{"sort"}}{1,2,4} = ("NUM", "INT", "REV");
294$priv{"threadsv"}{64} = "SVREFd";
295$priv{$_}{16} = "INBIN" for ("open", "backtick");
296$priv{$_}{32} = "INCR" for ("open", "backtick");
297$priv{$_}{64} = "OUTBIN" for ("open", "backtick");
298$priv{$_}{128} = "OUTCR" for ("open", "backtick");
299$priv{"exit"}{128} = "VMS";
300
301sub private_flags {
302 my($name, $x) = @_;
303 my @s;
304 for my $flag (128, 96, 64, 32, 16, 8, 4, 2, 1) {
305 if ($priv{$name}{$flag} and $x & $flag and $x >= $flag) {
306 $x -= $flag;
307 push @s, $priv{$name}{$flag};
308 }
309 }
310 push @s, $x if $x;
311 return join(",", @s);
312}
313
314sub concise_op {
315 my ($op, $level, $format) = @_;
316 my %h;
317 $h{exname} = $h{name} = $op->name;
318 $h{NAME} = uc $h{name};
319 $h{class} = class($op);
320 $h{extarg} = $h{targ} = $op->targ;
321 $h{extarg} = "" unless $h{extarg};
322 if ($h{name} eq "null" and $h{targ}) {
323 $h{exname} = "ex-" . substr(ppname($h{targ}), 3);
324 $h{extarg} = "";
325 } elsif ($h{targ}) {
326 my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}];
327 if (defined $padname and class($padname) ne "SPECIAL") {
328 $h{targarg} = $padname->PV;
329 my $intro = $padname->NVX - $cop_seq_base;
330 my $finish = int($padname->IVX) - $cop_seq_base;
331 $finish = "end" if $finish == 999999999 - $cop_seq_base;
332 $h{targarglife} = "$h{targarg}:$intro,$finish";
333 } else {
334 $h{targarglife} = $h{targarg} = "t" . $h{targ};
335 }
336 }
337 $h{arg} = "";
338 $h{svclass} = $h{svaddr} = $h{svval} = "";
339 if ($h{class} eq "PMOP") {
340 my $precomp = $op->precomp;
341 $precomp = defined($precomp) ? "/$precomp/" : "";
342 my $pmreplstart;
343 if ($ {$op->pmreplstart}) {
344 undef $lastnext;
345 $pmreplstart = "replstart->" . seq($op->pmreplstart);
346 $h{arg} = "(" . join(" ", $precomp, $pmreplstart) . ")";
347 } else {
348 $h{arg} = "($precomp)";
349 }
350 } elsif ($h{class} eq "PVOP" and $h{name} ne "trans") {
351 $h{arg} = '("' . $op->pv . '")';
352 $h{svval} = '"' . $op->pv . '"';
353 } elsif ($h{class} eq "COP") {
354 my $label = $op->label;
355 $label = $label ? "$label: " : "";
356 my $loc = $op->file;
357 $loc =~ s[.*/][];
358 $loc .= ":" . $op->line;
359 my($stash, $cseq) = ($op->stash->NAME, $op->cop_seq - $cop_seq_base);
360 my $arybase = $op->arybase;
361 $arybase = $arybase ? ' $[=' . $arybase : "";
362 $h{arg} = "($label$stash $cseq $loc$arybase)";
363 } elsif ($h{class} eq "LOOP") {
364 $h{arg} = "(next->" . seq($op->nextop) . " last->" . seq($op->lastop)
365 . " redo->" . seq($op->redoop) . ")";
366 } elsif ($h{class} eq "LOGOP") {
367 undef $lastnext;
368 $h{arg} = "(other->" . seq($op->other) . ")";
369 } elsif ($h{class} eq "SVOP") {
370 my $sv = $op->sv;
371 $h{svclass} = class($sv);
372 $h{svaddr} = sprintf("%#x", $$sv);
373 if ($h{svclass} eq "GV") {
374 my $gv = $sv;
375 my $stash = $gv->STASH->NAME;
376 if ($stash eq "main") {
377 $stash = "";
378 } else {
379 $stash = $stash . "::";
380 }
381 $h{arg} = "(*$stash" . $gv->NAME . ")";
382 $h{svval} = "*$stash" . $gv->NAME;
383 } else {
384 while (class($sv) eq "RV") {
385 $h{svval} .= "\\";
386 $sv = $sv->RV;
387 }
388 if (class($sv) eq "SPECIAL") {
389 $h{svval} = ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv];
390 } elsif ($sv->FLAGS & SVf_NOK) {
391 $h{svval} = $sv->NV;
392 } elsif ($sv->FLAGS & SVf_IOK) {
393 $h{svval} = $sv->IV;
394 } elsif ($sv->FLAGS & SVf_POK) {
395 $h{svval} = cstring($sv->PV);
396 }
397 $h{arg} = "($h{svclass} $h{svval})";
398 }
399 }
400 $h{seq} = $h{hyphseq} = seq($op);
401 $h{seq} = "" if $h{seq} eq "-";
402 $h{seqnum} = $op->seq;
403 $h{next} = $op->next;
404 $h{next} = (class($h{next}) eq "NULL") ? "(end)" : seq($h{next});
405 $h{nextaddr} = sprintf("%#x", $ {$op->next});
406 $h{sibaddr} = sprintf("%#x", $ {$op->sibling});
407 $h{firstaddr} = sprintf("%#x", $ {$op->first}) if $op->can("first");
408 $h{lastaddr} = sprintf("%#x", $ {$op->last}) if $op->can("last");
409
410 $h{classsym} = $opclass{$h{class}};
411 $h{flagval} = $op->flags;
412 $h{flags} = op_flags($op->flags);
413 $h{privval} = $op->private;
414 $h{private} = private_flags($h{name}, $op->private);
415 $h{addr} = sprintf("%#x", $$op);
416 $h{label} = $labels{$op->seq};
417 $h{typenum} = $op->type;
418 $h{noise} = $linenoise[$op->type];
419 return fmt_line(\%h, $format, $level);
420}
421
422sub B::OP::concise {
423 my($op, $level) = @_;
424 if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
425 my $h = {"seq" => seq($lastnext), "class" => class($lastnext),
426 "addr" => sprintf("%#x", $$lastnext)};
427 print fmt_line($h, $gotofmt, $level+1);
428 }
429 $lastnext = $op->next;
430 print concise_op($op, $level, $format);
431}
432
433sub tree {
434 my $op = shift;
435 my $level = shift;
436 my $style = $tree_decorations[$tree_style];
437 my($space, $single, $kids, $kid, $nokid, $last, $lead, $size) = @$style;
438 my $name = concise_op($op, $level, $treefmt);
439 if (not $op->flags & OPf_KIDS) {
440 return $name . "\n";
441 }
442 my @lines;
443 for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
444 push @lines, tree($kid, $level+1);
445 }
446 my $i;
447 for ($i = $#lines; substr($lines[$i], 0, 1) eq " "; $i--) {
448 $lines[$i] = $space . $lines[$i];
449 }
450 if ($i > 0) {
451 $lines[$i] = $last . $lines[$i];
452 while ($i-- > 1) {
453 if (substr($lines[$i], 0, 1) eq " ") {
454 $lines[$i] = $nokid . $lines[$i];
455 } else {
456 $lines[$i] = $kid . $lines[$i];
457 }
458 }
459 $lines[$i] = $kids . $lines[$i];
460 } else {
461 $lines[0] = $single . $lines[0];
462 }
463 return("$name$lead" . shift @lines,
464 map(" " x (length($name)+$size) . $_, @lines));
465}
466
467# This is a bit of a hack; the 2 and 15 were determined empirically.
468# These need to stay the last things in the module.
469$cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + 2;
470$seq_base = svref_2object(eval 'sub{}')->START->seq + 15;
471
4721;
473
474__END__
475
476=head1 NAME
477
478B::Concise - Walk Perl syntax tree, printing concise info about ops
479
480=head1 SYNOPSIS
481
482 perl -MO=Concise[,OPTIONS] foo.pl
483
484=head1 DESCRIPTION
485
486This compiler backend prints the internal OPs of a Perl program's syntax
487tree in one of several space-efficient text formats suitable for debugging
488the inner workings of perl or other compiler backends. It can print OPs in
489the order they appear in the OP tree, in the order they will execute, or
490in a text approximation to their tree structure, and the format of the
491information displyed is customizable. Its function is similar to that of
492perl's B<-Dx> debugging flag or the B<B::Terse> module, but it is more
493sophisticated and flexible.
494
495=head1 OPTIONS
496
497Arguments that don't start with a hyphen are taken to be the names of
498subroutines to print the OPs of; if no such functions are specified, the
499main body of the program (outside any subroutines, and not including use'd
500or require'd files) is printed.
501
502=over 4
503
504=item B<-basic>
505
506Print OPs in the order they appear in the OP tree (a preorder
507traversal, starting at the root). The indentation of each OP shows its
508level in the tree. This mode is the default, so the flag is included
509simply for completeness.
510
511=item B<-exec>
512
513Print OPs in the order they would normally execute (for the majority
514of constructs this is a postorder traversal of the tree, ending at the
515root). In most cases the OP that usually follows a given OP will
516appear directly below it; alternate paths are shown by indentation. In
517cases like loops when control jumps out of a linear path, a 'goto'
518line is generated.
519
520=item B<-tree>
521
522Print OPs in a text approximation of a tree, with the root of the tree
523at the left and 'left-to-right' order of children transformed into
524'top-to-bottom'. Because this mode grows both to the right and down,
525it isn't suitable for large programs (unless you have a very wide
526terminal).
527
528=item B<-compact>
529
530Use a tree format in which the minimum amount of space is used for the
531lines connecting nodes (one character in most cases). This squeezes out
532a few precious columns of screen real estate.
533
534=item B<-loose>
535
536Use a tree format that uses longer edges to separate OP nodes. This format
537tends to look better than the compact one, especially in ASCII, and is
538the default.
539
540=item B<-vt>
541
542Use tree connecting characters drawn from the VT100 line-drawing set.
543This looks better if your terminal supports it.
544
545=item B<-ascii>
546
547Draw the tree with standard ASCII characters like C<+> and C<|>. These don't
548look as clean as the VT100 characters, but they'll work with almost any
549terminal (or the horizontal scrolling mode of less(1)) and are suitable
550for text documentation or email. This is the default.
551
552=item B<-main>
553
554Include the main program in the output, even if subroutines were also
555specified.
556
557=item B<-base>I<n>
558
559Print OP sequence numbers in base I<n>. If I<n> is greater than 10, the
560digit for 11 will be 'a', and so on. If I<n> is greater than 36, the digit
561for 37 will be 'A', and so on until 62. Values greater than 62 are not
562currently supported. The default is 36.
563
564=item B<-bigendian>
565
566Print sequence numbers with the most significant digit first. This is the
567usual convention for Arabic numerals, and the default.
568
569=item B<-littleendian>
570
571Print seqence numbers with the least significant digit first.
572
573=item B<-concise>
574
575Use the author's favorite set of formatting conventions. This is the
576default, of course.
577
578=item B<-terse>
579
580Use formatting conventions that emulate the ouput of B<B::Terse>. The
581basic mode is almost indistinguishable from the real B<B::Terse>, and the
582exec mode looks very similar, but is in a more logical order and lacks
583curly brackets. B<B::Terse> doesn't have a tree mode, so the tree mode
584is only vaguely reminiscient of B<B::Terse>.
585
586=item B<-linenoise>
587
588Use formatting conventions in which the name of each OP, rather than being
589written out in full, is represented by a one- or two-character abbreviation.
590This is mainly a joke.
591
592=item B<-debug>
593
594Use formatting conventions reminiscient of B<B::Debug>; these aren't
595very concise at all.
596
597=item B<-env>
598
599Use formatting conventions read from the environment variables
600C<B_CONCISE_FORMAT>, C<B_CONCISE_GOTO_FORMAT>, and C<B_CONCISE_TREE_FORMAT>.
601
602=back
603
604=head1 FORMATTING SPECIFICATIONS
605
606For each general style ('concise', 'terse', 'linenoise', etc.) there are
607three specifications: one of how OPs should appear in the basic or exec
608modes, one of how 'goto' lines should appear (these occur in the exec
609mode only), and one of how nodes should appear in tree mode. Each has the
610same format, described below. Any text that doesn't match a special
611pattern is copied verbatim.
612
613=over 4
614
615=item B<(x(>I<exec_text>B<;>I<basic_text>B<)x)>
616
617Generates I<exec_text> in exec mode, or I<basic_text> in basic mode.
618
619=item B<(*(>I<text>B<)*)>
620
621Generates one copy of I<text> for each indentation level.
622
623=item B<(*(>I<text1>B<;>I<text2>B<)*)>
624
625Generates one fewer copies of I<text1> than the indentation level, followed
626by one copy of I<text2> if the indentation level is more than 0.
627
628=item B<(?(>I<text1>B<#>I<var>I<Text2>B<)?)>
629
630If the value of I<var> is true (not empty or zero), generates the
631value of I<var> surrounded by I<text1> and I<Text2>, otherwise
632nothing.
633
634=item B<#>I<var>
635
636Generates the value of the variable I<var>.
637
638=item B<#>I<var>I<N>
639
640Generates the value of I<var>, left jutified to fill I<N> spaces.
641
642=item B<~>
643
644Any number of tildes and surrounding whitespace will be collapsed to
645a single space.
646
647=back
648
649The following variables are recognized:
650
651=over 4
652
653=item B<#addr>
654
655The address of the OP, in hexidecimal.
656
657=item B<#arg>
658
659The OP-specific information of the OP (such as the SV for an SVOP, the
660non-local exit pointers for a LOOP, etc.) enclosed in paretheses.
661
662=item B<#class>
663
664The B-determined class of the OP, in all caps.
665
666=item B<#classym>
667
668A single symbol abbreviating the class of the OP.
669
670=item B<#exname>
671
672The name of the OP, or 'ex-foo' if the OP is a null that used to be a foo.
673
674=item B<#extarg>
675
676The target of the OP, or nothing for a nulled OP.
677
678=item B<#firstaddr>
679
680The address of the OP's first child, in hexidecimal.
681
682=item B<#flags>
683
684The OP's flags, abbreviated as a series of symbols.
685
686=item B<#flagval>
687
688The numeric value of the OP's flags.
689
690=item B<#hyphenseq>
691
692The sequence number of the OP, or a hyphen if it doesn't have one.
693
694=item B<#label>
695
696'NEXT', 'LAST', or 'REDO' if the OP is a target of one of those in exec
697mode, or empty otherwise.
698
699=item B<#lastaddr>
700
701The address of the OP's last child, in hexidecimal.
702
703=item B<#name>
704
705The OP's name.
706
707=item B<#NAME>
708
709The OP's name, in all caps.
710
711=item B<#next>
712
713The sequence number of the OP's next OP.
714
715=item B<#nextaddr>
716
717The address of the OP's next OP, in hexidecimal.
718
719=item B<#noise>
720
721The two-character abbreviation for the OP's name.
722
723=item B<#private>
724
725The OP's private flags, rendered with abbreviated names if possible.
726
727=item B<#privval>
728
729The numeric value of the OP's private flags.
730
731=item B<#seq>
732
733The sequence number of the OP.
734
735=item B<#seqnum>
736
737The real sequence number of the OP, as a regular number and not adjusted
738to be relative to the start of the real program. (This will generally be
739a fairly large number because all of B<B::Concise> is compiled before
740your program is).
741
742=item B<#sibaddr>
743
744The address of the OP's next youngest sibling, in hexidecimal.
745
746=item B<#svaddr>
747
748The address of the OP's SV, if it has an SV, in hexidecimal.
749
750=item B<#svclass>
751
752The class of the OP's SV, if it has one, in all caps (e.g., 'IV').
753
754=item B<#svval>
755
756The value of the OP's SV, if it has one, in a short human-readable format.
757
758=item B<#targ>
759
760The numeric value of the OP's targ.
761
762=item B<#targarg>
763
764The name of the variable the OP's targ refers to, if any, otherwise the
765letter t followed by the OP's targ in decimal.
766
767=item B<#targarglife>
768
769Same as B<#targarg>, but followed by the COP sequence numbers that delimit
770the variable's lifetime (or 'end' for a variable in an open scope) for a
771variable.
772
773=item B<#typenum>
774
775The numeric value of the OP's type, in decimal.
776
777=back
778
779=head1 ABBREVIATIONS
780
781=head2 OP flags abbreviations
782
783 v OPf_WANT_VOID Want nothing (void context)
784 s OPf_WANT_SCALAR Want single value (scalar context)
785 l OPf_WANT_LIST Want list of any length (list context)
786 K OPf_KIDS There is a firstborn child.
787 P OPf_PARENS This operator was parenthesized.
788 (Or block needs explicit scope entry.)
789 R OPf_REF Certified reference.
790 (Return container, not containee).
791 M OPf_MOD Will modify (lvalue).
792 S OPf_STACKED Some arg is arriving on the stack.
793 * OPf_SPECIAL Do something weird for this op (see op.h)
794
795=head2 OP class abbreviations
796
797 0 OP (aka BASEOP) An OP with no children
798 1 UNOP An OP with one child
799 2 BINOP An OP with two children
800 | LOGOP A control branch OP
801 @ LISTOP An OP that could have lots of children
802 / PMOP An OP with a regular expression
803 $ SVOP An OP with an SV
804 " PVOP An OP with a string
805 { LOOP An OP that holds pointers for a loop
806 ; COP An OP that marks the start of a statement
807
808=head1 AUTHOR
809
810Stephen McCamant, C<smcc@CSUA.Berkeley.EDU>
811
812=cut