This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make the ! suffix handle n/N/v/V as signed integers
[perl5.git] / ext / B / B / Concise.pm
CommitLineData
c99ca59a 1package B::Concise;
c27ea44e 2# Copyright (C) 2000-2003 Stephen McCamant. All rights reserved.
c99ca59a
SM
3# This program is free software; you can redistribute and/or modify it
4# under the same terms as Perl itself.
5
8ec8fbef
SM
6# Note: we need to keep track of how many use declarations/BEGIN
7# blocks this module uses, so we can avoid printing them when user
8# asks for the BEGIN blocks in her program. Update the comments and
9# the count in concise_specials if you add or delete one. The
10# -MO=Concise counts as use #1.
78ad9108 11
8ec8fbef
SM
12use strict; # use #2
13use warnings; # uses #3 and #4, since warnings uses Carp
78ad9108 14
8ec8fbef
SM
15use Exporter (); # use #5
16
f95e3c3c 17our $VERSION = "0.60";
78ad9108 18our @ISA = qw(Exporter);
31b49ad4 19our @EXPORT_OK = qw(set_style set_style_standard add_callback
f95e3c3c
JC
20 concise_subref concise_cv concise_main
21 add_style walk_output);
78ad9108 22
8ec8fbef 23# use #6
c99ca59a 24use B qw(class ppname main_start main_root main_cv cstring svref_2object
6a077020
DM
25 SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL
26 CVf_ANON);
c99ca59a 27
f95e3c3c 28my %style =
c99ca59a 29 ("terse" =>
c3caa09d
SM
30 ["(?(#label =>\n)?)(*( )*)#class (#addr) #name (?([#targ])?) "
31 . "#svclass~(?((#svaddr))?)~#svval~(?(label \"#coplabel\")?)\n",
c99ca59a
SM
32 "(*( )*)goto #class (#addr)\n",
33 "#class pp_#name"],
34 "concise" =>
35 ["#hyphseq2 (*( (x( ;)x))*)<#classsym> "
36 . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x)\n",
37 " (*( )*) goto #seq\n",
38 "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"],
39 "linenoise" =>
40 ["(x(;(*( )*))x)#noise#arg(?([#targarg])?)(x( ;\n)x)",
41 "gt_#seq ",
42 "(?(#seq)?)#noise#arg(?([#targarg])?)"],
43 "debug" =>
44 ["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t"
2814eb74
PJ
45 . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n"
46 . "\top_flags\t#flagval\n\top_private\t#privval\n"
c99ca59a
SM
47 . "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)"
48 . "(?(\top_sv\t\t#svaddr\n)?)",
49 " GOTO #addr\n",
50 "#addr"],
51 "env" => [$ENV{B_CONCISE_FORMAT}, $ENV{B_CONCISE_GOTO_FORMAT},
52 $ENV{B_CONCISE_TREE_FORMAT}],
53 );
54
55my($format, $gotofmt, $treefmt);
56my $curcv;
c27ea44e 57my $cop_seq_base;
78ad9108 58my @callbacks;
f95e3c3c 59my $stylename;
78ad9108
PJ
60
61sub set_style {
62 ($format, $gotofmt, $treefmt) = @_;
f95e3c3c
JC
63 die "expecting 3 style-format args\n" unless @_ == 3;
64}
65
66sub add_style {
67 my ($newstyle,@args) = @_;
68 die "style '$newstyle' already exists, choose a new name\n"
69 if exists $style{$newstyle};
70 die "expecting 3 style-format args\n" unless @args == 3;
71 $style{$newstyle} = [@args];
78ad9108
PJ
72}
73
31b49ad4 74sub set_style_standard {
f95e3c3c
JC
75 ($stylename) = @_;
76 die "err: style '$stylename' unknown\n" unless exists $style{$stylename};
77 set_style(@{$style{$stylename}});
31b49ad4
SM
78}
79
78ad9108
PJ
80sub add_callback {
81 push @callbacks, @_;
82}
c99ca59a 83
f95e3c3c
JC
84# output handle, used with all Concise-output printing
85our $walkHandle = \*STDOUT; # public for your convenience
86
87sub walk_output { # updates $walkHandle
88 my $handle = shift;
89 if (ref $handle eq 'SCALAR') {
90 # in 5.8+, open(FILEHANDLE,MODE,REFERENCE) writes to string
91 open my $tmp, '>', $handle; # but cant re-set an existing filehandle
92 $walkHandle = $tmp; # so use my $tmp as intermediate var
93 return;
94 }
95 $walkHandle = $handle;
96 my $iotype = ref $walkHandle;
97 die "expecting argument/object that can print\n"
98 unless $iotype eq 'GLOB' or $iotype and $walkHandle->can('print');
99}
100
8ec8fbef 101sub concise_subref {
f95e3c3c
JC
102 my($order, $coderef) = @_;
103 my $codeobj = svref_2object($coderef);
104 die "err: not a coderef: $coderef\n" unless ref $codeobj eq 'B::CV';#CODE';
105 concise_cv_obj($order, $codeobj);
8ec8fbef
SM
106}
107
108# This should have been called concise_subref, but it was exported
109# under this name in versions before 0.56
110sub concise_cv { concise_subref(@_); }
111
112sub concise_cv_obj {
113 my ($order, $cv) = @_;
c99ca59a 114 $curcv = $cv;
f95e3c3c 115 die "err: coderef has no START\n" if class($cv->START) eq "NULL";
c27ea44e 116 sequence($cv->START);
c99ca59a
SM
117 if ($order eq "exec") {
118 walk_exec($cv->START);
119 } elsif ($order eq "basic") {
120 walk_topdown($cv->ROOT, sub { $_[0]->concise($_[1]) }, 0);
121 } else {
f95e3c3c 122 print $walkHandle tree($cv->ROOT, 0);
c99ca59a
SM
123 }
124}
125
31b49ad4
SM
126sub concise_main {
127 my($order) = @_;
128 sequence(main_start);
129 $curcv = main_cv;
130 if ($order eq "exec") {
131 return if class(main_start) eq "NULL";
132 walk_exec(main_start);
133 } elsif ($order eq "tree") {
134 return if class(main_root) eq "NULL";
f95e3c3c 135 print $walkHandle tree(main_root, 0);
31b49ad4
SM
136 } elsif ($order eq "basic") {
137 return if class(main_root) eq "NULL";
138 walk_topdown(main_root,
139 sub { $_[0]->concise($_[1]) }, 0);
140 }
141}
142
8ec8fbef
SM
143sub concise_specials {
144 my($name, $order, @cv_s) = @_;
145 my $i = 1;
146 if ($name eq "BEGIN") {
147 splice(@cv_s, 0, 7); # skip 7 BEGIN blocks in this file
148 } elsif ($name eq "CHECK") {
149 pop @cv_s; # skip the CHECK block that calls us
150 }
f95e3c3c
JC
151 for my $cv (@cv_s) {
152 print $walkHandle "$name $i:\n";
8ec8fbef
SM
153 $i++;
154 concise_cv_obj($order, $cv);
155 }
156}
157
c99ca59a
SM
158my $start_sym = "\e(0"; # "\cN" sometimes also works
159my $end_sym = "\e(B"; # "\cO" respectively
160
f95e3c3c 161my @tree_decorations =
c99ca59a
SM
162 ([" ", "--", "+-", "|-", "| ", "`-", "-", 1],
163 [" ", "-", "+", "+", "|", "`", "", 0],
164 [" ", map("$start_sym$_$end_sym", "qq", "wq", "tq", "x ", "mq", "q"), 1],
165 [" ", map("$start_sym$_$end_sym", "q", "w", "t", "x", "m"), "", 0],
166 );
167my $tree_style = 0;
168
169my $base = 36;
170my $big_endian = 1;
171
172my $order = "basic";
173
31b49ad4 174set_style_standard("concise");
78ad9108 175
c99ca59a
SM
176sub compile {
177 my @options = grep(/^-/, @_);
178 my @args = grep(!/^-/, @_);
179 my $do_main = 0;
c99ca59a
SM
180 for my $o (@options) {
181 if ($o eq "-basic") {
182 $order = "basic";
183 } elsif ($o eq "-exec") {
184 $order = "exec";
185 } elsif ($o eq "-tree") {
186 $order = "tree";
187 } elsif ($o eq "-compact") {
188 $tree_style |= 1;
189 } elsif ($o eq "-loose") {
190 $tree_style &= ~1;
191 } elsif ($o eq "-vt") {
192 $tree_style |= 2;
193 } elsif ($o eq "-ascii") {
194 $tree_style &= ~2;
195 } elsif ($o eq "-main") {
196 $do_main = 1;
197 } elsif ($o =~ /^-base(\d+)$/) {
198 $base = $1;
199 } elsif ($o eq "-bigendian") {
200 $big_endian = 1;
201 } elsif ($o eq "-littleendian") {
202 $big_endian = 0;
203 } elsif (exists $style{substr($o, 1)}) {
f95e3c3c
JC
204 $stylename = substr($o, 1);
205 set_style(@{$style{$stylename}});
c99ca59a
SM
206 } else {
207 warn "Option $o unrecognized";
208 }
209 }
c27ea44e
SM
210 return sub {
211 if (@args) {
c99ca59a 212 for my $objname (@args) {
8ec8fbef
SM
213 if ($objname eq "BEGIN") {
214 concise_specials("BEGIN", $order,
215 B::begin_av->isa("B::AV") ?
216 B::begin_av->ARRAY : ());
217 } elsif ($objname eq "INIT") {
218 concise_specials("INIT", $order,
219 B::init_av->isa("B::AV") ?
220 B::init_av->ARRAY : ());
221 } elsif ($objname eq "CHECK") {
222 concise_specials("CHECK", $order,
223 B::check_av->isa("B::AV") ?
224 B::check_av->ARRAY : ());
225 } elsif ($objname eq "END") {
226 concise_specials("END", $order,
227 B::end_av->isa("B::AV") ?
228 B::end_av->ARRAY : ());
229 } else {
f95e3c3c
JC
230 # convert function names to subrefs
231 my $objref;
232 if (ref $objname) {
233 print $walkHandle "B::Concise::compile($objname)\n";
234 $objref = $objname;
235 } else {
236 $objname = "main::" . $objname unless $objname =~ /::/;
237 print $walkHandle "$objname:\n";
238 no strict 'refs';
239 die "err: unknown function ($objname)\n"
240 unless *{$objname}{CODE};
241 $objref = \&$objname;
242 }
243 concise_subref($order, $objref);
8ec8fbef 244 }
c99ca59a
SM
245 }
246 }
c27ea44e 247 if (!@args or $do_main) {
f95e3c3c 248 print $walkHandle "main program:\n" if $do_main;
31b49ad4 249 concise_main($order);
c99ca59a
SM
250 }
251 }
252}
253
254my %labels;
255my $lastnext;
256
257my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|",
258 'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*",
051f02e9 259 'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#");
c99ca59a 260
8ec8fbef 261no warnings 'qw'; # "Possible attempt to put comments..."; use #7
35fc55f1
RH
262my @linenoise =
263 qw'# () sc ( @? 1 $* gv *{ m$ m@ m% m? p/ *$ $ $# & a& pt \\ s\\ rf bl
c99ca59a
SM
264 ` *? <> ?? ?/ r/ c/ // qr s/ /c y/ = @= C sC Cp sp df un BM po +1 +I
265 -1 -I 1+ I+ 1- I- ** * i* / i/ %$ i% x + i+ - i- . " << >> < i<
266 > i> <= i, >= i. == i= != i! <? i? s< s> s, s. s= s! s? b& b^ b| -0 -i
267 ! ~ a2 si cs rd sr e^ lg sq in %x %o ab le ss ve ix ri sf FL od ch cy
268 uf lf uc lc qm @ [f [ @[ eh vl ky dl ex % ${ @{ uk pk st jn ) )[ a@
269 a% sl +] -] [- [+ so rv GS GW MS MW .. f. .f && || ^^ ?: &= |= -> s{ s}
270 v} ca wa di rs ;; ; ;d }{ { } {} f{ it {l l} rt }l }n }r dm }g }e ^o
271 ^c ^| ^# um bm t~ u~ ~d DB db ^s se ^g ^r {w }w pf pr ^O ^K ^R ^W ^d ^v
272 ^e ^t ^k t. fc ic fl .s .p .b .c .l .a .h g1 s1 g2 s2 ?. l? -R -W -X -r
273 -w -x -e -o -O -z -s -M -A -C -S -c -b -f -d -p -l -u -g -k -t -T -B cd
274 co cr u. cm ut r. l@ s@ r@ mD uD oD rD tD sD wD cD f$ w$ p$ sh e$ k$ g3
275 g4 s4 g5 s5 T@ C@ L@ G@ A@ S@ Hg Hc Hr Hw Mg Mc Ms Mr Sg Sc So rq do {e
276 e} {t t} g6 G6 6e g7 G7 7e g8 G8 8e g9 G9 9e 6s 7s 8s 9s 6E 7E 8E 9E Pn
c27ea44e 277 Pu GP SP EP Gn Gg GG SG EG g0 c$ lk t$ ;s n> // /= CO';
c99ca59a
SM
278
279my $chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
280
281sub op_flags {
282 my($x) = @_;
283 my(@v);
284 push @v, "v" if ($x & 3) == 1;
285 push @v, "s" if ($x & 3) == 2;
286 push @v, "l" if ($x & 3) == 3;
287 push @v, "K" if $x & 4;
288 push @v, "P" if $x & 8;
289 push @v, "R" if $x & 16;
290 push @v, "M" if $x & 32;
291 push @v, "S" if $x & 64;
292 push @v, "*" if $x & 128;
293 return join("", @v);
294}
295
296sub base_n {
297 my $x = shift;
298 return "-" . base_n(-$x) if $x < 0;
299 my $str = "";
300 do { $str .= substr($chars, $x % $base, 1) } while $x = int($x / $base);
301 $str = reverse $str if $big_endian;
302 return $str;
303}
304
c27ea44e
SM
305my %sequence_num;
306my $seq_max = 1;
307
f95e3c3c
JC
308sub reset_sequence {
309 # reset the sequence
310 %sequence_num = ();
311 $seq_max = 1;
312}
313
c27ea44e
SM
314sub seq {
315 my($op) = @_;
316 return "-" if not exists $sequence_num{$$op};
317 return base_n($sequence_num{$$op});
318}
c99ca59a
SM
319
320sub walk_topdown {
321 my($op, $sub, $level) = @_;
322 $sub->($op, $level);
323 if ($op->flags & OPf_KIDS) {
324 for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
325 walk_topdown($kid, $sub, $level + 1);
326 }
327 }
c6e79e55
SM
328 if (class($op) eq "PMOP") {
329 my $maybe_root = $op->pmreplroot;
330 if (ref($maybe_root) and $maybe_root->isa("B::OP")) {
331 # It really is the root of the replacement, not something
332 # else stored here for lack of space elsewhere
333 walk_topdown($maybe_root, $sub, $level + 1);
334 }
c99ca59a
SM
335 }
336}
337
338sub walklines {
339 my($ar, $level) = @_;
340 for my $l (@$ar) {
341 if (ref($l) eq "ARRAY") {
342 walklines($l, $level + 1);
343 } else {
344 $l->concise($level);
345 }
346 }
347}
348
349sub walk_exec {
350 my($top, $level) = @_;
351 my %opsseen;
352 my @lines;
353 my @todo = ([$top, \@lines]);
354 while (@todo and my($op, $targ) = @{shift @todo}) {
355 for (; $$op; $op = $op->next) {
356 last if $opsseen{$$op}++;
357 push @$targ, $op;
358 my $name = $op->name;
62e36f8a 359 if (class($op) eq "LOGOP") {
c99ca59a
SM
360 my $ar = [];
361 push @$targ, $ar;
362 push @todo, [$op->other, $ar];
363 } elsif ($name eq "subst" and $ {$op->pmreplstart}) {
364 my $ar = [];
365 push @$targ, $ar;
366 push @todo, [$op->pmreplstart, $ar];
367 } elsif ($name =~ /^enter(loop|iter)$/) {
2814eb74
PJ
368 $labels{${$op->nextop}} = "NEXT";
369 $labels{${$op->lastop}} = "LAST";
370 $labels{${$op->redoop}} = "REDO";
c99ca59a
SM
371 }
372 }
373 }
374 walklines(\@lines, 0);
375}
376
c27ea44e
SM
377# The structure of this routine is purposely modeled after op.c's peep()
378sub sequence {
379 my($op) = @_;
380 my $oldop = 0;
381 return if class($op) eq "NULL" or exists $sequence_num{$$op};
382 for (; $$op; $op = $op->next) {
383 last if exists $sequence_num{$$op};
384 my $name = $op->name;
385 if ($name =~ /^(null|scalar|lineseq|scope)$/) {
386 next if $oldop and $ {$op->next};
387 } else {
388 $sequence_num{$$op} = $seq_max++;
389 if (class($op) eq "LOGOP") {
390 my $other = $op->other;
391 $other = $other->next while $other->name eq "null";
392 sequence($other);
393 } elsif (class($op) eq "LOOP") {
394 my $redoop = $op->redoop;
395 $redoop = $redoop->next while $redoop->name eq "null";
396 sequence($redoop);
397 my $nextop = $op->nextop;
398 $nextop = $nextop->next while $nextop->name eq "null";
399 sequence($nextop);
400 my $lastop = $op->lastop;
401 $lastop = $lastop->next while $lastop->name eq "null";
402 sequence($lastop);
403 } elsif ($name eq "subst" and $ {$op->pmreplstart}) {
404 my $replstart = $op->pmreplstart;
405 $replstart = $replstart->next while $replstart->name eq "null";
406 sequence($replstart);
407 }
408 }
409 $oldop = $op;
410 }
411}
412
c99ca59a 413sub fmt_line {
f95e3c3c
JC
414 my($hr, $text, $level) = @_;
415 return '' if $hr->{SKIP}; # another way to suppress lines of output
416
c99ca59a 417 $text =~ s/\(\?\(([^\#]*?)\#(\w+)([^\#]*?)\)\?\)/
f95e3c3c
JC
418 $hr->{$2} ? $1.$hr->{$2}.$3 : ""/eg;
419
c99ca59a
SM
420 $text =~ s/\(x\((.*?);(.*?)\)x\)/$order eq "exec" ? $1 : $2/egs;
421 $text =~ s/\(\*\(([^;]*?)\)\*\)/$1 x $level/egs;
422 $text =~ s/\(\*\((.*?);(.*?)\)\*\)/$1 x ($level - 1) . $2 x ($level>0)/egs;
423 $text =~ s/#([a-zA-Z]+)(\d+)/sprintf("%-$2s", $hr->{$1})/eg;
424 $text =~ s/#([a-zA-Z]+)/$hr->{$1}/eg;
425 $text =~ s/[ \t]*~+[ \t]*/ /g;
f95e3c3c
JC
426 chomp $text;
427 return "$text\n" if $text ne "";
428 return $text; # suppress empty lines
c99ca59a
SM
429}
430
431my %priv;
432$priv{$_}{128} = "LVINTRO"
433 for ("pos", "substr", "vec", "threadsv", "gvsv", "rv2sv", "rv2hv", "rv2gv",
434 "rv2av", "rv2arylen", "aelem", "helem", "aslice", "hslice", "padsv",
241416b8 435 "padav", "padhv", "enteriter");
c99ca59a
SM
436$priv{$_}{64} = "REFC" for ("leave", "leavesub", "leavesublv", "leavewrite");
437$priv{"aassign"}{64} = "COMMON";
4ac6efe6 438$priv{"aassign"}{32} = "PHASH" if $] < 5.009;
c99ca59a
SM
439$priv{"sassign"}{64} = "BKWARD";
440$priv{$_}{64} = "RTIME" for ("match", "subst", "substcont");
441@{$priv{"trans"}}{1,2,4,8,16,64} = ("<UTF", ">UTF", "IDENT", "SQUASH", "DEL",
442 "COMPL", "GROWS");
443$priv{"repeat"}{64} = "DOLIST";
444$priv{"leaveloop"}{64} = "CONT";
445@{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV")
314d4778 446 for (qw(rv2gv rv2sv padsv aelem helem));
c99ca59a
SM
447$priv{"entersub"}{16} = "DBG";
448$priv{"entersub"}{32} = "TARG";
449@{$priv{$_}}{4,8,128} = ("INARGS","AMPER","NO()") for ("entersub", "rv2cv");
450$priv{"gv"}{32} = "EARLYCV";
451$priv{"aelem"}{16} = $priv{"helem"}{16} = "LVDEFER";
241416b8
DM
452$priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv",
453 "enteriter");
c99ca59a
SM
454$priv{$_}{16} = "TARGMY"
455 for (map(($_,"s$_"),"chop", "chomp"),
456 map(($_,"i_$_"), "postinc", "postdec", "multiply", "divide", "modulo",
457 "add", "subtract", "negate"), "pow", "concat", "stringify",
458 "left_shift", "right_shift", "bit_and", "bit_xor", "bit_or",
459 "complement", "atan2", "sin", "cos", "rand", "exp", "log", "sqrt",
460 "int", "hex", "oct", "abs", "length", "index", "rindex", "sprintf",
461 "ord", "chr", "crypt", "quotemeta", "join", "push", "unshift", "flock",
462 "chdir", "chown", "chroot", "unlink", "chmod", "utime", "rename",
463 "link", "symlink", "mkdir", "rmdir", "wait", "waitpid", "system",
464 "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority",
465 "setpriority", "time", "sleep");
7a9b44b9 466@{$priv{"const"}}{8,16,32,64,128} = ("STRICT","ENTERED", '$[', "BARE", "WARN");
c99ca59a
SM
467$priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM";
468$priv{"list"}{64} = "GUESSED";
469$priv{"delete"}{64} = "SLICE";
470$priv{"exists"}{64} = "SUB";
471$priv{$_}{64} = "LOCALE"
472 for ("sort", "prtf", "sprintf", "slt", "sle", "seq", "sne", "sgt", "sge",
473 "scmp", "lc", "uc", "lcfirst", "ucfirst");
2b6e98cb 474@{$priv{"sort"}}{1,2,4,8} = ("NUM", "INT", "REV", "INPLACE");
c99ca59a 475$priv{"threadsv"}{64} = "SVREFd";
c27ea44e
SM
476@{$priv{$_}}{16,32,64,128} = ("INBIN","INCR","OUTBIN","OUTCR")
477 for ("open", "backtick");
c99ca59a 478$priv{"exit"}{128} = "VMS";
feaeca78
JH
479$priv{$_}{2} = "FTACCESS"
480 for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec");
32454ac8
NC
481if ($] >= 5.009) {
482 # Stacked filetests are post 5.8.x
483 $priv{$_}{4} = "FTSTACKED"
484 for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec",
485 "ftis", "fteowned", "ftrowned", "ftzero", "ftsize", "ftmtime",
486 "ftatime", "ftctime", "ftsock", "ftchr", "ftblk", "ftfile", "ftdir",
487 "ftpipe", "ftlink", "ftsuid", "ftsgid", "ftsvtx", "fttty", "fttext",
488 "ftbinary");
489 # Lexical $_ is post 5.8.x
490 $priv{$_}{2} = "GREPLEX"
491 for ("mapwhile", "mapstart", "grepwhile", "grepstart");
492}
c99ca59a
SM
493
494sub private_flags {
495 my($name, $x) = @_;
496 my @s;
497 for my $flag (128, 96, 64, 32, 16, 8, 4, 2, 1) {
498 if ($priv{$name}{$flag} and $x & $flag and $x >= $flag) {
499 $x -= $flag;
500 push @s, $priv{$name}{$flag};
501 }
502 }
503 push @s, $x if $x;
504 return join(",", @s);
505}
506
c27ea44e
SM
507sub concise_sv {
508 my($sv, $hr) = @_;
509 $hr->{svclass} = class($sv);
31b49ad4
SM
510 $hr->{svclass} = "UV"
511 if $hr->{svclass} eq "IV" and $sv->FLAGS & SVf_IVisUV;
c27ea44e
SM
512 $hr->{svaddr} = sprintf("%#x", $$sv);
513 if ($hr->{svclass} eq "GV") {
514 my $gv = $sv;
515 my $stash = $gv->STASH->NAME;
516 if ($stash eq "main") {
517 $stash = "";
518 } else {
519 $stash = $stash . "::";
520 }
521 $hr->{svval} = "*$stash" . $gv->SAFENAME;
522 return "*$stash" . $gv->SAFENAME;
523 } else {
524 while (class($sv) eq "RV") {
525 $hr->{svval} .= "\\";
526 $sv = $sv->RV;
527 }
528 if (class($sv) eq "SPECIAL") {
40b5b14f 529 $hr->{svval} .= ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv];
c27ea44e 530 } elsif ($sv->FLAGS & SVf_NOK) {
40b5b14f 531 $hr->{svval} .= $sv->NV;
c27ea44e 532 } elsif ($sv->FLAGS & SVf_IOK) {
31b49ad4 533 $hr->{svval} .= $sv->int_value;
c27ea44e 534 } elsif ($sv->FLAGS & SVf_POK) {
40b5b14f 535 $hr->{svval} .= cstring($sv->PV);
31b49ad4
SM
536 } elsif (class($sv) eq "HV") {
537 $hr->{svval} .= 'HASH';
c27ea44e
SM
538 }
539 return $hr->{svclass} . " " . $hr->{svval};
540 }
541}
542
c99ca59a
SM
543sub concise_op {
544 my ($op, $level, $format) = @_;
545 my %h;
546 $h{exname} = $h{name} = $op->name;
547 $h{NAME} = uc $h{name};
548 $h{class} = class($op);
549 $h{extarg} = $h{targ} = $op->targ;
550 $h{extarg} = "" unless $h{extarg};
551 if ($h{name} eq "null" and $h{targ}) {
8ec8fbef 552 # targ holds the old type
c99ca59a
SM
553 $h{exname} = "ex-" . substr(ppname($h{targ}), 3);
554 $h{extarg} = "";
8ec8fbef
SM
555 } elsif ($op->name =~ /^leave(sub(lv)?|write)?$/) {
556 # targ potentially holds a reference count
557 if ($op->private & 64) {
558 my $refs = "ref" . ($h{targ} != 1 ? "s" : "");
559 $h{targarglife} = $h{targarg} = "$h{targ} $refs";
560 }
c99ca59a
SM
561 } elsif ($h{targ}) {
562 my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}];
563 if (defined $padname and class($padname) ne "SPECIAL") {
0b40bd6d 564 $h{targarg} = $padname->PVX;
127212b2 565 if ($padname->FLAGS & SVf_FAKE) {
4ac6efe6
NC
566 if ($] < 5.009) {
567 $h{targarglife} = "$h{targarg}:FAKE";
568 } else {
569 # These changes relate to the jumbo closure fix.
570 # See changes 19939 and 20005
571 my $fake = '';
572 $fake .= 'a' if $padname->IVX & 1; # PAD_FAKELEX_ANON
573 $fake .= 'm' if $padname->IVX & 2; # PAD_FAKELEX_MULTI
574 $fake .= ':' . $padname->NVX if $curcv->CvFLAGS & CVf_ANON;
575 $h{targarglife} = "$h{targarg}:FAKE:$fake";
576 }
127212b2
DM
577 }
578 else {
579 my $intro = $padname->NVX - $cop_seq_base;
580 my $finish = int($padname->IVX) - $cop_seq_base;
581 $finish = "end" if $finish == 999999999 - $cop_seq_base;
582 $h{targarglife} = "$h{targarg}:$intro,$finish";
583 }
c99ca59a
SM
584 } else {
585 $h{targarglife} = $h{targarg} = "t" . $h{targ};
586 }
587 }
588 $h{arg} = "";
589 $h{svclass} = $h{svaddr} = $h{svval} = "";
590 if ($h{class} eq "PMOP") {
591 my $precomp = $op->precomp;
7a9b44b9 592 if (defined $precomp) {
c27ea44e
SM
593 $precomp = cstring($precomp); # Escape literal control sequences
594 $precomp = "/$precomp/";
595 } else {
596 $precomp = "";
7a9b44b9 597 }
b2a3cfdd 598 my $pmreplroot = $op->pmreplroot;
34a48b4b 599 my $pmreplstart;
c6e79e55 600 if (ref($pmreplroot) eq "B::GV") {
b2a3cfdd 601 # with C<@stash_array = split(/pat/, str);>,
c6e79e55 602 # *stash_array is stored in /pat/'s pmreplroot.
b2a3cfdd 603 $h{arg} = "($precomp => \@" . $pmreplroot->NAME . ")";
c6e79e55
SM
604 } elsif (!ref($pmreplroot) and $pmreplroot) {
605 # same as the last case, except the value is actually a
606 # pad offset for where the GV is kept (this happens under
607 # ithreads)
608 my $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$pmreplroot];
609 $h{arg} = "($precomp => \@" . $gv->NAME . ")";
b2a3cfdd 610 } elsif ($ {$op->pmreplstart}) {
c99ca59a
SM
611 undef $lastnext;
612 $pmreplstart = "replstart->" . seq($op->pmreplstart);
613 $h{arg} = "(" . join(" ", $precomp, $pmreplstart) . ")";
614 } else {
615 $h{arg} = "($precomp)";
616 }
617 } elsif ($h{class} eq "PVOP" and $h{name} ne "trans") {
618 $h{arg} = '("' . $op->pv . '")';
619 $h{svval} = '"' . $op->pv . '"';
620 } elsif ($h{class} eq "COP") {
621 my $label = $op->label;
c3caa09d 622 $h{coplabel} = $label;
c99ca59a
SM
623 $label = $label ? "$label: " : "";
624 my $loc = $op->file;
625 $loc =~ s[.*/][];
626 $loc .= ":" . $op->line;
627 my($stash, $cseq) = ($op->stash->NAME, $op->cop_seq - $cop_seq_base);
628 my $arybase = $op->arybase;
629 $arybase = $arybase ? ' $[=' . $arybase : "";
630 $h{arg} = "($label$stash $cseq $loc$arybase)";
631 } elsif ($h{class} eq "LOOP") {
632 $h{arg} = "(next->" . seq($op->nextop) . " last->" . seq($op->lastop)
633 . " redo->" . seq($op->redoop) . ")";
634 } elsif ($h{class} eq "LOGOP") {
635 undef $lastnext;
636 $h{arg} = "(other->" . seq($op->other) . ")";
637 } elsif ($h{class} eq "SVOP") {
6a077020
DM
638 unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) {
639 if (! ${$op->sv}) {
640 my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$op->targ];
641 $h{arg} = "[" . concise_sv($sv, \%h) . "]";
642 $h{targarglife} = $h{targarg} = "";
643 } else {
644 $h{arg} = "(" . concise_sv($op->sv, \%h) . ")";
645 }
c99ca59a 646 }
31b49ad4
SM
647 } elsif ($h{class} eq "PADOP") {
648 my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$op->padix];
649 $h{arg} = "[" . concise_sv($sv, \%h) . "]";
c99ca59a
SM
650 }
651 $h{seq} = $h{hyphseq} = seq($op);
652 $h{seq} = "" if $h{seq} eq "-";
2814eb74
PJ
653 $h{opt} = $op->opt;
654 $h{static} = $op->static;
c99ca59a
SM
655 $h{next} = $op->next;
656 $h{next} = (class($h{next}) eq "NULL") ? "(end)" : seq($h{next});
657 $h{nextaddr} = sprintf("%#x", $ {$op->next});
658 $h{sibaddr} = sprintf("%#x", $ {$op->sibling});
659 $h{firstaddr} = sprintf("%#x", $ {$op->first}) if $op->can("first");
660 $h{lastaddr} = sprintf("%#x", $ {$op->last}) if $op->can("last");
661
662 $h{classsym} = $opclass{$h{class}};
663 $h{flagval} = $op->flags;
664 $h{flags} = op_flags($op->flags);
665 $h{privval} = $op->private;
666 $h{private} = private_flags($h{name}, $op->private);
667 $h{addr} = sprintf("%#x", $$op);
2814eb74 668 $h{label} = $labels{$$op};
c99ca59a
SM
669 $h{typenum} = $op->type;
670 $h{noise} = $linenoise[$op->type];
f95e3c3c
JC
671
672 $_->(\%h, $op, \$format, \$level, $stylename) for @callbacks;
c99ca59a
SM
673 return fmt_line(\%h, $format, $level);
674}
675
676sub B::OP::concise {
677 my($op, $level) = @_;
678 if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
679 my $h = {"seq" => seq($lastnext), "class" => class($lastnext),
680 "addr" => sprintf("%#x", $$lastnext)};
f95e3c3c 681 print $walkHandle fmt_line($h, $gotofmt, $level+1);
c99ca59a
SM
682 }
683 $lastnext = $op->next;
f95e3c3c 684 print $walkHandle concise_op($op, $level, $format);
c99ca59a
SM
685}
686
31b49ad4
SM
687# B::OP::terse (see Terse.pm) now just calls this
688sub b_terse {
689 my($op, $level) = @_;
690
691 # This isn't necessarily right, but there's no easy way to get
692 # from an OP to the right CV. This is a limitation of the
693 # ->terse() interface style, and there isn't much to do about
694 # it. In particular, we can die in concise_op if the main pad
695 # isn't long enough, or has the wrong kind of entries, compared to
696 # the pad a sub was compiled with. The fix for that would be to
697 # make a backwards compatible "terse" format that never even
698 # looked at the pad, just like the old B::Terse. I don't think
699 # that's worth the effort, though.
700 $curcv = main_cv unless $curcv;
701
702 if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
703 my $h = {"seq" => seq($lastnext), "class" => class($lastnext),
704 "addr" => sprintf("%#x", $$lastnext)};
705 print fmt_line($h, $style{"terse"}[1], $level+1);
706 }
707 $lastnext = $op->next;
708 print concise_op($op, $level, $style{"terse"}[0]);
709}
710
c99ca59a
SM
711sub tree {
712 my $op = shift;
713 my $level = shift;
714 my $style = $tree_decorations[$tree_style];
715 my($space, $single, $kids, $kid, $nokid, $last, $lead, $size) = @$style;
716 my $name = concise_op($op, $level, $treefmt);
717 if (not $op->flags & OPf_KIDS) {
718 return $name . "\n";
719 }
720 my @lines;
721 for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
722 push @lines, tree($kid, $level+1);
723 }
724 my $i;
725 for ($i = $#lines; substr($lines[$i], 0, 1) eq " "; $i--) {
726 $lines[$i] = $space . $lines[$i];
727 }
728 if ($i > 0) {
729 $lines[$i] = $last . $lines[$i];
730 while ($i-- > 1) {
731 if (substr($lines[$i], 0, 1) eq " ") {
732 $lines[$i] = $nokid . $lines[$i];
733 } else {
f95e3c3c 734 $lines[$i] = $kid . $lines[$i];
c99ca59a
SM
735 }
736 }
737 $lines[$i] = $kids . $lines[$i];
738 } else {
739 $lines[0] = $single . $lines[0];
740 }
741 return("$name$lead" . shift @lines,
742 map(" " x (length($name)+$size) . $_, @lines));
743}
744
213a1a26
SM
745# *** Warning: fragile kludge ahead ***
746# Because the B::* modules run in the same interpreter as the code
2814eb74
PJ
747# they're compiling, their presence tends to distort the view we have of
748# the code we're looking at. In particular, perl gives sequence numbers
749# to COPs. If the program we're looking at were run on its own, this
750# would start at 1. Because all of B::Concise and all the modules it
751# uses are compiled first, though, by the time we get to the user's
752# program the sequence number is already pretty high, which could be
753# distracting if you're trying to tell OPs apart. Therefore we'd like to
754# subtract an offset from all the sequence numbers we display, to
755# restore the simpler view of the world. The trick is to know what that
756# offset will be, when we're still compiling B::Concise! If we
213a1a26 757# hardcoded a value, it would have to change every time B::Concise or
2814eb74
PJ
758# other modules we use do. To help a little, what we do here is compile
759# a little code at the end of the module, and compute the base sequence
760# number for the user's program as being a small offset later, so all we
761# have to worry about are changes in the offset.
f95e3c3c 762
213a1a26
SM
763# When you say "perl -MO=Concise -e '$a'", the output should look like:
764
765# 4 <@> leave[t1] vKP/REFC ->(end)
766# 1 <0> enter ->2
767 #^ smallest OP sequence number should be 1
768# 2 <;> nextstate(main 1 -e:1) v ->3
769 # ^ smallest COP sequence number should be 1
770# - <1> ex-rv2sv vK/1 ->4
771# 3 <$> gvsv(*a) s ->4
772
c27ea44e
SM
773# If the second of the marked numbers there isn't 1, it means you need
774# to update the corresponding magic number in the next line.
775# Remember, this needs to stay the last things in the module.
e69a2255 776
c27ea44e 777# Why is this different for MacOS? Does it matter?
8ec8fbef 778my $cop_seq_mnum = $^O eq 'MacOS' ? 12 : 11;
e69a2255 779$cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum;
c99ca59a
SM
780
7811;
782
783__END__
784
785=head1 NAME
786
787B::Concise - Walk Perl syntax tree, printing concise info about ops
788
789=head1 SYNOPSIS
790
791 perl -MO=Concise[,OPTIONS] foo.pl
792
78ad9108
PJ
793 use B::Concise qw(set_style add_callback);
794
c99ca59a
SM
795=head1 DESCRIPTION
796
797This compiler backend prints the internal OPs of a Perl program's syntax
798tree in one of several space-efficient text formats suitable for debugging
799the inner workings of perl or other compiler backends. It can print OPs in
800the order they appear in the OP tree, in the order they will execute, or
801in a text approximation to their tree structure, and the format of the
802information displyed is customizable. Its function is similar to that of
803perl's B<-Dx> debugging flag or the B<B::Terse> module, but it is more
804sophisticated and flexible.
805
f8a679e6
RGS
806=head1 EXAMPLE
807
808Here's is a short example of output, using the default formatting
809conventions :
810
811 % perl -MO=Concise -e '$a = $b + 42'
8ec8fbef 812 8 <@> leave[1 ref] vKP/REFC ->(end)
f8a679e6
RGS
813 1 <0> enter ->2
814 2 <;> nextstate(main 1 -e:1) v ->3
815 7 <2> sassign vKS/2 ->8
816 5 <2> add[t1] sK/2 ->6
817 - <1> ex-rv2sv sK/1 ->4
818 3 <$> gvsv(*b) s ->4
819 4 <$> const(IV 42) s ->5
820 - <1> ex-rv2sv sKRM*/1 ->7
821 6 <$> gvsv(*a) s ->7
822
823Each line corresponds to an operator. Null ops appear as C<ex-opname>,
824where I<opname> is the op that has been optimized away by perl.
825
826The number on the first row indicates the op's sequence number. It's
827given in base 36 by default.
828
829The symbol between angle brackets indicates the op's type : for example,
830<2> is a BINOP, <@> a LISTOP, etc. (see L</"OP class abbreviations">).
831
832The opname may be followed by op-specific information in parentheses
833(e.g. C<gvsv(*b)>), and by targ information in brackets (e.g.
834C<leave[t1]>).
835
836Next come the op flags. The common flags are listed below
837(L</"OP flags abbreviations">). The private flags follow, separated
838by a slash. For example, C<vKP/REFC> means that the leave op has
839public flags OPf_WANT_VOID, OPf_KIDS, and OPf_PARENS, and the private
840flag OPpREFCOUNTED.
841
842Finally an arrow points to the sequence number of the next op.
843
c99ca59a
SM
844=head1 OPTIONS
845
846Arguments that don't start with a hyphen are taken to be the names of
8ec8fbef
SM
847subroutines to print the OPs of; if no such functions are specified,
848the main body of the program (outside any subroutines, and not
849including use'd or require'd files) is printed. Passing C<BEGIN>,
850C<CHECK>, C<INIT>, or C<END> will cause all of the corresponding
851special blocks to be printed.
c99ca59a
SM
852
853=over 4
854
855=item B<-basic>
856
857Print OPs in the order they appear in the OP tree (a preorder
858traversal, starting at the root). The indentation of each OP shows its
859level in the tree. This mode is the default, so the flag is included
860simply for completeness.
861
862=item B<-exec>
863
864Print OPs in the order they would normally execute (for the majority
865of constructs this is a postorder traversal of the tree, ending at the
866root). In most cases the OP that usually follows a given OP will
867appear directly below it; alternate paths are shown by indentation. In
868cases like loops when control jumps out of a linear path, a 'goto'
869line is generated.
870
871=item B<-tree>
872
873Print OPs in a text approximation of a tree, with the root of the tree
874at the left and 'left-to-right' order of children transformed into
875'top-to-bottom'. Because this mode grows both to the right and down,
876it isn't suitable for large programs (unless you have a very wide
877terminal).
878
879=item B<-compact>
880
881Use a tree format in which the minimum amount of space is used for the
882lines connecting nodes (one character in most cases). This squeezes out
883a few precious columns of screen real estate.
884
885=item B<-loose>
886
887Use a tree format that uses longer edges to separate OP nodes. This format
888tends to look better than the compact one, especially in ASCII, and is
889the default.
890
891=item B<-vt>
892
893Use tree connecting characters drawn from the VT100 line-drawing set.
894This looks better if your terminal supports it.
895
896=item B<-ascii>
897
898Draw the tree with standard ASCII characters like C<+> and C<|>. These don't
899look as clean as the VT100 characters, but they'll work with almost any
900terminal (or the horizontal scrolling mode of less(1)) and are suitable
901for text documentation or email. This is the default.
902
903=item B<-main>
904
905Include the main program in the output, even if subroutines were also
906specified.
907
908=item B<-base>I<n>
909
910Print OP sequence numbers in base I<n>. If I<n> is greater than 10, the
911digit for 11 will be 'a', and so on. If I<n> is greater than 36, the digit
912for 37 will be 'A', and so on until 62. Values greater than 62 are not
913currently supported. The default is 36.
914
915=item B<-bigendian>
916
917Print sequence numbers with the most significant digit first. This is the
918usual convention for Arabic numerals, and the default.
919
920=item B<-littleendian>
921
922Print seqence numbers with the least significant digit first.
923
924=item B<-concise>
925
926Use the author's favorite set of formatting conventions. This is the
927default, of course.
928
929=item B<-terse>
930
a6d05634 931Use formatting conventions that emulate the output of B<B::Terse>. The
c99ca59a
SM
932basic mode is almost indistinguishable from the real B<B::Terse>, and the
933exec mode looks very similar, but is in a more logical order and lacks
934curly brackets. B<B::Terse> doesn't have a tree mode, so the tree mode
935is only vaguely reminiscient of B<B::Terse>.
936
937=item B<-linenoise>
938
939Use formatting conventions in which the name of each OP, rather than being
940written out in full, is represented by a one- or two-character abbreviation.
941This is mainly a joke.
942
943=item B<-debug>
944
945Use formatting conventions reminiscient of B<B::Debug>; these aren't
946very concise at all.
947
948=item B<-env>
949
950Use formatting conventions read from the environment variables
951C<B_CONCISE_FORMAT>, C<B_CONCISE_GOTO_FORMAT>, and C<B_CONCISE_TREE_FORMAT>.
952
953=back
954
955=head1 FORMATTING SPECIFICATIONS
956
957For each general style ('concise', 'terse', 'linenoise', etc.) there are
958three specifications: one of how OPs should appear in the basic or exec
959modes, one of how 'goto' lines should appear (these occur in the exec
960mode only), and one of how nodes should appear in tree mode. Each has the
961same format, described below. Any text that doesn't match a special
962pattern is copied verbatim.
963
964=over 4
965
966=item B<(x(>I<exec_text>B<;>I<basic_text>B<)x)>
967
968Generates I<exec_text> in exec mode, or I<basic_text> in basic mode.
969
970=item B<(*(>I<text>B<)*)>
971
972Generates one copy of I<text> for each indentation level.
973
974=item B<(*(>I<text1>B<;>I<text2>B<)*)>
975
976Generates one fewer copies of I<text1> than the indentation level, followed
977by one copy of I<text2> if the indentation level is more than 0.
978
979=item B<(?(>I<text1>B<#>I<var>I<Text2>B<)?)>
980
981If the value of I<var> is true (not empty or zero), generates the
982value of I<var> surrounded by I<text1> and I<Text2>, otherwise
983nothing.
984
985=item B<#>I<var>
986
987Generates the value of the variable I<var>.
988
989=item B<#>I<var>I<N>
990
991Generates the value of I<var>, left jutified to fill I<N> spaces.
992
993=item B<~>
994
995Any number of tildes and surrounding whitespace will be collapsed to
996a single space.
997
998=back
999
1000The following variables are recognized:
1001
1002=over 4
1003
1004=item B<#addr>
1005
1006The address of the OP, in hexidecimal.
1007
1008=item B<#arg>
1009
1010The OP-specific information of the OP (such as the SV for an SVOP, the
1011non-local exit pointers for a LOOP, etc.) enclosed in paretheses.
1012
1013=item B<#class>
1014
1015The B-determined class of the OP, in all caps.
1016
f8a679e6 1017=item B<#classsym>
c99ca59a
SM
1018
1019A single symbol abbreviating the class of the OP.
1020
c3caa09d
SM
1021=item B<#coplabel>
1022
1023The label of the statement or block the OP is the start of, if any.
1024
c99ca59a
SM
1025=item B<#exname>
1026
1027The name of the OP, or 'ex-foo' if the OP is a null that used to be a foo.
1028
1029=item B<#extarg>
1030
1031The target of the OP, or nothing for a nulled OP.
1032
1033=item B<#firstaddr>
1034
1035The address of the OP's first child, in hexidecimal.
1036
1037=item B<#flags>
1038
1039The OP's flags, abbreviated as a series of symbols.
1040
1041=item B<#flagval>
1042
1043The numeric value of the OP's flags.
1044
f8a679e6 1045=item B<#hyphseq>
c99ca59a
SM
1046
1047The sequence number of the OP, or a hyphen if it doesn't have one.
1048
1049=item B<#label>
1050
1051'NEXT', 'LAST', or 'REDO' if the OP is a target of one of those in exec
1052mode, or empty otherwise.
1053
1054=item B<#lastaddr>
1055
1056The address of the OP's last child, in hexidecimal.
1057
1058=item B<#name>
1059
1060The OP's name.
1061
1062=item B<#NAME>
1063
1064The OP's name, in all caps.
1065
1066=item B<#next>
1067
1068The sequence number of the OP's next OP.
1069
1070=item B<#nextaddr>
1071
1072The address of the OP's next OP, in hexidecimal.
1073
1074=item B<#noise>
1075
c27ea44e 1076A one- or two-character abbreviation for the OP's name.
c99ca59a
SM
1077
1078=item B<#private>
1079
1080The OP's private flags, rendered with abbreviated names if possible.
1081
1082=item B<#privval>
1083
1084The numeric value of the OP's private flags.
1085
1086=item B<#seq>
1087
2814eb74
PJ
1088The sequence number of the OP. Note that this is a sequence number
1089generated by B::Concise.
c99ca59a 1090
2814eb74 1091=item B<#opt>
c99ca59a 1092
2814eb74
PJ
1093Whether or not the op has been optimised by the peephole optimiser.
1094
1095=item B<#static>
1096
1097Whether or not the op is statically defined. This flag is used by the
1098B::C compiler backend and indicates that the op should not be freed.
c99ca59a
SM
1099
1100=item B<#sibaddr>
1101
1102The address of the OP's next youngest sibling, in hexidecimal.
1103
1104=item B<#svaddr>
1105
1106The address of the OP's SV, if it has an SV, in hexidecimal.
1107
1108=item B<#svclass>
1109
1110The class of the OP's SV, if it has one, in all caps (e.g., 'IV').
1111
1112=item B<#svval>
1113
1114The value of the OP's SV, if it has one, in a short human-readable format.
1115
1116=item B<#targ>
1117
1118The numeric value of the OP's targ.
1119
1120=item B<#targarg>
1121
1122The name of the variable the OP's targ refers to, if any, otherwise the
1123letter t followed by the OP's targ in decimal.
1124
1125=item B<#targarglife>
1126
1127Same as B<#targarg>, but followed by the COP sequence numbers that delimit
1128the variable's lifetime (or 'end' for a variable in an open scope) for a
1129variable.
1130
1131=item B<#typenum>
1132
1133The numeric value of the OP's type, in decimal.
1134
1135=back
1136
1137=head1 ABBREVIATIONS
1138
1139=head2 OP flags abbreviations
1140
1141 v OPf_WANT_VOID Want nothing (void context)
1142 s OPf_WANT_SCALAR Want single value (scalar context)
1143 l OPf_WANT_LIST Want list of any length (list context)
1144 K OPf_KIDS There is a firstborn child.
1145 P OPf_PARENS This operator was parenthesized.
1146 (Or block needs explicit scope entry.)
1147 R OPf_REF Certified reference.
1148 (Return container, not containee).
1149 M OPf_MOD Will modify (lvalue).
1150 S OPf_STACKED Some arg is arriving on the stack.
1151 * OPf_SPECIAL Do something weird for this op (see op.h)
1152
1153=head2 OP class abbreviations
1154
1155 0 OP (aka BASEOP) An OP with no children
1156 1 UNOP An OP with one child
1157 2 BINOP An OP with two children
1158 | LOGOP A control branch OP
1159 @ LISTOP An OP that could have lots of children
1160 / PMOP An OP with a regular expression
1161 $ SVOP An OP with an SV
1162 " PVOP An OP with a string
1163 { LOOP An OP that holds pointers for a loop
1164 ; COP An OP that marks the start of a statement
051f02e9 1165 # PADOP An OP with a GV on the pad
c99ca59a 1166
78ad9108
PJ
1167=head1 Using B::Concise outside of the O framework
1168
f95e3c3c
JC
1169You can use B<B::Concise>, and call compile() directly, thereby
1170avoiding the compile-only operation of O. For example, you could use
1171the debugger to step through B::Concise::compile() itself.
1172
1173When doing so, you can alter Concise output by providing new output
1174styles, and optionally by adding callback routines which populate new
1175variables that may be rendered as part of those styles. For all
1176following sections, please review L</FORMATTING SPECIFICATIONS>.
1177
1178=head2 example: Altering Concise Output
78ad9108
PJ
1179
1180 use B::Concise qw(set_style add_callback);
f95e3c3c 1181 set_style($your_format, $your_gotofmt, $your_treefmt);
78ad9108 1182 add_callback
f95e3c3c
JC
1183 ( sub {
1184 my ($h, $op, $format, $level, $stylename) = @_;
78ad9108
PJ
1185 $h->{variable} = some_func($op);
1186 }
f95e3c3c 1187 );
78ad9108
PJ
1188 B::Concise::compile(@options)->();
1189
f95e3c3c
JC
1190=head2 set_style()
1191
1192B<set_style> accepts 3 arguments, and updates the three components of an
1193output style (basic-exec, goto, tree). It has one minor drawback though:
1194it doesn't register the style under a new name, thus you may prefer to use
1195add_style() and/or set_style_standard() instead.
1196
1197=head2 add_style()
78ad9108 1198
f95e3c3c
JC
1199This subroutine accepts a new style name and three style arguments as
1200above, and creates, registers, and selects the newly named style. It is
1201an error to re-add a style; call set_style_standard() to switch between
1202several styles.
1203
1204=head2 set_style_standard($name)
1205
1206This restores one of the standard styles: C<terse>, C<concise>,
1207C<linenoise>, C<debug>, C<env>, into effect. It also accepts style
1208names previously defined with add_style().
1209
1210=head2 add_callback()
1211
1212If your newly minted styles refer to any #variables, you'll need to
1213define a callback subroutine that will populate (or modify) those
1214variables. They are then available for use in the style you've chosen.
1215
1216The callbacks are called for each opcode visited by Concise, in the
1217same order as they are added. Each subroutine is passed five
1218parameters.
1219
1220 1. A hashref, containing the variable names and values which are
1221 populated into the report-line for the op
1222 2. the op, as a B<B::OP> object
1223 3. a reference to the format string
1224 4. the formatting (indent) level
1225 5. the selected stylename
78ad9108
PJ
1226
1227To define your own variables, simply add them to the hash, or change
1228existing values if you need to. The level and format are passed in as
1229references to scalars, but it is unlikely that they will need to be
1230changed or even used.
1231
f95e3c3c
JC
1232=head2 running B::Concise::compile()
1233
1234B<compile> accepts options as described above in L</OPTIONS>, and
1235arguments, which are either coderefs, or subroutine names.
1236
1237compile() constructs and returns a coderef, which when invoked, scans
1238the optree, and prints the results to STDOUT. Once you have the
1239coderef, you may change the output style; thereafter the coderef renders
1240in the new style.
1241
1242B<walk_output> lets you change the print destination from STDOUT to
1243another open filehandle, or into a string passed as a ref.
1244
1245 walk_output(\my $buf);
1246 B::Concise::compile('-concise','funcName', \&aSubRef)->();
1247 print "Concise Results: $buf\n";
1248
1249For each subroutine visited, the opcode info is preceded by a single
1250line containing either the subroutine name or the stringified coderef.
1251
31b49ad4 1252To switch back to one of the standard styles like C<concise> or
f95e3c3c
JC
1253C<terse>, call C<set_style_standard>, or pass the style name into
1254B::Concise::compile() (as done above).
1255
1256=head2 B::Concise::reset_sequence()
1257
1258This function (not exported) lets you reset the sequence numbers (note
1259that they're numbered arbitrarily, their goal being to be human
1260readable). Its purpose is mostly to support testing, i.e. to compare
1261the concise output from two identical anonymous subroutines (but
1262different instances). Without the reset, B::Concise, seeing that
1263they're separate optrees, generates different sequence numbers in
1264the output.
1265
1266=head2 Errors
1267
1268All detected errors, (invalid arguments, internal errors, etc.) are
1269resolved with a die($message). Use an eval if you wish to catch these
1270errors and continue processing.
31b49ad4 1271
f95e3c3c
JC
1272In particular, B<compile> will die as follows if you've asked for a
1273non-existent function-name, a non-existent coderef, or a non-CODE
1274reference.
78ad9108 1275
c99ca59a
SM
1276=head1 AUTHOR
1277
31b49ad4 1278Stephen McCamant, E<lt>smcc@CSUA.Berkeley.EDUE<gt>.
c99ca59a
SM
1279
1280=cut