pad.c: More clearly separate targ/constant allocation

[perl5.git] / pad.c

diff --git a/pad.c b/pad.c
index 31282d1..7f896c4 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -56,7 +56,8 @@ at that depth of recursion into the CV.  The 0th slot of a frame AV is an
 AV which is @_.  Other entries are storage for variables and op targets.
 
 Iterating over the PADNAMELIST iterates over all possible pad
-items.  Pad slots for targets (SVs_PADTMP) and GVs end up having &PL_sv_no
+items.  Pad slots for targets (SVs_PADTMP)
+and GVs end up having &PL_sv_undef
 "names", while slots for constants have &PL_sv_no "names" (see
 pad_alloc()).  That &PL_sv_no is used is an implementation detail subject
 to change.  To test for it, use C<PadnamePV(name) && !PadnameLEN(name)>.
@@ -153,28 +154,6 @@ Points directly to the body of the L</PL_comppad> array.
   STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
 
 /*
-=for apidoc mx|void|pad_peg|const char *s
-
-When PERL_MAD is enabled, this is a small no-op function that gets called
-at the start of each pad-related function.  It can be breakpointed to
-track all pad operations.  The parameter is a string indicating the type
-of pad operation being performed.
-
-=cut
-*/
-
-#ifdef PERL_MAD
-void pad_peg(const char* s) {
-    static int pegcnt; /* XXX not threadsafe */
-    PERL_UNUSED_ARG(s);
-
-    PERL_ARGS_ASSERT_PAD_PEG;
-
-    pegcnt++;
-}
-#endif
-
-/*
 This is basically sv_eq_flags() in sv.c, but we avoid the magic
 and bytes checking.
 */
