Skip trailing constants when searching pads

Under ithreads, constants and GVs are stored in the pad.

When names are looked up up in a pad, the search begins at the end and
works its way toward the beginning, so that an $x declared later masks
one declared earlier.

If there are many constants at the end of the pad, which can happen
for generated code such as lib/unicore/TestProp.pl (which has about
100,000 lines and over 500,000 pad entries for constants at the
end of the file scope’s pad), it can take a long time to search
through them all.

Before commit 325e1816, constants used &PL_sv_undef ‘names’.  Since
that is the default value for array elements (when viewed directly
through AvARRAY, rather than av_fetch), the pad allocation code did
not even bother storing the ‘name’ for these.  So the name pad (aka
padnamelist) was not extended, leaving just 10 entries or so in the
case of lib/unicore/TestProp.pl.

Commit 325e1816 make pad constants have &PL_sv_no names, so the
name pad would be implicitly extended as a result of storing
&PL_sv_no, causing a huge slowdown in t/re/uniprops.t (which runs
lib/unicore/TestProp.pl) under threaded builds.

Now, normally the name pad *does* get extended to match the pad,
in pad_tidy, but that is skipped for string eval (and required
file scope, of course).  Hence, wrapping the contents of
lib/unicore/TestProp.pl in a sub or adding ‘my $x’ to end of it will
cause the same slowdown before 325e1816.

lib/unicore/TestProp.pl just happened to be written (ok, generated) in
such a way that it ended up with a small name pad.

This commit fixes things to make them as fast as before by recording
the index of the last named variable in the pad.  Anything following
that is disregarded in pad lookup and search begins with the last
named variable.  (This actually does make things faster before for
subs with many trailing constants in the pad.)

This is not a complete fix.  Adding ‘my $x’ to the end of a large file
like lib/unicore/TestProp.pl will make it just as slow again.

Ultimately we need another algorithm, such as a binary search.

diff --git a/av.h b/av.h
index 391ae36..e15ebe6 100644 (file)
--- a/av.h
+++ b/av.h
@@ -73,6 +73,9 @@ Same as C<av_top_index()>.
 #define AvREIFY_on(av) (SvFLAGS(av) |= SVpav_REIFY)
 #define AvREIFY_off(av)        (SvFLAGS(av) &= ~SVpav_REIFY)
 #define AvREIFY_only(av)       (AvREAL_off(av), SvFLAGS(av) |= SVpav_REIFY)
+#define AvPAD_NAMELIST(av)     (SvFLAGS(av) & SVpad_NAMELIST)
+#define AvPAD_NAMELIST_on(av)  (SvFLAGS(av) |= SVpad_NAMELIST)
+
 
 #define AvREALISH(av)  (SvFLAGS(av) & (SVpav_REAL|SVpav_REIFY))
                                           

diff --git a/dump.c b/dump.c
index 84d3eb8..bbb045a 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1515,7 +1515,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (SvWEAKREF(sv))      sv_catpv(d, "WEAKREF,");
     }
     append_flags(d, flags, second_sv_flags_names);
-    if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)) {
+    if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
+                          && type != SVt_PVAV) {
        if (SvPCS_IMPORTED(sv))
                                sv_catpv(d, "PCS_IMPORTED,");
        else
@@ -1563,6 +1564,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (SvPAD_STATE(sv))    sv_catpv(d, "STATE,");
        goto evaled_or_uv;
     case SVt_PVAV:
+       if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
        break;
     }
     /* SVphv_SHAREKEYS is also 0x20000000 */
@@ -1705,6 +1707,9 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            HV * const ost = SvOURSTASH(sv);
            if (ost)
                do_hv_dump(level, file, "  OURSTASH", ost);
+       } else if (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
+           Perl_dump_indent(aTHX_ level, file, "  MAXNAMED = %"UVuf"\n",
+                                  (UV)PadnamelistMAXNAMED(sv));
        } else {
            if (SvMAGIC(sv))
                do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
@@ -1730,7 +1735,11 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            PerlIO_putc(file, '\n');
        Perl_dump_indent(aTHX_ level, file, "  FILL = %"IVdf"\n", (IV)AvFILLp(sv));
        Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)AvMAX(sv));
