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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- a/op.h
+++ b/op.h
@@ -108,6 +108,7 @@ Deprecated.  Use C<GIMME_V> 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 (file)
--- 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);