3 use B qw(peekop class walkoptree walkoptree_exec walkoptree_slow
4 main_start main_root cstring svref_2object SVf_IVisUV);
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");
18 my $order = @_ ? shift : "";
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") }
40 my $level = @_ ? shift : 0;
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), " ", $op->padix, "\n";
63 my ($op, $level) = @_;
64 my $precomp = $op->precomp;
65 print indent($level), peekop($op),
66 defined($precomp) ? " /$precomp/\n" : " (regexp not compiled)\n";
71 my ($op, $level) = @_;
72 print indent($level), peekop($op), " ", cstring($op->pv), "\n";
76 my ($op, $level) = @_;
77 my $label = $op->label;
79 $label = " label ".cstring($label);
81 print indent($level), peekop($op), $label || "", "\n";
85 my ($sv, $level) = @_;
87 printf "%s (0x%lx) %s\n", class($sv), $$sv, cstring($sv->PV);
91 my ($sv, $level) = @_;
93 printf "%s (0x%lx) FILL %d\n", class($sv), $$sv, $sv->FILL;
97 my ($gv, $level) = @_;
98 my $stash = $gv->STASH->NAME;
99 if ($stash eq "main") {
102 $stash = $stash . "::";
104 print indent($level);
105 printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->SAFENAME;
109 my ($sv, $level) = @_;
110 print indent($level);
111 my $v = $sv->FLAGS & SVf_IVisUV ? "%u" : "%d";
112 printf "%s (0x%lx) $v\n", class($sv), $$sv, $sv->int_value;
116 my ($sv, $level) = @_;
117 print indent($level);
118 printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->NV;
122 my ($rv, $level) = @_;
123 print indent($level);
124 printf "%s (0x%lx) %s\n", class($rv), $$rv, printref($rv);
129 my $rcl = class($rv->RV);
131 return "\\" . cstring($rv->RV->$rcl);
132 } elsif ($rcl eq 'NV') {
133 return "\\" . $rv->RV->$rcl;
134 } elsif ($rcl eq 'IV') {
135 return sprintf "\\%" . ($rv->RV->FLAGS & SVf_IVisUV ? "u" : "d"),
137 } elsif ($rcl eq 'RV') {
138 return "\\" . printref($rv->RV);
143 my ($sv, $level) = @_;
144 print indent($level);
145 printf "%s (0x%lx)\n", class($sv), $$sv;
148 sub B::SPECIAL::terse {
149 my ($sv, $level) = @_;
150 print indent($level);
151 printf "%s #%d %s\n", class($sv), $$sv, $specialsv_name[$$sv];
160 B::Terse - Walk Perl syntax tree, printing terse info about ops
164 perl -MO=Terse[,OPTIONS] foo.pl
172 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>