-       Perl_dump_indent(aTHX_ level, file, "  ARYLEN = 0x%"UVxf"\n", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
+       /* arylen is stored in magic, and padnamelists use SvMAGIC for
+          something else. */
+       if (!AvPAD_NAMELIST(sv))
+           Perl_dump_indent(aTHX_ level, file, "  ARYLEN = 0x%"UVxf"\n",
+                                  SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
        sv_setpvs(d, "");
        if (AvREAL(sv)) sv_catpv(d, ",REAL");
        if (AvREIFY(sv))        sv_catpv(d, ",REIFY");

diff --git a/mg.c b/mg.c
index 4ef6c25..a6f2c53 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -397,6 +397,8 @@ S_mg_findext_flags(pTHX_ const SV *sv, int type, const MGVTBL *vtbl, U32 flags)
     if (sv) {
        MAGIC *mg;
 
+       assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
+
        for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
            if (mg->mg_type == type && (!flags || mg->mg_virtual == vtbl)) {
                return mg;

diff --git a/pad.c b/pad.c
index 6969537..d2b6c4f 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -284,6 +284,7 @@ Perl_pad_new(pTHX_ int flags)
     else {
        av_store(pad, 0, NULL);
        padname = newAV();
+       AvPAD_NAMELIST_on(padname);
     }
 
     /* Most subroutines never recurse, hence only need 2 entries in the padlist
@@ -574,6 +575,7 @@ S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash)
     }
 
     av_store(PL_comppad_name, offset, namesv);
+    PadnamelistMAXNAMED(PL_comppad_name) = offset;
     return offset;
 }
 
@@ -1178,7 +1180,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
         const AV * const nameav = PadlistARRAY(padlist)[0];
        SV * const * const name_svp = AvARRAY(nameav);
 
-       for (offset = AvFILLp(nameav); offset > 0; offset--) {
+       for (offset = PadnamelistMAXNAMED(nameav); offset > 0; offset--) {
             const SV * const namesv = name_svp[offset];
            if (namesv && PadnameLEN(namesv) == namelen
                     && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,

diff --git a/pad.h b/pad.h
index f6f3455..2558b7e 100644 (file)
--- a/pad.h
+++ b/pad.h
@@ -285,6 +285,8 @@ Restore the old pad saved into the local variable opad by PAD_SAVE_LOCAL()
 
 #define PadnamelistARRAY(pnl)  AvARRAY(pnl)
 #define PadnamelistMAX(pnl)    AvFILLp(pnl)
+#define PadnamelistMAXNAMED(pnl) \
+       ((XPVAV*) SvANY(pnl))->xmg_u.xmg_hash_index
 
 #define PadARRAY(pad)          AvARRAY(pad)
 #define PadMAX(pad)            AvFILLp(pad)

diff --git a/sv.c b/sv.c
index a6917d0..43488a2 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5356,6 +5356,8 @@ Perl_sv_magicext(pTHX_ SV *const sv, SV *const obj, const int how,
 
     PERL_ARGS_ASSERT_SV_MAGICEXT;
 
+    if (SvTYPE(sv)==SVt_PVAV) { assert (!AvPAD_NAMELIST(sv)); }
+
     SvUPGRADE(sv, SVt_PVMG);
     Newxz(mg, 1, MAGIC);
     mg->mg_moremagic = SvMAGIC(sv);
@@ -6211,6 +6213,9 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
            }
            else if (type == SVt_PVMG && SvPAD_OUR(sv)) {
                SvREFCNT_dec(SvOURSTASH(sv));
+           }
+           else if (type == SVt_PVAV && AvPAD_NAMELIST(sv)) {
+               assert(!SvMAGICAL(sv));
            } else if (SvMAGIC(sv)) {
                /* Free back-references before other types of magic. */
                sv_unmagic(sv, PERL_MAGIC_backref);
@@ -12313,6 +12318,8 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
            if (sv_type >= SVt_PVMG) {
                if ((sv_type == SVt_PVMG) && SvPAD_OUR(dstr)) {
                    SvOURSTASH_set(dstr, hv_dup_inc(SvOURSTASH(dstr), param));
+               } else if (sv_type == SVt_PVAV && AvPAD_NAMELIST(dstr)) {
+                   NOOP;
                } else if (SvMAGIC(dstr))
                    SvMAGIC_set(dstr, mg_dup(SvMAGIC(dstr), param));
                if (SvOBJECT(dstr) && SvSTASH(dstr))

diff --git a/sv.h b/sv.h
index 32fe744..c63aeff 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -360,6 +360,7 @@ perform the upgrade if necessary.  See C<svtype>.
                                       subroutine in another package. Set the
                                       GvIMPORTED_CV_on() if it needs to be
                                       expanded to a real GV */
+#define SVpad_NAMELIST SVp_SCREAM  /* AV is a padnamelist */
 #define SVf_IsCOW      0x00010000  /* copy on write (shared hash key if
                                       SvLEN == 0) */
 #define SVs_PADTMP     0x00020000  /* in use as tmp; only if ! SVs_PADMY */
@@ -489,7 +490,7 @@ union _xmgu {
     MAGIC*  xmg_magic;         /* linked list of magicalness */
     HV*            xmg_ourstash;       /* Stash for our (when SvPAD_OUR is true) */
     STRLEN  xmg_hash_index;    /* used while freeing hash entries */
-};
+};                             /* also used by PadnamelistMAXNAMED */
 
 struct xpv {
     _XPV_HEAD;