7 @EXPORT_OK = qw(find_leaders);
9 use B qw(peekop walkoptree walkoptree_exec
10 main_root main_start svref_2object
11 OPf_SPECIAL OPf_STACKED );
13 use B::Concise qw(concise_cv concise_main set_style_standard);
22 $bblock->{$$op} = $op;
27 foreach (keys %$bblock){
28 my $leader=$$bblock{$_};
29 delete $$bblock{$_} if( $leader == 0);
33 my ($root, $start) = @_;
35 mark_leader($start) if ( ref $start ne "B::NULL" );
36 walkoptree($root, "mark_if_leader") if ((ref $root) ne "B::NULL") ;
43 my ($root, $start) = @_;
44 my ($op, $lastop, $leader, $bb);
47 walkoptree($root, "mark_if_leader");
48 my @leaders = values %$bblock;
49 while ($leader = shift @leaders) {
52 while ($$op && !exists($bblock->{$$op})) {
53 $bblock->{$$op} = $leader;
57 push(@bblock_ends, [$leader, $lastop]);
59 foreach $bb (@bblock_ends) {
60 ($leader, $lastop) = @$bb;
61 printf "%s .. %s\n", peekop($leader), peekop($lastop);
62 for ($op = $leader; $$op != $$lastop; $op = $op->next) {
63 printf " %s\n", peekop($op);
65 printf " %s\n", peekop($lastop);
69 sub walk_bblocks_obj {
71 my $cv = svref_2object($cvref);
72 walk_bblocks($cv->ROOT, $cv->START);
75 sub B::OP::mark_if_leader {}
77 sub B::COP::mark_if_leader {
84 sub B::LOOP::mark_if_leader {
86 mark_leader($op->next);
87 mark_leader($op->nextop);
88 mark_leader($op->redoop);
89 mark_leader($op->lastop->next);
92 sub B::LOGOP::mark_if_leader {
94 my $opname = $op->name;
95 mark_leader($op->next);
96 if ($opname eq "entertry") {
97 mark_leader($op->other->next);
99 mark_leader($op->other);
103 sub B::LISTOP::mark_if_leader {
105 my $first=$op->first;
106 $first=$first->next while ($first->name eq "null");
107 mark_leader($op->first) unless (exists( $bblock->{$$first}));
108 mark_leader($op->next);
109 if ($op->name eq "sort" and $op->flags & OPf_SPECIAL
110 and $op->flags & OPf_STACKED){
111 my $root=$op->first->sibling->first;
112 my $leader=$root->first;
113 $bblock->{$$leader} = 0;
117 sub B::PMOP::mark_if_leader {
119 if ($op->name ne "pushre") {
120 my $replroot = $op->pmreplroot;
122 mark_leader($replroot);
123 mark_leader($op->next);
124 mark_leader($op->pmreplstart);
137 foreach $objname (@options) {
138 $objname = "main::$objname" unless $objname =~ /::/;
139 eval "walk_bblocks_obj(\\&$objname)";
140 die "walk_bblocks_obj(\\&$objname) failed: $@" if $@;
142 set_style_standard("terse");
143 eval "concise_cv('exec', \\&$objname)";
144 die "concise_cv('exec', \\&$objname) failed: $@" if $@;
149 walk_bblocks(main_root, main_start);
151 set_style_standard("terse");
152 concise_main("exec");
157 # Basic block leaders:
158 # Any COP (pp_nextstate) with a non-NULL label
159 # [The op after a pp_enter] Omit
160 # [The op after a pp_entersub. Don't count this one.]
161 # The ops pointed at by nextop, redoop and lastop->op_next of a LOOP
162 # The ops pointed at by op_next and op_other of a LOGOP, except
163 # for pp_entertry which has op_next and op_other->op_next
164 # The op pointed at by op_pmreplstart of a PMOP
165 # The op pointed at by op_other->op_pmreplstart of pp_substcont?
166 # [The op after a pp_return] Omit
174 B::Bblock - Walk basic blocks
179 perl -MO=Bblock[,OPTIONS] foo.pl
182 use B::Bblock qw(find_leaders);
183 my $leaders = find_leaders($root_op, $start_op);
187 This module is used by the B::CC back end. It walks "basic blocks".
188 A basic block is a series of operations which is known to execute from
189 start to finish, with no possiblity of branching or halting.
191 It can be used either stand alone or from inside another program.
194 Somebody who understands the stand-alone options document them, please.
200 =item B<find_leaders>
202 my $leaders = find_leaders($root_op, $start_op);
204 Given the root of the op tree and an op from which to start
205 processing, it will return a hash ref representing all the ops which
209 The above description may be somewhat wrong.
211 The values of %$leaders are the op objects themselves. Keys are $$op
215 Above cribbed from B::CC's comments. What's a $$op address?
222 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>