In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/7db6405c07905ec5bc4178ea8184089842949690?hp=533d93cc1b438187c43582769dc47b2f8c1797a3>
- Log ----------------------------------------------------------------- commit 7db6405c07905ec5bc4178ea8184089842949690 Author: Father Chrysostomos <[email protected]> Date: Mon Jul 29 20:40:24 2013 -0700 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. ----------------------------------------------------------------------- Summary of changes: av.h | 3 +++ dump.c | 13 +++++++++++-- mg.c | 2 ++ pad.c | 4 +++- pad.h | 2 ++ sv.c | 7 +++++++ sv.h | 3 ++- 7 files changed, 30 insertions(+), 4 deletions(-) diff --git a/av.h b/av.h index 391ae36..e15ebe6 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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; -- Perl5 Master Repository
