[Jifty-commit] r5458 - in Method-Inline: lib/Class/Accessor lib/Method t
Jifty commits
jifty-commit at lists.jifty.org
Sat May 10 18:19:46 EDT 2008
Author: clkao
Date: Sat May 10 18:19:44 2008
New Revision: 5458
Modified:
Method-Inline/Inline.xs
Method-Inline/bench.pl
Method-Inline/lib/Class/Accessor/Inline.pm
Method-Inline/lib/Method/Inline.pm
Method-Inline/t/guard.t
Log:
guarding, mostly works.
Modified: Method-Inline/Inline.xs
==============================================================================
--- Method-Inline/Inline.xs (original)
+++ Method-Inline/Inline.xs Sat May 10 18:19:44 2008
@@ -3,16 +3,18 @@
#include "embed.h"
#include "XSUB.h"
+typedef OP *B__OP;
+
struct inlined_cv {
SV sv;
- CV *cv;
OP *inlined;
OP *entersub;
+ OP *revert;
};
OP *
Method_Inline_inlined (pTHX) {
- dVAR; dSP; dTOPss;
+ dSP; dTOPss;
GV *gv;
register CV *cv;
struct inlined_cv *i = (struct inlined_cv *)cSVOP_sv;
@@ -79,34 +81,39 @@
break;
}
#else
- if (SvTYPE(sv) == SVt_PVCV)
- cv = (CV*)sv;
+ if (SvTYPE(sv) == SVt_PVCV) {
+ cv = (CV*)sv;
+ }
#endif
-
- if ( i->cv == cv ) {
- RETURNOP(i->inlined);
- } else {
+ if ( SvANY(&i->sv) == SvANY(cv) ) {
+ RETURNOP(i->inlined);
+ }
+ else {
/* save some work for ENTERSUB if possible
* disabled because the above is
if (cv) SETs((SV *)cv)
*/
- RETURNOP(i->entersub);
- }
+ // i->revert->op_next = i->entersub;
+ RETURNOP(i->entersub);
+ }
}
OP *
-Method_Inline_create_inlined (pTHX_ CV* cv, OP *inlined, OP *entersub) {
+Method_Inline_create_inlined (pTHX_ CV* cv, OP *inlined, OP *entersub, OP *prev) {
struct inlined_cv *i;
OP *op;
/* create our fake SV */
Newx(i, 1, struct inlined_cv);
- i->cv = cv;
+ i->sv = *(SV *)cv;
+ SvREFCNT_inc(&i->sv);
i->entersub = entersub;
i->inlined = inlined;
+ i->revert = prev;
- op = newSVOP( OP_CUSTOM, 0, (SV *)i );
+ op = newSVOP( OP_CUSTOM, 0, (SV *)i );
+ op->op_ppaddr = Method_Inline_inlined;
op->op_next = entersub->op_next;
return op;
@@ -116,6 +123,16 @@
MODULE = Method::Inline PACKAGE = Method::Inline
+void
+inlined_op(CV *cv, B::OP inlined, B::OP entersub, B::OP prev)
+ OP *o = NO_INIT
+ CODE:
+{
+ o = Method_Inline_create_inlined(aTHX_ cv, inlined, entersub, prev);
+ ST(0) = sv_newmortal();
+ sv_setiv(newSVrv(ST(0), "B::OP"), PTR2IV(o));
+}
+
IV
inline_op_pp_addr ()
CODE:
Modified: Method-Inline/bench.pl
==============================================================================
--- Method-Inline/bench.pl (original)
+++ Method-Inline/bench.pl Sat May 10 18:19:44 2008
@@ -34,14 +34,36 @@
}
-warn call_cai();
-warn call_cai();
-
use Benchmark 'cmpthese';
cmpthese(-2, { ca => sub { call_ca() },
caf => sub { call_caf() },
cai => sub { call_cai() },
cad => sub { call_cad() },
});
-
B::Concise::compile('', 'call_cai', 'call_cad')->(); use B::Concise;
+
+sub set_caf {
+ $caf->foo('orz');
+}
+
+sub set_cai {
+# $_[0] == 1 ? 1 : 0;
+ $cai->foo('orz');
+}
+
+sub set_ca {
+ $ca->foo('orz')
+}
+
+sub set_cad {
+ $cai->{foo} = 'orz';
+}
+
+cmpthese (-2, { ca => sub { set_ca() },
+ caf => sub { set_caf() },
+ cai => sub { set_cai() },
+ cad => sub { set_cad() },
+ });
+
+B::Concise::compile('', 'set_cai', 'set_cad')->(); use B::Concise;
+
Modified: Method-Inline/lib/Class/Accessor/Inline.pm
==============================================================================
--- Method-Inline/lib/Class/Accessor/Inline.pm (original)
+++ Method-Inline/lib/Class/Accessor/Inline.pm Sat May 10 18:19:44 2008
@@ -29,6 +29,7 @@
my $tree = find_detachable( $caller_op, $return_op );
# B::Concise::compile('', $cv)->(); use B::Concise;
+# warn "rewrite for $cv";
$cvme->rewrite($tree);
return;
@@ -38,13 +39,15 @@
sub find_detachable {
my ( $parent_cop, $return_op ) = @_;
- my ($parent, $prev, $prevsibling, $thisop, $entry);
+ my ($parent, $prev, $prevsibling, $thisop, $thisop_prev, $entry);
+ no warnings 'redefine';
local *B::OP::my_visit = sub { my $op = shift;
$thisop = $op if ${$op->next} == $$return_op;
};
B::walkoptree( $_, 'my_visit' ) for $parent_cop->sibling;
local *B::OP::my_visit = sub { my $op = shift;
+ $thisop_prev = $op if ${$op->next} == $$thisop;
$parent = $op if $op->can('first') && ${$op->first} == $$thisop;
$prevsibling = $op if ${$op->sibling} == $$thisop;
};
@@ -68,6 +71,7 @@
return { return => $return_op,
parent_cop => $parent_cop,
thisop => $thisop,
+ thisop_prev => $thisop_prev,
parent => $parent,
prev => $prev,
prevsibling => $prevsibling,
@@ -92,7 +96,14 @@
my $mname;
my $key;
- my $self_op = $op; $op = $op->sibling;
+ return unless $op->name eq 'padsv';
+ my $orig_entry = $op;
+ # duplicate $self_op
+ my $self_op = B::OP->new('padsv', ($op->flags | OPpDEREF_HV) & ~OPf_STACKED);
+ $self_op->targ( $op->targ );
+ $self_op->sibling(undef);
+
+ $op = $op->sibling;
my $rv2hv = B::UNOP->new( "rv2hv", OPf_WANT_SCALAR|OPf_KIDS|OPf_REF, $self_op);
my $valop;
@@ -115,22 +126,22 @@
# self-contained floating $helem tree
my $helem = B::BINOP->new( "helem", OPf_WANT_SCALAR, $rv2hv, $key);
- $self_op->flags( ($self_op->flags | OPpDEREF_HV) & ~OPf_STACKED);
- $self_op->sibling(undef);
$self_op->next($rv2hv);
$rv2hv->next($key);
$key->next($helem);
+ my ($entry, $exit);
+
if ($valop) {
my $sassign = B::BINOP->new( "sassign", OPf_WANT_SCALAR|OPf_KIDS|OPf_STACKED, $helem, $valop);
- $sassign->next($tree->{return});
- $sassign->next($tree->{sibling}) if $tree->{sibling};
+ $entry = $valtree->{entry};
+ $exit = $sassign;
+# $sassign->sibling($tree->{sibling}) if $tree->{sibling};
$helem->next($sassign);
$valtree->{thisop}->next($self_op);
- $tree->{prev}->next( $valtree->{entry} );
- $tree->{prevsibling}->sibling( $sassign ) if $tree->{prevsibling};
+# $tree->{prevsibling}->sibling( $sassign ) if $tree->{prevsibling};
}
else {
@@ -139,14 +150,23 @@
# warn "=== $_: @{[ $tree->{$_}->name ]} ( @{[ $tree->{$_}->seq ]}) ";
# }
# reconnect helem to replace $tree
- $helem->next($tree->{return});
- $helem->sibling($tree->{sibling}) if $tree->{sibling};
-
- $tree->{parent}->first( $helem ) if $tree->{parent};
- $tree->{prev}->next( $self_op );
- $tree->{prevsibling}->sibling( $helem ) if $tree->{prevsibling};
+ $entry = $self_op;
+ $exit = $helem;
+ # tree restruct, not really necessary
+# $helem->sibling($tree->{sibling}) if $tree->{sibling};
+# $tree->{parent}->first( $helem ) if $tree->{parent};
+# $tree->{prevsibling}->sibling( $helem ) if $tree->{prevsibling};
}
+ $exit->next($tree->{return});
+
+
+ use Method::Inline;
+ my $iop= Method::Inline::inlined_op($self, $entry, $tree->{thisop}, $tree->{thisop_prev});
+
+ $tree->{thisop_prev}->next( $iop );
+
+
}
1
Modified: Method-Inline/lib/Method/Inline.pm
==============================================================================
--- Method-Inline/lib/Method/Inline.pm (original)
+++ Method-Inline/lib/Method/Inline.pm Sat May 10 18:19:44 2008
@@ -7,6 +7,10 @@
our $VERSION = "0.01";
+use XSLoader;
+
+XSLoader::load 'Method::Inline', $VERSION;
+
__PACKAGE__
__END__
Modified: Method-Inline/t/guard.t
==============================================================================
--- Method-Inline/t/guard.t (original)
+++ Method-Inline/t/guard.t Sat May 10 18:19:44 2008
@@ -1,4 +1,4 @@
-use Test::More tests => 4;
+use Test::More tests => 5;
use ok 'Class::Accessor::Inline';
package Foo;
@@ -22,5 +22,6 @@
}
is(hate($foo), 'orz');
+is(hate($foo), 'orz');
is(hate($bar), 'orzorz');
is(hate('Bar'), 'orzorz');
More information about the Jifty-commit
mailing list