1N/Apackage B::Bblock;
1N/A
1N/Aour $VERSION = '1.02';
1N/A
1N/Ause Exporter ();
1N/A@ISA = "Exporter";
1N/A@EXPORT_OK = qw(find_leaders);
1N/A
1N/Ause B qw(peekop walkoptree walkoptree_exec
1N/A main_root main_start svref_2object
1N/A OPf_SPECIAL OPf_STACKED );
1N/A
1N/Ause B::Concise qw(concise_cv concise_main set_style_standard);
1N/Ause strict;
1N/A
1N/Amy $bblock;
1N/Amy @bblock_ends;
1N/A
1N/Asub mark_leader {
1N/A my $op = shift;
1N/A if ($$op) {
1N/A $bblock->{$$op} = $op;
1N/A }
1N/A}
1N/A
1N/Asub remove_sortblock{
1N/A foreach (keys %$bblock){
1N/A my $leader=$$bblock{$_};
1N/A delete $$bblock{$_} if( $leader == 0);
1N/A }
1N/A}
1N/Asub find_leaders {
1N/A my ($root, $start) = @_;
1N/A $bblock = {};
1N/A mark_leader($start) if ( ref $start ne "B::NULL" );
1N/A walkoptree($root, "mark_if_leader") if ((ref $root) ne "B::NULL") ;
1N/A remove_sortblock();
1N/A return $bblock;
1N/A}
1N/A
1N/A# Debugging
1N/Asub walk_bblocks {
1N/A my ($root, $start) = @_;
1N/A my ($op, $lastop, $leader, $bb);
1N/A $bblock = {};
1N/A mark_leader($start);
1N/A walkoptree($root, "mark_if_leader");
1N/A my @leaders = values %$bblock;
1N/A while ($leader = shift @leaders) {
1N/A $lastop = $leader;
1N/A $op = $leader->next;
1N/A while ($$op && !exists($bblock->{$$op})) {
1N/A $bblock->{$$op} = $leader;
1N/A $lastop = $op;
1N/A $op = $op->next;
1N/A }
1N/A push(@bblock_ends, [$leader, $lastop]);
1N/A }
1N/A foreach $bb (@bblock_ends) {
1N/A ($leader, $lastop) = @$bb;
1N/A printf "%s .. %s\n", peekop($leader), peekop($lastop);
1N/A for ($op = $leader; $$op != $$lastop; $op = $op->next) {
1N/A printf " %s\n", peekop($op);
1N/A }
1N/A printf " %s\n", peekop($lastop);
1N/A }
1N/A}
1N/A
1N/Asub walk_bblocks_obj {
1N/A my $cvref = shift;
1N/A my $cv = svref_2object($cvref);
1N/A walk_bblocks($cv->ROOT, $cv->START);
1N/A}
1N/A
1N/Asub B::OP::mark_if_leader {}
1N/A
1N/Asub B::COP::mark_if_leader {
1N/A my $op = shift;
1N/A if ($op->label) {
1N/A mark_leader($op);
1N/A }
1N/A}
1N/A
1N/Asub B::LOOP::mark_if_leader {
1N/A my $op = shift;
1N/A mark_leader($op->next);
1N/A mark_leader($op->nextop);
1N/A mark_leader($op->redoop);
1N/A mark_leader($op->lastop->next);
1N/A}
1N/A
1N/Asub B::LOGOP::mark_if_leader {
1N/A my $op = shift;
1N/A my $opname = $op->name;
1N/A mark_leader($op->next);
1N/A if ($opname eq "entertry") {
1N/A mark_leader($op->other->next);
1N/A } else {
1N/A mark_leader($op->other);
1N/A }
1N/A}
1N/A
1N/Asub B::LISTOP::mark_if_leader {
1N/A my $op = shift;
1N/A my $first=$op->first;
1N/A $first=$first->next while ($first->name eq "null");
1N/A mark_leader($op->first) unless (exists( $bblock->{$$first}));
1N/A mark_leader($op->next);
1N/A if ($op->name eq "sort" and $op->flags & OPf_SPECIAL
1N/A and $op->flags & OPf_STACKED){
1N/A my $root=$op->first->sibling->first;
1N/A my $leader=$root->first;
1N/A $bblock->{$$leader} = 0;
1N/A }
1N/A}
1N/A
1N/Asub B::PMOP::mark_if_leader {
1N/A my $op = shift;
1N/A if ($op->name ne "pushre") {
1N/A my $replroot = $op->pmreplroot;
1N/A if ($$replroot) {
1N/A mark_leader($replroot);
1N/A mark_leader($op->next);
1N/A mark_leader($op->pmreplstart);
1N/A }
1N/A }
1N/A}
1N/A
1N/A# PMOP stuff omitted
1N/A
1N/Asub compile {
1N/A my @options = @_;
1N/A B::clearsym();
1N/A if (@options) {
1N/A return sub {
1N/A my $objname;
1N/A foreach $objname (@options) {
1N/A $objname = "main::$objname" unless $objname =~ /::/;
1N/A eval "walk_bblocks_obj(\\&$objname)";
1N/A die "walk_bblocks_obj(\\&$objname) failed: $@" if $@;
1N/A print "-------\n";
1N/A set_style_standard("terse");
1N/A eval "concise_cv('exec', \\&$objname)";
1N/A die "concise_cv('exec', \\&$objname) failed: $@" if $@;
1N/A }
1N/A }
1N/A } else {
1N/A return sub {
1N/A walk_bblocks(main_root, main_start);
1N/A print "-------\n";
1N/A set_style_standard("terse");
1N/A concise_main("exec");
1N/A };
1N/A }
1N/A}
1N/A
1N/A# Basic block leaders:
1N/A# Any COP (pp_nextstate) with a non-NULL label
1N/A# [The op after a pp_enter] Omit
1N/A# [The op after a pp_entersub. Don't count this one.]
1N/A# The ops pointed at by nextop, redoop and lastop->op_next of a LOOP
1N/A# The ops pointed at by op_next and op_other of a LOGOP, except
1N/A# for pp_entertry which has op_next and op_other->op_next
1N/A# The op pointed at by op_pmreplstart of a PMOP
1N/A# The op pointed at by op_other->op_pmreplstart of pp_substcont?
1N/A# [The op after a pp_return] Omit
1N/A
1N/A1;
1N/A
1N/A__END__
1N/A
1N/A=head1 NAME
1N/A
1N/AB::Bblock - Walk basic blocks
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A # External interface
1N/A perl -MO=Bblock[,OPTIONS] foo.pl
1N/A
1N/A # Programmatic API
1N/A use B::Bblock qw(find_leaders);
1N/A my $leaders = find_leaders($root_op, $start_op);
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/AThis module is used by the B::CC back end. It walks "basic blocks".
1N/AA basic block is a series of operations which is known to execute from
1N/Astart to finish, with no possiblity of branching or halting.
1N/A
1N/AIt can be used either stand alone or from inside another program.
1N/A
1N/A=for _private
1N/ASomebody who understands the stand-alone options document them, please.
1N/A
1N/A=head2 Functions
1N/A
1N/A=over 4
1N/A
1N/A=item B<find_leaders>
1N/A
1N/A my $leaders = find_leaders($root_op, $start_op);
1N/A
1N/AGiven the root of the op tree and an op from which to start
1N/Aprocessing, it will return a hash ref representing all the ops which
1N/Astart a block.
1N/A
1N/A=for _private
1N/AThe above description may be somewhat wrong.
1N/A
1N/AThe values of %$leaders are the op objects themselves. Keys are $$op
1N/Aaddresses.
1N/A
1N/A=for _private
1N/AAbove cribbed from B::CC's comments. What's a $$op address?
1N/A
1N/A=back
1N/A
1N/A
1N/A=head1 AUTHOR
1N/A
1N/AMalcolm Beattie, C<mbeattie@sable.ox.ac.uk>
1N/A
1N/A=cut