3 use B qw(peekop class walkoptree_slow walkoptree_exec
4 main_start main_root cstring svref_2object);
5 use B::Asmdata qw(@specialsv_name);
8 my ($order, $cvref) = @_;
9 my $cv = svref_2object($cvref);
10 if ($order eq "exec") {
11 walkoptree_exec($cv->START, "terse");
13 walkoptree_slow($cv->ROOT, "terse");
24 foreach $objname (@options) {
25 $objname = "main::$objname" unless $objname =~ /::/;
26 eval "terse(\$order, \\&$objname)";
27 die "terse($order, \\&$objname) failed: $@" if $@;
31 if ($order eq "exec") {
32 return sub { walkoptree_exec(main_start, "terse") }
34 return sub { walkoptree_slow(main_root, "terse") }
45 my ($op, $level) = @_;
47 $targ = ($targ > 0) ? " [$targ]" : "";
48 print indent($level), peekop($op), $targ, "\n";
52 my ($op, $level) = @_;
53 print indent($level), peekop($op), " ";
58 my ($op, $level) = @_;
59 print indent($level), peekop($op), " ";
64 my ($op, $level) = @_;
65 my $precomp = $op->precomp;
66 print indent($level), peekop($op),
67 defined($precomp) ? " /$precomp/\n" : " (regexp not compiled)\n";
72 my ($op, $level) = @_;
73 print indent($level), peekop($op), " ", cstring($op->pv), "\n";
77 my ($op, $level) = @_;
78 my $label = $op->label;
80 $label = " label ".cstring($label);
82 print indent($level), peekop($op), $label || "", "\n";
86 my ($sv, $level) = @_;
88 printf "%s (0x%lx) %s\n", class($sv), $$sv, cstring($sv->PV);
92 my ($sv, $level) = @_;
94 printf "%s (0x%lx) FILL %d\n", class($sv), $$sv, $sv->FILL;
98 my ($gv, $level) = @_;
99 my $stash = $gv->STASH->NAME;
100 if ($stash eq "main") {
103 $stash = $stash . "::";
105 print indent($level);
106 printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->NAME;
110 my ($sv, $level) = @_;
111 print indent($level);
112 printf "%s (0x%lx) %d\n", class($sv), $$sv, $sv->IV;
116 my ($sv, $level) = @_;
117 print indent($level);
118 printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->NV;
122 my ($sv, $level) = @_;
123 print indent($level);
124 printf "%s (0x%lx)\n", class($sv), $$sv;
127 sub B::SPECIAL::terse {
128 my ($sv, $level) = @_;
129 print indent($level);
130 printf "%s #%d %s\n", class($sv), $$sv, $specialsv_name[$$sv];
139 B::Terse - Walk Perl syntax tree, printing terse info about ops
143 perl -MO=Terse[,OPTIONS] foo.pl
151 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>