From: Dave Mitchell Date: Sun, 22 Feb 2004 15:43:53 +0000 (+0000) Subject: Extend OP_AELEMFAST optimisation to lexical arrays X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6a077020aea1c5f03f401226b0a81b82d07f7761;p=p5sagit%2Fp5-mst-13.2.git Extend OP_AELEMFAST optimisation to lexical arrays p4raw-id: //depot/perl@22357 --- diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index e664970..787e45b 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -21,7 +21,8 @@ our @EXPORT_OK = qw(set_style set_style_standard add_callback # use #6 use B qw(class ppname main_start main_root main_cv cstring svref_2object - SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS CVf_ANON); + SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL + CVf_ANON); my %style = ("terse" => @@ -570,12 +571,14 @@ sub concise_op { undef $lastnext; $h{arg} = "(other->" . seq($op->other) . ")"; } elsif ($h{class} eq "SVOP") { - if (! ${$op->sv}) { - my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$op->targ]; - $h{arg} = "[" . concise_sv($sv, \%h) . "]"; - $h{targarglife} = $h{targarg} = ""; - } else { - $h{arg} = "(" . concise_sv($op->sv, \%h) . ")"; + unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) { + if (! ${$op->sv}) { + my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$op->targ]; + $h{arg} = "[" . concise_sv($sv, \%h) . "]"; + $h{targarglife} = $h{targarg} = ""; + } else { + $h{arg} = "(" . concise_sv($op->sv, \%h) . ")"; + } } } elsif ($h{class} eq "PADOP") { my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$op->padix]; diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index 65f314d..e709d36 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -2690,13 +2690,20 @@ sub pp_gv { sub pp_aelemfast { my $self = shift; my($op, $cx) = @_; - my $gv = $self->gv_or_padgv($op); - my $name = $self->gv_name($gv); - $name = $self->{'curstash'}."::$name" - if $name !~ /::/ && $self->lex_in_scope('@'.$name); + my $name; + if ($op->flags & OPf_SPECIAL) { # optimised PADAV + $name = $self->padname($op->targ); + $name =~ s/^@/\$/; + } + else { + my $gv = $self->gv_or_padgv($op); + $name = $self->gv_name($gv); + $name = $self->{'curstash'}."::$name" + if $name !~ /::/ && $self->lex_in_scope('@'.$name); + $name = '$' . $name; + } - return "\$" . $name . "[" . - ($op->private + $self->{'arybase'}) . "]"; + return $name . "[" . ($op->private + $self->{'arybase'}) . "]"; } sub rv2x { diff --git a/op.c b/op.c index e48ea1a..c5b2e83 100644 --- a/op.c +++ b/op.c @@ -275,17 +275,20 @@ Perl_op_clear(pTHX_ OP *o) case OP_GVSV: case OP_GV: case OP_AELEMFAST: + if (! (o->op_type == OP_AELEMFAST && o->op_flags & OPf_SPECIAL)) { + /* not an OP_PADAV replacement */ #ifdef USE_ITHREADS - if (cPADOPo->op_padix > 0) { - /* No GvIN_PAD_off(cGVOPo_gv) here, because other references - * may still exist on the pad */ - pad_swipe(cPADOPo->op_padix, TRUE); - cPADOPo->op_padix = 0; - } + if (cPADOPo->op_padix > 0) { + /* No GvIN_PAD_off(cGVOPo_gv) here, because other references + * may still exist on the pad */ + pad_swipe(cPADOPo->op_padix, TRUE); + cPADOPo->op_padix = 0; + } #else - SvREFCNT_dec(cSVOPo->op_sv); - cSVOPo->op_sv = Nullsv; + SvREFCNT_dec(cSVOPo->op_sv); + cSVOPo->op_sv = Nullsv; #endif + } break; case OP_METHOD_NAMED: case OP_CONST: @@ -294,7 +297,7 @@ Perl_op_clear(pTHX_ OP *o) #ifdef USE_ITHREADS /** Bug #15654 Even if op_clear does a pad_free for the target of the op, - pad_free doesn't actually remove the sv that exists in the bad + pad_free doesn't actually remove the sv that exists in the pad; instead it lives on. This results in that it could be reused as a target later on when the pad was reallocated. **/ @@ -1108,7 +1111,7 @@ Perl_mod(pTHX_ OP *o, I32 type) break; case OP_AELEMFAST: - localize = 1; + localize = -1; PL_modcount++; break; @@ -6404,19 +6407,11 @@ Perl_peep(pTHX_ register OP *o) o->op_opt = 1; break; + case OP_PADAV: case OP_GV: - if (o->op_next->op_type == OP_RV2SV) { - if (!(o->op_next->op_private & OPpDEREF)) { - op_null(o->op_next); - o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO - | OPpOUR_INTRO); - o->op_next = o->op_next->op_next; - o->op_type = OP_GVSV; - o->op_ppaddr = PL_ppaddr[OP_GVSV]; - } - } - else if (o->op_next->op_type == OP_RV2AV) { - OP* pop = o->op_next->op_next; + if (o->op_type == OP_PADAV || o->op_next->op_type == OP_RV2AV) { + OP* pop = (o->op_type == OP_PADAV) ? + o->op_next : o->op_next->op_next; IV i; if (pop && pop->op_type == OP_CONST && (PL_op = pop->op_next) && @@ -6428,16 +6423,34 @@ Perl_peep(pTHX_ register OP *o) i >= 0) { GV *gv; - op_null(o->op_next); + if (o->op_type == OP_GV) + op_null(o->op_next); op_null(pop->op_next); op_null(pop); o->op_flags |= pop->op_next->op_flags & OPf_MOD; o->op_next = pop->op_next->op_next; - o->op_type = OP_AELEMFAST; o->op_ppaddr = PL_ppaddr[OP_AELEMFAST]; o->op_private = (U8)i; - gv = cGVOPo_gv; - GvAVn(gv); + if (o->op_type == OP_GV) { + gv = cGVOPo_gv; + GvAVn(gv); + } + else + o->op_flags |= OPf_SPECIAL; + o->op_type = OP_AELEMFAST; + } + o->op_opt = 1; + break; + } + + if (o->op_next->op_type == OP_RV2SV) { + if (!(o->op_next->op_private & OPpDEREF)) { + op_null(o->op_next); + o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO + | OPpOUR_INTRO); + o->op_next = o->op_next->op_next; + o->op_type = OP_GVSV; + o->op_ppaddr = PL_ppaddr[OP_GVSV]; } } else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) { diff --git a/op.h b/op.h index c9f1139..889b3ea 100644 --- a/op.h +++ b/op.h @@ -108,6 +108,7 @@ Deprecated. Use C instead. /* On RV2[SG]V, don't create GV--in defined()*/ /* On OP_DBSTATE, indicates breakpoint * (runtime property) */ + /* On OP_AELEMFAST, indiciates pad var */ /* old names; don't use in new code, but don't break them, either */ #define OPf_LIST OPf_WANT_LIST diff --git a/pp_hot.c b/pp_hot.c index 60ce962..4d87255 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -521,7 +521,8 @@ PP(pp_add) PP(pp_aelemfast) { dSP; - AV *av = GvAV(cGVOP_gv); + AV *av = PL_op->op_flags & OPf_SPECIAL ? + (AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv); U32 lval = PL_op->op_flags & OPf_MOD; SV** svp = av_fetch(av, PL_op->op_private, lval); SV *sv = (svp ? *svp : &PL_sv_undef);