X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pad.c;h=a68e202efb0849d578b1ce24f2680b05bbc5ed3c;hb=ddea3ea7e37dd9e47ccbeefed8302a04c561f972;hp=9f6e764cedbcf6875506316b21d288189b44124c;hpb=5fe77bf88d77245625a76ac492c734cdfcf1ae14;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pad.c b/pad.c index 9f6e764..a68e202 100644 --- a/pad.c +++ b/pad.c @@ -5,13 +5,17 @@ * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. + */ + +/* + * 'Anyway: there was this Mr. Frodo left an orphan and stranded, as you + * might say, among those queer Bucklanders, being brought up anyhow in + * Brandy Hall. A regular warren, by all accounts. Old Master Gorbadoc + * never had fewer than a couple of hundred relations in the place. + * Mr. Bilbo never did a kinder deed than when he brought the lad back + * to live among decent folk.' --the Gaffer * - * "Anyway: there was this Mr Frodo left an orphan and stranded, as you - * might say, among those queer Bucklanders, being brought up anyhow in - * Brandy Hall. A regular warren, by all accounts. Old Master Gorbadoc - * never had fewer than a couple of hundred relations in the place. Mr - * Bilbo never did a kinder deed than when he brought the lad back to - * live among decent folk." --the Gaffer + * [p.23 of _The Lord of the Rings_, I/i: "A Long-Expected Party"] */ /* XXX DAPM @@ -176,7 +180,7 @@ Perl_pad_new(pTHX_ int flags) SAVEI32(PL_max_intro_pending); SAVEBOOL(PL_cv_has_eval); if (flags & padnew_SAVESUB) { - SAVEI32(PL_pad_reset_pending); + SAVEBOOL(PL_pad_reset_pending); } } } @@ -197,7 +201,7 @@ Perl_pad_new(pTHX_ int flags) AV * const a0 = newAV(); /* will be @_ */ av_extend(a0, 0); - av_store(pad, 0, (SV*)a0); + av_store(pad, 0, MUTABLE_SV(a0)); AvREIFY_only(a0); } else { @@ -205,13 +209,13 @@ Perl_pad_new(pTHX_ int flags) } AvREAL_off(padlist); - av_store(padlist, 0, (SV*)padname); - av_store(padlist, 1, (SV*)pad); + av_store(padlist, 0, MUTABLE_SV(padname)); + av_store(padlist, 1, MUTABLE_SV(pad)); /* ... then update state variables */ - PL_comppad_name = (AV*)(*av_fetch(padlist, 0, FALSE)); - PL_comppad = (AV*)(*av_fetch(padlist, 1, FALSE)); + PL_comppad_name = MUTABLE_AV((*av_fetch(padlist, 0, FALSE))); + PL_comppad = MUTABLE_AV((*av_fetch(padlist, 1, FALSE))); PL_curpad = AvARRAY(PL_comppad); if (! (flags & padnew_CLONE)) { @@ -276,16 +280,16 @@ Perl_pad_undef(pTHX_ CV* cv) if (!PL_dirty) { /* don't bother during global destruction */ CV * const outercv = CvOUTSIDE(cv); const U32 seq = CvOUTSIDE_SEQ(cv); - AV * const comppad_name = (AV*)AvARRAY(padlist)[0]; + AV * const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]); SV ** const namepad = AvARRAY(comppad_name); - AV * const comppad = (AV*)AvARRAY(padlist)[1]; + AV * const comppad = MUTABLE_AV(AvARRAY(padlist)[1]); SV ** const curpad = AvARRAY(comppad); for (ix = AvFILLp(comppad_name); ix > 0; ix--) { SV * const namesv = namepad[ix]; if (namesv && namesv != &PL_sv_undef && *SvPVX_const(namesv) == '&') { - CV * const innercv = (CV*)curpad[ix]; + CV * const innercv = MUTABLE_CV(curpad[ix]); U32 inner_rc = SvREFCNT(innercv); assert(inner_rc); namepad[ix] = NULL; @@ -319,16 +323,16 @@ Perl_pad_undef(pTHX_ CV* cv) while (ix >= 0) { SV* const sv = AvARRAY(padlist)[ix--]; if (sv) { - if (sv == (SV*)PL_comppad_name) + if (sv == (const SV *)PL_comppad_name) PL_comppad_name = NULL; - else if (sv == (SV*)PL_comppad) { + else if (sv == (const SV *)PL_comppad) { PL_comppad = NULL; PL_curpad = NULL; } } SvREFCNT_dec(sv); } - SvREFCNT_dec((SV*)CvPADLIST(cv)); + SvREFCNT_dec(MUTABLE_SV(CvPADLIST(cv))); CvPADLIST(cv) = NULL; } @@ -367,7 +371,7 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake if (typestash) { assert(SvTYPE(namesv) == SVt_PVMG); SvPAD_TYPED_on(namesv); - SvSTASH_set(namesv, (HV*)SvREFCNT_inc_simple_NN((SV*)typestash)); + SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash)))); } if (ourstash) { SvPAD_OUR_on(namesv); @@ -396,9 +400,9 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake /* XXX DAPM since slot has been allocated, replace * av_store with PL_curpad[offset] ? */ if (*name == '@') - av_store(PL_comppad, offset, (SV*)newAV()); + av_store(PL_comppad, offset, MUTABLE_SV(newAV())); else if (*name == '%') - av_store(PL_comppad, offset, (SV*)newHV()); + av_store(PL_comppad, offset, MUTABLE_SV(newHV())); SvPADMY_on(PL_curpad[offset]); DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n", @@ -499,7 +503,7 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type) PERL_ARGS_ASSERT_PAD_ADD_ANON; pad_peg("add_anon"); - sv_setpvn(name, "&", 1); + sv_setpvs(name, "&"); /* Are these two actually ever read? */ COP_SEQ_RANGE_HIGH_set(name, ~0); COP_SEQ_RANGE_LOW_set(name, 1); @@ -511,10 +515,10 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type) /* to avoid ref loops, we never have parent + child referencing each * other simultaneously */ - if (CvOUTSIDE((CV*)sv)) { - assert(!CvWEAKOUTSIDE((CV*)sv)); - CvWEAKOUTSIDE_on((CV*)sv); - SvREFCNT_dec(CvOUTSIDE((CV*)sv)); + if (CvOUTSIDE((const CV *)sv)) { + assert(!CvWEAKOUTSIDE((const CV *)sv)); + CvWEAKOUTSIDE_on(MUTABLE_CV(sv)); + SvREFCNT_dec(CvOUTSIDE(MUTABLE_CV(sv))); } return ix; } @@ -629,7 +633,7 @@ Perl_pad_findmy(pTHX_ const char *name) * our $foo = 0 unless defined $foo; * to not give a warning. (Yes, this is a hack) */ - nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0]; + nameav = MUTABLE_AV(AvARRAY(CvPADLIST(PL_compcv))[0]); name_svp = AvARRAY(nameav); for (offset = AvFILLp(nameav); offset > 0; offset--) { const SV * const namesv = name_svp[offset]; @@ -712,7 +716,7 @@ 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 * const nameav = (AV*)AvARRAY(padlist)[0]; + const AV * const nameav = MUTABLE_AV(AvARRAY(padlist)[0]); SV * const * const name_svp = AvARRAY(nameav); for (offset = AvFILLp(nameav); offset > 0; offset--) { @@ -810,8 +814,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, return offset; } - *out_capture = AvARRAY((AV*)AvARRAY(padlist)[ - CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset]; + *out_capture = AvARRAY(MUTABLE_AV(AvARRAY(padlist)[ + CvDEPTH(cv) ? CvDEPTH(cv) : 1]))[offset]; DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n", PTR2UV(cv), PTR2UV(*out_capture))); @@ -827,9 +831,9 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, } if (!*out_capture) { if (*name == '@') - *out_capture = sv_2mortal((SV*)newAV()); + *out_capture = sv_2mortal(MUTABLE_SV(newAV())); else if (*name == '%') - *out_capture = sv_2mortal((SV*)newHV()); + *out_capture = sv_2mortal(MUTABLE_SV(newHV())); else *out_capture = sv_newmortal(); } @@ -865,8 +869,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, SV *new_namesv; AV * const ocomppad_name = PL_comppad_name; PAD * const ocomppad = PL_comppad; - PL_comppad_name = (AV*)AvARRAY(padlist)[0]; - PL_comppad = (AV*)AvARRAY(padlist)[1]; + PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]); + PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]); PL_curpad = AvARRAY(PL_comppad); new_offset = pad_add_name( @@ -1146,8 +1150,8 @@ Mark all the current temporaries for reuse * to a shared TARG. Such an alias will change randomly and unpredictably. * We avoid doing this until we can think of a Better Way. * GSAR 97-10-29 */ -void -Perl_pad_reset(pTHX) +static void +S_pad_reset(pTHX) { dVAR; #ifdef USE_BROKEN_PAD_RESET @@ -1250,7 +1254,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type) /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */ AV * const av = newAV(); /* Will be @_ */ av_extend(av, 0); - av_store(PL_comppad, 0, (SV*)av); + av_store(PL_comppad, 0, MUTABLE_SV(av)); AvREIFY_only(av); } @@ -1306,13 +1310,7 @@ Perl_pad_free(pTHX_ PADOFFSET po) SvPADTMP_off(PL_curpad[po]); #ifdef USE_ITHREADS /* SV could be a shared hash key (eg bugid #19022) */ - if ( -#ifdef PERL_OLD_COPY_ON_WRITE - !SvIsCOW(PL_curpad[po]) -#else - !SvFAKE(PL_curpad[po]) -#endif - ) + if (!SvIsCOW(PL_curpad[po])) SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */ #endif } @@ -1345,8 +1343,8 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full) if (!padlist) { return; } - pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE); - pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE); + pad_name = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 0, FALSE)); + pad = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 1, FALSE)); pname = AvARRAY(pad_name); ppad = AvARRAY(pad); Perl_dump_indent(aTHX_ level, file, @@ -1455,8 +1453,8 @@ Perl_cv_clone(pTHX_ CV *proto) dVAR; I32 ix; AV* const protopadlist = CvPADLIST(proto); - const AV* const protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE); - const AV* const protopad = (AV*)*av_fetch(protopadlist, 1, FALSE); + const AV *const protopad_name = (const AV *)*av_fetch(protopadlist, 0, FALSE); + const AV *const protopad = (const AV *)*av_fetch(protopadlist, 1, FALSE); SV** const pname = AvARRAY(protopad_name); SV** const ppad = AvARRAY(protopad); const I32 fname = AvFILLp(protopad_name); @@ -1486,7 +1484,7 @@ Perl_cv_clone(pTHX_ CV *proto) ENTER; SAVESPTR(PL_compcv); - cv = PL_compcv = (CV*)newSV_type(SvTYPE(proto)); + cv = PL_compcv = MUTABLE_CV(newSV_type(SvTYPE(proto))); CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE); CvCLONED_on(cv); @@ -1502,11 +1500,11 @@ Perl_cv_clone(pTHX_ CV *proto) CvROOT(cv) = OpREFCNT_inc(CvROOT(proto)); OP_REFCNT_UNLOCK; CvSTART(cv) = CvSTART(proto); - CvOUTSIDE(cv) = (CV*)SvREFCNT_inc_simple(outside); + CvOUTSIDE(cv) = MUTABLE_CV(SvREFCNT_inc_simple(outside)); CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto); if (SvPOK(proto)) - sv_setpvn((SV*)cv, SvPVX_const(proto), SvCUR(proto)); + sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto)); CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE); @@ -1542,9 +1540,9 @@ Perl_cv_clone(pTHX_ CV *proto) if (sigil == '&') sv = SvREFCNT_inc(ppad[ix]); else if (sigil == '@') - sv = (SV*)newAV(); + sv = MUTABLE_SV(newAV()); else if (sigil == '%') - sv = (SV*)newHV(); + sv = MUTABLE_SV(newHV()); else sv = newSV(0); SvPADMY_on(sv); @@ -1607,8 +1605,8 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv) { dVAR; I32 ix; - AV * const comppad_name = (AV*)AvARRAY(padlist)[0]; - AV * const comppad = (AV*)AvARRAY(padlist)[1]; + AV * const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]); + AV * const comppad = MUTABLE_AV(AvARRAY(padlist)[1]); SV ** const namepad = AvARRAY(comppad_name); SV ** const curpad = AvARRAY(comppad); @@ -1620,7 +1618,7 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv) if (namesv && namesv != &PL_sv_undef && *SvPVX_const(namesv) == '&') { - CV * const innercv = (CV*)curpad[ix]; + CV * const innercv = MUTABLE_CV(curpad[ix]); assert(CvWEAKOUTSIDE(innercv)); assert(CvOUTSIDE(innercv) == old_cv); CvOUTSIDE(innercv) = new_cv; @@ -1650,8 +1648,8 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) 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]); + I32 ix = AvFILLp((const AV *)svp[1]); + const I32 names_fill = AvFILLp((const AV *)svp[0]); SV** const names = AvARRAY(svp[0]); AV *av; @@ -1668,9 +1666,9 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) else { /* our own lexical */ SV *sv; if (sigil == '@') - sv = (SV*)newAV(); + sv = MUTABLE_SV(newAV()); else if (sigil == '%') - sv = (SV*)newHV(); + sv = MUTABLE_SV(newHV()); else sv = newSV(0); av_store(newpad, ix, sv); @@ -1689,10 +1687,10 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) } av = newAV(); av_extend(av, 0); - av_store(newpad, 0, (SV*)av); + av_store(newpad, 0, MUTABLE_SV(av)); AvREIFY_only(av); - av_store(padlist, depth, (SV*)newpad); + av_store(padlist, depth, MUTABLE_SV(newpad)); AvFILLp(padlist) = depth; } }