PageRenderTime 27ms CodeModel.GetById 2ms app.highlight 22ms RepoModel.GetById 1ms app.codeStats 0ms

/IronPython_Main/Runtime/Tests/LinqDlrTests/testenv/perl/lib/B/Bblock.pm

#
Perl | 180 lines | 141 code | 27 blank | 12 comment | 20 complexity | e9f93b2821faeef698ea7976e2320ffa MD5 | raw file
  1package B::Bblock;
  2use Exporter ();
  3@ISA = "Exporter";
  4@EXPORT_OK = qw(find_leaders);
  5
  6use B qw(peekop walkoptree walkoptree_exec
  7	 main_root main_start svref_2object
  8         OPf_SPECIAL OPf_STACKED );
  9
 10use B::Terse;
 11use strict;
 12
 13my $bblock;
 14my @bblock_ends;
 15
 16sub mark_leader {
 17    my $op = shift;
 18    if ($$op) {
 19	$bblock->{$$op} = $op;
 20    }
 21}
 22
 23sub remove_sortblock{
 24    foreach (keys %$bblock){
 25        my $leader=$$bblock{$_};	
 26	delete $$bblock{$_} if( $leader == 0);   
 27    }
 28}
 29sub find_leaders {
 30    my ($root, $start) = @_;
 31    $bblock = {};
 32    mark_leader($start) if ( ref $start ne "B::NULL" );
 33    walkoptree($root, "mark_if_leader") if ((ref $root) ne "B::NULL") ;
 34    remove_sortblock();
 35    return $bblock;
 36}
 37
 38# Debugging
 39sub walk_bblocks {
 40    my ($root, $start) = @_;
 41    my ($op, $lastop, $leader, $bb);
 42    $bblock = {};
 43    mark_leader($start);
 44    walkoptree($root, "mark_if_leader");
 45    my @leaders = values %$bblock;
 46    while ($leader = shift @leaders) {
 47	$lastop = $leader;
 48	$op = $leader->next;
 49	while ($$op && !exists($bblock->{$$op})) {
 50	    $bblock->{$$op} = $leader;
 51	    $lastop = $op;
 52	    $op = $op->next;
 53	}
 54	push(@bblock_ends, [$leader, $lastop]);
 55    }
 56    foreach $bb (@bblock_ends) {
 57	($leader, $lastop) = @$bb;
 58	printf "%s .. %s\n", peekop($leader), peekop($lastop);
 59	for ($op = $leader; $$op != $$lastop; $op = $op->next) {
 60	    printf "    %s\n", peekop($op);
 61	}
 62	printf "    %s\n", peekop($lastop);
 63    }
 64    print "-------\n";
 65    walkoptree_exec($start, "terse");
 66}
 67
 68sub walk_bblocks_obj {
 69    my $cvref = shift;
 70    my $cv = svref_2object($cvref);
 71    walk_bblocks($cv->ROOT, $cv->START);
 72}
 73
 74sub B::OP::mark_if_leader {}
 75
 76sub B::COP::mark_if_leader {
 77    my $op = shift;
 78    if ($op->label) {
 79	mark_leader($op);
 80    }
 81}
 82
 83sub B::LOOP::mark_if_leader {
 84    my $op = shift;
 85    mark_leader($op->next);
 86    mark_leader($op->nextop);
 87    mark_leader($op->redoop);
 88    mark_leader($op->lastop->next);
 89}
 90
 91sub B::LOGOP::mark_if_leader {
 92    my $op = shift;
 93    my $opname = $op->name;
 94    mark_leader($op->next);
 95    if ($opname eq "entertry") {
 96	mark_leader($op->other->next);
 97    } else {
 98	mark_leader($op->other);
 99    }
100}
101
102sub B::LISTOP::mark_if_leader {
103    my $op = shift;
104    my $first=$op->first;
105    $first=$first->next while ($first->name eq "null");
106    mark_leader($op->first) unless (exists( $bblock->{$$first}));
107    mark_leader($op->next);
108    if ($op->name eq "sort" and $op->flags & OPf_SPECIAL
109	and $op->flags & OPf_STACKED){
110        my $root=$op->first->sibling->first;
111        my $leader=$root->first;
112        $bblock->{$$leader} = 0;
113    }
114}
115
116sub B::PMOP::mark_if_leader {
117    my $op = shift;
118    if ($op->name ne "pushre") {
119	my $replroot = $op->pmreplroot;
120	if ($$replroot) {
121	    mark_leader($replroot);
122	    mark_leader($op->next);
123	    mark_leader($op->pmreplstart);
124	}
125    }
126}
127
128# PMOP stuff omitted
129
130sub compile {
131    my @options = @_;
132    B::clearsym();
133    if (@options) {
134	return sub {
135	    my $objname;
136	    foreach $objname (@options) {
137		$objname = "main::$objname" unless $objname =~ /::/;
138		eval "walk_bblocks_obj(\\&$objname)";
139		die "walk_bblocks_obj(\\&$objname) failed: $@" if $@;
140	    }
141	}
142    } else {
143	return sub { walk_bblocks(main_root, main_start) };
144    }
145}
146
147# Basic block leaders:
148#     Any COP (pp_nextstate) with a non-NULL label
149#     [The op after a pp_enter] Omit
150#     [The op after a pp_entersub. Don't count this one.]
151#     The ops pointed at by nextop, redoop and lastop->op_next of a LOOP
152#     The ops pointed at by op_next and op_other of a LOGOP, except
153#     for pp_entertry which has op_next and op_other->op_next
154#     The op pointed at by op_pmreplstart of a PMOP
155#     The op pointed at by op_other->op_pmreplstart of pp_substcont?
156#     [The op after a pp_return] Omit
157
1581;
159
160__END__
161
162=head1 NAME
163
164B::Bblock - Walk basic blocks
165
166=head1 SYNOPSIS
167
168	perl -MO=Bblock[,OPTIONS] foo.pl
169
170=head1 DESCRIPTION
171
172This module is used by the B::CC back end.  It walks "basic blocks".
173A basic block is a series of operations which is known to execute from
174start to finish, with no possiblity of branching or halting.
175
176=head1 AUTHOR
177
178Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
179
180=cut