6 use B qw(peekop class walkoptree walkoptree_exec walkoptree_slow
7 main_start main_root cstring svref_2object SVf_IVisUV);
8 use B::Asmdata qw(@specialsv_name);
11 my ($order, $cvref) = @_;
12 my $cv = svref_2object($cvref);
13 if ($order eq "exec") {
14 walkoptree_exec($cv->START, "terse");
16 walkoptree_slow($cv->ROOT, "terse");
21 my $order = @_ ? shift : "";
27 foreach $objname (@options) {
28 $objname = "main::$objname" unless $objname =~ /::/;
29 eval "terse(\$order, \\&$objname)";
30 die "terse($order, \\&$objname) failed: $@" if $@;
34 if ($order eq "exec") {
35 return sub { walkoptree_exec(main_start, "terse") }
37 return sub { walkoptree_slow(main_root, "terse") }
43 my $level = @_ ? shift : 0;
48 my ($op, $level) = @_;
50 $targ = ($targ > 0) ? " [$targ]" : "";
51 print indent($level), peekop($op), $targ, "\n";
55 my ($op, $level) = @_;
56 print indent($level), peekop($op), " ";
61 my ($op, $level) = @_;
62 print indent($level), peekop($op), " ", $op->padix, "\n";
66 my ($op, $level) = @_;
67 my $precomp = $op->precomp;
68 print indent($level), peekop($op),
69 defined($precomp) ? " /$precomp/\n" : " (regexp not compiled)\n";
74 my ($op, $level) = @_;
75 print indent($level), peekop($op), " ", cstring($op->pv), "\n";
79 my ($op, $level) = @_;
80 my $label = $op->label;
82 $label = " label ".cstring($label);
84 print indent($level), peekop($op), $label || "", "\n";
88 my ($sv, $level) = @_;
90 printf "%s (0x%lx) %s\n", class($sv), $$sv, cstring($sv->PV);
94 my ($sv, $level) = @_;
96 printf "%s (0x%lx) FILL %d\n", class($sv), $$sv, $sv->FILL;
100 my ($gv, $level) = @_;
101 my $stash = $gv->STASH->NAME;
102 if ($stash eq "main") {
105 $stash = $stash . "::";
107 print indent($level);
108 printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->SAFENAME;
112 my ($sv, $level) = @_;
113 print indent($level);
114 my $v = $sv->FLAGS & SVf_IVisUV ? "%u" : "%d";
115 printf "%s (0x%lx) $v\n", class($sv), $$sv, $sv->int_value;
119 my ($sv, $level) = @_;
120 print indent($level);
121 printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->NV;
125 my ($rv, $level) = @_;
126 print indent($level);
127 printf "%s (0x%lx) %s\n", class($rv), $$rv, printref($rv);
132 my $rcl = class($rv->RV);
134 return "\\" . cstring($rv->RV->$rcl);
135 } elsif ($rcl eq 'NV') {
136 return "\\" . $rv->RV->$rcl;
137 } elsif ($rcl eq 'IV') {
138 return sprintf "\\%" . ($rv->RV->FLAGS & SVf_IVisUV ? "u" : "d"),
140 } elsif ($rcl eq 'RV') {
141 return "\\" . printref($rv->RV);
146 my ($sv, $level) = @_;
147 print indent($level);
148 printf "%s (0x%lx)\n", class($sv), $$sv;
151 sub B::SPECIAL::terse {
152 my ($sv, $level) = @_;
153 print indent($level);
154 printf "%s #%d %s\n", class($sv), $$sv, $specialsv_name[$$sv];
163 B::Terse - Walk Perl syntax tree, printing terse info about ops
167 perl -MO=Terse[,OPTIONS] foo.pl
175 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>