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 );
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);
68 walkoptree_exec($start, "terse");
71 sub walk_bblocks_obj {
73 my $cv = svref_2object($cvref);
74 walk_bblocks($cv->ROOT, $cv->START);
77 sub B::OP::mark_if_leader {}
79 sub B::COP::mark_if_leader {
86 sub B::LOOP::mark_if_leader {
88 mark_leader($op->next);
89 mark_leader($op->nextop);
90 mark_leader($op->redoop);
91 mark_leader($op->lastop->next);
94 sub B::LOGOP::mark_if_leader {
96 my $opname = $op->name;
97 mark_leader($op->next);
98 if ($opname eq "entertry") {
99 mark_leader($op->other->next);
101 mark_leader($op->other);
105 sub B::LISTOP::mark_if_leader {
107 my $first=$op->first;
108 $first=$first->next while ($first->name eq "null");
109 mark_leader($op->first) unless (exists( $bblock->{$$first}));
110 mark_leader($op->next);
111 if ($op->name eq "sort" and $op->flags & OPf_SPECIAL
112 and $op->flags & OPf_STACKED){
113 my $root=$op->first->sibling->first;
114 my $leader=$root->first;
115 $bblock->{$$leader} = 0;
119 sub B::PMOP::mark_if_leader {
121 if ($op->name ne "pushre") {
122 my $replroot = $op->pmreplroot;
124 mark_leader($replroot);
125 mark_leader($op->next);
126 mark_leader($op->pmreplstart);
139 foreach $objname (@options) {
140 $objname = "main::$objname" unless $objname =~ /::/;
141 eval "walk_bblocks_obj(\\&$objname)";
142 die "walk_bblocks_obj(\\&$objname) failed: $@" if $@;
146 return sub { walk_bblocks(main_root, main_start) };
150 # Basic block leaders:
151 # Any COP (pp_nextstate) with a non-NULL label
152 # [The op after a pp_enter] Omit
153 # [The op after a pp_entersub. Don't count this one.]
154 # The ops pointed at by nextop, redoop and lastop->op_next of a LOOP
155 # The ops pointed at by op_next and op_other of a LOGOP, except
156 # for pp_entertry which has op_next and op_other->op_next
157 # The op pointed at by op_pmreplstart of a PMOP
158 # The op pointed at by op_other->op_pmreplstart of pp_substcont?
159 # [The op after a pp_return] Omit
167 B::Bblock - Walk basic blocks
172 perl -MO=Bblock[,OPTIONS] foo.pl
175 use B::Bblock qw(find_leaders);
176 my $leaders = find_leaders($root_op, $start_op);
180 This module is used by the B::CC back end. It walks "basic blocks".
181 A basic block is a series of operations which is known to execute from
182 start to finish, with no possiblity of branching or halting.
184 It can be used either stand alone or from inside another program.
187 Somebody who understands the stand-alone options document them, please.
193 =item B<find_leaders>
195 my $leaders = find_leaders($root_op, $start_op);
197 Given the root of the op tree and an op from which to start
198 processing, it will return a hash ref representing all the ops which
202 The above description may be somewhat wrong.
204 The values of %$leaders are the op objects themselves. Keys are $$op
208 Above cribbed from B::CC's comments. What's a $$op address?
215 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>