@@ -232,7 +211,6 @@ flags can be OR'ed together:
 PADLIST *
 Perl_pad_new(pTHX_ int flags)
 {
-    dVAR;
     PADLIST *padlist;
     PAD *padname, *pad;
     PAD **ary;
@@ -339,7 +317,6 @@ children can still follow the full lexical scope chain.
 void
 Perl_cv_undef(pTHX_ CV *cv)
 {
-    dVAR;
     const PADLIST *padlist = CvPADLIST(cv);
     bool const slabbed = !!CvSLABBED(cv);
 
@@ -382,7 +359,7 @@ Perl_cv_undef(pTHX_ CV *cv)
        LEAVE;
     }
 #ifdef DEBUGGING
-    else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
+    else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", (void*)cv);
 #endif
     SvPOK_off(MUTABLE_SV(cv));         /* forget prototype */
     sv_unmagic((SV *)cv, PERL_MAGIC_checkcall);
@@ -522,7 +499,7 @@ Perl_cv_forget_slab(pTHX_ CV *cv)
     if      (CvROOT(cv))  slab = OpSLAB(CvROOT(cv));
     else if (CvSTART(cv)) slab = (OPSLAB *)CvSTART(cv);
 #ifdef DEBUGGING
-    else if (slabbed)     Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
+    else if (slabbed)     Perl_warn(aTHX_ "Slab leaked from cv %p", (void*)cv);
 #endif
 
     if (slab) {
@@ -554,7 +531,6 @@ is done.  Returns the offset of the allocated pad slot.
 static PADOFFSET
 S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash)
 {
-    dVAR;
     const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
 
     PERL_ARGS_ASSERT_PAD_ALLOC_NAME;
@@ -605,7 +581,6 @@ PADOFFSET
 Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
                U32 flags, HV *typestash, HV *ourstash)
 {
-    dVAR;
     PADOFFSET offset;
     SV *namesv;
     bool is_utf8;
@@ -737,7 +712,6 @@ but is used for debugging.
 PADOFFSET
 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 {
-    dVAR;
     SV *sv;
     I32 retval;
 
@@ -771,7 +745,13 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
                   (sv = names[PL_padix]) && sv != &PL_sv_undef)
                continue;
            sv = *av_fetch(PL_comppad, PL_padix, TRUE);
-           if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
+           if (!(SvFLAGS(sv) &
+#ifdef USE_BROKEN_PAD_RESET
+                   (SVs_PADMY|(tmptype & SVf_READONLY ? SVs_PADTMP : 0))
+#else
+                   (SVs_PADMY|SVs_PADTMP)
+#endif
+                ) &&
                !IS_PADGV(sv))
                break;
        }
@@ -817,7 +797,6 @@ but is used for debugging.
 PADOFFSET
 Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
 {
-    dVAR;
     PADOFFSET ix;
     SV* const name = newSV_type(SVt_PVNV);
 
@@ -869,7 +848,6 @@ C<is_our> indicates that the name to check is an 'our' declaration.
 STATIC void
 S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
 {
-    dVAR;
     SV         **svp;
     PADOFFSET  top, off;
     const U32  is_our = flags & padadd_OUR;
@@ -904,7 +882,7 @@ S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
                "\"%s\" %s %"SVf" masks earlier declaration in same %s",
                (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
                *SvPVX(sv) == '&' ? "subroutine" : "variable",
-               sv,
+               SVfARG(sv),
                (COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO
                    ? "scope" : "statement"));
            --off;
@@ -924,7 +902,7 @@ S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
                && sv_eq(name, sv))
            {
                Perl_warner(aTHX_ packWARN(WARN_MISC),
-                   "\"our\" variable %"SVf" redeclared", sv);
+                   "\"our\" variable %"SVf" redeclared", SVfARG(sv));
                if ((I32)off <= PL_comppad_name_floor)
                    Perl_warner(aTHX_ packWARN(WARN_MISC),
                        "\t(Did you mean \"local\" instead of \"our\"?)\n");
@@ -954,7 +932,6 @@ or C<NOT_IN_PAD> if no such lexical is in scope.
 PADOFFSET
 Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
 {
-    dVAR;
     SV *out_sv;
     int out_flags;
     I32 offset;
@@ -1056,7 +1033,6 @@ L</find_rundefsv> is likely to be more convenient.
 PADOFFSET
 Perl_find_rundefsvoffset(pTHX)
 {
-    dVAR;
     SV *out_sv;
     int out_flags;
     return pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
@@ -1147,14 +1123,13 @@ S_unavailable(pTHX_ SV *namesv)
                         *SvPVX_const(namesv) == '&'
                                         ? "Subroutin"
                                         : "Variabl",
-                        namesv);
+                        SVfARG(namesv));
 }
 
 STATIC PADOFFSET
 S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, 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;
@@ -1287,9 +1262,9 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
                        newwarn = 0;
                        Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
                            "Variable \"%"SVf"\" will not stay shared",
-                            newSVpvn_flags(namepv, namelen,
+                            SVfARG(newSVpvn_flags(namepv, namelen,
                                 SVs_TEMP |
-                                (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
+                                (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0))));
                    }
 
                    if (fake_offset && CvANON(cv)
@@ -1434,7 +1409,6 @@ 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)
@@ -1458,8 +1432,6 @@ Use the macro PAD_SETSV() rather than calling this function directly.
 void
 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_PAD_SETSV;
 
     ASSERT_CURPAD_ACTIVE("pad_setsv");
@@ -1490,7 +1462,6 @@ 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);
@@ -1520,7 +1491,6 @@ subsequent statements.
 U32
 Perl_intro_my(pTHX)
 {
-    dVAR;
     SV **svp;
     I32 i;
     U32 seq;
@@ -1570,7 +1540,6 @@ lexicals in this scope and warn of any lexicals that never got introduced.
 OP *
 Perl_pad_leavemy(pTHX)
 {
-    dVAR;
     I32 off;
     OP *o = NULL;
     SV * const * const svp = AvARRAY(PL_comppad_name);
@@ -1628,7 +1597,6 @@ new one.
 void
 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
 {
-    dVAR;
     ASSERT_CURPAD_LEGAL("pad_swipe");
     if (!PL_curpad)
        return;
@@ -1683,7 +1651,6 @@ Mark all the current temporaries for reuse
 static void
 S_pad_reset(pTHX)
 {
-    dVAR;
 #ifdef USE_BROKEN_PAD_RESET
     if (AvARRAY(PL_comppad) != PL_curpad)
        Perl_croak(aTHX_ "panic: pad_reset curpad, %p!=%p",
@@ -1697,11 +1664,6 @@ S_pad_reset(pTHX)
     );
 
     if (!TAINTING_get) {       /* Can't mix tainted and non-tainted temporaries. */
-        I32 po;
-       for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
-           if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
-               SvPADTMP_off(PL_curpad[po]);
-       }
        PL_padix = PL_padix_floor;
     }
 #endif
@@ -1848,7 +1810,6 @@ Free the SV at offset po in the current pad.
 void
 Perl_pad_free(pTHX_ PADOFFSET po)
 {
-    dVAR;
     SV *sv;
     ASSERT_CURPAD_LEGAL("pad_free");
     if (!PL_curpad)
@@ -1884,7 +1845,6 @@ 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;
@@ -1957,7 +1917,6 @@ 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);
     PADLIST* const padlist = CvPADLIST(cv);
 
@@ -2003,7 +1962,6 @@ static CV *S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside);
 static void
 S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
 {
-    dVAR;
     I32 ix;
     PADLIST* const protopadlist = CvPADLIST(proto);
     PAD *const protopad_name = *PadlistARRAY(protopadlist);
@@ -2158,7 +2116,9 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
 static CV *
 S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside)
 {
+#ifdef USE_ITHREADS
     dVAR;
+#endif
     const bool newcv = !cv;
 
     assert(!CvUNIQUE(proto));
@@ -2250,7 +2210,6 @@ 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 = PadlistARRAY(padlist)[0];
     AV * const comppad = PadlistARRAY(padlist)[1];
@@ -2307,8 +2266,6 @@ the new pad an @_ in slot zero.
 void
 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_PAD_PUSH;
 
     if (depth > PadlistMAX(padlist) || !PadlistARRAY(padlist)[depth]) {
@@ -2373,10 +2330,9 @@ class to which it is typed is returned.  If not, C<NULL> is returned.
 HV *
 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
 {
-    dVAR;
-    SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
-    if ( SvPAD_TYPED(*av) ) {
-        return SvSTASH(*av);
+    SV* const av = PAD_COMPNAME_SV(po);
+    if ( SvPAD_TYPED(av) ) {
+        return SvSTASH(av);
     }
     return NULL;
 }
@@ -2515,7 +2471,6 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param)
 PAD **
 Perl_padlist_store(pTHX_ PADLIST *padlist, I32 key, PAD *val)
 {
-    dVAR;
     PAD **ary;
     SSize_t const oldmax = PadlistMAX(padlist);