This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
todo: expand the list of OS access builtins to update
[perl5.git] / pad.c
diff --git a/pad.c b/pad.c
index 4d55635..00ba632 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -47,15 +47,20 @@ 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 "static type information" for lexicals.  The individual elements of a
 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 "static type information" for lexicals.  The individual elements of a
-PADNAMELIST are PADNAMEs (just SVs; but, again, that may change).
+PADNAMELIST are PADNAMEs (just SVs; but, again, that may change).  Future
+refactorings might stop the PADNAMELIST from being stored in the PADLIST's
+array, so don't rely on it.  See L</PadlistNAMES>.
 
 The CvDEPTH'th entry of a PADLIST is a PAD (an AV) which is the stack frame
 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
 
 The CvDEPTH'th entry of a PADLIST is a PAD (an AV) which is the stack frame
 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 that are SVs_PADTMP (targets/GVs/constants) end up having
-&PL_sv_undef "names" (see pad_alloc()).
+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)>.
 
 Only my/our variable (SvPADMY/PADNAME_isOUR) slots get valid names.
 The rest are op targets/GVs/constants which are statically allocated
 
 Only my/our variable (SvPADMY/PADNAME_isOUR) slots get valid names.
 The rest are op targets/GVs/constants which are statically allocated
@@ -83,10 +88,11 @@ SvOURSTASH slot pointing at the stash of the associated global (so that
 duplicate C<our> declarations in the same package can be detected).  SvUVX is
 sometimes hijacked to store the generation number during compilation.
 
 duplicate C<our> declarations in the same package can be detected).  SvUVX is
 sometimes hijacked to store the generation number during compilation.
 
-If SvFAKE is set on the name SV, then that slot in the frame AV is
-a REFCNT'ed reference to a lexical from "outside". In this case,
+If PADNAME_OUTER (SvFAKE) is set on the
+name SV, then that slot in the frame AV is
+a REFCNT'ed reference to a lexical from "outside".  In this case,
 the name SV does not use xlow and xhigh to store a cop_seq range, since it is
 the name SV does not use xlow and xhigh to store a cop_seq range, since it is
-in scope throughout. Instead xhigh stores some flags containing info about
+in scope throughout.  Instead xhigh stores some flags containing info about
 the real lexical (is it declared in an anon, and is it capable of being
 instantiated multiple times?), and for fake ANONs, xlow contains the index
 within the parent's pad where the lexical's value is stored, to make
 the real lexical (is it declared in an anon, and is it capable of being
 instantiated multiple times?), and for fake ANONs, xlow contains the index
 within the parent's pad where the lexical's value is stored, to make
@@ -94,7 +100,8 @@ cloning quicker.
 
 If the 'name' is '&' the corresponding entry in the PAD
 is a CV representing a possible closure.
 
 If the 'name' is '&' the corresponding entry in the PAD
 is a CV representing a possible closure.
-(SvFAKE and name of '&' is not a meaningful combination currently but could
+(PADNAME_OUTER and name of '&' is not a
+meaningful combination currently but could
 become so if C<my sub foo {}> is implemented.)
 
 Note that formats are treated as anon subs, and are cloned each time
 become so if C<my sub foo {}> is implemented.)
 
 Note that formats are treated as anon subs, and are cloned each time
@@ -147,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
 
 /*
   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.
 */
 This is basically sv_eq_flags() in sv.c, but we avoid the magic
 and bytes checking.
 */
@@ -192,7 +177,7 @@ sv_eq_pvn_flags(pTHX_ const SV *sv, const char* pv, const STRLEN pvlen, const U3
                   sv_recode_to_utf8(svrecode, PL_encoding);
                   pv1      = SvPV_const(svrecode, cur1);
              }
                   sv_recode_to_utf8(svrecode, PL_encoding);
                   pv1      = SvPV_const(svrecode, cur1);
              }
