From 9b7476d7a269a4d9bb24393ae5c8d75efe2fcab4 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sun, 23 Nov 2014 14:25:22 -0800 Subject: [PATCH] Make PADNAMELIST a separate type This is in preparation for making PADNAME a separate type. --- av.h | 2 - dump.c | 15 +--- embed.fnc | 7 ++ embed.h | 4 + ext/B/B.pm | 32 +++++++- ext/B/B.xs | 61 +++++++++++++-- ext/B/typemap | 13 ++++ mg.c | 2 - op.c | 2 +- pad.c | 241 ++++++++++++++++++++++++++++++++++++++++++++-------------- pad.h | 39 +++++++--- perl.h | 2 +- proto.h | 27 +++++++ sv.c | 11 +-- sv.h | 3 +- 15 files changed, 355 insertions(+), 106 deletions(-) diff --git a/av.h b/av.h index e15ebe6..dcd32cf 100644 --- a/av.h +++ b/av.h @@ -73,8 +73,6 @@ Same as C. #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 9209d06..a1ff768 100644 --- a/dump.c +++ b/dump.c @@ -1496,7 +1496,6 @@ 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 */ @@ -1643,9 +1642,6 @@ 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); @@ -1671,10 +1667,7 @@ 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)); - /* 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", + 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"); @@ -2303,17 +2296,17 @@ Perl_debop(pTHX_ const OP *o) { CV * const cv = deb_curcv(cxstack_ix); SV *sv; - PAD * comppad = NULL; + PADNAMELIST * comppad = NULL; int i; if (cv) { PADLIST * const padlist = CvPADLIST(cv); - comppad = *PadlistARRAY(padlist); + comppad = PadlistNAMES(padlist); } PerlIO_printf(Perl_debug_log, "("); for (i = 0; i < count; i++) { if (comppad && - (sv = *av_fetch(comppad, o->op_targ + i, FALSE))) + (sv = padnamelist_fetch(comppad, o->op_targ + i))) PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv)); else PerlIO_printf(Perl_debug_log, "[%"UVuf"]", diff --git a/embed.fnc b/embed.fnc index c7b585e..37638c8 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1000,6 +1000,7 @@ AmdbR |HV* |newHV ApaR |HV* |newHVhv |NULLOK HV *hv Apabm |IO* |newIO Apda |OP* |newLISTOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last +AMpda |PADNAMELIST *|newPADNAMELIST|size_t max #ifdef USE_ITHREADS Apda |OP* |newPADOP |I32 type|I32 flags|NN SV* sv #endif @@ -2583,7 +2584,13 @@ p |CV* |cv_clone_into |NN CV* proto|NN CV *target pd |void |pad_fixup_inner_anons|NN PADLIST *padlist|NN CV *old_cv|NN CV *new_cv pdX |void |pad_push |NN PADLIST *padlist|int depth ApbdR |HV* |pad_compname_type|const PADOFFSET po +AMpdR |PADNAME *|padnamelist_fetch|NN PADNAMELIST *pnl|SSize_t key +Xop |void |padnamelist_free|NN PADNAMELIST *pnl +AMpd |PADNAME **|padnamelist_store|NN PADNAMELIST *pnl|SSize_t key \ + |NULLOK PADNAME *val #if defined(USE_ITHREADS) +pR |PADNAMELIST *|padnamelist_dup|NN PADNAMELIST *srcpad \ + |NN CLONE_PARAMS *param pdR |PADLIST *|padlist_dup |NN PADLIST *srcpad \ |NN CLONE_PARAMS *param #endif diff --git a/embed.h b/embed.h index c8dfde3..1ea0b1f 100644 --- a/embed.h +++ b/embed.h @@ -384,6 +384,7 @@ #define newMYSUB(a,b,c,d,e) Perl_newMYSUB(aTHX_ a,b,c,d,e) #define newNULLLIST() Perl_newNULLLIST(aTHX) #define newOP(a,b) Perl_newOP(aTHX_ a,b) +#define newPADNAMELIST(a) Perl_newPADNAMELIST(aTHX_ a) #define newPMOP(a,b) Perl_newPMOP(aTHX_ a,b) #define newPROG(a) Perl_newPROG(aTHX_ a) #define newPVOP(a,b,c) Perl_newPVOP(aTHX_ a,b,c) @@ -449,6 +450,8 @@ #define pad_findmy_sv(a,b) Perl_pad_findmy_sv(aTHX_ a,b) #define pad_new(a) Perl_pad_new(aTHX_ a) #define pad_tidy(a) Perl_pad_tidy(aTHX_ a) +#define padnamelist_fetch(a,b) Perl_padnamelist_fetch(aTHX_ a,b) +#define padnamelist_store(a,b,c) Perl_padnamelist_store(aTHX_ a,b,c) #define parse_arithexpr(a) Perl_parse_arithexpr(aTHX_ a) #define parse_barestmt(a) Perl_parse_barestmt(aTHX_ a) #define parse_block(a) Perl_parse_block(aTHX_ a) @@ -1755,6 +1758,7 @@ # if defined(USE_ITHREADS) #define mro_meta_dup(a,b) Perl_mro_meta_dup(aTHX_ a,b) #define padlist_dup(a,b) Perl_padlist_dup(aTHX_ a,b) +#define padnamelist_dup(a,b) Perl_padnamelist_dup(aTHX_ a,b) # endif # if defined(USE_LOCALE) && (defined(PERL_IN_LOCALE_C) || defined (PERL_EXT_POSIX)) #define stdize_locale(a) S_stdize_locale(aTHX_ a) diff --git a/ext/B/B.pm b/ext/B/B.pm index 01db20d..48b8303 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -1296,11 +1296,13 @@ Since perl 5.17.1 =back -=head2 OTHER CLASSES +=head2 PAD-RELATED CLASSES -Perl 5.18 introduces a new class, B::PADLIST, returned by B::CV's +Perl 5.18 introduced a new class, B::PADLIST, returned by B::CV's C method. +Perl 5.22 introduced the B::PADNAMELIST and B::PADNAME classes. + =head2 B::PADLIST Methods =over 4 @@ -1309,14 +1311,36 @@ C method. =item ARRAY -A list of pads. The first one contains the names. These are currently -B::AV objects, but that is likely to change in future versions. +A list of pads. The first one contains the names. + +The first one is a B::PADNAMELIST under Perl 5.22, and a B::AV under +earlier versions. The rest are currently B::AV objects, but that could +change in future versions. =item ARRAYelt Like C, but takes an index as an argument to get only one element, rather than a list of all of them. +=item NAMES + +This method, introduced in 5.22, returns the B::PADNAMELIST. It is +equivalent to C with a 0 argument. + +=item REFCNT + +=back + +=head2 B::PADNAMELIST Methods + +=over 4 + +=item MAX + +=item ARRAY + +=item ARRAYelt + =item REFCNT =back diff --git a/ext/B/B.xs b/ext/B/B.xs index a26c1c9..def00a0 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -620,6 +620,8 @@ typedef struct refcounted_he *B__RHE; #ifdef PadlistARRAY typedef PADLIST *B__PADLIST; #endif +typedef PADNAMELIST *B__PADNAMELIST; + #ifdef MULTIPLICITY # define ASSIGN_COMMON_ALIAS(prefix, var) \ @@ -2059,15 +2061,31 @@ MODULE = B PACKAGE = B::PADLIST PREFIX = Padlist SSize_t PadlistMAX(padlist) B::PADLIST padlist + ALIAS: B::PADNAMELIST::MAX = 0 + CODE: + PERL_UNUSED_VAR(ix); + RETVAL = PadlistMAX(padlist); + OUTPUT: + RETVAL + +B::PADNAMELIST +PadlistNAMES(padlist) + B::PADLIST padlist void PadlistARRAY(padlist) B::PADLIST padlist PPCODE: if (PadlistMAX(padlist) >= 0) { + dXSTARG; PAD **padp = PadlistARRAY(padlist); SSize_t i; - for (i = 0; i <= PadlistMAX(padlist); i++) + sv_setiv(newSVrv(TARG, PadlistNAMES(padlist) + ? "B::PADNAMELIST" + : "B::NULL"), + PTR2IV(PadlistNAMES(padlist))); + XPUSHTARG; + for (i = 1; i <= PadlistMAX(padlist); i++) XPUSHs(make_sv_object(aTHX_ (SV *)padp[i])); } @@ -2076,12 +2094,17 @@ PadlistARRAYelt(padlist, idx) B::PADLIST padlist SSize_t idx PPCODE: - if (PadlistMAX(padlist) >= 0 - && idx <= PadlistMAX(padlist)) + if (idx < 0 || idx > PadlistMAX(padlist)) + XPUSHs(make_sv_object(aTHX_ NULL)); + else if (!idx) { + PL_stack_sp--; + PUSHMARK(PL_stack_sp-1); + XS_B__PADLIST_NAMES(aTHX_ cv); + return; + } + else XPUSHs(make_sv_object(aTHX_ (SV *)PadlistARRAY(padlist)[idx])); - else - XPUSHs(make_sv_object(aTHX_ NULL)); U32 PadlistREFCNT(padlist) @@ -2093,3 +2116,31 @@ PadlistREFCNT(padlist) RETVAL #endif + +MODULE = B PACKAGE = B::PADNAMELIST PREFIX = Padnamelist + +void +PadnamelistARRAY(pnl) + B::PADNAMELIST pnl + PPCODE: + if (PadnamelistMAX(pnl) >= 0) { + PADNAME **padp = PadnamelistARRAY(pnl); + SSize_t i = 0; + for (; i <= PadnamelistMAX(pnl); i++) + XPUSHs(make_sv_object(aTHX_ padp[i])); + } + +void +PadnamelistARRAYelt(pnl, idx) + B::PADNAMELIST pnl + SSize_t idx + PPCODE: + if (idx < 0 || idx > PadnamelistMAX(pnl)) + XPUSHs(make_sv_object(aTHX_ NULL)); + else + XPUSHs(make_sv_object(aTHX_ + (SV *)PadnamelistARRAY(pnl)[idx])); + +U32 +PadnamelistREFCNT(pnl) + B::PADNAMELIST pnl diff --git a/ext/B/typemap b/ext/B/typemap index e97fb76..9bb2ed3 100644 --- a/ext/B/typemap +++ b/ext/B/typemap @@ -37,6 +37,7 @@ B::HE T_HE_OBJ B::RHE T_RHE_OBJ B::PADLIST T_PL_OBJ +B::PADNAMELIST T_PNL_OBJ INPUT T_OP_OBJ @@ -87,6 +88,14 @@ T_PL_OBJ else croak(\"$var is not a reference\") +T_PNL_OBJ + if (SvROK($arg)) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = INT2PTR($type,tmp); + } + else + croak(\"$var is not a reference\") + OUTPUT T_MG_OBJ sv_setiv(newSVrv($arg, "B::MAGIC"), PTR2IV($var)); @@ -100,3 +109,7 @@ T_RHE_OBJ T_PL_OBJ sv_setiv(newSVrv($arg, $var ? "B::PADLIST" : "B::NULL"), PTR2IV($var)); + +T_PNL_OBJ + sv_setiv(newSVrv($arg, $var ? "B::PADNAMELIST" : "B::NULL"), + PTR2IV($var)); diff --git a/mg.c b/mg.c index be26512..77dd9c0 100644 --- a/mg.c +++ b/mg.c @@ -390,8 +390,6 @@ S_mg_findext_flags(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/op.c b/op.c index 324991c..04e130c 100644 --- a/op.c +++ b/op.c @@ -2295,7 +2295,7 @@ S_finalize_op(pTHX_ OP* o) check_fields = rop - && (lexname = *av_fetch(PL_comppad_name, rop->op_targ, TRUE), + && (lexname = padnamelist_fetch(PL_comppad_name, rop->op_targ), SvPAD_TYPED(lexname)) && (fields = (GV**)hv_fetchs(SvSTASH(lexname), "FIELDS", FALSE)) && isGV(*fields) && GvHV(*fields); diff --git a/pad.c b/pad.c index 9519283..88dd981 100644 --- a/pad.c +++ b/pad.c @@ -46,10 +46,10 @@ internal purpose in XSUBs. The PADLIST has a C array where pads are stored. -The 0th entry of the PADLIST is a PADNAMELIST (which is actually just an -AV, but that may change) which represents the "names" or rather +The 0th entry of the PADLIST is a PADNAMELIST +which represents the "names" or rather the "static type information" for lexicals. The individual elements of a -PADNAMELIST are PADNAMEs (just SVs; but, again, that may change). Future +PADNAMELIST are PADNAMEs. Future refactorings might stop the PADNAMELIST from being stored in the PADLIST's array, so don't rely on it. See L. @@ -216,7 +216,8 @@ PADLIST * Perl_pad_new(pTHX_ int flags) { PADLIST *padlist; - PAD *padname, *pad; + PADNAMELIST *padname; + PAD *pad; PAD **ary; ASSERT_CURPAD_LEGAL("pad_new"); @@ -262,13 +263,12 @@ Perl_pad_new(pTHX_ int flags) av_store(pad, 0, MUTABLE_SV(a0)); AvREIFY_only(a0); - padname = (PAD *)SvREFCNT_inc_simple_NN(PL_comppad_name); + PadnamelistREFCNT(padname = PL_comppad_name)++; } else { av_store(pad, 0, NULL); - padname = newAV(); - AvPAD_NAMELIST_on(padname); - av_store(padname, 0, &PL_sv_undef); + padname = newPADNAMELIST(0); + padnamelist_store(padname, 0, &PL_sv_undef); } /* Most subroutines never recurse, hence only need 2 entries in the padlist @@ -278,7 +278,7 @@ Perl_pad_new(pTHX_ int flags) Newx(ary, 2, PAD *); PadlistMAX(padlist) = 1; PadlistARRAY(padlist) = ary; - ary[0] = padname; + ary[0] = (PAD *)padname; ary[1] = pad; /* ... then update state variables */ @@ -426,11 +426,11 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags) if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */ CV * const outercv = CvOUTSIDE(&cvbody); const U32 seq = CvOUTSIDE_SEQ(&cvbody); - PAD * const comppad_name = PadlistARRAY(padlist)[0]; - SV ** const namepad = AvARRAY(comppad_name); + PADNAMELIST * const comppad_name = PadlistNAMES(padlist); + SV ** const namepad = PadnamelistARRAY(comppad_name); PAD * const comppad = PadlistARRAY(padlist)[1]; SV ** const curpad = AvARRAY(comppad); - for (ix = AvFILLp(comppad_name); ix > 0; ix--) { + for (ix = PadnamelistMAX(comppad_name); ix > 0; ix--) { SV * const namesv = namepad[ix]; if (namesv && namesv != &PL_sv_undef && *SvPVX_const(namesv) == '&') @@ -476,10 +476,10 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags) } } { - PAD * const sv = PadlistARRAY(padlist)[0]; - if (sv == PL_comppad_name && SvREFCNT(sv) == 1) + PADNAMELIST * const names = PadlistNAMES(padlist); + if (names == PL_comppad_name && PadnamelistREFCNT(names) == 1) PL_comppad_name = NULL; - SvREFCNT_dec(sv); + PadnamelistREFCNT_dec(names); } if (PadlistARRAY(padlist)) Safefree(PadlistARRAY(padlist)); Safefree(padlist); @@ -590,7 +590,7 @@ S_pad_alloc_name(pTHX_ PADNAME *name, U32 flags, HV *typestash, SvPAD_STATE_on(name); } - av_store(PL_comppad_name, offset, (SV *)name); + padnamelist_store(PL_comppad_name, offset, (SV *)name); PadnamelistMAXNAMED(PL_comppad_name) = offset; return offset; } @@ -773,8 +773,8 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) * for a slot which has no name and no active value. * For a constant, likewise, but use PL_constpadix. */ - SV * const * const names = AvARRAY(PL_comppad_name); - const SSize_t names_fill = AvFILLp(PL_comppad_name); + PADNAME * const * const names = PadnamelistARRAY(PL_comppad_name); + const SSize_t names_fill = PadnamelistMAX(PL_comppad_name); const bool konst = cBOOL(tmptype & SVf_READONLY); retval = konst ? PL_constpadix : PL_padix; for (;;) { @@ -802,7 +802,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) break; } if (konst) { - av_store(PL_comppad_name, retval, &PL_sv_no); + padnamelist_store(PL_comppad_name, retval, &PL_sv_no); tmptype &= ~SVf_READONLY; tmptype |= SVs_PADTMP; } @@ -855,7 +855,7 @@ Perl_pad_add_anon(pTHX_ CV* func, I32 optype) COP_SEQ_RANGE_LOW_set(name, 0); COP_SEQ_RANGE_HIGH_set(name, 0); ix = pad_alloc(optype, SVs_PADMY); - av_store(PL_comppad_name, ix, name); + padnamelist_store(PL_comppad_name, ix, name); /* XXX DAPM use PL_curpad[] ? */ if (SvTYPE(func) == SVt_PVCV || !CvOUTSIDE(func)) av_store(PL_comppad, ix, (SV*)func); @@ -903,11 +903,11 @@ S_pad_check_dup(pTHX_ PADNAME *name, U32 flags, const HV *ourstash) assert((flags & ~padadd_OUR) == 0); - if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC)) + if (PadnamelistMAX(PL_comppad_name) < 0 || !ckWARN(WARN_MISC)) return; /* nothing to check */ - svp = AvARRAY(PL_comppad_name); - top = AvFILLp(PL_comppad_name); + svp = PadnamelistARRAY(PL_comppad_name); + top = PadnamelistMAX(PL_comppad_name); /* check the current scope */ /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same * type ? */ @@ -980,7 +980,7 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags) PADNAME *out_pn; int out_flags; I32 offset; - const AV *nameav; + const PADNAMELIST *namelist; PADNAME **name_p; PERL_ARGS_ASSERT_PAD_FINDMY_PVN; @@ -1014,9 +1014,9 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags) * our $foo = 0 unless defined $foo; * to not give a warning. (Yes, this is a hack) */ - nameav = PadlistARRAY(CvPADLIST(PL_compcv))[0]; - name_p = PadnamelistARRAY(nameav); - for (offset = PadnamelistMAXNAMED(nameav); offset > 0; offset--) { + namelist = PadlistNAMES(CvPADLIST(PL_compcv)); + name_p = PadnamelistARRAY(namelist); + for (offset = PadnamelistMAXNAMED(namelist); offset > 0; offset--) { const PADNAME * const name = name_p[offset]; if (name && PadnameLEN(name) == namelen && !PadnameOUTER(name) @@ -1203,10 +1203,10 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, if (padlist) { /* not an undef CV */ I32 fake_offset = 0; - const AV * const nameav = PadlistARRAY(padlist)[0]; - PADNAME * const * const name_p = PadnamelistARRAY(nameav); + const PADNAMELIST * const names = PadlistNAMES(padlist); + PADNAME * const * const name_p = PadnamelistARRAY(names); - for (offset = PadnamelistMAXNAMED(nameav); offset > 0; offset--) { + for (offset = PadnamelistMAXNAMED(names); offset > 0; offset--) { const PADNAME * const name = name_p[offset]; if (name && PadnameLEN(name) == namelen && padname_eq_pvn_flags(aTHX_ name, namepv, namelen, @@ -1372,9 +1372,9 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, "good" and only copying flag bits and pointers that it understands. */ PADNAME *new_name = (PADNAME *)newSVsv((SV *)*out_name); - AV * const ocomppad_name = PL_comppad_name; + PADNAMELIST * const ocomppad_name = PL_comppad_name; PAD * const ocomppad = PL_comppad; - PL_comppad_name = PadlistARRAY(padlist)[0]; + PL_comppad_name = PadlistNAMES(padlist); PL_comppad = PadlistARRAY(padlist)[1]; PL_curpad = AvARRAY(PL_comppad); @@ -1490,7 +1490,7 @@ Perl_pad_block_start(pTHX_ int full) { ASSERT_CURPAD_ACTIVE("pad_block_start"); SAVEI32(PL_comppad_name_floor); - PL_comppad_name_floor = AvFILLp(PL_comppad_name); + PL_comppad_name_floor = PadnamelistMAX(PL_comppad_name); if (full) PL_comppad_name_fill = PL_comppad_name_floor; if (PL_comppad_name_floor < 0) @@ -1537,7 +1537,7 @@ Perl_intro_my(pTHX) if (! PL_min_intro_pending) return seq; - svp = AvARRAY(PL_comppad_name); + svp = PadnamelistARRAY(PL_comppad_name); for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) { SV * const sv = svp[i]; @@ -1577,7 +1577,7 @@ Perl_pad_leavemy(pTHX) { I32 off; OP *o = NULL; - SV * const * const svp = AvARRAY(PL_comppad_name); + PADNAME * const * const svp = PadnamelistARRAY(PL_comppad_name); PL_pad_reset_pending = FALSE; @@ -1592,7 +1592,8 @@ Perl_pad_leavemy(pTHX) } } /* "Deintroduce" my variables that are leaving with this scope. */ - for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) { + for (off = PadnamelistMAX(PL_comppad_name); + off > PL_comppad_name_fill; off--) { SV * const sv = svp[off]; if (sv && PadnameLEN(sv) && !SvFAKE(sv) && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO) @@ -1764,11 +1765,11 @@ Perl_pad_tidy(pTHX_ padtidy_type type) } /* extend namepad to match curpad */ - if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad)) - av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL); + if (PadnamelistMAX(PL_comppad_name) < AvFILLp(PL_comppad)) + padnamelist_store(PL_comppad_name, AvFILLp(PL_comppad), NULL); if (type == padtidy_SUBCLONE) { - SV ** const namep = AvARRAY(PL_comppad_name); + PADNAME ** const namep = PadnamelistARRAY(PL_comppad_name); PADOFFSET ix; for (ix = AvFILLp(PL_comppad); ix > 0; ix--) { @@ -1799,7 +1800,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type) } if (type == padtidy_SUB || type == padtidy_FORMAT) { - SV ** const namep = AvARRAY(PL_comppad_name); + PADNAME ** const namep = PadnamelistARRAY(PL_comppad_name); PADOFFSET ix; for (ix = AvFILLp(PL_comppad); ix > 0; ix--) { if (!namep[ix]) namep[ix] = &PL_sv_undef; @@ -1879,7 +1880,7 @@ Dump the contents of a padlist void Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full) { - const AV *pad_name; + const PADNAMELIST *pad_name; const AV *pad; SV **pname; SV **ppad; @@ -1890,16 +1891,16 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full) if (!padlist) { return; } - pad_name = *PadlistARRAY(padlist); + pad_name = PadlistNAMES(padlist); pad = PadlistARRAY(padlist)[1]; - pname = AvARRAY(pad_name); + pname = PadnamelistARRAY(pad_name); ppad = AvARRAY(pad); Perl_dump_indent(aTHX_ level, file, "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n", PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad) ); - for (ix = 1; ix <= AvFILLp(pad_name); ix++) { + for (ix = 1; ix <= PadnamelistMAX(pad_name); ix++) { const SV *namesv = pname[ix]; if (namesv && !PadnameLEN(namesv)) { namesv = NULL; @@ -1998,11 +1999,11 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv) { I32 ix; PADLIST* const protopadlist = CvPADLIST(proto); - PAD *const protopad_name = *PadlistARRAY(protopadlist); + PADNAMELIST *const protopad_name = PadlistNAMES(protopadlist); const PAD *const protopad = PadlistARRAY(protopadlist)[1]; - SV** const pname = AvARRAY(protopad_name); + SV** const pname = PadnamelistARRAY(protopad_name); SV** const ppad = AvARRAY(protopad); - const I32 fname = AvFILLp(protopad_name); + const I32 fname = PadnamelistMAX(protopad_name); const I32 fpad = AvFILLp(protopad); SV** outpad; long depth; @@ -2367,15 +2368,15 @@ void Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv) { I32 ix; - AV * const comppad_name = PadlistARRAY(padlist)[0]; + PADNAMELIST * const comppad_name = PadlistNAMES(padlist); AV * const comppad = PadlistARRAY(padlist)[1]; - SV ** const namepad = AvARRAY(comppad_name); + SV ** const namepad = PadnamelistARRAY(comppad_name); SV ** const curpad = AvARRAY(comppad); PERL_ARGS_ASSERT_PAD_FIXUP_INNER_ANONS; PERL_UNUSED_ARG(old_cv); - for (ix = AvFILLp(comppad_name); ix > 0; ix--) { + for (ix = PadnamelistMAX(comppad_name); ix > 0; ix--) { const SV * const namesv = namepad[ix]; if (namesv && namesv != &PL_sv_undef && !SvPAD_STATE(namesv) && *SvPVX_const(namesv) == '&') @@ -2429,8 +2430,8 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) AV* const newpad = newAV(); SV** const oldpad = AvARRAY(svp[depth-1]); I32 ix = AvFILLp((const AV *)svp[1]); - const I32 names_fill = AvFILLp((const AV *)svp[0]); - SV** const names = AvARRAY(svp[0]); + const I32 names_fill = PadnamelistMAX((PADNAMELIST *)svp[0]); + SV** const names = PadnamelistARRAY((PADNAMELIST *)svp[0]); AV *av; for ( ;ix > 0; ix--) { @@ -2504,9 +2505,12 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param) PadlistMAX(dstpad) = max; Newx(PadlistARRAY(dstpad), max + 1, PAD *); + PadlistARRAY(dstpad)[0] = (PAD *) + padnamelist_dup(PadlistNAMES(srcpad), param); + PadnamelistREFCNT(PadlistNAMES(dstpad))++; if (cloneall) { PADOFFSET depth; - for (depth = 0; depth <= max; ++depth) + for (depth = 1; depth <= max; ++depth) PadlistARRAY(dstpad)[depth] = av_dup_inc(PadlistARRAY(srcpad)[depth], param); } else { @@ -2514,17 +2518,13 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param) to build anything other than the first level of pads. */ I32 ix = AvFILLp(PadlistARRAY(srcpad)[1]); AV *pad1; - const I32 names_fill = AvFILLp(PadlistARRAY(srcpad)[0]); + const I32 names_fill = PadnamelistMAX(PadlistNAMES(srcpad)); const PAD *const srcpad1 = PadlistARRAY(srcpad)[1]; SV **oldpad = AvARRAY(srcpad1); - SV **names; + SV ** const names = PadnamelistARRAY(PadlistNAMES(dstpad)); SV **pad1a; AV *args; - PadlistARRAY(dstpad)[0] = - av_dup_inc(PadlistARRAY(srcpad)[0], param); - names = AvARRAY(PadlistARRAY(dstpad)[0]); - pad1 = newAV(); av_extend(pad1, ix); @@ -2620,6 +2620,129 @@ Perl_padlist_store(pTHX_ PADLIST *padlist, I32 key, PAD *val) } /* +=for apidoc newPADNAMELIST + +Creates a new pad name list. C is the highest index for which space +is allocated. + +=cut +*/ + +PADNAMELIST * +Perl_newPADNAMELIST(pTHX_ size_t max) +{ + PADNAMELIST *pnl; + Newx(pnl, 1, PADNAMELIST); + Newxz(PadnamelistARRAY(pnl), max+1, PADNAME *); + PadnamelistMAX(pnl) = -1; + PadnamelistREFCNT(pnl) = 1; + PadnamelistMAXNAMED(pnl) = 0; + pnl->xpadnl_max = max; + return pnl; +} + +/* +=for apidoc padnamelist_store + +Stores the pad name (which may be null) at the given index, freeing any +existing pad name in that slot. + +=cut +*/ + +PADNAME ** +Perl_padnamelist_store(pTHX_ PADNAMELIST *pnl, SSize_t key, PADNAME *val) +{ + PADNAME **ary; + + PERL_ARGS_ASSERT_PADNAMELIST_STORE; + + assert(key >= 0); + + if (key > pnl->xpadnl_max) + av_extend_guts(NULL,key,&pnl->xpadnl_max, + (SV ***)&PadnamelistARRAY(pnl), + (SV ***)&PadnamelistARRAY(pnl)); + if (PadnamelistMAX(pnl) < key) { + Zero(PadnamelistARRAY(pnl)+PadnamelistMAX(pnl)+1, + key-PadnamelistMAX(pnl), PADNAME *); + PadnamelistMAX(pnl) = key; + } + ary = PadnamelistARRAY(pnl); + SvREFCNT_dec(ary[key]); + ary[key] = val; + return &ary[key]; +} + +/* +=for apidoc padnamelist_fetch + +Fetches the pad name from the given index. + +=cut +*/ + +PADNAME * +Perl_padnamelist_fetch(pTHX_ PADNAMELIST *pnl, SSize_t key) +{ + PERL_ARGS_ASSERT_PADNAMELIST_FETCH; + ASSUME(key >= 0); + + return key > PadnamelistMAX(pnl) ? NULL : PadnamelistARRAY(pnl)[key]; +} + +void +Perl_padnamelist_free(pTHX_ PADNAMELIST *pnl) +{ + PERL_ARGS_ASSERT_PADNAMELIST_FREE; + if (!--PadnamelistREFCNT(pnl)) { + while(PadnamelistMAX(pnl) >= 0) + SvREFCNT_dec(PadnamelistARRAY(pnl)[PadnamelistMAX(pnl)--]); + Safefree(PadnamelistARRAY(pnl)); + Safefree(pnl); + } +} + +#if defined(USE_ITHREADS) + +/* +=for apidoc padnamelist_dup + +Duplicates a pad name list. + +=cut +*/ + +PADNAMELIST * +Perl_padnamelist_dup(pTHX_ PADNAMELIST *srcpad, CLONE_PARAMS *param) +{ + PADNAMELIST *dstpad; + SSize_t max = PadnamelistMAX(srcpad); + + PERL_ARGS_ASSERT_PADNAMELIST_DUP; + + /* look for it in the table first */ + dstpad = (PADNAMELIST *)ptr_table_fetch(PL_ptr_table, srcpad); + if (dstpad) + return dstpad; + + dstpad = newPADNAMELIST(max); + PadnamelistREFCNT(dstpad) = 0; /* The caller will increment it. */ + PadnamelistMAXNAMED(dstpad) = PadnamelistMAXNAMED(srcpad); + PadnamelistMAX(dstpad) = max; + + ptr_table_store(PL_ptr_table, srcpad, dstpad); + for (; max >= 0; max--) + PadnamelistARRAY(dstpad)[max] = + sv_dup_inc(PadnamelistARRAY(srcpad)[max], param); + + return dstpad; +} + +#endif /* USE_ITHREADS */ + + +/* * Local variables: * c-indentation-style: bsd * c-basic-offset: 4 diff --git a/pad.h b/pad.h index 7624b21..df008be 100644 --- a/pad.h +++ b/pad.h @@ -27,6 +27,9 @@ typedef U64TYPE PADOFFSET; #endif #define NOT_IN_PAD ((PADOFFSET) -1) +/* B.xs expects the first members of these two structs to line up + (xpadl_max with xpadnl_fill). + */ struct padlist { SSize_t xpadl_max; /* max index for which array has space */ @@ -34,6 +37,14 @@ struct padlist { PADNAMELIST*xpadl_outid; /* Padnamelist of outer pad; used as ID */ }; +struct padnamelist { + SSize_t xpadnl_fill; /* max index in use */ + PADNAME ** xpadnl_alloc; /* pointer to beginning of array */ + SSize_t xpadnl_max; /* max index for which array has space */ + PADOFFSET xpadnl_max_named; /* highest index with len > 0 */ + U32 xpadnl_refcnt; +}; + /* a value that PL_cop_seqmax is guaranteed never to be, * flagging that a lexical is being introduced, or has not yet left scope @@ -203,6 +214,12 @@ The C array of pad names. =for apidoc Amx|SSize_t|PadnamelistMAX|PADNAMELIST pnl The index of the last pad name. +=for apidoc Amx|SSize_t|PadnamelistREFCNT|PADNAMELIST pnl +The reference count of the pad name list. + +=for apidoc Amx|void|PadnamelistREFCNT_dec|PADNAMELIST pnl +Lowers the reference count of the pad name list. + =for apidoc Amx|SV **|PadARRAY|PAD pad The C array of pad entries. @@ -282,15 +299,16 @@ Restore the old pad saved into the local variable opad by PAD_SAVE_LOCAL() #define PadlistARRAY(pl) (pl)->xpadl_alloc #define PadlistMAX(pl) (pl)->xpadl_max -#define PadlistNAMES(pl) (*PadlistARRAY(pl)) +#define PadlistNAMES(pl) ((PADNAMELIST *)*PadlistARRAY(pl)) #define PadlistNAMESARRAY(pl) PadnamelistARRAY(PadlistNAMES(pl)) #define PadlistNAMESMAX(pl) PadnamelistMAX(PadlistNAMES(pl)) #define PadlistREFCNT(pl) 1 /* reserved for future use */ -#define PadnamelistARRAY(pnl) ((PADNAME **)AvARRAY(pnl)) -#define PadnamelistMAX(pnl) AvFILLp(pnl) -#define PadnamelistMAXNAMED(pnl) \ - ((XPVAV*) SvANY(pnl))->xmg_u.xmg_hash_index +#define PadnamelistARRAY(pnl) (pnl)->xpadnl_alloc +#define PadnamelistMAX(pnl) (pnl)->xpadnl_fill +#define PadnamelistMAXNAMED(pnl) (pnl)->xpadnl_max_named +#define PadnamelistREFCNT(pnl) (pnl)->xpadnl_refcnt +#define PadnamelistREFCNT_dec(pnl) Perl_padnamelist_free(aTHX_ pnl) #define PadARRAY(pad) AvARRAY(pad) #define PadMAX(pad) AvFILLp(pad) @@ -404,7 +422,7 @@ ling pad (lvalue) to C. Note that C is hijacked for this purpose */ #define PAD_COMPNAME(po) PAD_COMPNAME_SV(po) -#define PAD_COMPNAME_SV(po) ((PADNAME *)AvARRAY(PL_comppad_name)[(po)]) +#define PAD_COMPNAME_SV(po) (PadnamelistARRAY(PL_comppad_name)[(po)]) #define PAD_COMPNAME_FLAGS(po) SvFLAGS(PAD_COMPNAME_SV(po)) #define PAD_COMPNAME_FLAGS_isOUR(po) SvPAD_OUR(PAD_COMPNAME_SV(po)) #define PAD_COMPNAME_PV(po) PadnamePV(PAD_COMPNAME(po)) @@ -414,9 +432,11 @@ ling pad (lvalue) to C. Note that C is hijacked for this purpose #define PAD_COMPNAME_OURSTASH(po) \ (SvOURSTASH(PAD_COMPNAME_SV(po))) -#define PAD_COMPNAME_GEN(po) ((STRLEN)SvUVX(AvARRAY(PL_comppad_name)[po])) +#define PAD_COMPNAME_GEN(po) \ + ((STRLEN)SvUVX(PadnamelistARRAY(PL_comppad_name)[po])) -#define PAD_COMPNAME_GEN_set(po, gen) SvUV_set(AvARRAY(PL_comppad_name)[po], (UV)(gen)) +#define PAD_COMPNAME_GEN_set(po, gen) \ + SvUV_set(PadnamelistARRAY(PL_comppad_name)[po], (UV)(gen)) /* @@ -437,7 +457,8 @@ Clone the state variables associated with running and compiling pads. #define PAD_CLONE_VARS(proto_perl, param) \ PL_comppad = av_dup(proto_perl->Icomppad, param); \ PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ - PL_comppad_name = av_dup(proto_perl->Icomppad_name, param); \ + PL_comppad_name = \ + padnamelist_dup(proto_perl->Icomppad_name, param); \ PL_comppad_name_fill = proto_perl->Icomppad_name_fill; \ PL_comppad_name_floor = proto_perl->Icomppad_name_floor; \ PL_min_intro_pending = proto_perl->Imin_intro_pending; \ diff --git a/perl.h b/perl.h index 8a930de..6f8f79a 100644 --- a/perl.h +++ b/perl.h @@ -2656,7 +2656,7 @@ typedef struct clone_params CLONE_PARAMS; * so hide the type. */ typedef struct padlist PADLIST; typedef AV PAD; -typedef AV PADNAMELIST; +typedef struct padnamelist PADNAMELIST; typedef SV PADNAME; /* enable PERL_NEW_COPY_ON_WRITE by default */ diff --git a/proto.h b/proto.h index 5aa63ac..61e52ec 100644 --- a/proto.h +++ b/proto.h @@ -2981,6 +2981,10 @@ PERL_CALLCONV OP* Perl_newOP(pTHX_ I32 optype, I32 flags) __attribute__malloc__ __attribute__warn_unused_result__; +PERL_CALLCONV PADNAMELIST * Perl_newPADNAMELIST(pTHX_ size_t max) + __attribute__malloc__ + __attribute__warn_unused_result__; + PERL_CALLCONV OP* Perl_newPMOP(pTHX_ I32 type, I32 flags) __attribute__malloc__ __attribute__warn_unused_result__; @@ -3349,6 +3353,22 @@ PERL_CALLCONV PAD ** Perl_padlist_store(pTHX_ PADLIST *padlist, I32 key, PAD *va #define PERL_ARGS_ASSERT_PADLIST_STORE \ assert(padlist) +PERL_CALLCONV PADNAME * Perl_padnamelist_fetch(pTHX_ PADNAMELIST *pnl, SSize_t key) + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_1); +#define PERL_ARGS_ASSERT_PADNAMELIST_FETCH \ + assert(pnl) + +PERL_CALLCONV void Perl_padnamelist_free(pTHX_ PADNAMELIST *pnl) + __attribute__nonnull__(pTHX_1); +#define PERL_ARGS_ASSERT_PADNAMELIST_FREE \ + assert(pnl) + +PERL_CALLCONV PADNAME ** Perl_padnamelist_store(pTHX_ PADNAMELIST *pnl, SSize_t key, PADNAME *val) + __attribute__nonnull__(pTHX_1); +#define PERL_ARGS_ASSERT_PADNAMELIST_STORE \ + assert(pnl) + PERL_CALLCONV OP* Perl_parse_arithexpr(pTHX_ U32 flags); PERL_CALLCONV OP* Perl_parse_barestmt(pTHX_ U32 flags); PERL_CALLCONV OP* Perl_parse_block(pTHX_ U32 flags); @@ -8018,6 +8038,13 @@ PERL_CALLCONV PADLIST * Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *pa #define PERL_ARGS_ASSERT_PADLIST_DUP \ assert(srcpad); assert(param) +PERL_CALLCONV PADNAMELIST * Perl_padnamelist_dup(pTHX_ PADNAMELIST *srcpad, CLONE_PARAMS *param) + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); +#define PERL_ARGS_ASSERT_PADNAMELIST_DUP \ + assert(srcpad); assert(param) + PERL_CALLCONV yy_parser* Perl_parser_dup(pTHX_ const yy_parser *const proto, CLONE_PARAMS *const param) __attribute__nonnull__(pTHX_2); #define PERL_ARGS_ASSERT_PARSER_DUP \ diff --git a/sv.c b/sv.c index d2b549e..ec2f5e2 100644 --- a/sv.c +++ b/sv.c @@ -5653,8 +5653,6 @@ 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); @@ -6511,9 +6509,6 @@ 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); @@ -13496,8 +13491,6 @@ 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) && !SvPAD_NAME(dstr) && SvSTASH(dstr)) @@ -15411,14 +15404,12 @@ Perl_varname(pTHX_ const GV *const gv, const char gvtype, PADOFFSET targ, else { CV * const cv = gv ? ((CV *)gv) : find_runcv(NULL); SV *sv; - AV *av; assert(!cv || SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM); if (!cv || !CvPADLIST(cv)) return NULL; - av = *PadlistARRAY(CvPADLIST(cv)); - sv = *av_fetch(av, targ, FALSE); + sv = padnamelist_fetch(PadlistNAMES(CvPADLIST(cv)), targ); sv_setsv_flags(name, sv, 0); } diff --git a/sv.h b/sv.h index 35a396e..f2d6aba 100644 --- a/sv.h +++ b/sv.h @@ -371,7 +371,6 @@ perform the upgrade if necessary. See C. 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_PROTECT 0x00010000 /* very read-only */ #define SVs_PADTMP 0x00020000 /* in use as tmp */ #define SVpad_TYPED 0x00020000 /* pad name is a Typed Lexical */ @@ -506,7 +505,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; -- 1.8.3.1