X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pad.c;h=3ab7497301ecb84244e78c019eefe3a3cb56a6d3;hb=ae706db49f17350f7e2ed5eccdc792223f4ea020;hp=c0e7a5b6199b75c674277283ed3633691141fd26;hpb=cf525c36fb4613d400e7bd3733f96430dee2d396;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pad.c b/pad.c index c0e7a5b..3ab7497 100644 --- a/pad.c +++ b/pad.c @@ -1,6 +1,6 @@ /* pad.c * - * Copyright (C) 2002, 2003, 2004, 2005 by Larry Wall and others + * Copyright (C) 2002, 2003, 2004, 2005, 2006, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -132,6 +132,7 @@ can be OR'ed together: PADLIST * Perl_pad_new(pTHX_ int flags) { + dVAR; AV *padlist, *padname, *pad; ASSERT_CURPAD_LEGAL("pad_new"); @@ -228,12 +229,13 @@ taken) void Perl_pad_undef(pTHX_ CV* cv) { + dVAR; I32 ix; const PADLIST * const padlist = CvPADLIST(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 +299,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**); @@ -329,6 +331,7 @@ If fake, it means we're cloning an existing entry PADOFFSET Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake) { + dVAR; const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY); SV* const namesv = NEWSV(1102, 0); @@ -393,14 +396,22 @@ for a slot which has no name and no active value. /* 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) { + dVAR; SV *sv; I32 retval; + PERL_UNUSED_ARG(optype); ASSERT_CURPAD_ACTIVE("pad_alloc"); if (AvARRAY(PL_comppad) != PL_curpad) @@ -412,7 +423,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 (;;) { /* @@ -456,6 +467,7 @@ Add an anon code entry to the current compiling pad PADOFFSET Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type) { + dVAR; PADOFFSET ix; SV* const name = NEWSV(1106, 0); sv_upgrade(name, SVt_PVNV); @@ -497,6 +509,7 @@ C indicates that the name to check is an 'our' declaration void Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash) { + dVAR; SV **svp; PADOFFSET top, off; @@ -566,6 +579,7 @@ Returns the offset in the current pad, or NOT_IN_PAD on failure. PADOFFSET Perl_pad_findmy(pTHX_ const char *name) { + dVAR; SV *out_sv; int out_flags; I32 offset; @@ -584,7 +598,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) @@ -604,6 +618,7 @@ Perl_pad_findmy(pTHX_ const char *name) PADOFFSET Perl_find_rundefsvoffset(pTHX) { + dVAR; SV *out_sv; int out_flags; return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1, @@ -650,6 +665,7 @@ STATIC PADOFFSET S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, SV** out_capture, SV** out_name_sv, int *out_flags) { + dVAR; I32 offset, new_offset; SV *new_capture; SV **new_capturep; @@ -665,11 +681,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)) { @@ -821,9 +837,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 */ ); @@ -856,7 +872,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, return new_offset; } - + +#ifdef DEBUGGING /* =for apidoc pad_sv @@ -870,6 +887,7 @@ Use macro PAD_SV instead of calling this function directly. SV * Perl_pad_sv(pTHX_ PADOFFSET po) { + dVAR; ASSERT_CURPAD_ACTIVE("pad_sv"); if (!po) @@ -891,10 +909,10 @@ Use the macro PAD_SETSV() rather than calling this function directly. =cut */ -#ifdef DEBUGGING void Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv) { + dVAR; ASSERT_CURPAD_ACTIVE("pad_setsv"); DEBUG_X(PerlIO_printf(Perl_debug_log, @@ -924,6 +942,7 @@ Update the pad compilation state variables on entry to a new block void Perl_pad_block_start(pTHX_ int full) { + dVAR; ASSERT_CURPAD_ACTIVE("pad_block_start"); SAVEI32(PL_comppad_name_floor); PL_comppad_name_floor = AvFILLp(PL_comppad_name); @@ -952,6 +971,7 @@ Perl_pad_block_start(pTHX_ int full) U32 Perl_intro_my(pTHX) { + dVAR; SV **svp; I32 i; @@ -993,8 +1013,9 @@ lexicals in this scope and warn of any lexicals that never got introduced. void Perl_pad_leavemy(pTHX) { + dVAR; I32 off; - SV ** const svp = AvARRAY(PL_comppad_name); + SV * const * const svp = AvARRAY(PL_comppad_name); PL_pad_reset_pending = FALSE; @@ -1038,6 +1059,7 @@ new one. void Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust) { + dVAR; ASSERT_CURPAD_LEGAL("pad_swipe"); if (!PL_curpad) return; @@ -1086,6 +1108,7 @@ Mark all the current temporaries for reuse void Perl_pad_reset(pTHX) { + dVAR; #ifdef USE_BROKEN_PAD_RESET if (AvARRAY(PL_comppad) != PL_curpad) Perl_croak(aTHX_ "panic: pad_reset curpad"); @@ -1160,7 +1183,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--) { @@ -1224,6 +1247,7 @@ Free the SV at offset po in the current pad. void Perl_pad_free(pTHX_ PADOFFSET po) { + dVAR; ASSERT_CURPAD_LEGAL("pad_free"); if (!PL_curpad) return; @@ -1268,6 +1292,7 @@ Dump the contents of a padlist void Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full) { + dVAR; const AV *pad_name; const AV *pad; SV **pname; @@ -1339,6 +1364,7 @@ dump the contents of a CV STATIC void S_cv_dump(pTHX_ const CV *cv, const char *title) { + dVAR; const CV * const outside = CvOUTSIDE(cv); AV* const padlist = CvPADLIST(cv); @@ -1503,7 +1529,7 @@ 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), Nullch, const_sv); @@ -1530,13 +1556,14 @@ moved to a pre-existing CV struct. void 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]; 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) == '&') { @@ -1562,16 +1589,17 @@ the new pad an @_ in slot zero. void Perl_pad_push(pTHX_ PADLIST *padlist, int depth) { + dVAR; if (depth <= AvFILLp(padlist)) 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--) { @@ -1598,7 +1626,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); } @@ -1617,11 +1645,12 @@ 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); + dVAR; + SV* const * const av = av_fetch(PL_comppad_name, po, FALSE); if ( SvFLAGS(*av) & SVpad_TYPED ) { return SvSTASH(*av); } - return Nullhv; + return NULL; } /*