X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pad.c;h=ea2969d576182754f0343c8b4e844971efb6ddf1;hb=74ac850a5ee417afa60a477ea52af7a8f46a7e5a;hp=5f04fd63b38438cd2282219cd53ba33b114668a8;hpb=282e17420839364a06808f9f85ab641c510d8296;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pad.c b/pad.c index 5f04fd6..ea2969d 100644 --- a/pad.c +++ b/pad.c @@ -75,7 +75,7 @@ The SVs in the names AV have their PV being the name of the variable. NV+1..IV inclusive is a range of cop_seq numbers for which the name is valid. For typed lexicals name SV is SVt_PVMG and SvSTASH points at the type. For C lexicals, the type is SVt_PVGV, and GvSTASH points at the -stash of the associated global (so that duplicate C delarations in the +stash of the associated global (so that duplicate C declarations in the same package can be detected). SvCUR is sometimes hijacked to store the generation number during compilation. @@ -233,7 +233,7 @@ Perl_pad_undef(pTHX_ CV* cv) if (!padlist) return; - if (!SvREFCNT(CvPADLIST(cv))) /* may be during global destruction */ + if (SvIS_FREED(padlist)) /* may be during global destruction */ return; DEBUG_X(PerlIO_printf(Perl_debug_log, @@ -297,7 +297,7 @@ Perl_pad_undef(pTHX_ CV* cv) if (!sv) continue; if (sv == (SV*)PL_comppad_name) - PL_comppad_name = Nullav; + PL_comppad_name = NULL; else if (sv == (SV*)PL_comppad) { PL_comppad = Null(PAD*); PL_curpad = Null(SV**); @@ -386,14 +386,20 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake Allocate a new my or tmp pad entry. For a my, simply push a null SV onto the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards -for a slot which has no name and and no active value. +for a slot which has no name and no active value. =cut */ /* XXX DAPM integrate alloc(), add_name() and add_anon(), * or at least rationalise ??? */ - +/* And flag whether the incoming name is UTF8 or 8 bit? + Could do this either with the +ve/-ve hack of the HV code, or expanding + the flag bits. Either way, this makes proper Unicode safe pad support. + Also could change the sv structure to make the NV a union with 2 U32s, + so that SvCUR() could stop being overloaded in pad SVs. + NWC +*/ PADOFFSET Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) @@ -412,7 +418,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) retval = AvFILLp(PL_comppad); } else { - SV ** const names = AvARRAY(PL_comppad_name); + SV * const * const names = AvARRAY(PL_comppad_name); const SSize_t names_fill = AvFILLp(PL_comppad_name); for (;;) { /* @@ -501,7 +507,7 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash) PADOFFSET top, off; ASSERT_CURPAD_ACTIVE("pad_check_dup"); - if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0) + if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC)) return; /* nothing to check */ svp = AvARRAY(PL_comppad_name); @@ -515,10 +521,10 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash) && sv != &PL_sv_undef && !SvFAKE(sv) && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0) - && (!is_our - || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)) && strEQ(name, SvPVX_const(sv))) { + if (is_our && (SvFLAGS(sv) & SVpad_OUR)) + break; /* "our" masking "our" */ Perl_warner(aTHX_ packWARN(WARN_MISC), "\"%s\" variable %s masks earlier declaration in same %s", (is_our ? "our" : "my"), @@ -541,8 +547,9 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash) { Perl_warner(aTHX_ packWARN(WARN_MISC), "\"our\" variable %s redeclared", name); - Perl_warner(aTHX_ packWARN(WARN_MISC), - "\t(Did you mean \"local\" instead of \"our\"?)\n"); + if ((I32)off <= PL_comppad_name_floor) + Perl_warner(aTHX_ packWARN(WARN_MISC), + "\t(Did you mean \"local\" instead of \"our\"?)\n"); break; } } while ( off-- > 0 ); @@ -583,7 +590,7 @@ Perl_pad_findmy(pTHX_ const char *name) nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0]; name_svp = AvARRAY(nameav); for (offset = AvFILLp(nameav); offset > 0; offset--) { - const SV *namesv = name_svp[offset]; + const SV * const namesv = name_svp[offset]; if (namesv && namesv != &PL_sv_undef && !SvFAKE(namesv) && (SvFLAGS(namesv) & SVpad_OUR) @@ -664,11 +671,11 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, if (padlist) { /* not an undef CV */ I32 fake_offset = 0; - const AV *nameav = (AV*)AvARRAY(padlist)[0]; - SV **name_svp = AvARRAY(nameav); + const AV * const nameav = (AV*)AvARRAY(padlist)[0]; + SV * const * const name_svp = AvARRAY(nameav); for (offset = AvFILLp(nameav); offset > 0; offset--) { - const SV *namesv = name_svp[offset]; + const SV * const namesv = name_svp[offset]; if (namesv && namesv != &PL_sv_undef && strEQ(SvPVX_const(namesv), name)) { @@ -820,9 +827,9 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, new_offset = pad_add_name( SvPVX_const(*out_name_sv), (SvFLAGS(*out_name_sv) & SVpad_TYPED) - ? SvSTASH(*out_name_sv) : Nullhv, + ? SvSTASH(*out_name_sv) : NULL, (SvFLAGS(*out_name_sv) & SVpad_OUR) - ? GvSTASH(*out_name_sv) : Nullhv, + ? GvSTASH(*out_name_sv) : NULL, 1 /* fake */ ); @@ -855,7 +862,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, return new_offset; } - + +#ifdef DEBUGGING /* =for apidoc pad_sv @@ -890,7 +898,6 @@ Use the macro PAD_SETSV() rather than calling this function directly. =cut */ -#ifdef DEBUGGING void Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv) { @@ -993,7 +1000,7 @@ void Perl_pad_leavemy(pTHX) { I32 off; - SV ** const svp = AvARRAY(PL_comppad_name); + SV * const * const svp = AvARRAY(PL_comppad_name); PL_pad_reset_pending = FALSE; @@ -1159,7 +1166,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type) av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv); if (type == padtidy_SUBCLONE) { - SV ** const namep = AvARRAY(PL_comppad_name); + SV * const * const namep = AvARRAY(PL_comppad_name); PADOFFSET ix; for (ix = AvFILLp(PL_comppad); ix > 0; ix--) { @@ -1214,7 +1221,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type) /* =for apidoc pad_free -Free the SV at offet po in the current pad. +Free the SV at offset po in the current pad. =cut */ @@ -1502,10 +1509,10 @@ Perl_cv_clone(pTHX_ CV *proto) * so try to grab the current const value, and if successful, * turn into a const sub: */ - SV* const_sv = op_const_sv(CvSTART(cv), cv); + SV* const const_sv = op_const_sv(CvSTART(cv), cv); if (const_sv) { SvREFCNT_dec(cv); - cv = newCONSTSUB(CvSTASH(proto), 0, const_sv); + cv = newCONSTSUB(CvSTASH(proto), Nullch, const_sv); } else { CvCONST_off(cv); @@ -1535,11 +1542,11 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv) SV ** const namepad = AvARRAY(comppad_name); SV ** const curpad = AvARRAY(comppad); for (ix = AvFILLp(comppad_name); ix > 0; ix--) { - const SV *namesv = namepad[ix]; + const SV * const namesv = namepad[ix]; if (namesv && namesv != &PL_sv_undef && *SvPVX_const(namesv) == '&') { - CV *innercv = (CV*)curpad[ix]; + CV * const innercv = (CV*)curpad[ix]; assert(CvWEAKOUTSIDE(innercv)); assert(CvOUTSIDE(innercv) == old_cv); CvOUTSIDE(innercv) = new_cv; @@ -1565,12 +1572,12 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) return; { - SV** svp = AvARRAY(padlist); - AV *newpad = newAV(); - SV **oldpad = AvARRAY(svp[depth-1]); + SV** const svp = AvARRAY(padlist); + AV* const newpad = newAV(); + SV** const oldpad = AvARRAY(svp[depth-1]); I32 ix = AvFILLp((AV*)svp[1]); const I32 names_fill = AvFILLp((AV*)svp[0]); - SV** names = AvARRAY(svp[0]); + SV** const names = AvARRAY(svp[0]); AV *av; for ( ;ix > 0; ix--) { @@ -1597,7 +1604,7 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) } else { /* save temporaries on recursion? */ - SV *sv = NEWSV(0, 0); + SV * const sv = NEWSV(0, 0); av_store(newpad, ix, sv); SvPADTMP_on(sv); } @@ -1616,11 +1623,11 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) HV * Perl_pad_compname_type(pTHX_ const PADOFFSET po) { - SV** const av = av_fetch(PL_comppad_name, po, FALSE); + SV* const * const av = av_fetch(PL_comppad_name, po, FALSE); if ( SvFLAGS(*av) & SVpad_TYPED ) { return SvSTASH(*av); } - return Nullhv; + return NULL; } /*