1# Maintained now in B::C by Reini Urban <rurban@cpan.org> 2package B::Bblock; 3 4our $VERSION = '1.05'; 5 6use Exporter (); 7@ISA = "Exporter"; 8our @EXPORT_OK = qw(find_leaders); 9 10use B qw(peekop walkoptree walkoptree_exec 11 main_root main_start svref_2object 12 OPf_SPECIAL OPf_STACKED ); 13 14use strict; 15 16my $bblock; 17my @bblock_ends; 18# don't load Config with its dependencies 19use B::C (); 20sub CPERL56 () { ($B::C::Config::Config{usecperl} and $] >= 5.025003) ? 1 : 0 } #sibparent, xpad_cop_seq 21sub PUSHRE () { ($] >= 5.025006 or CPERL56) ? "split" : "pushre" } 22 23sub mark_leader { 24 my $op = shift; 25 if ($$op) { 26 $bblock->{$$op} = $op; 27 } 28} 29 30sub remove_sortblock { 31 foreach ( keys %$bblock ) { 32 my $leader = $$bblock{$_}; 33 delete $$bblock{$_} if ( $leader == 0 ); 34 } 35} 36 37sub find_leaders { 38 my ( $root, $start ) = @_; 39 $bblock = {}; 40 mark_leader($start) if ( ref $start ne "B::NULL" ); 41 walkoptree( $root, "mark_if_leader" ) if ( ( ref $root ) ne "B::NULL" ); 42 remove_sortblock(); 43 return $bblock; 44} 45 46# Debugging 47sub walk_bblocks { 48 my ( $root, $start ) = @_; 49 my ( $op, $lastop, $leader, $bb ); 50 $bblock = {}; 51 mark_leader($start); 52 walkoptree( $root, "mark_if_leader" ); 53 my @leaders = values %$bblock; 54 while ( $leader = shift @leaders ) { 55 $lastop = $leader; 56 $op = $leader->next; 57 while ( $$op && !exists( $bblock->{$$op} ) ) { 58 $bblock->{$$op} = $leader; 59 $lastop = $op; 60 $op = $op->next; 61 } 62 push( @bblock_ends, [ $leader, $lastop ] ); 63 } 64 foreach $bb (@bblock_ends) { 65 ( $leader, $lastop ) = @$bb; 66 printf "%s .. %s\n", peekop($leader), peekop($lastop); 67 for ( $op = $leader ; $$op != $$lastop ; $op = $op->next ) { 68 printf " %s\n", peekop($op); 69 } 70 printf " %s\n", peekop($lastop); 71 } 72} 73 74sub walk_bblocks_obj { 75 my $cvref = shift; 76 my $cv = svref_2object($cvref); 77 walk_bblocks( $cv->ROOT, $cv->START ); 78} 79 80sub B::OP::mark_if_leader { } 81 82sub B::COP::mark_if_leader { 83 my $op = shift; 84 if ( $op->label ) { 85 mark_leader($op); 86 } 87} 88 89sub B::LOOP::mark_if_leader { 90 my $op = shift; 91 mark_leader( $op->next ); 92 mark_leader( $op->nextop ); 93 mark_leader( $op->redoop ); 94 mark_leader( $op->lastop->next ); 95} 96 97sub B::LOGOP::mark_if_leader { 98 my $op = shift; 99 my $opname = $op->name; 100 mark_leader( $op->next ); 101 if ( $opname eq "entertry" ) { 102 mark_leader( $op->other->next ); 103 } 104 else { 105 mark_leader( $op->other ); 106 } 107} 108 109sub B::LISTOP::mark_if_leader { 110 my $op = shift; 111 my $first = $op->first; 112 $first = $first->next while ( $first->name eq "null" ); 113 mark_leader( $op->first ) unless ( exists( $bblock->{$$first} ) ); 114 mark_leader( $op->next ); 115 if ( $op->name eq "sort" 116 and $op->flags & OPf_SPECIAL 117 and $op->flags & OPf_STACKED ) 118 { 119 my $root = $op->first->sibling->first; 120 my $leader = $root->first; 121 $bblock->{$$leader} = 0; 122 } 123} 124 125sub B::PMOP::mark_if_leader { 126 my $op = shift; 127 if ( $op->type 128 and $op->name ne PUSHRE 129 and ($] > 5.008005 or $op->name ne "substcont") ) 130 { 131 #warn $op->name, $op->type if $] == 5.008004; 132 my $replroot = $op->pmreplroot; 133 if ($$replroot) { 134 mark_leader( $replroot ); 135 mark_leader( $op->next ); 136 mark_leader( $op->pmreplstart ); 137 } 138 } 139} 140 141# PMOP stuff omitted 142 143sub compile { 144 my @options = @_; 145 my $have_B_Concise; 146 B::clearsym(); 147 148 eval { require B::Concise; 1 } and $have_B_Concise = 1; 149 B::Concise->import(qw(concise_cv concise_main set_style_standard)) 150 if $have_B_Concise; 151 152 if ( @options and $have_B_Concise ) { 153 return sub { 154 my $objname; 155 foreach $objname (@options) { 156 $objname = "main::$objname" unless $objname =~ /::/; 157 print "walk_bblocks $objname\n"; 158 eval "walk_bblocks_obj(\\&$objname)"; 159 die "walk_bblocks_obj(\\&$objname) failed: $@" if $@; 160 print "-------\n"; 161 set_style_standard("terse"); 162 eval "concise_cv('exec', \\&$objname)"; 163 die "concise_cv('exec', \\&$objname) failed: $@" if $@; 164 } 165 } 166 } 167 else { 168 return sub { 169 walk_bblocks( main_root, main_start ); 170 print "-------\n"; 171 if ($have_B_Concise) { 172 set_style_standard("terse"); 173 concise_main("exec"); 174 } 175 }; 176 } 177} 178 1791; 180 181__END__ 182 183=head1 NAME 184 185B::Bblock - Walk basic blocks 186 187=head1 SYNOPSIS 188 189 # External interface 190 perl -MO=Bblock[,OPTIONS] foo.pl 191 192 perl -MO=Bblock foo.pl prints the basic block for main_root 193 perl -MO=Bblock,foo::mysub foo.pm prints the basic block for &pkg::mysub 194 perl -MO=Bblock,mysub foo.pm prints the basic block for &main::mysub 195 196 # Programmatic API 197 use B::Bblock qw(find_leaders); 198 my $leaders = find_leaders($root_op, $start_op); 199 200=head1 DESCRIPTION 201 202This module is used by the L<B::CC> backend. It walks "basic blocks". 203A basic block is a series of operations which is known to execute from 204start to finish, with no possibility of branching or halting. 205 206The block is the list of ops from the every leader up to the next. 207The leaders are the separator of each basic block. 208 209The module can be used either stand alone or from inside another program. 210Standalone it just prints the basic blocks ops in L<B::Concise>. 211terse format to STDOUT. 212Without options it starts at the main_root. 213 214Basic block leaders are: 215 216 Any COP (pp_nextstate) with a non-NULL label. 217 [The op after a pp_enter] Omit 218 [The op after a pp_entersub. Don't count this one.] 219 The ops pointed at by nextop, redoop and lastop->op_next of a LOOP. 220 The ops pointed at by op_next and op_other of a LOGOP, except 221 for pp_entertry which has op_next and op_other->op_next 222 The op pointed at by op_pmreplstart of a PMOP. 223 The op pointed at by op_other->op_pmreplstart of pp_substcont? 224 [The op after a pp_return] Omit 225 226=head1 OPTIONS 227 228A comma-separated list of sub names to walk. 229 230=head2 Functions 231 232=over 4 233 234=item B<find_leaders> 235 236 my $leaders = find_leaders($root_op, $start_op); 237 238Given the root of the op tree and an op from which to start 239processing, it will return a hash ref representing all the ops which 240start a block. 241 242The values of %$leaders are the op objects themselves. Keys are $$op 243addresses. 244 245=back 246 247=head1 AUTHOR 248 249Malcolm Beattie C<MICB at cpan.org> I<(retired)>, 250Reini Urban C<perl-compiler@googlegroups.com> 251 252=cut 253 254# Local Variables: 255# mode: cperl 256# cperl-indent-level: 2 257# fill-column: 78 258# End: 259# vim: expandtab shiftwidth=2: 260