forked from rurban/optimize
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
git-cpan-module: optimize git-cpan-version: 0.02 git-cpan-authorid: ABERGMAN git-cpan-file: authors/id/A/AB/ABERGMAN/optimize-0.02.tar.gz
- Loading branch information
Artur Bergman
authored and
Reini Urban
committed
Feb 27, 2011
1 parent
bb7ca1e
commit 5fa9f78
Showing
7 changed files
with
156 additions
and
113 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,6 @@ | ||
Revision history for Perl extension optimize | ||
|
||
0.02 Fri Jun 28 00:22:01 CEST 2002 | ||
- Added register() and unregister() functions to | ||
allow third party modules to hook into | ||
optimize |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,103 @@ | ||
|
||
if($op->name eq 'sassign') { | ||
my $dst = $state->next->next; | ||
my $src = $state->next; | ||
if($dst->name eq 'padsv' && $dst->next->name eq 'sassign') { | ||
my $cv = $op->find_cv(); | ||
if(exists($pads{$cv->ROOT->seq}) && | ||
exists($pads{$cv->ROOT->seq}->[$dst->targ]) && | ||
$pads{$cv->ROOT->seq}->[$dst->targ]->[1]->{tied} | ||
) { | ||
# print "sassign tied optimization possible\n"; | ||
|
||
|
||
# return; | ||
my $n = $op->next; | ||
# $op->next(0); | ||
$op->first(0); | ||
$op->null(); | ||
# $op->dump(); | ||
|
||
my $pushmark = B::OP->new("pushmark",2); | ||
$state->next($pushmark); | ||
$pushmark->next($dst); | ||
$pushmark->seq(optimizer::op_seqmax_inc()); | ||
my $tied = B::UNOP->new('tied',38,$dst); | ||
$tied->seq(optimizer::op_seqmax_inc()); | ||
$pushmark->sibling($tied); | ||
# $dst->flags(50); | ||
$dst->next($tied); | ||
$tied->next($src); | ||
$tied->sibling($src); | ||
# $src->flags(34); | ||
|
||
my $method_named = B::SVOP->new('method_named',0,"STORE"); | ||
$method_named->seq(optimizer::op_seqmax_inc()); | ||
$src->next($method_named); | ||
$src->sibling($method_named); | ||
|
||
|
||
my $entersub = B::UNOP->new('entersub',69,0); | ||
$entersub->seq(optimizer::op_seqmax_inc()); | ||
$method_named->next($entersub); | ||
$entersub->next($n); | ||
$entersub->first($pushmark); | ||
$state->sibling($entersub); | ||
|
||
if($n->flags & OPf_KIDS) { | ||
my $no_sibling = 1; | ||
for (my $kid = $n->first; $$kid; $kid = $kid->sibling) { | ||
if($kid->seq == $entersub->seq) { | ||
$no_sibling = 0; | ||
last; | ||
} | ||
} | ||
if($no_sibling) { | ||
$entersub->sibling($n); | ||
} | ||
} else { | ||
$entersub->sibling($n); | ||
} | ||
# print $tied->next->name . "\n"; | ||
# print $src->next->name . "\n"; | ||
# print $dst->next->name . "\n"; | ||
|
||
} | ||
} | ||
} elsif($op->name eq 'padsv' && !($op->flags & OPf_MOD)) { | ||
my $cv = $op->find_cv(); | ||
if(exists($pads{$cv->ROOT->seq}) && | ||
exists($pads{$cv->ROOT->seq}->[$op->targ]) && | ||
$pads{$cv->ROOT->seq}->[$op->targ]->[1]->{tied} | ||
) { | ||
# print $old_op->seq . " - " . $state->seq . "\n"; | ||
# $old_op->dump(); | ||
# $op->dump(); | ||
my $sibling = $op->sibling(); | ||
|
||
my $pushmark = B::OP->new("pushmark",2); | ||
my $n = $op->next(); | ||
$old_op->next($pushmark); | ||
$pushmark->seq(optimizer::op_seqmax_inc()); | ||
$pushmark->next($op); | ||
$op->sibling(0); | ||
my $tied = B::UNOP->new('tied',38,$op); | ||
$pushmark->sibling($tied); | ||
$op->next($tied); | ||
my $method_named = B::SVOP->new('method_named',OPf_WANT_SCALAR,"FETCH"); | ||
$tied->sibling($method_named); | ||
# $tied->seq(optimizer::op_seqmax_inc()); | ||
$tied->next($method_named); | ||
my $entersub = B::UNOP->new('entersub',OPf_WANT_SCALAR| OPf_PARENS | OPf_STACKED,0); | ||
# $method_named->seq(optimizer::op_seqmax_inc()); | ||
$method_named->next($entersub); | ||
$entersub->first($pushmark); | ||
# $entersub->seq(optimizer::op_seqmax_inc()); | ||
$entersub->next($n); | ||
$entersub->sibling($sibling); | ||
$n->next->first($entersub); | ||
# $old_op->sibling($entersub); | ||
} | ||
} | ||
|
||
}; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,13 @@ | ||
|
||
use Test::More tests=> 9; | ||
use optimize; | ||
|
||
package foo; | ||
BEGIN { optimize->register(sub { Test::More::pass() }, "bar")}; | ||
$i++; | ||
package bar; | ||
$i++; | ||
$i++; | ||
$i++; | ||
package yeah; | ||
$i++; |