-              SvREFCNT_dec(svrecode);
+              SvREFCNT_dec_NN(svrecode);
         }
         if (flags & SVf_UTF8)
             return (bytes_cmp_utf8(
         }
         if (flags & SVf_UTF8)
             return (bytes_cmp_utf8(
@@ -226,7 +211,6 @@ flags can be OR'ed together:
 PADLIST *
 Perl_pad_new(pTHX_ int flags)
 {
 PADLIST *
 Perl_pad_new(pTHX_ int flags)
 {
-    dVAR;
     PADLIST *padlist;
     PAD *padname, *pad;
     PAD **ary;
     PADLIST *padlist;
     PAD *padname, *pad;
     PAD **ary;
@@ -243,8 +227,8 @@ Perl_pad_new(pTHX_ int flags)
 
     if (flags & padnew_SAVE) {
        SAVECOMPPAD();
 
     if (flags & padnew_SAVE) {
        SAVECOMPPAD();
-       SAVESPTR(PL_comppad_name);
        if (! (flags & padnew_CLONE)) {
        if (! (flags & padnew_CLONE)) {
+           SAVESPTR(PL_comppad_name);
            SAVEI32(PL_padix);
            SAVEI32(PL_comppad_name_fill);
            SAVEI32(PL_min_intro_pending);
            SAVEI32(PL_padix);
            SAVEI32(PL_comppad_name_fill);
            SAVEI32(PL_min_intro_pending);
@@ -261,7 +245,6 @@ Perl_pad_new(pTHX_ int flags)
     /* ... create new pad ... */
 
     Newxz(padlist, 1, PADLIST);
     /* ... create new pad ... */
 
     Newxz(padlist, 1, PADLIST);
-    padname    = newAV();
     pad                = newAV();
 
     if (flags & padnew_CLONE) {
     pad                = newAV();
 
     if (flags & padnew_CLONE) {
@@ -273,10 +256,14 @@ Perl_pad_new(pTHX_ int flags)
         AV * const a0 = newAV();                       /* will be @_ */
        av_store(pad, 0, MUTABLE_SV(a0));
        AvREIFY_only(a0);
         AV * const a0 = newAV();                       /* will be @_ */
        av_store(pad, 0, MUTABLE_SV(a0));
        AvREIFY_only(a0);
+
+       padname = (PAD *)SvREFCNT_inc_simple_NN(PL_comppad_name);
     }
     else {
     }
     else {
-       padlist->xpadl_id = PL_padlist_generation++;
        av_store(pad, 0, NULL);
        av_store(pad, 0, NULL);
+       padname = newAV();
+       AvPAD_NAMELIST_on(padname);
+       av_store(padname, 0, &PL_sv_undef);
     }
 
     /* Most subroutines never recurse, hence only need 2 entries in the padlist
     }
 
     /* Most subroutines never recurse, hence only need 2 entries in the padlist
@@ -284,18 +271,18 @@ Perl_pad_new(pTHX_ int flags)
        0..3, and even an explicit call to av_extend() with <3 will be rounded
        up, so we inline the allocation of the array here.  */
     Newx(ary, 2, PAD *);
        0..3, and even an explicit call to av_extend() with <3 will be rounded
        up, so we inline the allocation of the array here.  */
     Newx(ary, 2, PAD *);
-    PADLIST_MAX(padlist) = 1;
-    PADLIST_ARRAY(padlist) = ary;
+    PadlistMAX(padlist) = 1;
+    PadlistARRAY(padlist) = ary;
     ary[0] = padname;
     ary[1] = pad;
 
     /* ... then update state variables */
 
     ary[0] = padname;
     ary[1] = pad;
 
     /* ... then update state variables */
 
-    PL_comppad_name    = padname;
     PL_comppad         = pad;
     PL_curpad          = AvARRAY(pad);
 
     if (! (flags & padnew_CLONE)) {
     PL_comppad         = pad;
     PL_curpad          = AvARRAY(pad);
 
     if (! (flags & padnew_CLONE)) {
+       PL_comppad_name      = padname;
        PL_comppad_name_fill = 0;
        PL_min_intro_pending = 0;
        PL_padix             = 0;
        PL_comppad_name_fill = 0;
        PL_min_intro_pending = 0;
        PL_padix             = 0;
@@ -319,7 +306,7 @@ Perl_pad_new(pTHX_ int flags)
 
 =for apidoc cv_undef
 
 
 =for apidoc cv_undef
 
-Clear out all the active components of a CV. This can happen either
+Clear out all the active components of a CV.  This can happen either
 by an explicit C<undef &foo>, or by the reference count going to zero.
 In the former case, we keep the CvOUTSIDE pointer, so that any anonymous
 children can still follow the full lexical scope chain.
 by an explicit C<undef &foo>, or by the reference count going to zero.
 In the former case, we keep the CvOUTSIDE pointer, so that any anonymous
 children can still follow the full lexical scope chain.
@@ -330,7 +317,6 @@ children can still follow the full lexical scope chain.
 void
 Perl_cv_undef(pTHX_ CV *cv)
 {
 void
 Perl_cv_undef(pTHX_ CV *cv)
 {
-    dVAR;
     const PADLIST *padlist = CvPADLIST(cv);
     bool const slabbed = !!CvSLABBED(cv);
 
     const PADLIST *padlist = CvPADLIST(cv);
     bool const slabbed = !!CvSLABBED(cv);
 
@@ -365,17 +351,20 @@ Perl_cv_undef(pTHX_ CV *cv)
        PAD_SAVE_SETNULLPAD();
 
        /* discard any leaked ops */
        PAD_SAVE_SETNULLPAD();
 
        /* discard any leaked ops */
+       if (PL_parser)
+           parser_free_nexttoke_ops(PL_parser, (OPSLAB *)CvSTART(cv));
        opslab_force_free((OPSLAB *)CvSTART(cv));
        CvSTART(cv) = NULL;
 
        LEAVE;
     }
 #ifdef DEBUGGING
        opslab_force_free((OPSLAB *)CvSTART(cv));
        CvSTART(cv) = NULL;
 
        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);
 #endif
     SvPOK_off(MUTABLE_SV(cv));         /* forget prototype */
     sv_unmagic((SV *)cv, PERL_MAGIC_checkcall);
-    CvGV_set(cv, NULL);
+    if (CvNAMED(cv)) CvNAME_HEK_set(cv, NULL);
+    else            CvGV_set(cv, NULL);
 
     /* This statement and the subsequence if block was pad_undef().  */
     pad_peg("pad_undef");
 
     /* This statement and the subsequence if block was pad_undef().  */
     pad_peg("pad_undef");
@@ -403,9 +392,9 @@ Perl_cv_undef(pTHX_ CV *cv)
        if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */
            CV * const outercv = CvOUTSIDE(cv);
            const U32 seq = CvOUTSIDE_SEQ(cv);
        if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */
            CV * const outercv = CvOUTSIDE(cv);
            const U32 seq = CvOUTSIDE_SEQ(cv);
-           PAD * const comppad_name = PADLIST_ARRAY(padlist)[0];
+           PAD * const comppad_name = PadlistARRAY(padlist)[0];
            SV ** const namepad = AvARRAY(comppad_name);
            SV ** const namepad = AvARRAY(comppad_name);
-           PAD * const comppad = PADLIST_ARRAY(padlist)[1];
+           PAD * const comppad = PadlistARRAY(padlist)[1];
            SV ** const curpad = AvARRAY(comppad);
            for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
                SV * const namesv = namepad[ix];
            SV ** const curpad = AvARRAY(comppad);
            for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
                SV * const namesv = namepad[ix];
@@ -416,12 +405,10 @@ Perl_cv_undef(pTHX_ CV *cv)
                        U32 inner_rc = SvREFCNT(innercv);
                        assert(inner_rc);
                        assert(SvTYPE(innercv) != SVt_PVFM);
                        U32 inner_rc = SvREFCNT(innercv);
                        assert(inner_rc);
                        assert(SvTYPE(innercv) != SVt_PVFM);
-                       namepad[ix] = NULL;
-                       SvREFCNT_dec(namesv);
 
                        if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
                            curpad[ix] = NULL;
 
                        if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
                            curpad[ix] = NULL;
-                           SvREFCNT_dec(innercv);
+                           SvREFCNT_dec_NN(innercv);
                            inner_rc--;
                        }
 
                            inner_rc--;
                        }
 
@@ -443,24 +430,24 @@ Perl_cv_undef(pTHX_ CV *cv)
            }
        }
 
            }
        }
 
-       ix = PADLIST_MAX(padlist);
+       ix = PadlistMAX(padlist);
        while (ix > 0) {
        while (ix > 0) {
-           PAD * const sv = PADLIST_ARRAY(padlist)[ix--];
+           PAD * const sv = PadlistARRAY(padlist)[ix--];
            if (sv) {
                if (sv == PL_comppad) {
                    PL_comppad = NULL;
                    PL_curpad = NULL;
                }
            if (sv) {
                if (sv == PL_comppad) {
                    PL_comppad = NULL;
                    PL_curpad = NULL;
                }
-               SvREFCNT_dec(sv);
+               SvREFCNT_dec_NN(sv);
            }
        }
        {
            }
        }
        {
-           PAD * const sv = PADLIST_ARRAY(padlist)[0];
-           if (sv == PL_comppad_name)
+           PAD * const sv = PadlistARRAY(padlist)[0];
+           if (sv == PL_comppad_name && SvREFCNT(sv) == 1)
                PL_comppad_name = NULL;
            SvREFCNT_dec(sv);
        }
                PL_comppad_name = NULL;
            SvREFCNT_dec(sv);
        }
-       if (PADLIST_ARRAY(padlist)) Safefree(PADLIST_ARRAY(padlist));
+       if (PadlistARRAY(padlist)) Safefree(PadlistARRAY(padlist));
        Safefree(padlist);
        CvPADLIST(cv) = NULL;
     }
        Safefree(padlist);
        CvPADLIST(cv) = NULL;
     }
@@ -501,9 +488,7 @@ void
 Perl_cv_forget_slab(pTHX_ CV *cv)
 {
     const bool slabbed = !!CvSLABBED(cv);
 Perl_cv_forget_slab(pTHX_ CV *cv)
 {
     const bool slabbed = !!CvSLABBED(cv);
-#ifdef PERL_DEBUG_READONLY_OPS
     OPSLAB *slab = NULL;
     OPSLAB *slab = NULL;
-#endif
 
     PERL_ARGS_ASSERT_CV_FORGET_SLAB;
 
 
     PERL_ARGS_ASSERT_CV_FORGET_SLAB;
 
@@ -511,25 +496,21 @@ Perl_cv_forget_slab(pTHX_ CV *cv)
 
     CvSLABBED_off(cv);
 
 
     CvSLABBED_off(cv);
 
-#ifdef PERL_DEBUG_READONLY_OPS
     if      (CvROOT(cv))  slab = OpSLAB(CvROOT(cv));
     else if (CvSTART(cv)) slab = (OPSLAB *)CvSTART(cv);
     if      (CvROOT(cv))  slab = OpSLAB(CvROOT(cv));
     else if (CvSTART(cv)) slab = (OPSLAB *)CvSTART(cv);
-#else
-    if      (CvROOT(cv))  OpslabREFCNT_dec(OpSLAB(CvROOT(cv)));
-    else if (CvSTART(cv)) OpslabREFCNT_dec((OPSLAB *)CvSTART(cv));
-#endif
 #ifdef DEBUGGING
 #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
 
 #endif
 
-#ifdef PERL_DEBUG_READONLY_OPS
     if (slab) {
     if (slab) {
-       size_t refcnt;
-       refcnt = slab->opslab_refcnt;
+#ifdef PERL_DEBUG_READONLY_OPS
+       const size_t refcnt = slab->opslab_refcnt;
+#endif
        OpslabREFCNT_dec(slab);
        OpslabREFCNT_dec(slab);
+#ifdef PERL_DEBUG_READONLY_OPS
        if (refcnt > 1) Slab_to_ro(slab);
        if (refcnt > 1) Slab_to_ro(slab);
-    }
 #endif
 #endif
+    }
 }
 
 /*
 }
 
 /*
@@ -550,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)
 {
 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;
     const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
 
     PERL_ARGS_ASSERT_PAD_ALLOC_NAME;
@@ -572,6 +552,7 @@ S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash)
     }
 
     av_store(PL_comppad_name, offset, namesv);
     }
 
     av_store(PL_comppad_name, offset, namesv);
+    PadnamelistMAXNAMED(PL_comppad_name) = offset;
     return offset;
 }
 
     return offset;
 }
 
@@ -600,7 +581,6 @@ PADOFFSET
 Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
                U32 flags, HV *typestash, HV *ourstash)
 {
 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;
     PADOFFSET offset;
     SV *namesv;
     bool is_utf8;
@@ -627,8 +607,12 @@ Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
         flags &= ~padadd_UTF8_NAME;
 
     if ((flags & padadd_NO_DUP_CHECK) == 0) {
         flags &= ~padadd_UTF8_NAME;
 
     if ((flags & padadd_NO_DUP_CHECK) == 0) {
+       ENTER;
+       SAVEFREESV(namesv); /* in case of fatal warnings */
        /* check for duplicate declaration */
        pad_check_dup(namesv, flags & padadd_OUR, ourstash);
        /* check for duplicate declaration */
        pad_check_dup(namesv, flags & padadd_OUR, ourstash);
+       SvREFCNT_inc_simple_void_NN(namesv);
+       LEAVE;
     }
 
     offset = pad_alloc_name(namesv, flags & ~padadd_UTF8_NAME, typestash, ourstash);
     }
 
     offset = pad_alloc_name(namesv, flags & ~padadd_UTF8_NAME, typestash, ourstash);
@@ -647,6 +631,8 @@ Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
        sv_upgrade(PL_curpad[offset], SVt_PVAV);
     else if (namelen != 0 && *namepv == '%')
        sv_upgrade(PL_curpad[offset], SVt_PVHV);
        sv_upgrade(PL_curpad[offset], SVt_PVAV);
     else if (namelen != 0 && *namepv == '%')
        sv_upgrade(PL_curpad[offset], SVt_PVHV);
+    else if (namelen != 0 && *namepv == '&')
+       sv_upgrade(PL_curpad[offset], SVt_PVCV);
     assert(SvPADMY(PL_curpad[offset]));
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                           "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
     assert(SvPADMY(PL_curpad[offset]));
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                           "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
@@ -705,6 +691,13 @@ which will be set in the value SV for the allocated pad entry:
 
     SVs_PADMY    named lexical variable ("my", "our", "state")
     SVs_PADTMP   unnamed temporary store
 
     SVs_PADMY    named lexical variable ("my", "our", "state")
     SVs_PADTMP   unnamed temporary store
+    SVf_READONLY constant shared between recursion levels
+
+C<SVf_READONLY> has been supported here only since perl 5.20.  To work with
+earlier versions as well, use C<SVf_READONLY|SVs_PADTMP>.  C<SVf_READONLY>
+does not cause the SV in the pad slot to be marked read-only, but simply
+tells C<pad_alloc> that it I<will> be made read-only (by the caller), or at
+least should be treated as such.
 
 I<optype> should be an opcode indicating the type of operation that the
 pad entry is to support.  This doesn't affect operational semantics,
 
 I<optype> should be an opcode indicating the type of operation that the
 pad entry is to support.  This doesn't affect operational semantics,
@@ -719,7 +712,6 @@ but is used for debugging.
 PADOFFSET
 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 {
 PADOFFSET
 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 {
-    dVAR;
     SV *sv;
     I32 retval;
 
     SV *sv;
     I32 retval;
 
@@ -744,19 +736,24 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
         const SSize_t names_fill = AvFILLp(PL_comppad_name);
        for (;;) {
            /*
         const SSize_t names_fill = AvFILLp(PL_comppad_name);
        for (;;) {
            /*
-            * "foreach" index vars temporarily become aliases to non-"my"
-            * values.  Thus we must skip, not just pad values that are
+            * Entries that close over unavailable variables
+            * in outer subs contain values not marked PADMY.
+            * Thus we must skip, not just pad values that are
             * marked as current pad values, but also those with names.
             */
             * marked as current pad values, but also those with names.
             */
-           /* HVDS why copy to sv here? we don't seem to use it */
            if (++PL_padix <= names_fill &&
                   (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 (++PL_padix <= names_fill &&
                   (sv = names[PL_padix]) && sv != &PL_sv_undef)
                continue;
            sv = *av_fetch(PL_comppad, PL_padix, TRUE);
            if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
-               !IS_PADGV(sv) && !IS_PADCONST(sv))
+               !IS_PADGV(sv))
                break;
        }
                break;
        }
+       if (tmptype & SVf_READONLY) {
+           av_store(PL_comppad_name, PL_padix, &PL_sv_no);
+           tmptype &= ~SVf_READONLY;
+           tmptype |= SVs_PADTMP;
+       }
        retval = PL_padix;
     }
     SvFLAGS(sv) |= tmptype;
        retval = PL_padix;
     }
     SvFLAGS(sv) |= tmptype;
@@ -794,7 +791,6 @@ but is used for debugging.
 PADOFFSET
 Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
 {
 PADOFFSET
 Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
 {
-    dVAR;
     PADOFFSET ix;
     SV* const name = newSV_type(SVt_PVNV);
 
     PADOFFSET ix;
     SV* const name = newSV_type(SVt_PVNV);
 
@@ -824,7 +820,7 @@ Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
     if (CvOUTSIDE(func) && SvTYPE(func) == SVt_PVCV) {
        assert(!CvWEAKOUTSIDE(func));
        CvWEAKOUTSIDE_on(func);
     if (CvOUTSIDE(func) && SvTYPE(func) == SVt_PVCV) {
        assert(!CvWEAKOUTSIDE(func));
        CvWEAKOUTSIDE_on(func);
-       SvREFCNT_dec(CvOUTSIDE(func));
+       SvREFCNT_dec_NN(CvOUTSIDE(func));
     }
     return ix;
 }
     }
     return ix;
 }
@@ -846,7 +842,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)
 {
 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;
     SV         **svp;
     PADOFFSET  top, off;
     const U32  is_our = flags & padadd_OUR;
@@ -868,7 +863,7 @@ S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
     for (off = top; (I32)off > PL_comppad_name_floor; off--) {
        SV * const sv = svp[off];
        if (sv
     for (off = top; (I32)off > PL_comppad_name_floor; off--) {
        SV * const sv = svp[off];
        if (sv
-           && sv != &PL_sv_undef
+           && PadnameLEN(sv)
            && !SvFAKE(sv)
            && (   COP_SEQ_RANGE_LOW(sv)  == PERL_PADSEQ_INTRO
                || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
            && !SvFAKE(sv)
            && (   COP_SEQ_RANGE_LOW(sv)  == PERL_PADSEQ_INTRO
                || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
@@ -876,10 +871,12 @@ S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
        {
            if (is_our && (SvPAD_OUR(sv)))
                break; /* "our" masking "our" */
        {
            if (is_our && (SvPAD_OUR(sv)))
                break; /* "our" masking "our" */
+           /* diag_listed_as: "%s" variable %s masks earlier declaration in same %s */
            Perl_warner(aTHX_ packWARN(WARN_MISC),
            Perl_warner(aTHX_ packWARN(WARN_MISC),
-               "\"%s\" variable %"SVf" masks earlier declaration in same %s",
+               "\"%s\" %s %"SVf" masks earlier declaration in same %s",
                (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
                (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
-               sv,
+               *SvPVX(sv) == '&' ? "subroutine" : "variable",
+               SVfARG(sv),
                (COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO
                    ? "scope" : "statement"));
            --off;
                (COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO
                    ? "scope" : "statement"));
            --off;
@@ -891,7 +888,7 @@ S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
        while (off > 0) {
            SV * const sv = svp[off];
            if (sv
        while (off > 0) {
            SV * const sv = svp[off];
            if (sv
-               && sv != &PL_sv_undef
+               && PadnameLEN(sv)
                && !SvFAKE(sv)
                && (   COP_SEQ_RANGE_LOW(sv)  == PERL_PADSEQ_INTRO
                    || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
                && !SvFAKE(sv)
                && (   COP_SEQ_RANGE_LOW(sv)  == PERL_PADSEQ_INTRO
                    || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
@@ -899,7 +896,7 @@ S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
                && sv_eq(name, sv))
            {
                Perl_warner(aTHX_ packWARN(WARN_MISC),
                && 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");
                if ((I32)off <= PL_comppad_name_floor)
                    Perl_warner(aTHX_ packWARN(WARN_MISC),
                        "\t(Did you mean \"local\" instead of \"our\"?)\n");
@@ -929,7 +926,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)
 {
 PADOFFSET
 Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
 {
-    dVAR;
     SV *out_sv;
     int out_flags;
     I32 offset;
     SV *out_sv;
     int out_flags;
     I32 offset;
@@ -963,14 +959,13 @@ 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) */
 
      *    our $foo = 0 unless defined $foo;
      * to not give a warning. (Yes, this is a hack) */
 
-    nameav = PADLIST_ARRAY(CvPADLIST(PL_compcv))[0];
+    nameav = PadlistARRAY(CvPADLIST(PL_compcv))[0];
     name_svp = AvARRAY(nameav);
     for (offset = AvFILLp(nameav); offset > 0; offset--) {
         const SV * const namesv = name_svp[offset];
     name_svp = AvARRAY(nameav);
     for (offset = AvFILLp(nameav); offset > 0; offset--) {
         const SV * const namesv = name_svp[offset];
-       if (namesv && namesv != &PL_sv_undef
+       if (namesv && PadnameLEN(namesv) == namelen
            && !SvFAKE(namesv)
            && (SvPAD_OUR(namesv))
            && !SvFAKE(namesv)
            && (SvPAD_OUR(namesv))
-           && SvCUR(namesv) == namelen
             && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
                                 flags & padadd_UTF8_NAME ? SVf_UTF8 : 0 )
            && COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO
             && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
                                 flags & padadd_UTF8_NAME ? SVf_UTF8 : 0 )
            && COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO
@@ -1032,7 +1027,6 @@ L</find_rundefsv> is likely to be more convenient.
 PADOFFSET
 Perl_find_rundefsvoffset(pTHX)
 {
 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,
     SV *out_sv;
     int out_flags;
     return pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
@@ -1080,26 +1074,27 @@ Perl_find_rundefsv2(pTHX_ CV *cv, U32 seq)
     if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
        return DEFSV;
 
     if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
        return DEFSV;
 
-    return AvARRAY(PADLIST_ARRAY(CvPADLIST(cv))[CvDEPTH(cv)])[po];
+    return AvARRAY(PadlistARRAY(CvPADLIST(cv))[CvDEPTH(cv)])[po];
 }
 
 /*
 =for apidoc m|PADOFFSET|pad_findlex|const char *namepv|STRLEN namelen|U32 flags|const CV* cv|U32 seq|int warn|SV** out_capture|SV** out_name_sv|int *out_flags
 
 }
 
 /*
 =for apidoc m|PADOFFSET|pad_findlex|const char *namepv|STRLEN namelen|U32 flags|const CV* cv|U32 seq|int warn|SV** out_capture|SV** out_name_sv|int *out_flags
 
-Find a named lexical anywhere in a chain of nested pads. Add fake entries
+Find a named lexical anywhere in a chain of nested pads.  Add fake entries
 in the inner pads if it's found in an outer one.
 
 Returns the offset in the bottom pad of the lex or the fake lex.
 cv is the CV in which to start the search, and seq is the current cop_seq
 in the inner pads if it's found in an outer one.
 
 Returns the offset in the bottom pad of the lex or the fake lex.
 cv is the CV in which to start the search, and seq is the current cop_seq
-to match against. If warn is true, print appropriate warnings.  The out_*
+to match against.  If warn is true, print appropriate warnings.  The out_*
 vars return values, and so are pointers to where the returned values
 vars return values, and so are pointers to where the returned values
-should be stored. out_capture, if non-null, requests that the innermost
+should be stored.  out_capture, if non-null, requests that the innermost
 instance of the lexical is captured; out_name_sv is set to the innermost
 matched namesv or fake namesv; out_flags returns the flags normally
 associated with the IVX field of a fake namesv.
 
 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
 instance of the lexical is captured; out_name_sv is set to the innermost
 matched namesv or fake namesv; out_flags returns the flags normally
 associated with the IVX field of a fake namesv.
 
 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
-then comes back down, adding fake entries as it goes. It has to be this way
+then comes back down, adding fake entries
+as it goes.  It has to be this way
 because fake namesvs in anon protoypes have to store in xlow the index into
 the parent pad.
 
 because fake namesvs in anon protoypes have to store in xlow the index into
 the parent pad.
 
@@ -1111,14 +1106,24 @@ the parent pad.
 #define CvCOMPILED(cv) CvROOT(cv)
 
 /* the CV does late binding of its lexicals */
 #define CvCOMPILED(cv) CvROOT(cv)
 
 /* the CV does late binding of its lexicals */
-#define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
+#define CvLATE(cv) (CvANON(cv) || CvCLONE(cv) || SvTYPE(cv) == SVt_PVFM)
 
 
+static void
+S_unavailable(pTHX_ SV *namesv)
+{
+    /* diag_listed_as: Variable "%s" is not available */
+    Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+                       "%se \"%"SVf"\" is not available",
+                        *SvPVX_const(namesv) == '&'
+                                        ? "Subroutin"
+                                        : "Variabl",
+                        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)
 {
 
 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;
     I32 offset, new_offset;
     SV *new_capture;
     SV **new_capturep;
@@ -1143,13 +1148,12 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
 
     if (padlist) { /* not an undef CV */
        I32 fake_offset = 0;
 
     if (padlist) { /* not an undef CV */
        I32 fake_offset = 0;
-        const AV * const nameav = PADLIST_ARRAY(padlist)[0];
+        const AV * const nameav = PadlistARRAY(padlist)[0];
        SV * const * const name_svp = AvARRAY(nameav);
 
        SV * const * const name_svp = AvARRAY(nameav);
 
-       for (offset = AvFILLp(nameav); offset > 0; offset--) {
+       for (offset = PadnamelistMAXNAMED(nameav); offset > 0; offset--) {
             const SV * const namesv = name_svp[offset];
             const SV * const namesv = name_svp[offset];
-           if (namesv && namesv != &PL_sv_undef
-                   && SvCUR(namesv) == namelen
+           if (namesv && PadnameLEN(namesv) == namelen
                     && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
                                     flags & padadd_UTF8_NAME ? SVf_UTF8 : 0))
            {
                     && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
                                     flags & padadd_UTF8_NAME ? SVf_UTF8 : 0))
            {
@@ -1235,8 +1239,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
                        : *out_flags & PAD_FAKELEX_ANON)
                {
                    if (warn)
                        : *out_flags & PAD_FAKELEX_ANON)
                {
                    if (warn)
-                       Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-                                      "Variable \"%"SVf"\" is not available",
+                       S_unavailable(aTHX_
                                        newSVpvn_flags(namepv, namelen,
                                            SVs_TEMP |
                                            (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
                                        newSVpvn_flags(namepv, namelen,
                                            SVs_TEMP |
                                            (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
@@ -1253,9 +1256,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",
                        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 |
                                 SVs_TEMP |
-                                (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
+                                (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0))));
                    }
 
                    if (fake_offset && CvANON(cv)
                    }
 
                    if (fake_offset && CvANON(cv)
@@ -1274,7 +1277,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
                        return offset;
                    }
 
                        return offset;
                    }
 
-                   *out_capture = AvARRAY(PADLIST_ARRAY(padlist)[
+                   *out_capture = AvARRAY(PadlistARRAY(padlist)[
                                    CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
                    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                        "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
                                    CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
                    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                        "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
@@ -1284,8 +1287,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
                        && (!CvDEPTH(cv) || !staleok)
                        && !SvPAD_STATE(name_svp[offset]))
                    {
                        && (!CvDEPTH(cv) || !staleok)
                        && !SvPAD_STATE(name_svp[offset]))
                    {
-                       Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-                                      "Variable \"%"SVf"\" is not available",
+                       S_unavailable(aTHX_
                                        newSVpvn_flags(namepv, namelen,
                                            SVs_TEMP |
                                            (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
                                        newSVpvn_flags(namepv, namelen,
                                            SVs_TEMP |
                                            (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
@@ -1297,6 +1299,8 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
                        *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
                    else if (namelen != 0 && *namepv == '%')
                        *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
                        *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
                    else if (namelen != 0 && *namepv == '%')
                        *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
+                   else if (namelen != 0 && *namepv == '&')
+                       *out_capture = sv_2mortal(newSV_type(SVt_PVCV));
                    else
                        *out_capture = sv_newmortal();
                }
                    else
                        *out_capture = sv_newmortal();
                }
@@ -1338,8 +1342,8 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
        SV *new_namesv = newSVsv(*out_name_sv);
        AV *  const ocomppad_name = PL_comppad_name;
        PAD * const ocomppad = PL_comppad;
        SV *new_namesv = newSVsv(*out_name_sv);
        AV *  const ocomppad_name = PL_comppad_name;
        PAD * const ocomppad = PL_comppad;
-       PL_comppad_name = PADLIST_ARRAY(padlist)[0];
-       PL_comppad = PADLIST_ARRAY(padlist)[1];
+       PL_comppad_name = PadlistARRAY(padlist)[0];
+       PL_comppad = PadlistARRAY(padlist)[1];
        PL_curpad = AvARRAY(PL_comppad);
 
        new_offset
        PL_curpad = AvARRAY(PL_comppad);
 
        new_offset
@@ -1369,6 +1373,8 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
        else {
            /* immediate creation - capture outer value right now */
            av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
        else {
            /* immediate creation - capture outer value right now */
            av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
+           /* But also note the offset, as newMYSUB needs it */
+           PARENT_PAD_INDEX_set(new_namesv, offset);
            DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
                PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
            DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
                PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
@@ -1397,7 +1403,6 @@ Use macro PAD_SV instead of calling this function directly.
 SV *
 Perl_pad_sv(pTHX_ PADOFFSET po)
 {
 SV *
 Perl_pad_sv(pTHX_ PADOFFSET po)
 {
-    dVAR;
     ASSERT_CURPAD_ACTIVE("pad_sv");
 
     if (!po)
     ASSERT_CURPAD_ACTIVE("pad_sv");
 
     if (!po)
@@ -1421,8 +1426,6 @@ Use the macro PAD_SETSV() rather than calling this function directly.
 void
 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
 {
 void
 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_PAD_SETSV;
 
     ASSERT_CURPAD_ACTIVE("pad_setsv");
     PERL_ARGS_ASSERT_PAD_SETSV;
 
     ASSERT_CURPAD_ACTIVE("pad_setsv");
@@ -1453,7 +1456,6 @@ Update the pad compilation state variables on entry to a new block.
 void
 Perl_pad_block_start(pTHX_ int full)
 {
 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);
     ASSERT_CURPAD_ACTIVE("pad_block_start");
     SAVEI32(PL_comppad_name_floor);
     PL_comppad_name_floor = AvFILLp(PL_comppad_name);
@@ -1483,7 +1485,6 @@ subsequent statements.
 U32
 Perl_intro_my(pTHX)
 {
 U32
 Perl_intro_my(pTHX)
 {
-    dVAR;
     SV **svp;
     I32 i;
     U32 seq;
     SV **svp;
     I32 i;
     U32 seq;
@@ -1496,7 +1497,7 @@ Perl_intro_my(pTHX)
     for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
        SV * const sv = svp[i];
 
     for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
        SV * const sv = svp[i];
 
-       if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
+       if (sv && PadnameLEN(sv) && !SvFAKE(sv)
            && COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO)
        {
            COP_SEQ_RANGE_HIGH_set(sv, PERL_PADSEQ_INTRO); /* Don't know scope end yet. */
            && COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO)
        {
            COP_SEQ_RANGE_HIGH_set(sv, PERL_PADSEQ_INTRO); /* Don't know scope end yet. */
@@ -1530,11 +1531,11 @@ lexicals in this scope and warn of any lexicals that never got introduced.
 =cut
 */
 
 =cut
 */
 
-void
+OP *
 Perl_pad_leavemy(pTHX)
 {
 Perl_pad_leavemy(pTHX)
 {
-    dVAR;
     I32 off;
     I32 off;
+    OP *o = NULL;
     SV * const * const svp = AvARRAY(PL_comppad_name);
 
     PL_pad_reset_pending = FALSE;
     SV * const * const svp = AvARRAY(PL_comppad_name);
 
     PL_pad_reset_pending = FALSE;
@@ -1543,7 +1544,7 @@ Perl_pad_leavemy(pTHX)
     if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
        for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
            const SV * const sv = svp[off];
     if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
        for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
            const SV * const sv = svp[off];
-           if (sv && sv != &PL_sv_undef && !SvFAKE(sv))
+           if (sv && PadnameLEN(sv) && !SvFAKE(sv))
                Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
                                 "%"SVf" never introduced",
                                 SVfARG(sv));
                Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
                                 "%"SVf" never introduced",
                                 SVfARG(sv));
@@ -1551,8 +1552,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--) {
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
     for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
-       const SV * const sv = svp[off];
-       if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
+       SV * const sv = svp[off];
+       if (sv && PadnameLEN(sv) && !SvFAKE(sv)
            && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
        {
            COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);
            && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
        {
            COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);
@@ -1562,6 +1563,12 @@ Perl_pad_leavemy(pTHX)
                (unsigned long)COP_SEQ_RANGE_LOW(sv),
                (unsigned long)COP_SEQ_RANGE_HIGH(sv))
            );
                (unsigned long)COP_SEQ_RANGE_LOW(sv),
                (unsigned long)COP_SEQ_RANGE_HIGH(sv))
            );
+           if (!PadnameIsSTATE(sv) && !PadnameIsOUR(sv)
+            && *PadnamePV(sv) == '&' && PadnameLEN(sv) > 1) {
+               OP *kid = newOP(OP_INTROCV, 0);
+               kid->op_targ = off;
+               o = op_prepend_elem(OP_LINESEQ, kid, o);
+           }
        }
     }
     PL_cop_seqmax++;
        }
     }
     PL_cop_seqmax++;
@@ -1569,6 +1576,7 @@ Perl_pad_leavemy(pTHX)
        PL_cop_seqmax++;
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
            "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
        PL_cop_seqmax++;
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
            "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
+    return o;
 }
 
 /*
 }
 
 /*
@@ -1583,7 +1591,6 @@ new one.
 void
 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
 {
 void
 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
 {
-    dVAR;
     ASSERT_CURPAD_LEGAL("pad_swipe");
     if (!PL_curpad)
        return;
     ASSERT_CURPAD_LEGAL("pad_swipe");
     if (!PL_curpad)
        return;
@@ -1598,8 +1605,6 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
                "Pad 0x%"UVxf"[0x%"UVxf"] swipe:   %ld\n",
                PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
 
                "Pad 0x%"UVxf"[0x%"UVxf"] swipe:   %ld\n",
                PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
 
-    if (PL_curpad[po])
-       SvPADTMP_off(PL_curpad[po]);
     if (refadjust)
        SvREFCNT_dec(PL_curpad[po]);
 
     if (refadjust)
        SvREFCNT_dec(PL_curpad[po]);
 
@@ -1610,8 +1615,15 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
     PL_curpad[po] = newSV(0);
     SvPADTMP_on(PL_curpad[po]);
 #else
     PL_curpad[po] = newSV(0);
     SvPADTMP_on(PL_curpad[po]);
 #else
-    PL_curpad[po] = &PL_sv_undef;
+    PL_curpad[po] = NULL;
 #endif
 #endif
+    if (PadnamelistMAX(PL_comppad_name) != -1
+     && (PADOFFSET)PadnamelistMAX(PL_comppad_name) >= po) {
+       if (PadnamelistARRAY(PL_comppad_name)[po]) {
+           assert(!PadnameLEN(PadnamelistARRAY(PL_comppad_name)[po]));
+       }
+       PadnamelistARRAY(PL_comppad_name)[po] = &PL_sv_undef;
+    }
     if ((I32)po < PL_padix)
        PL_padix = po - 1;
 }
     if ((I32)po < PL_padix)
        PL_padix = po - 1;
 }
@@ -1633,7 +1645,6 @@ Mark all the current temporaries for reuse
 static void
 S_pad_reset(pTHX)
 {
 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",
 #ifdef USE_BROKEN_PAD_RESET
     if (AvARRAY(PL_comppad) != PL_curpad)
        Perl_croak(aTHX_ "panic: pad_reset curpad, %p!=%p",
@@ -1646,7 +1657,7 @@ S_pad_reset(pTHX)
            )
     );
 
            )
     );
 
-    if (!PL_tainting) {        /* Can't mix tainted and non-tainted temporaries. */
+    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]))
         I32 po;
        for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
            if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
@@ -1685,13 +1696,21 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 
     ASSERT_CURPAD_ACTIVE("pad_tidy");
 
 
     ASSERT_CURPAD_ACTIVE("pad_tidy");
 
-    /* If this CV has had any 'eval-capable' ops planted in it
-     * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
-     * anon prototypes in the chain of CVs should be marked as cloneable,
-     * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
-     * the right CvOUTSIDE.
-     * If running with -d, *any* sub may potentially have an eval
-     * executed within it.
+    /* If this CV has had any 'eval-capable' ops planted in it:
+     * i.e. it contains any of:
+     *
+     *     * eval '...',
+     *     * //ee,
+     *     * use re 'eval'; /$var/
+     *     * /(?{..})/),
+     *
+     * Then any anon prototypes in the chain of CVs should be marked as
+     * cloneable, so that for example the eval's CV in
+     *
+     *    sub { eval '$x' }
+     *
+     * gets the right CvOUTSIDE.  If running with -d, *any* sub may
+     * potentially have an eval executed within it.
      */
 
     if (PL_cv_has_eval || PL_perldb) {
      */
 
     if (PL_cv_has_eval || PL_perldb) {
@@ -1703,32 +1722,34 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
                DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                    "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
                CvCLONE_on(cv);
                DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                    "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
                CvCLONE_on(cv);
-               CvHASEVAL_on(cv);
            }
            }
+           CvHASEVAL_on(cv);
        }
     }
 
        }
     }
 
-    /* extend curpad to match namepad */
+    /* extend namepad to match curpad */
     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
        av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
 
     if (type == padtidy_SUBCLONE) {
     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
        av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
 
     if (type == padtidy_SUBCLONE) {
-       SV * const * const namep = AvARRAY(PL_comppad_name);
+       SV ** const namep = AvARRAY(PL_comppad_name);
        PADOFFSET ix;
 
        for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
            SV *namesv;
        PADOFFSET ix;
 
        for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
            SV *namesv;
+           if (!namep[ix]) namep[ix] = &PL_sv_undef;
 
 
-           if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
-               continue;
            /*
             * The only things that a clonable function needs in its
            /*
             * The only things that a clonable function needs in its
-            * pad are anonymous subs.
+            * pad are anonymous subs, constants and GVs.
             * The rest are created anew during cloning.
             */
             * The rest are created anew during cloning.
             */
-           if (!((namesv = namep[ix]) != NULL &&
-                 namesv != &PL_sv_undef &&
-                  *SvPVX_const(namesv) == '&'))
+           if (!PL_curpad[ix] || SvIMMORTAL(PL_curpad[ix])
+                || IS_PADGV(PL_curpad[ix]))
+               continue;
+           namesv = namep[ix];
+           if (!(PadnamePV(namesv) &&
+                  (!PadnameLEN(namesv) || *SvPVX_const(namesv) == '&')))
            {
                SvREFCNT_dec(PL_curpad[ix]);
                PL_curpad[ix] = NULL;
            {
                SvREFCNT_dec(PL_curpad[ix]);
                PL_curpad[ix] = NULL;
@@ -1743,10 +1764,12 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
     }
 
     if (type == padtidy_SUB || type == padtidy_FORMAT) {
     }
 
     if (type == padtidy_SUB || type == padtidy_FORMAT) {
-       SV * const * const namep = AvARRAY(PL_comppad_name);
+       SV ** const namep = AvARRAY(PL_comppad_name);
        PADOFFSET ix;
        for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
        PADOFFSET ix;
        for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
-           if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
+           if (!namep[ix]) namep[ix] = &PL_sv_undef;
+           if (!PL_curpad[ix] || SvIMMORTAL(PL_curpad[ix])
+                || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
                continue;
            if (!SvPADMY(PL_curpad[ix])) {
                SvPADTMP_on(PL_curpad[ix]);
                continue;
            if (!SvPADMY(PL_curpad[ix])) {
                SvPADTMP_on(PL_curpad[ix]);
@@ -1786,7 +1809,7 @@ Free the SV at offset po in the current pad.
 void
 Perl_pad_free(pTHX_ PADOFFSET po)
 {
 void
 Perl_pad_free(pTHX_ PADOFFSET po)
 {
-    dVAR;
+    SV *sv;
     ASSERT_CURPAD_LEGAL("pad_free");
     if (!PL_curpad)
        return;
     ASSERT_CURPAD_LEGAL("pad_free");
     if (!PL_curpad)
        return;
@@ -1801,9 +1824,11 @@ Perl_pad_free(pTHX_ PADOFFSET po)
            PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
     );
 
            PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
     );
 
-    if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
-       SvFLAGS(PL_curpad[po]) &= ~SVs_PADTMP; /* also clears SVs_PADSTALE */
-    }
+
+    sv = PL_curpad[po];
+    if (sv && sv != &PL_sv_undef && !SvPADMY(sv))
+       SvFLAGS(sv) &= ~SVs_PADTMP;
+
     if ((I32)po < PL_padix)
        PL_padix = po - 1;
 }
     if ((I32)po < PL_padix)
        PL_padix = po - 1;
 }
@@ -1819,7 +1844,6 @@ Dump the contents of a padlist
 void
 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
 {
 void
 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
 {
-    dVAR;
     const AV *pad_name;
     const AV *pad;
     SV **pname;
     const AV *pad_name;
     const AV *pad;
     SV **pname;
@@ -1831,8 +1855,8 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
     if (!padlist) {
        return;
     }
     if (!padlist) {
        return;
     }
-    pad_name = *PADLIST_ARRAY(padlist);
-    pad = PADLIST_ARRAY(padlist)[1];
+    pad_name = *PadlistARRAY(padlist);
+    pad = PadlistARRAY(padlist)[1];
     pname = AvARRAY(pad_name);
     ppad = AvARRAY(pad);
     Perl_dump_indent(aTHX_ level, file,
     pname = AvARRAY(pad_name);
     ppad = AvARRAY(pad);
     Perl_dump_indent(aTHX_ level, file,
@@ -1842,7 +1866,7 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
 
     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
         const SV *namesv = pname[ix];
 
     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
         const SV *namesv = pname[ix];
-       if (namesv && namesv == &PL_sv_undef) {
+       if (namesv && !PadnameLEN(namesv)) {
            namesv = NULL;
        }
        if (namesv) {
            namesv = NULL;
        }
        if (namesv) {
@@ -1892,7 +1916,6 @@ dump the contents of a CV
 STATIC void
 S_cv_dump(pTHX_ const CV *cv, const char *title)
 {
 STATIC void
 S_cv_dump(pTHX_ const CV *cv, const char *title)
 {
-    dVAR;
     const CV * const outside = CvOUTSIDE(cv);
     PADLIST* const padlist = CvPADLIST(cv);
 
     const CV * const outside = CvOUTSIDE(cv);
     PADLIST* const padlist = CvPADLIST(cv);
 
@@ -1933,107 +1956,92 @@ the immediately surrounding code.
 =cut
 */
 
 =cut
 */
 
-CV *
-Perl_cv_clone(pTHX_ CV *proto)
+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);
     I32 ix;
     PADLIST* const protopadlist = CvPADLIST(proto);
-    const PAD *const protopad_name = *PADLIST_ARRAY(protopadlist);
-    const PAD *const protopad = PADLIST_ARRAY(protopadlist)[1];
+    PAD *const protopad_name = *PadlistARRAY(protopadlist);
+    const PAD *const protopad = PadlistARRAY(protopadlist)[1];
     SV** const pname = AvARRAY(protopad_name);
     SV** const ppad = AvARRAY(protopad);
     const I32 fname = AvFILLp(protopad_name);
     const I32 fpad = AvFILLp(protopad);
     SV** const pname = AvARRAY(protopad_name);
     SV** const ppad = AvARRAY(protopad);
     const I32 fname = AvFILLp(protopad_name);
     const I32 fpad = AvFILLp(protopad);
-    CV* cv;
     SV** outpad;
     SV** outpad;
-    CV* outside;
     long depth;
     long depth;
-
-    PERL_ARGS_ASSERT_CV_CLONE;
+    bool subclones = FALSE;
 
     assert(!CvUNIQUE(proto));
 
     /* Anonymous subs have a weak CvOUTSIDE pointer, so its value is not
      * reliable.  The currently-running sub is always the one we need to
      * close over.
 
     assert(!CvUNIQUE(proto));
 
     /* Anonymous subs have a weak CvOUTSIDE pointer, so its value is not
      * reliable.  The currently-running sub is always the one we need to
      * close over.
+     * For my subs, the currently-running sub may not be the one we want.
+     * We have to check whether it is a clone of CvOUTSIDE.
      * Note that in general for formats, CvOUTSIDE != find_runcv.
      * Since formats may be nested inside closures, CvOUTSIDE may point
      * to a prototype; we instead want the cloned parent who called us.
      */
 
      * Note that in general for formats, CvOUTSIDE != find_runcv.
      * Since formats may be nested inside closures, CvOUTSIDE may point
      * to a prototype; we instead want the cloned parent who called us.
      */
 
-    if (SvTYPE(proto) == SVt_PVCV)
+    if (!outside) {
+      if (CvWEAKOUTSIDE(proto))
        outside = find_runcv(NULL);
        outside = find_runcv(NULL);
-    else {
+      else {
        outside = CvOUTSIDE(proto);
        if ((CvCLONE(outside) && ! CvCLONED(outside))
            || !CvPADLIST(outside)
        outside = CvOUTSIDE(proto);
        if ((CvCLONE(outside) && ! CvCLONED(outside))
            || !CvPADLIST(outside)
-           || CvPADLIST(outside)->xpadl_id != protopadlist->xpadl_outid) {
+           || PadlistNAMES(CvPADLIST(outside))
+                != protopadlist->xpadl_outid) {
            outside = find_runcv_where(
            outside = find_runcv_where(
-               FIND_RUNCV_padid_eq, (IV)protopadlist->xpadl_outid, NULL
+               FIND_RUNCV_padid_eq, PTR2IV(protopadlist->xpadl_outid), NULL
            );
            /* outside could be null */
        }
            );
            /* outside could be null */
        }
+      }
     }
     depth = outside ? CvDEPTH(outside) : 0;
     }
     depth = outside ? CvDEPTH(outside) : 0;
-    assert(depth || SvTYPE(proto) == SVt_PVFM);
     if (!depth)
        depth = 1;
     if (!depth)
        depth = 1;
-    assert(SvTYPE(proto) == SVt_PVFM || CvPADLIST(outside));
 
     ENTER;
     SAVESPTR(PL_compcv);
 
     ENTER;
     SAVESPTR(PL_compcv);
+    PL_compcv = cv;
+    if (newcv) SAVEFREESV(cv); /* in case of fatal warnings */
 
 
-    cv = PL_compcv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
-    CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC
-                                   |CVf_SLABBED);
-    CvCLONED_on(cv);
-
-    CvFILE(cv)         = CvDYNFILE(proto) ? savepv(CvFILE(proto))
-                                          : CvFILE(proto);
-    CvGV_set(cv,CvGV(proto));
-    CvSTASH_set(cv, CvSTASH(proto));
-    OP_REFCNT_LOCK;
-    CvROOT(cv)         = OpREFCNT_inc(CvROOT(proto));
-    OP_REFCNT_UNLOCK;
-    CvSTART(cv)                = CvSTART(proto);
     if (CvHASEVAL(cv))
        CvOUTSIDE(cv)   = MUTABLE_CV(SvREFCNT_inc_simple(outside));
     if (CvHASEVAL(cv))
        CvOUTSIDE(cv)   = MUTABLE_CV(SvREFCNT_inc_simple(outside));
-    CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
-
-    if (SvPOK(proto))
-       sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto));
-    if (SvMAGIC(proto))
-       mg_copy((SV *)proto, (SV *)cv, 0, 0);
 
 
+    SAVESPTR(PL_comppad_name);
+    PL_comppad_name = protopad_name;
     CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
     CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
-    CvPADLIST(cv)->xpadl_id = protopadlist->xpadl_id;
 
     av_fill(PL_comppad, fpad);
 
     av_fill(PL_comppad, fpad);
-    for (ix = fname; ix > 0; ix--)
-       av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
 
     PL_curpad = AvARRAY(PL_comppad);
 
     outpad = outside && CvPADLIST(outside)
 
     PL_curpad = AvARRAY(PL_comppad);
 
     outpad = outside && CvPADLIST(outside)
-       ? AvARRAY(PADLIST_ARRAY(CvPADLIST(outside))[depth])
+       ? AvARRAY(PadlistARRAY(CvPADLIST(outside))[depth])
        : NULL;
        : NULL;
-    assert(outpad || SvTYPE(cv) == SVt_PVFM);
-    if (outpad) CvPADLIST(cv)->xpadl_outid = CvPADLIST(outside)->xpadl_id;
+    if (outpad)
+       CvPADLIST(cv)->xpadl_outid = PadlistNAMES(CvPADLIST(outside));
 
     for (ix = fpad; ix > 0; ix--) {
        SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
        SV *sv = NULL;
 
     for (ix = fpad; ix > 0; ix--) {
        SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
        SV *sv = NULL;
-       if (namesv && namesv != &PL_sv_undef) { /* lexical */
+       if (namesv && PadnameLEN(namesv)) { /* lexical */
+         if (PadnameIsOUR(namesv)) { /* or maybe not so lexical */
+               NOOP;
+         }
+         else {
            if (SvFAKE(namesv)) {   /* lexical from outside? */
                /* formats may have an inactive, or even undefined, parent;
                   but state vars are always available. */
                if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)])
                 || (  SvPADSTALE(sv) && !SvPAD_STATE(namesv)
                    && (!outside || !CvDEPTH(outside)))  ) {
            if (SvFAKE(namesv)) {   /* lexical from outside? */
                /* formats may have an inactive, or even undefined, parent;
                   but state vars are always available. */
                if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)])
                 || (  SvPADSTALE(sv) && !SvPAD_STATE(namesv)
                    && (!outside || !CvDEPTH(outside)))  ) {
-                   assert(SvTYPE(cv) == SVt_PVFM);
-                   Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-                                  "Variable \"%"SVf"\" is not available", namesv);
+                   S_unavailable(aTHX_ namesv);
                    sv = NULL;
                }
                else 
                    sv = NULL;
                }
                else 
@@ -2042,7 +2050,33 @@ Perl_cv_clone(pTHX_ CV *proto)
            if (!sv) {
                 const char sigil = SvPVX_const(namesv)[0];
                 if (sigil == '&')
            if (!sv) {
                 const char sigil = SvPVX_const(namesv)[0];
                 if (sigil == '&')
-                   sv = SvREFCNT_inc(ppad[ix]);
+                   /* If there are state subs, we need to clone them, too.
+                      But they may need to close over variables we have
+                      not cloned yet.  So we will have to do a second
+                      pass.  Furthermore, there may be state subs clos-
+                      ing over other state subs’ entries, so we have
+                      to put a stub here and then clone into it on the
+                      second pass. */
+                   if (SvPAD_STATE(namesv) && !CvCLONED(ppad[ix])) {
+                       assert(SvTYPE(ppad[ix]) == SVt_PVCV);
+                       subclones = 1;
+                       sv = newSV_type(SVt_PVCV);
+                   }
+                   else if (PadnameLEN(namesv)>1 && !PadnameIsOUR(namesv))
+                   {
+                       /* my sub */
+                       /* Just provide a stub, but name it.  It will be
+                          upgrade to the real thing on scope entry. */
+                       sv = newSV_type(SVt_PVCV);
+                       CvNAME_HEK_set(
+                           sv,
+                           share_hek(SvPVX_const(namesv)+1,
+                                     SvCUR(namesv) - 1
+                                        * (SvUTF8(namesv) ? -1 : 1),
+                                     0)
+                       );
+                   }
+                   else sv = SvREFCNT_inc(ppad[ix]);
                 else if (sigil == '@')
                    sv = MUTABLE_SV(newAV());
                 else if (sigil == '%')
                 else if (sigil == '@')
                    sv = MUTABLE_SV(newAV());
                 else if (sigil == '%')
@@ -2051,11 +2085,12 @@ Perl_cv_clone(pTHX_ CV *proto)
                    sv = newSV(0);
                SvPADMY_on(sv);
                /* reset the 'assign only once' flag on each state var */
                    sv = newSV(0);
                SvPADMY_on(sv);
                /* reset the 'assign only once' flag on each state var */
-               if (SvPAD_STATE(namesv))
+               if (sigil != '&' && SvPAD_STATE(namesv))
                    SvPADSTALE_on(sv);
            }
                    SvPADSTALE_on(sv);
            }
+         }
        }
        }
-       else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
+       else if (IS_PADGV(ppad[ix]) || (namesv && PadnamePV(namesv))) {
            sv = SvREFCNT_inc_NN(ppad[ix]);
        }
        else {
            sv = SvREFCNT_inc_NN(ppad[ix]);
        }
        else {
@@ -2065,15 +2100,62 @@ Perl_cv_clone(pTHX_ CV *proto)
        PL_curpad[ix] = sv;
     }
 
        PL_curpad[ix] = sv;
     }
 
+    if (subclones)
+       for (ix = fpad; ix > 0; ix--) {
+           SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
+           if (namesv && namesv != &PL_sv_undef && !SvFAKE(namesv)
+            && SvPVX_const(namesv)[0] == '&' && SvPAD_STATE(namesv))
+               S_cv_clone(aTHX_ (CV *)ppad[ix], (CV *)PL_curpad[ix], cv);
+       }
+
+    if (newcv) SvREFCNT_inc_simple_void_NN(cv);
+    LEAVE;
+}
+
+static CV *
+S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside)
+{
+#ifdef USE_ITHREADS
+    dVAR;
+#endif
+    const bool newcv = !cv;
+
+    assert(!CvUNIQUE(proto));
+
+    if (!cv) cv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
+    CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC
+                                   |CVf_SLABBED);
+    CvCLONED_on(cv);
+
+    CvFILE(cv)         = CvDYNFILE(proto) ? savepv(CvFILE(proto))
+                                          : CvFILE(proto);
+    if (CvNAMED(proto))
+        CvNAME_HEK_set(cv, share_hek_hek(CvNAME_HEK(proto)));
+    else CvGV_set(cv,CvGV(proto));
+    CvSTASH_set(cv, CvSTASH(proto));
+    OP_REFCNT_LOCK;
+    CvROOT(cv)         = OpREFCNT_inc(CvROOT(proto));
+    OP_REFCNT_UNLOCK;
+    CvSTART(cv)                = CvSTART(proto);
+    CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
+
+    if (SvPOK(proto)) {
+       sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto));
+        if (SvUTF8(proto))
+           SvUTF8_on(MUTABLE_SV(cv));
+    }
+    if (SvMAGIC(proto))
+       mg_copy((SV *)proto, (SV *)cv, 0, 0);
+
+    if (CvPADLIST(proto)) S_cv_clone_pad(aTHX_ proto, cv, outside, newcv);
+
     DEBUG_Xv(
        PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
     DEBUG_Xv(
        PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
-       if (outside) cv_dump(outside, "Outside");
+       if (CvOUTSIDE(cv)) cv_dump(CvOUTSIDE(cv), "Outside");
        cv_dump(proto,   "Proto");
        cv_dump(cv,      "To");
     );
 
        cv_dump(proto,   "Proto");
        cv_dump(cv,      "To");
     );
 
-    LEAVE;
-
     if (CvCONST(cv)) {
        /* Constant sub () { $x } closing over $x - see lib/constant.pm:
         * The prototype was marked as a candiate for const-ization,
     if (CvCONST(cv)) {
        /* Constant sub () { $x } closing over $x - see lib/constant.pm:
         * The prototype was marked as a candiate for const-ization,
@@ -2082,7 +2164,7 @@ Perl_cv_clone(pTHX_ CV *proto)
         */
        SV* const const_sv = op_const_sv(CvSTART(cv), cv);
        if (const_sv) {
         */
        SV* const const_sv = op_const_sv(CvSTART(cv), cv);
        if (const_sv) {
-           SvREFCNT_dec(cv);
+           SvREFCNT_dec_NN(cv);
             /* For this calling case, op_const_sv returns a *copy*, which we
                donate to newCONSTSUB. Yes, this is ugly, and should be killed.
                Need to fix how lib/constant.pm works to eliminate this.  */
             /* For this calling case, op_const_sv returns a *copy*, which we
                donate to newCONSTSUB. Yes, this is ugly, and should be killed.
                Need to fix how lib/constant.pm works to eliminate this.  */
@@ -2096,11 +2178,29 @@ Perl_cv_clone(pTHX_ CV *proto)
     return cv;
 }
 
     return cv;
 }
 
+CV *
+Perl_cv_clone(pTHX_ CV *proto)
+{
+    PERL_ARGS_ASSERT_CV_CLONE;
+
+    if (!CvPADLIST(proto)) Perl_croak(aTHX_ "panic: no pad in cv_clone");
+    return S_cv_clone(aTHX_ proto, NULL, NULL);
+}
+
+/* Called only by pp_clonecv */
+CV *
+Perl_cv_clone_into(pTHX_ CV *proto, CV *target)
+{
+    PERL_ARGS_ASSERT_CV_CLONE_INTO;
+    cv_undef(target);
+    return S_cv_clone(aTHX_ proto, target, NULL);
+}
+
 /*
 =for apidoc m|void|pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv
 
 For any anon CVs in the pad, change CvOUTSIDE of that CV from
 /*
 =for apidoc m|void|pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv
 
 For any anon CVs in the pad, change CvOUTSIDE of that CV from
-old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
+old_cv to new_cv if necessary.  Needed when a newly-compiled CV has to be
 moved to a pre-existing CV struct.
 
 =cut
 moved to a pre-existing CV struct.
 
 =cut
@@ -2109,10 +2209,9 @@ moved to a pre-existing CV struct.
 void
 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
 {
 void
 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
 {
-    dVAR;
     I32 ix;
     I32 ix;
-    AV * const comppad_name = PADLIST_ARRAY(padlist)[0];
-    AV * const comppad = PADLIST_ARRAY(padlist)[1];
+    AV * const comppad_name = PadlistARRAY(padlist)[0];
+    AV * const comppad = PadlistARRAY(padlist)[1];
     SV ** const namepad = AvARRAY(comppad_name);
     SV ** const curpad = AvARRAY(comppad);
 
     SV ** const namepad = AvARRAY(comppad_name);
     SV ** const curpad = AvARRAY(comppad);
 
@@ -2121,14 +2220,22 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
 
     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
         const SV * const namesv = namepad[ix];
 
     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
         const SV * const namesv = namepad[ix];
-       if (namesv && namesv != &PL_sv_undef
+       if (namesv && namesv != &PL_sv_undef && !SvPAD_STATE(namesv)
            && *SvPVX_const(namesv) == '&')
        {
          if (SvTYPE(curpad[ix]) == SVt_PVCV) {
            && *SvPVX_const(namesv) == '&')
        {
          if (SvTYPE(curpad[ix]) == SVt_PVCV) {
-           CV * const innercv = MUTABLE_CV(curpad[ix]);
-           assert(CvWEAKOUTSIDE(innercv));
-           assert(CvOUTSIDE(innercv) == old_cv);
-           CvOUTSIDE(innercv) = new_cv;
+           MAGIC * const mg =
+               SvMAGICAL(curpad[ix])
+                   ? mg_find(curpad[ix], PERL_MAGIC_proto)
+                   : NULL;
+           CV * const innercv = MUTABLE_CV(mg ? mg->mg_obj : curpad[ix]);
+           if (CvOUTSIDE(innercv) == old_cv) {
+               if (!CvWEAKOUTSIDE(innercv)) {
+                   SvREFCNT_dec(old_cv);
+                   SvREFCNT_inc_simple_void_NN(new_cv);
+               }
+               CvOUTSIDE(innercv) = new_cv;
+           }
          }
          else { /* format reference */
            SV * const rv = curpad[ix];
          }
          else { /* format reference */
            SV * const rv = curpad[ix];
@@ -2158,12 +2265,10 @@ the new pad an @_ in slot zero.
 void
 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 {
 void
 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_PAD_PUSH;
 
     PERL_ARGS_ASSERT_PAD_PUSH;
 
-    if (depth > PADLIST_MAX(padlist) || !PADLIST_ARRAY(padlist)[depth]) {
-       PAD** const svp = PADLIST_ARRAY(padlist);
+    if (depth > PadlistMAX(padlist) || !PadlistARRAY(padlist)[depth]) {
+       PAD** const svp = PadlistARRAY(padlist);
        AV* const newpad = newAV();
        SV** const oldpad = AvARRAY(svp[depth-1]);
        I32 ix = AvFILLp((const AV *)svp[1]);
        AV* const newpad = newAV();
        SV** const oldpad = AvARRAY(svp[depth-1]);
        I32 ix = AvFILLp((const AV *)svp[1]);
@@ -2172,7 +2277,7 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
        AV *av;
 
        for ( ;ix > 0; ix--) {
        AV *av;
 
        for ( ;ix > 0; ix--) {
-           if (names_fill >= ix && names[ix] != &PL_sv_undef) {
+           if (names_fill >= ix && PadnameLEN(names[ix])) {
                const char sigil = SvPVX_const(names[ix])[0];
                if ((SvFLAGS(names[ix]) & SVf_FAKE)
                        || (SvFLAGS(names[ix]) & SVpad_STATE)
                const char sigil = SvPVX_const(names[ix])[0];
                if ((SvFLAGS(names[ix]) & SVf_FAKE)
                        || (SvFLAGS(names[ix]) & SVpad_STATE)
@@ -2193,7 +2298,7 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
                    SvPADMY_on(sv);
                }
            }
                    SvPADMY_on(sv);
                }
            }
-           else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
+           else if (IS_PADGV(oldpad[ix]) || PadnamePV(names[ix])) {
                av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
            }
            else {
                av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
            }
            else {
@@ -2224,10 +2329,9 @@ class to which it is typed is returned.  If not, C<NULL> is returned.
 HV *
 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
 {
 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;
 }
     }
     return NULL;
 }
@@ -2257,41 +2361,41 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param)
        return NULL;
 
     cloneall = param->flags & CLONEf_COPY_STACKS
        return NULL;
 
     cloneall = param->flags & CLONEf_COPY_STACKS
-       || SvREFCNT(PADLIST_ARRAY(srcpad)[1]) > 1;
-    assert (SvREFCNT(PADLIST_ARRAY(srcpad)[1]) == 1);
+       || SvREFCNT(PadlistARRAY(srcpad)[1]) > 1;
+    assert (SvREFCNT(PadlistARRAY(srcpad)[1]) == 1);
 
 
-    max = cloneall ? PADLIST_MAX(srcpad) : 1;
+    max = cloneall ? PadlistMAX(srcpad) : 1;
 
     Newx(dstpad, 1, PADLIST);
     ptr_table_store(PL_ptr_table, srcpad, dstpad);
 
     Newx(dstpad, 1, PADLIST);
     ptr_table_store(PL_ptr_table, srcpad, dstpad);
-    PADLIST_MAX(dstpad) = max;
-    Newx(PADLIST_ARRAY(dstpad), max + 1, PAD *);
+    PadlistMAX(dstpad) = max;
+    Newx(PadlistARRAY(dstpad), max + 1, PAD *);
 
     if (cloneall) {
        PADOFFSET depth;
        for (depth = 0; depth <= max; ++depth)
 
     if (cloneall) {
        PADOFFSET depth;
        for (depth = 0; depth <= max; ++depth)
-           PADLIST_ARRAY(dstpad)[depth] =
-               av_dup_inc(PADLIST_ARRAY(srcpad)[depth], param);
+           PadlistARRAY(dstpad)[depth] =
+               av_dup_inc(PadlistARRAY(srcpad)[depth], param);
     } else {
        /* CvDEPTH() on our subroutine will be set to 0, so there's no need
           to build anything other than the first level of pads.  */
     } else {
        /* CvDEPTH() on our subroutine will be set to 0, so there's no need
           to build anything other than the first level of pads.  */
-       I32 ix = AvFILLp(PADLIST_ARRAY(srcpad)[1]);
+       I32 ix = AvFILLp(PadlistARRAY(srcpad)[1]);
        AV *pad1;
        AV *pad1;
-       const I32 names_fill = AvFILLp(PADLIST_ARRAY(srcpad)[0]);
-       const PAD *const srcpad1 = PADLIST_ARRAY(srcpad)[1];
+       const I32 names_fill = AvFILLp(PadlistARRAY(srcpad)[0]);
+       const PAD *const srcpad1 = PadlistARRAY(srcpad)[1];
        SV **oldpad = AvARRAY(srcpad1);
        SV **names;
        SV **pad1a;
        AV *args;
 
        SV **oldpad = AvARRAY(srcpad1);
        SV **names;
        SV **pad1a;
        AV *args;
 
-       PADLIST_ARRAY(dstpad)[0] =
-           av_dup_inc(PADLIST_ARRAY(srcpad)[0], param);
-       names = AvARRAY(PADLIST_ARRAY(dstpad)[0]);
+       PadlistARRAY(dstpad)[0] =
+           av_dup_inc(PadlistARRAY(srcpad)[0], param);
+       names = AvARRAY(PadlistARRAY(dstpad)[0]);
 
        pad1 = newAV();
 
        av_extend(pad1, ix);
 
        pad1 = newAV();
 
        av_extend(pad1, ix);
-       PADLIST_ARRAY(dstpad)[1] = pad1;
+       PadlistARRAY(dstpad)[1] = pad1;
        pad1a = AvARRAY(pad1);
 
        if (ix > -1) {
        pad1a = AvARRAY(pad1);
 
        if (ix > -1) {
@@ -2300,7 +2404,8 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param)
            for ( ;ix > 0; ix--) {
                if (!oldpad[ix]) {
                    pad1a[ix] = NULL;
            for ( ;ix > 0; ix--) {
                if (!oldpad[ix]) {
                    pad1a[ix] = NULL;
-               } else if (names_fill >= ix && names[ix] != &PL_sv_undef) {
+               } else if (names_fill >= ix && names[ix] &&
+                          PadnameLEN(names[ix])) {
                    const char sigil = SvPVX_const(names[ix])[0];
                    if ((SvFLAGS(names[ix]) & SVf_FAKE)
                        || (SvFLAGS(names[ix]) & SVpad_STATE)
                    const char sigil = SvPVX_const(names[ix])[0];
                    if ((SvFLAGS(names[ix]) & SVf_FAKE)
                        || (SvFLAGS(names[ix]) & SVpad_STATE)
@@ -2329,7 +2434,9 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param)
                        }
                    }
                }
                        }
                    }
                }
-               else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
+               else if (IS_PADGV(oldpad[ix])
+                     || (  names_fill >= ix && names[ix]
+                        && PadnamePV(names[ix])  )) {
                    pad1a[ix] = sv_dup_inc(oldpad[ix], param);
                }
                else {
                    pad1a[ix] = sv_dup_inc(oldpad[ix], param);
                }
                else {
@@ -2361,24 +2468,23 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param)
 #endif /* USE_ITHREADS */
 
 PAD **
 #endif /* USE_ITHREADS */
 
 PAD **
-Perl_padlist_store(pTHX_ register PADLIST *padlist, I32 key, PAD *val)
+Perl_padlist_store(pTHX_ PADLIST *padlist, I32 key, PAD *val)
 {
 {
-    dVAR;
     PAD **ary;
     PAD **ary;
-    SSize_t const oldmax = PADLIST_MAX(padlist);
+    SSize_t const oldmax = PadlistMAX(padlist);
 
     PERL_ARGS_ASSERT_PADLIST_STORE;
 
     assert(key >= 0);
 
 
     PERL_ARGS_ASSERT_PADLIST_STORE;
 
     assert(key >= 0);
 
-    if (key > PADLIST_MAX(padlist)) {
-       av_extend_guts(NULL,key,&PADLIST_MAX(padlist),
-                      (SV ***)&PADLIST_ARRAY(padlist),
-                      (SV ***)&PADLIST_ARRAY(padlist));
-       Zero(PADLIST_ARRAY(padlist)+oldmax+1, PADLIST_MAX(padlist)-oldmax,
+    if (key > PadlistMAX(padlist)) {
+       av_extend_guts(NULL,key,&PadlistMAX(padlist),
+                      (SV ***)&PadlistARRAY(padlist),
+                      (SV ***)&PadlistARRAY(padlist));
+       Zero(PadlistARRAY(padlist)+oldmax+1, PadlistMAX(padlist)-oldmax,
             PAD *);
     }
             PAD *);
     }
-    ary = PADLIST_ARRAY(padlist);
+    ary = PadlistARRAY(padlist);
     SvREFCNT_dec(ary[key]);
     ary[key] = val;
     return &ary[key];
     SvREFCNT_dec(ary[key]);
     ary[key] = val;
     return &ary[key];
Unnamed repository; edit this file 'description' to name the repository.