Commit | Line | Data |
a798dbf2 |
1 | package B::Terse; |
ad4997d3 |
2 | use strict; |
3 | use B qw(peekop class walkoptree walkoptree_exec walkoptree_slow |
4 | main_start main_root cstring svref_2object); |
5 | use B::Asmdata qw(@specialsv_name); |
6 | |
7 | sub terse { |
8 | my ($order, $cvref) = @_; |
9 | my $cv = svref_2object($cvref); |
10 | if ($order eq "exec") { |
11 | walkoptree_exec($cv->START, "terse"); |
12 | } else { |
13 | walkoptree_slow($cv->ROOT, "terse"); |
14 | } |
15 | } |
a798dbf2 |
16 | |
17 | sub compile { |
244826eb |
18 | my $order = @_ ? shift : ""; |
ad4997d3 |
19 | my @options = @_; |
20 | B::clearsym(); |
21 | if (@options) { |
22 | return sub { |
23 | my $objname; |
24 | foreach $objname (@options) { |
25 | $objname = "main::$objname" unless $objname =~ /::/; |
26 | eval "terse(\$order, \\&$objname)"; |
27 | die "terse($order, \\&$objname) failed: $@" if $@; |
28 | } |
29 | } |
30 | } else { |
31 | if ($order eq "exec") { |
32 | return sub { walkoptree_exec(main_start, "terse") } |
33 | } else { |
34 | return sub { walkoptree_slow(main_root, "terse") } |
35 | } |
36 | } |
37 | } |
38 | |
39 | sub indent { |
244826eb |
40 | my $level = @_ ? shift : 0; |
ad4997d3 |
41 | return " " x $level; |
42 | } |
43 | |
44 | sub B::OP::terse { |
45 | my ($op, $level) = @_; |
46 | my $targ = $op->targ; |
47 | $targ = ($targ > 0) ? " [$targ]" : ""; |
48 | print indent($level), peekop($op), $targ, "\n"; |
49 | } |
50 | |
51 | sub B::SVOP::terse { |
52 | my ($op, $level) = @_; |
53 | print indent($level), peekop($op), " "; |
54 | $op->sv->terse(0); |
55 | } |
56 | |
57 | sub B::PADOP::terse { |
58 | my ($op, $level) = @_; |
59 | print indent($level), peekop($op), " ", $op->padix, "\n"; |
60 | } |
61 | |
62 | sub B::PMOP::terse { |
63 | my ($op, $level) = @_; |
64 | my $precomp = $op->precomp; |
65 | print indent($level), peekop($op), |
66 | defined($precomp) ? " /$precomp/\n" : " (regexp not compiled)\n"; |
67 | |
68 | } |
69 | |
70 | sub B::PVOP::terse { |
71 | my ($op, $level) = @_; |
72 | print indent($level), peekop($op), " ", cstring($op->pv), "\n"; |
73 | } |
74 | |
75 | sub B::COP::terse { |
76 | my ($op, $level) = @_; |
77 | my $label = $op->label; |
78 | if ($label) { |
79 | $label = " label ".cstring($label); |
80 | } |
81 | print indent($level), peekop($op), $label || "", "\n"; |
82 | } |
83 | |
84 | sub B::PV::terse { |
85 | my ($sv, $level) = @_; |
86 | print indent($level); |
87 | printf "%s (0x%lx) %s\n", class($sv), $$sv, cstring($sv->PV); |
88 | } |
89 | |
90 | sub B::AV::terse { |
91 | my ($sv, $level) = @_; |
92 | print indent($level); |
93 | printf "%s (0x%lx) FILL %d\n", class($sv), $$sv, $sv->FILL; |
94 | } |
95 | |
96 | sub B::GV::terse { |
97 | my ($gv, $level) = @_; |
98 | my $stash = $gv->STASH->NAME; |
99 | if ($stash eq "main") { |
100 | $stash = ""; |
101 | } else { |
102 | $stash = $stash . "::"; |
103 | } |
104 | print indent($level); |
002b978b |
105 | printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->SAFENAME; |
ad4997d3 |
106 | } |
107 | |
108 | sub B::IV::terse { |
109 | my ($sv, $level) = @_; |
110 | print indent($level); |
111 | printf "%s (0x%lx) %d\n", class($sv), $$sv, $sv->IV; |
112 | } |
113 | |
114 | sub B::NV::terse { |
115 | my ($sv, $level) = @_; |
116 | print indent($level); |
117 | printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->NV; |
118 | } |
119 | |
120 | sub B::NULL::terse { |
121 | my ($sv, $level) = @_; |
122 | print indent($level); |
123 | printf "%s (0x%lx)\n", class($sv), $$sv; |
124 | } |
125 | |
126 | sub B::SPECIAL::terse { |
127 | my ($sv, $level) = @_; |
128 | print indent($level); |
129 | printf "%s #%d %s\n", class($sv), $$sv, $specialsv_name[$$sv]; |
a798dbf2 |
130 | } |
131 | |
132 | 1; |
7f20e9dd |
133 | |
134 | __END__ |
135 | |
136 | =head1 NAME |
137 | |
138 | B::Terse - Walk Perl syntax tree, printing terse info about ops |
139 | |
140 | =head1 SYNOPSIS |
141 | |
ad4997d3 |
142 | perl -MO=Terse[,OPTIONS] foo.pl |
7f20e9dd |
143 | |
144 | =head1 DESCRIPTION |
145 | |
ad4997d3 |
146 | See F<ext/B/README>. |
7f20e9dd |
147 | |
148 | =head1 AUTHOR |
149 | |
ad4997d3 |
150 | Malcolm Beattie, C<mbeattie@sable.ox.ac.uk> |
7f20e9dd |
151 | |
152 | =cut |