This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Close over stale vars in active subs
[perl5.git] / pad.c
diff --git a/pad.c b/pad.c
index ff52eb8..1e796e7 100644 (file)
--- a/pad.c
+++ b/pad.c
 /*
 =head1 Pad Data Structures
 
-This file contains the functions that create and manipulate scratchpads,
-which are array-of-array data structures attached to a CV (ie a sub)
-and which store lexical variables and opcode temporary and per-thread
-values.
+=for apidoc Amx|PADLIST *|CvPADLIST|CV *cv
 
-=for apidoc m|AV *|CvPADLIST|CV *cv
-CV's can have CvPADLIST(cv) set to point to an AV.
+CV's can have CvPADLIST(cv) set to point to an AV.  This is the CV's
+scratchpad, which stores lexical variables and opcode temporary and
+per-thread values.
 
 For these purposes "forms" are a kind-of CV, eval""s are too (except they're
 not callable at will and are always thrown away after the eval"" is done
@@ -44,8 +42,9 @@ XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
 but that is really the callers pad (a slot of which is allocated by
 every entersub).
 
-The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
-is managed "manual" (mostly in pad.c) rather than normal av.c rules.
+The CvPADLIST AV has the REFCNT of its component items managed "manually"
+(mostly in pad.c) rather than by normal av.c rules.  So we turn off AvREAL
+just before freeing it, to let av.c know not to touch the entries.
 The items in the AV are not SVs as for a normal AV, but other AVs:
 
 0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
@@ -56,14 +55,6 @@ depth of recursion into the CV.
 The 0'th slot of a frame AV is an AV which is @_.
 other entries are storage for variables and op targets.
 
-During compilation:
-C<PL_comppad_name> is set to the names AV.
-C<PL_comppad> is set to the frame AV for the frame CvDEPTH == 1.
-C<PL_curpad> is set to the body of the frame AV (i.e. AvARRAY(PL_comppad)).
-
-During execution, C<PL_comppad> and C<PL_curpad> refer to the live
-frame of the currently executing sub.
-
 Iterating over the names AV 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()).
@@ -119,6 +110,24 @@ to be generated in evals, such as
 
 For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'
 
+=for apidoc AmxU|AV *|PL_comppad_name
+
+During compilation, this points to the array containing the names part
+of the pad for the currently-compiling code.
+
+=for apidoc AmxU|AV *|PL_comppad
+
+During compilation, this points to the array containing the values
+part of the pad for the currently-compiling code.  (At runtime a CV may
+have many such value arrays; at compile time just one is constructed.)
+At runtime, this points to the array containing the currently-relevant
+values for the pad for the currently-executing code.
+
+=for apidoc AmxU|SV **|PL_curpad
+
+Points directly to the body of the L</PL_comppad> array.
+(I.e., this is C<AvARRAY(PL_comppad)>.)
+
 =cut
 */
 
@@ -138,6 +147,17 @@ For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'
 #define PARENT_FAKELEX_FLAGS_set(sv,val)       \
   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 */
@@ -150,14 +170,55 @@ void pad_peg(const char* s) {
 #endif
 
 /*
-=for apidoc pad_new
+This is basically sv_eq_flags() in sv.c, but we avoid the magic
+and bytes checking.
+*/
+
+static bool
+sv_eq_pvn_flags(pTHX_ const SV *sv, const char* pv, const STRLEN pvlen, const U32 flags) {
+    if ( (SvUTF8(sv) & SVf_UTF8 ) != (flags & SVf_UTF8) ) {
+        const char *pv1 = SvPVX_const(sv);
+        STRLEN cur1     = SvCUR(sv);
+        const char *pv2 = pv;
+        STRLEN cur2     = pvlen;
+       if (PL_encoding) {
+              SV* svrecode = NULL;
+             if (SvUTF8(sv)) {
+                  svrecode = newSVpvn(pv2, cur2);
+                  sv_recode_to_utf8(svrecode, PL_encoding);
+                  pv2      = SvPV_const(svrecode, cur2);
+             }
+             else {
+                  svrecode = newSVpvn(pv1, cur1);
+                  sv_recode_to_utf8(svrecode, PL_encoding);
+                  pv1      = SvPV_const(svrecode, cur1);
+             }
+              SvREFCNT_dec(svrecode);
+        }
+        if (flags & SVf_UTF8)
+            return (bytes_cmp_utf8(
+                        (const U8*)pv1, cur1,
+                       (const U8*)pv2, cur2) == 0);
+        else
+            return (bytes_cmp_utf8(
+                        (const U8*)pv2, cur2,
+                       (const U8*)pv1, cur1) == 0);
+    }
+    else
+        return ((SvPVX_const(sv) == pv)
+                    || memEQ(SvPVX_const(sv), pv, pvlen));
+}
+
+
+/*
+=for apidoc Am|PADLIST *|pad_new|int flags
 
-Create a new compiling padlist, saving and updating the various global
-vars at the same time as creating the pad itself. The following flags
-can be OR'ed together:
+Create a new padlist, updating the global variables for the
+currently-compiling padlist to point to the new padlist.  The following
+flags can be OR'ed together:
 
     padnew_CLONE       this pad is for a cloned CV
-    padnew_SAVE                save old globals
+    padnew_SAVE                save old globals on the save stack
     padnew_SAVESUB     also save extra stuff for start of sub
 
 =cut
@@ -217,7 +278,6 @@ Perl_pad_new(pTHX_ int flags)
        av_store(pad, 0, NULL);
     }
 
-    AvREAL_off(padlist);
     /* Most subroutines never recurse, hence only need 2 entries in the padlist
        array - names, and depth=1.  The default for av_store() is to allocate
        0..3, and even an explicit call to av_extend() with <3 will be rounded
@@ -273,6 +333,7 @@ Perl_cv_undef(pTHX_ CV *cv)
 {
     dVAR;
     const PADLIST *padlist = CvPADLIST(cv);
+    bool const slabbed = !!CvSLABBED(cv);
 
     PERL_ARGS_ASSERT_CV_UNDEF;
 
@@ -281,14 +342,12 @@ Perl_cv_undef(pTHX_ CV *cv)
            PTR2UV(cv), PTR2UV(PL_comppad))
     );
 
-#ifdef USE_ITHREADS
-    if (CvFILE(cv) && !CvISXSUB(cv)) {
-       /* for XSUBs CvFILE point directly to static memory; __FILE__ */
+    if (CvFILE(cv) && CvDYNFILE(cv)) {
        Safefree(CvFILE(cv));
     }
     CvFILE(cv) = NULL;
-#endif
 
+    CvSLABBED_off(cv);
     if (!CvISXSUB(cv) && CvROOT(cv)) {
        if (SvTYPE(cv) == SVt_PVCV && CvDEPTH(cv))
            Perl_croak(aTHX_ "Can't undef active subroutine");
@@ -296,12 +355,27 @@ Perl_cv_undef(pTHX_ CV *cv)
 
        PAD_SAVE_SETNULLPAD();
 
+       if (slabbed) OpslabREFCNT_dec_padok(OpSLAB(CvROOT(cv)));
        op_free(CvROOT(cv));
        CvROOT(cv) = NULL;
        CvSTART(cv) = NULL;
        LEAVE;
     }
+    else if (slabbed && CvSTART(cv)) {
+       ENTER;
+       PAD_SAVE_SETNULLPAD();
+
+       /* discard any leaked ops */
+       opslab_force_free((OPSLAB *)CvSTART(cv));
+       CvSTART(cv) = NULL;
+
+       LEAVE;
+    }
+#ifdef DEBUGGING
+    else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
+#endif
     SvPOK_off(MUTABLE_SV(cv));         /* forget prototype */
+    sv_unmagic((SV *)cv, PERL_MAGIC_checkcall);
     CvGV_set(cv, NULL);
 
     /* This statement and the subsequence if block was pad_undef().  */
@@ -343,6 +417,7 @@ Perl_cv_undef(pTHX_ CV *cv)
                        CV * const innercv = MUTABLE_CV(curpad[ix]);
                        U32 inner_rc = SvREFCNT(innercv);
                        assert(inner_rc);
+                       assert(SvTYPE(innercv) != SVt_PVFM);
                        namepad[ix] = NULL;
                        SvREFCNT_dec(namesv);
 
@@ -387,6 +462,7 @@ Perl_cv_undef(pTHX_ CV *cv)
                PL_comppad_name = NULL;
            SvREFCNT_dec(sv);
        }
+       AvREAL_off(CvPADLIST(cv));
        SvREFCNT_dec(MUTABLE_SV(CvPADLIST(cv)));
        CvPADLIST(cv) = NULL;
     }
@@ -406,20 +482,82 @@ Perl_cv_undef(pTHX_ CV *cv)
        CvXSUB(cv) = NULL;
     }
     /* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the
-     * ref status of CvOUTSIDE and CvGV */
-    CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC);
+     * ref status of CvOUTSIDE and CvGV, and ANON, which pp_entersub uses
+     * to choose an error message */
+    CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC|CVf_ANON);
+}
+
+/*
+=for apidoc cv_forget_slab
+
+When a CV has a reference count on its slab (CvSLABBED), it is responsible
+for making sure it is freed.  (Hence, no two CVs should ever have a
+reference count on the same slab.)  The CV only needs to reference the slab
+during compilation.  Once it is compiled and CvROOT attached, it has
+finished its job, so it can forget the slab.
+
+=cut
+*/
+
+void
+Perl_cv_forget_slab(pTHX_ CV *cv)
+{
+    const bool slabbed = !!CvSLABBED(cv);
+#ifdef PERL_DEBUG_READONLY_OPS
+    OPSLAB *slab = NULL;
+#endif
+
+    PERL_ARGS_ASSERT_CV_FORGET_SLAB;
+
+    if (!slabbed) return;
+
+    CvSLABBED_off(cv);
+
+#ifdef PERL_DEBUG_READONLY_OPS
+    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
+    else if (slabbed)     Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
+#endif
+
+#ifdef PERL_DEBUG_READONLY_OPS
+    if (slab) {
+       size_t refcnt;
+       refcnt = slab->opslab_refcnt;
+       OpslabREFCNT_dec(slab);
+       if (refcnt > 1) Slab_to_ro(slab);
+    }
+#endif
 }
 
+/*
+=for apidoc m|PADOFFSET|pad_alloc_name|SV *namesv|U32 flags|HV *typestash|HV *ourstash
+
+Allocates a place in the currently-compiling
+pad (via L<perlapi/pad_alloc>) and
+then stores a name for that entry.  I<namesv> is adopted and becomes the
+name entry; it must already contain the name string and be sufficiently
+upgraded.  I<typestash> and I<ourstash> and the C<padadd_STATE> flag get
+added to I<namesv>.  None of the other
+processing of L<perlapi/pad_add_name_pvn>
+is done.  Returns the offset of the allocated pad slot.
+
+=cut
+*/
+
 static PADOFFSET
-S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash,
-                 HV *ourstash)
+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_ADD_NAME_SV;
+    PERL_ARGS_ASSERT_PAD_ALLOC_NAME;
 
-    ASSERT_CURPAD_ACTIVE("pad_add_name");
+    ASSERT_CURPAD_ACTIVE("pad_alloc_name");
 
     if (typestash) {
        assert(SvTYPE(namesv) == SVt_PVMG);
@@ -440,49 +578,62 @@ S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash,
 }
 
 /*
-=for apidoc pad_add_name
+=for apidoc Am|PADOFFSET|pad_add_name_pvn|const char *namepv|STRLEN namelen|U32 flags|HV *typestash|HV *ourstash
+
+Allocates a place in the currently-compiling pad for a named lexical
+variable.  Stores the name and other metadata in the name part of the
+pad, and makes preparations to manage the variable's lexical scoping.
+Returns the offset of the allocated pad slot.
 
-Create a new name and associated PADMY SV in the current pad; return the
-offset.
-If C<typestash> is valid, the name is for a typed lexical; set the
-name's stash to that value.
-If C<ourstash> is valid, it's an our lexical, set the name's
-SvOURSTASH to that value
+I<namepv>/I<namelen> specify the variable's name, including leading sigil.
+If I<typestash> is non-null, the name is for a typed lexical, and this
+identifies the type.  If I<ourstash> is non-null, it's a lexical reference
+to a package variable, and this identifies the package.  The following
+flags can be OR'ed together:
 
-If fake, it means we're cloning an existing entry
+    padadd_OUR          redundantly specifies if it's a package var
+    padadd_STATE        variable will retain value persistently
+    padadd_NO_DUP_CHECK skip check for lexical shadowing
 
 =cut
 */
 
 PADOFFSET
-Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const 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;
 
-    PERL_ARGS_ASSERT_PAD_ADD_NAME;
+    PERL_ARGS_ASSERT_PAD_ADD_NAME_PVN;
 
-    if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK))
-       Perl_croak(aTHX_ "panic: pad_add_name illegal flag bits 0x%" UVxf,
+    if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK|padadd_UTF8_NAME))
+       Perl_croak(aTHX_ "panic: pad_add_name_pvn illegal flag bits 0x%" UVxf,
                   (UV)flags);
 
     namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
+    
+    if ((is_utf8 = ((flags & padadd_UTF8_NAME) != 0))) {
+        namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
+    }
 
-    /* Until we're using the length for real, cross check that we're being told
-       the truth.  */
-    PERL_UNUSED_ARG(len);
-    assert(strlen(name) == len);
+    sv_setpvn(namesv, namepv, namelen);
 
-    sv_setpv(namesv, name);
+    if (is_utf8) {
+        flags |= padadd_UTF8_NAME;
+        SvUTF8_on(namesv);
+    }
+    else
+        flags &= ~padadd_UTF8_NAME;
 
     if ((flags & padadd_NO_DUP_CHECK) == 0) {
        /* check for duplicate declaration */
        pad_check_dup(namesv, flags & padadd_OUR, ourstash);
     }
 
-    offset = pad_add_name_sv(namesv, flags, typestash, ourstash);
+    offset = pad_alloc_name(namesv, flags & ~padadd_UTF8_NAME, typestash, ourstash);
 
     /* not yet introduced */
     COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
@@ -494,38 +645,78 @@ Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags,
     /* if it's not a simple scalar, replace with an AV or HV */
     assert(SvTYPE(PL_curpad[offset]) == SVt_NULL);
     assert(SvREFCNT(PL_curpad[offset]) == 1);
-    if (*name == '@')
+    if (namelen != 0 && *namepv == '@')
        sv_upgrade(PL_curpad[offset], SVt_PVAV);
-    else if (*name == '%')
+    else if (namelen != 0 && *namepv == '%')
        sv_upgrade(PL_curpad[offset], SVt_PVHV);
     assert(SvPADMY(PL_curpad[offset]));
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                           "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
-                          (long)offset, name, PTR2UV(PL_curpad[offset])));
+                          (long)offset, SvPVX(namesv),
+                          PTR2UV(PL_curpad[offset])));
 
     return offset;
 }
 
+/*
+=for apidoc Am|PADOFFSET|pad_add_name_pv|const char *name|U32 flags|HV *typestash|HV *ourstash
+
+Exactly like L</pad_add_name_pvn>, but takes a nul-terminated string
+instead of a string/length pair.
 
+=cut
+*/
 
+PADOFFSET
+Perl_pad_add_name_pv(pTHX_ const char *name,
+                    const U32 flags, HV *typestash, HV *ourstash)
+{
+    PERL_ARGS_ASSERT_PAD_ADD_NAME_PV;
+    return pad_add_name_pvn(name, strlen(name), flags, typestash, ourstash);
+}
 
 /*
-=for apidoc pad_alloc
+=for apidoc Am|PADOFFSET|pad_add_name_sv|SV *name|U32 flags|HV *typestash|HV *ourstash
 
-Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
-the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
-for a slot which has no name and no active value.
+Exactly like L</pad_add_name_pvn>, but takes the name string in the form
+of an SV instead of a string/length pair.
+
+=cut
+*/
+
+PADOFFSET
+Perl_pad_add_name_sv(pTHX_ SV *name, U32 flags, HV *typestash, HV *ourstash)
+{
+    char *namepv;
+    STRLEN namelen;
+    PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
+    namepv = SvPV(name, namelen);
+    if (SvUTF8(name))
+        flags |= padadd_UTF8_NAME;
+    return pad_add_name_pvn(namepv, namelen, flags, typestash, ourstash);
+}
+
+/*
+=for apidoc Amx|PADOFFSET|pad_alloc|I32 optype|U32 tmptype
+
+Allocates a place in the currently-compiling pad,
+returning the offset of the allocated pad slot.
+No name is initially attached to the pad slot.
+I<tmptype> is a set of flags indicating the kind of pad entry required,
+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
+
+I<optype> should be an opcode indicating the type of operation that the
+pad entry is to support.  This doesn't affect operational semantics,
+but is used for debugging.
 
 =cut
 */
 
 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
  * or at least rationalise ??? */
-/* And flag whether the incoming name is UTF8 or 8 bit?
-   Could do this either with the +ve/-ve hack of the HV code, or expanding
-   the flag bits. Either way, this makes proper Unicode safe pad support.
-   NWC
-*/
 
 PADOFFSET
 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
@@ -538,14 +729,19 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
     ASSERT_CURPAD_ACTIVE("pad_alloc");
 
     if (AvARRAY(PL_comppad) != PL_curpad)
-       Perl_croak(aTHX_ "panic: pad_alloc");
+       Perl_croak(aTHX_ "panic: pad_alloc, %p!=%p",
+                  AvARRAY(PL_comppad), PL_curpad);
     if (PL_pad_reset_pending)
        pad_reset();
     if (tmptype & SVs_PADMY) {
+       /* For a my, simply push a null SV onto the end of PL_comppad. */
        sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
        retval = AvFILLp(PL_comppad);
     }
     else {
+       /* For a tmp, scan the pad from PL_padix upwards
+        * for a slot which has no name and no active value.
+        */
        SV * const * const names = AvARRAY(PL_comppad_name);
         const SSize_t names_fill = AvFILLp(PL_comppad_name);
        for (;;) {
@@ -580,15 +776,23 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 }
 
 /*
-=for apidoc pad_add_anon
+=for apidoc Am|PADOFFSET|pad_add_anon|CV *func|I32 optype
+
+Allocates a place in the currently-compiling pad (via L</pad_alloc>)
+for an anonymous function that is lexically scoped inside the
+currently-compiling function.
+The function I<func> is linked into the pad, and its C<CvOUTSIDE> link
+to the outer scope is weakened to avoid a reference loop.
 
-Add an anon code entry to the current compiling pad
+I<optype> should be an opcode indicating the type of operation that the
+pad entry is to support.  This doesn't affect operational semantics,
+but is used for debugging.
 
 =cut
 */
 
 PADOFFSET
-Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
+Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
 {
     dVAR;
     PADOFFSET ix;
@@ -602,38 +806,45 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
      * PERL_PADSEQ_INTRO */
     COP_SEQ_RANGE_LOW_set(name, 0);
     COP_SEQ_RANGE_HIGH_set(name, 0);
-    ix = pad_alloc(op_type, SVs_PADMY);
+    ix = pad_alloc(optype, SVs_PADMY);
     av_store(PL_comppad_name, ix, name);
     /* XXX DAPM use PL_curpad[] ? */
-    av_store(PL_comppad, ix, sv);
-    SvPADMY_on(sv);
+    if (SvTYPE(func) == SVt_PVCV || !CvOUTSIDE(func))
+       av_store(PL_comppad, ix, (SV*)func);
+    else {
+       SV *rv = newRV_inc((SV *)func);
+       sv_rvweaken(rv);
+       assert (SvTYPE(func) == SVt_PVFM);
+       av_store(PL_comppad, ix, rv);
+    }
+    SvPADMY_on((SV*)func);
 
     /* to avoid ref loops, we never have parent + child referencing each
      * other simultaneously */
-    if (CvOUTSIDE((const CV *)sv)) {
-       assert(!CvWEAKOUTSIDE((const CV *)sv));
-       CvWEAKOUTSIDE_on(MUTABLE_CV(sv));
-       SvREFCNT_dec(CvOUTSIDE(MUTABLE_CV(sv)));
+    if (CvOUTSIDE(func) && SvTYPE(func) == SVt_PVCV) {
+       assert(!CvWEAKOUTSIDE(func));
+       CvWEAKOUTSIDE_on(func);
+       SvREFCNT_dec(CvOUTSIDE(func));
     }
     return ix;
 }
 
-
-
 /*
 =for apidoc pad_check_dup
 
 Check for duplicate declarations: report any of:
+
      * a my in the current scope with the same name;
-     * an our (anywhere in the pad) with the same name and the same stash
-       as C<ourstash>
-C<is_our> indicates that the name to check is an 'our' declaration
+     * an our (anywhere in the pad) with the same name and the
+       same stash as C<ourstash>
+
+C<is_our> indicates that the name to check is an 'our' declaration.
 
 =cut
 */
 
 STATIC void
-S_pad_check_dup(pTHX_ SV *name, const U32 flags, const HV *ourstash)
+S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
 {
     dVAR;
     SV         **svp;
@@ -701,19 +912,22 @@ S_pad_check_dup(pTHX_ SV *name, const U32 flags, const HV *ourstash)
 
 
 /*
-=for apidoc pad_findmy
+=for apidoc Am|PADOFFSET|pad_findmy_pvn|const char *namepv|STRLEN namelen|U32 flags
 
-Given a lexical name, try to find its offset, first in the current pad,
-or failing that, in the pads of any lexically enclosing subs (including
-the complications introduced by eval). If the name is found in an outer pad,
-then a fake entry is added to the current pad.
-Returns the offset in the current pad, or NOT_IN_PAD on failure.
+Given the name of a lexical variable, find its position in the
+currently-compiling pad.
+I<namepv>/I<namelen> specify the variable's name, including leading sigil.
+I<flags> is reserved and must be zero.
+If it is not in the current pad but appears in the pad of any lexically
+enclosing scope, then a pseudo-entry for it is added in the current pad.
+Returns the offset in the current pad,
+or C<NOT_IN_PAD> if no such lexical is in scope.
 
 =cut
 */
 
 PADOFFSET
-Perl_pad_findmy(pTHX_ const char *name, STRLEN len, U32 flags)
+Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
 {
     dVAR;
     SV *out_sv;
@@ -722,27 +936,26 @@ Perl_pad_findmy(pTHX_ const char *name, STRLEN len, U32 flags)
     const AV *nameav;
     SV **name_svp;
 
-    PERL_ARGS_ASSERT_PAD_FINDMY;
+    PERL_ARGS_ASSERT_PAD_FINDMY_PVN;
 
-    pad_peg("pad_findmy");
+    pad_peg("pad_findmy_pvn");
 
-    if (flags)
-       Perl_croak(aTHX_ "panic: pad_findmy illegal flag bits 0x%" UVxf,
+    if (flags & ~padadd_UTF8_NAME)
+       Perl_croak(aTHX_ "panic: pad_findmy_pvn illegal flag bits 0x%" UVxf,
                   (UV)flags);
 
-    /* Yes, it is a bug (read work in progress) that we're not really using this
-       length parameter, and instead relying on strlen() later on. But I'm not
-       comfortable about changing the pad API piecemeal to use and rely on
-       lengths. This only exists to avoid an "unused parameter" warning.  */
-    if (len < 2) 
-       return NOT_IN_PAD;
+    if (flags & padadd_UTF8_NAME) {
+        bool is_utf8 = TRUE;
+        namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
 
-    /* But until we're using the length for real, cross check that we're being
-       told the truth.  */
-    assert(strlen(name) == len);
+        if (is_utf8)
+            flags |= padadd_UTF8_NAME;
+        else
+            flags &= ~padadd_UTF8_NAME;
+    }
 
-    offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
-               NULL, &out_sv, &out_flags);
+    offset = pad_findlex(namepv, namelen, flags,
+                PL_compcv, PL_cop_seqmax, 1, NULL, &out_sv, &out_flags);
     if ((PADOFFSET)offset != NOT_IN_PAD) 
        return offset;
 
@@ -757,7 +970,9 @@ Perl_pad_findmy(pTHX_ const char *name, STRLEN len, U32 flags)
        if (namesv && namesv != &PL_sv_undef
            && !SvFAKE(namesv)
            && (SvPAD_OUR(namesv))
-           && strEQ(SvPVX_const(namesv), name)
+           && 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
        )
            return offset;
@@ -766,9 +981,53 @@ Perl_pad_findmy(pTHX_ const char *name, STRLEN len, U32 flags)
 }
 
 /*
- * Returns the offset of a lexical $_, if there is one, at run time.
- * Used by the UNDERBAR XS macro.
- */
+=for apidoc Am|PADOFFSET|pad_findmy_pv|const char *name|U32 flags
+
+Exactly like L</pad_findmy_pvn>, but takes a nul-terminated string
+instead of a string/length pair.
+
+=cut
+*/
+
+PADOFFSET
+Perl_pad_findmy_pv(pTHX_ const char *name, U32 flags)
+{
+    PERL_ARGS_ASSERT_PAD_FINDMY_PV;
+    return pad_findmy_pvn(name, strlen(name), flags);
+}
+
+/*
+=for apidoc Am|PADOFFSET|pad_findmy_sv|SV *name|U32 flags
+
+Exactly like L</pad_findmy_pvn>, but takes the name string in the form
+of an SV instead of a string/length pair.
+
+=cut
+*/
+
+PADOFFSET
+Perl_pad_findmy_sv(pTHX_ SV *name, U32 flags)
+{
+    char *namepv;
+    STRLEN namelen;
+    PERL_ARGS_ASSERT_PAD_FINDMY_SV;
+    namepv = SvPV(name, namelen);
+    if (SvUTF8(name))
+        flags |= padadd_UTF8_NAME;
+    return pad_findmy_pvn(namepv, namelen, flags);
+}
+
+/*
+=for apidoc Amp|PADOFFSET|find_rundefsvoffset
+
+Find the position of the lexical C<$_> in the pad of the
+currently-executing function.  Returns the offset in the current pad,
+or C<NOT_IN_PAD> if there is no lexical C<$_> in scope (in which case
+the global one should be used instead).
+L</find_rundefsv> is likely to be more convenient.
+
+=cut
+*/
 
 PADOFFSET
 Perl_find_rundefsvoffset(pTHX)
@@ -776,14 +1035,19 @@ Perl_find_rundefsvoffset(pTHX)
     dVAR;
     SV *out_sv;
     int out_flags;
-    return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
+    return pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
            NULL, &out_sv, &out_flags);
 }
 
 /*
- * Returns a lexical $_, if there is one, at run time ; or the global one
- * otherwise.
- */
+=for apidoc Am|SV *|find_rundefsv
+
+Find and return the variable that is named C<$_> in the lexical scope
+of the currently-executing function.  This may be a lexical C<$_>,
+or will otherwise be the global one.
+
+=cut
+*/
 
 SV *
 Perl_find_rundefsv(pTHX)
@@ -792,18 +1056,35 @@ Perl_find_rundefsv(pTHX)
     int flags;
     PADOFFSET po;
 
-    po = pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
+    po = pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
            NULL, &namesv, &flags);
 
-    if (po == NOT_IN_PAD
-       || (SvFLAGS(namesv) & (SVpad_NAME|SVpad_OUR)) == (SVpad_NAME|SVpad_OUR))
+    if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
        return DEFSV;
 
     return PAD_SVl(po);
 }
 
+SV *
+Perl_find_rundefsv2(pTHX_ CV *cv, U32 seq)
+{
+    SV *namesv;
+    int flags;
+    PADOFFSET po;
+
+    PERL_ARGS_ASSERT_FIND_RUNDEFSV2;
+
+    po = pad_findlex("$_", 2, 0, cv, seq, 1,
+           NULL, &namesv, &flags);
+
+    if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
+       return DEFSV;
+
+    return AvARRAY((PAD*) (AvARRAY(CvPADLIST(cv))[CvDEPTH(cv)]))[po];
+}
+
 /*
-=for apidoc pad_findlex
+=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
 in the inner pads if it's found in an outer one.
@@ -834,8 +1115,8 @@ the parent pad.
 
 
 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)
+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;
@@ -845,11 +1126,16 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
 
     PERL_ARGS_ASSERT_PAD_FINDLEX;
 
+    if (flags & ~padadd_UTF8_NAME)
+       Perl_croak(aTHX_ "panic: pad_findlex illegal flag bits 0x%" UVxf,
+                  (UV)flags);
+
     *out_flags = 0;
 
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-       "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
-       PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
+       "Pad findlex cv=0x%"UVxf" searching \"%.*s\" seq=%d%s\n",
+                          PTR2UV(cv), (int)namelen, namepv, (int)seq,
+       out_capture ? " capturing" : "" ));
 
     /* first, search this pad */
 
@@ -861,7 +1147,9 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
        for (offset = AvFILLp(nameav); offset > 0; offset--) {
             const SV * const namesv = name_svp[offset];
            if (namesv && namesv != &PL_sv_undef
-                   && strEQ(SvPVX_const(namesv), name))
+                   && SvCUR(namesv) == namelen
+                    && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
+                                    flags & padadd_UTF8_NAME ? SVf_UTF8 : 0))
            {
                if (SvFAKE(namesv)) {
                    fake_offset = offset; /* in case we don't find a real one */
@@ -946,7 +1234,11 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                {
                    if (warn)
                        Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-                                      "Variable \"%s\" is not available", name);
+                                      "Variable \"%"SVf"\" is not available",
+                                       newSVpvn_flags(namepv, namelen,
+                                           SVs_TEMP |
+                                           (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
+
                    *out_capture = NULL;
                }
 
@@ -958,7 +1250,10 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                         && warn && ckWARN(WARN_CLOSURE)) {
                        newwarn = 0;
                        Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-                           "Variable \"%s\" will not stay shared", name);
+                           "Variable \"%"SVf"\" will not stay shared",
+                            newSVpvn_flags(namepv, namelen,
+                                SVs_TEMP |
+                                (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
                    }
 
                    if (fake_offset && CvANON(cv)
@@ -970,7 +1265,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                            "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
                            PTR2UV(cv)));
                        n = *out_name_sv;
-                       (void) pad_findlex(name, CvOUTSIDE(cv),
+                       (void) pad_findlex(namepv, namelen, flags, CvOUTSIDE(cv),
                            CvOUTSIDE_SEQ(cv),
                            newwarn, out_capture, out_name_sv, out_flags);
                        *out_name_sv = n;
@@ -987,14 +1282,17 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                        && !SvPAD_STATE(name_svp[offset]))
                    {
                        Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-                                      "Variable \"%s\" is not available", name);
+                                      "Variable \"%"SVf"\" is not available",
+                                       newSVpvn_flags(namepv, namelen,
+                                           SVs_TEMP |
+                                           (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
                        *out_capture = NULL;
                    }
                }
                if (!*out_capture) {
-                   if (*name == '@')
+                   if (namelen != 0 && *namepv == '@')
                        *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
-                   else if (*name == '%')
+                   else if (namelen != 0 && *namepv == '%')
                        *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
                    else
                        *out_capture = sv_newmortal();
@@ -1015,7 +1313,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
     new_capturep = out_capture ? out_capture :
                CvLATE(cv) ? NULL : &new_capture;
 
-    offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
+    offset = pad_findlex(namepv, namelen, flags, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
                new_capturep, out_name_sv, out_flags);
     if ((PADOFFSET)offset == NOT_IN_PAD)
        return NOT_IN_PAD;
@@ -1040,7 +1338,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
        PL_curpad = AvARRAY(PL_comppad);
 
        new_offset
-           = pad_add_name_sv(new_namesv,
+           = pad_alloc_name(new_namesv,
                              (SvPAD_STATE(*out_name_sv) ? padadd_STATE : 0),
                              SvPAD_TYPED(*out_name_sv)
                              ? SvSTASH(*out_name_sv) : NULL,
@@ -1080,18 +1378,17 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
     return new_offset;
 }
 
-
 #ifdef DEBUGGING
+
 /*
-=for apidoc pad_sv
+=for apidoc Am|SV *|pad_sv|PADOFFSET po
 
-Get the value at offset po in the current pad.
+Get the value at offset I<po> in the current (compiling or executing) pad.
 Use macro PAD_SV instead of calling this function directly.
 
 =cut
 */
 
-
 SV *
 Perl_pad_sv(pTHX_ PADOFFSET po)
 {
@@ -1107,11 +1404,10 @@ Perl_pad_sv(pTHX_ PADOFFSET po)
     return PL_curpad[po];
 }
 
-
 /*
-=for apidoc pad_setsv
+=for apidoc Am|void|pad_setsv|PADOFFSET po|SV *sv
 
-Set the entry at offset po in the current pad to sv.
+Set the value at offset I<po> in the current (compiling or executing) pad.
 Use the macro PAD_SETSV() rather than calling this function directly.
 
 =cut
@@ -1132,12 +1428,11 @@ Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
     );
     PL_curpad[po] = sv;
 }
-#endif
-
 
+#endif /* DEBUGGING */
 
 /*
-=for apidoc pad_block_start
+=for apidoc m|void|pad_block_start|int full
 
 Update the pad compilation state variables on entry to a new block
 
@@ -1170,11 +1465,12 @@ Perl_pad_block_start(pTHX_ int full)
     PL_pad_reset_pending = FALSE;
 }
 
-
 /*
-=for apidoc intro_my
+=for apidoc m|U32|intro_my
 
-"Introduce" my variables to visible status.
+"Introduce" my variables to visible status.  This is called during parsing
+at the end of each statement to make lexical variables visible to
+subsequent statements.
 
 =cut
 */
@@ -1221,7 +1517,7 @@ Perl_intro_my(pTHX)
 }
 
 /*
-=for apidoc pad_leavemy
+=for apidoc m|void|pad_leavemy
 
 Cleanup at end of scope during compilation: set the max seq number for
 lexicals in this scope and warn of any lexicals that never got introduced.
@@ -1270,9 +1566,8 @@ Perl_pad_leavemy(pTHX)
            "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
 }
 
-
 /*
-=for apidoc pad_swipe
+=for apidoc m|void|pad_swipe|PADOFFSET po|bool refadjust
 
 Abandon the tmp in the current pad at offset po and replace with a
 new one.
@@ -1288,9 +1583,11 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
     if (!PL_curpad)
        return;
     if (AvARRAY(PL_comppad) != PL_curpad)
-       Perl_croak(aTHX_ "panic: pad_swipe curpad");
-    if (!po)
-       Perl_croak(aTHX_ "panic: pad_swipe po");
+       Perl_croak(aTHX_ "panic: pad_swipe curpad, %p!=%p",
+                  AvARRAY(PL_comppad), PL_curpad);
+    if (!po || ((SSize_t)po) > AvFILLp(PL_comppad))
+       Perl_croak(aTHX_ "panic: pad_swipe po=%ld, fill=%ld",
+                  (long)po, (long)AvFILLp(PL_comppad));
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
                "Pad 0x%"UVxf"[0x%"UVxf"] swipe:   %ld\n",
@@ -1314,9 +1611,8 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
        PL_padix = po - 1;
 }
 
-
 /*
-=for apidoc pad_reset
+=for apidoc m|void|pad_reset
 
 Mark all the current temporaries for reuse
 
@@ -1335,7 +1631,8 @@ S_pad_reset(pTHX)
     dVAR;
 #ifdef USE_BROKEN_PAD_RESET
     if (AvARRAY(PL_comppad) != PL_curpad)
-       Perl_croak(aTHX_ "panic: pad_reset curpad");
+       Perl_croak(aTHX_ "panic: pad_reset curpad, %p!=%p",
+                  AvARRAY(PL_comppad), PL_curpad);
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
            "Pad 0x%"UVxf"[0x%"UVxf"] reset:     padix %ld -> %ld",
@@ -1356,14 +1653,17 @@ S_pad_reset(pTHX)
     PL_pad_reset_pending = FALSE;
 }
 
-
 /*
-=for apidoc pad_tidy
+=for apidoc Amx|void|pad_tidy|padtidy_type type
+
+Tidy up a pad at the end of compilation of the code to which it belongs.
+Jobs performed here are: remove most stuff from the pads of anonsub
+prototypes; give it a @_; mark temporaries as such.  I<type> indicates
+the kind of subroutine:
 
-Tidy up a pad after we've finished compiling it:
-    * remove most stuff from the pads of anonsub prototypes;
-    * give it a @_;
-    * mark tmps as such.
+    padtidy_SUB        ordinary subroutine
+    padtidy_SUBCLONE   prototype for lexical closure
+    padtidy_FORMAT     format
 
 =cut
 */
@@ -1398,6 +1698,7 @@ 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);
+               CvHASEVAL_on(cv);
            }
        }
     }
@@ -1468,9 +1769,8 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
     PL_curpad = AvARRAY(PL_comppad);
 }
 
-
 /*
-=for apidoc pad_free
+=for apidoc m|void|pad_free|PADOFFSET po
 
 Free the SV at offset po in the current pad.
 
@@ -1486,7 +1786,8 @@ Perl_pad_free(pTHX_ PADOFFSET po)
     if (!PL_curpad)
        return;
     if (AvARRAY(PL_comppad) != PL_curpad)
-       Perl_croak(aTHX_ "panic: pad_free curpad");
+       Perl_croak(aTHX_ "panic: pad_free curpad, %p!=%p",
+                  AvARRAY(PL_comppad), PL_curpad);
     if (!po)
        Perl_croak(aTHX_ "panic: pad_free po");
 
@@ -1496,16 +1797,14 @@ Perl_pad_free(pTHX_ PADOFFSET po)
     );
 
     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
-       SvPADTMP_off(PL_curpad[po]);
+       SvFLAGS(PL_curpad[po]) &= ~SVs_PADTMP; /* also clears SVs_PADSTALE */
     }
     if ((I32)po < PL_padix)
        PL_padix = po - 1;
 }
 
-
-
 /*
-=for apidoc do_dump_pad
+=for apidoc m|void|do_dump_pad|I32 level|PerlIO *file|PADLIST *padlist|int full
 
 Dump the contents of a padlist
 
@@ -1575,17 +1874,16 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
     }
 }
 
-
+#ifdef DEBUGGING
 
 /*
-=for apidoc cv_dump
+=for apidoc m|void|cv_dump|CV *cv|const char *title
 
 dump the contents of a CV
 
 =cut
 */
 
-#ifdef DEBUGGING
 STATIC void
 S_cv_dump(pTHX_ const CV *cv, const char *title)
 {
@@ -1615,18 +1913,17 @@ S_cv_dump(pTHX_ const CV *cv, const char *title)
                    "    PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
     do_dump_pad(1, Perl_debug_log, padlist, 1);
 }
-#endif /* DEBUGGING */
-
-
-
 
+#endif /* DEBUGGING */
 
 /*
-=for apidoc cv_clone
+=for apidoc Am|CV *|cv_clone|CV *proto
 
-Clone a CV: make a new CV which points to the same code etc, but which
-has a newly-created pad built by copying the prototype pad and capturing
-any outer lexicals.
+Clone a CV, making a lexical closure.  I<proto> supplies the prototype
+of the function: its code, pad structure, and other attributes.
+The prototype is combined with a capture of outer lexicals to which the
+code refers, which are taken from the currently-executing instance of
+the immediately surrounding code.
 
 =cut
 */
@@ -1652,43 +1949,55 @@ Perl_cv_clone(pTHX_ CV *proto)
 
     assert(!CvUNIQUE(proto));
 
-    /* Since cloneable anon subs can be nested, CvOUTSIDE may point
+    /* 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.
+     * 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 */
+     */
 
-    outside = CvOUTSIDE(proto);
-    if (outside && CvCLONE(outside) && ! CvCLONED(outside))
+    if (SvTYPE(proto) == SVt_PVCV)
        outside = find_runcv(NULL);
+    else {
+       outside = CvOUTSIDE(proto);
+       if (CvCLONE(outside) && ! CvCLONED(outside)) {
+           CV * const runcv = find_runcv_where(
+               FIND_RUNCV_root_eq, (void *)CvROOT(outside), NULL
+           );
+           if (runcv) outside = runcv;
+       }
+    }
     depth = CvDEPTH(outside);
     assert(depth || SvTYPE(proto) == SVt_PVFM);
     if (!depth)
        depth = 1;
-    assert(CvPADLIST(outside));
+    assert(CvPADLIST(outside) || SvTYPE(proto) == SVt_PVFM);
 
     ENTER;
     SAVESPTR(PL_compcv);
 
     cv = PL_compcv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
-    CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC);
+    CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC
+                                   |CVf_SLABBED);
     CvCLONED_on(cv);
 
-#ifdef USE_ITHREADS
-    CvFILE(cv)         = CvISXSUB(proto) ? CvFILE(proto)
-                                         : savepv(CvFILE(proto));
-#else
-    CvFILE(cv)         = CvFILE(proto);
-#endif
+    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);
-    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);
 
     CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
 
@@ -1698,21 +2007,23 @@ Perl_cv_clone(pTHX_ CV *proto)
 
     PL_curpad = AvARRAY(PL_comppad);
 
-    outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
+    outpad = CvPADLIST(outside)
+       ? AvARRAY(AvARRAY(CvPADLIST(outside))[depth])
+       : 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 (SvFAKE(namesv)) {   /* lexical from outside? */
-               sv = outpad[PARENT_PAD_INDEX(namesv)];
-               assert(sv);
-               /* formats may have an inactive parent,
+               /* formats may have an inactive, or even undefined, parent,
                   while my $x if $false can leave an active var marked as
                   stale. And state vars are always available */
-               if (SvPADSTALE(sv) && !SvPAD_STATE(namesv)) {
+               if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)])
+                || (  SvPADSTALE(sv) && !SvPAD_STATE(namesv)
+                   && !CvDEPTH(outside))  ) {
                    Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-                                  "Variable \"%s\" is not available", SvPVX_const(namesv));
+                                  "Variable \"%"SVf"\" is not available", namesv);
                    sv = NULL;
                }
                else 
@@ -1772,9 +2083,8 @@ Perl_cv_clone(pTHX_ CV *proto)
     return cv;
 }
 
-
 /*
-=for apidoc pad_fixup_inner_anons
+=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
@@ -1801,17 +2111,29 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
        if (namesv && namesv != &PL_sv_undef
            && *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;
+         }
+         else { /* format reference */
+           SV * const rv = curpad[ix];
+           CV *innercv;
+           if (!SvOK(rv)) continue;
+           assert(SvROK(rv));
+           assert(SvWEAKREF(rv));
+           innercv = (CV *)SvRV(rv);
+           assert(!CvWEAKOUTSIDE(innercv));
+           SvREFCNT_dec(CvOUTSIDE(innercv));
+           CvOUTSIDE(innercv) = (CV *)SvREFCNT_inc_simple_NN(new_cv);
+         }
        }
     }
 }
 
-
 /*
-=for apidoc pad_push
+=for apidoc m|void|pad_push|PADLIST *padlist|int depth
 
 Push a new pad frame onto the padlist, unless there's already a pad at
 this depth, in which case don't bother creating a new one.  Then give
@@ -1877,6 +2199,15 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
     }
 }
 
+/*
+=for apidoc Am|HV *|pad_compname_type|PADOFFSET po
+
+Looks up the type of the lexical variable at position I<po> in the
+currently-compiling pad.  If the variable is typed, the stash of the
+class to which it is typed is returned.  If not, C<NULL> is returned.
+
+=cut
+*/
 
 HV *
 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
@@ -1893,8 +2224,16 @@ Perl_pad_compname_type(pTHX_ const PADOFFSET po)
 
 #  define av_dup_inc(s,t)      MUTABLE_AV(sv_dup_inc((const SV *)s,t))
 
+/*
+=for apidoc m|AV *|padlist_dup|AV *srcpad|CLONE_PARAMS *param
+
+Duplicates a pad.
+
+=cut
+*/
+
 AV *
-Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
+Perl_padlist_dup(pTHX_ AV *srcpad, CLONE_PARAMS *param)
 {
     AV *dstpad;
     PERL_ARGS_ASSERT_PADLIST_DUP;
@@ -1902,15 +2241,9 @@ Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
     if (!srcpad)
        return NULL;
 
-    assert(!AvREAL(srcpad));
-
     if (param->flags & CLONEf_COPY_STACKS
        || SvREFCNT(AvARRAY(srcpad)[1]) > 1) {
-       /* XXX padlists are real, but pretend to be not */
-       AvREAL_on(srcpad);
        dstpad = av_dup_inc(srcpad, param);
-       AvREAL_off(srcpad);
-       AvREAL_off(dstpad);
        assert (SvREFCNT(AvARRAY(srcpad)[1]) == 1);
     } else {
        /* CvDEPTH() on our subroutine will be set to 0, so there's no need
@@ -1924,17 +2257,16 @@ Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
        SV **names;
        SV **pad1a;
        AV *args;
-       /* look for it in the table first.
-          I *think* that it shouldn't be possible to find it there.
-          Well, except for how Perl_sv_compile_2op() "works" :-(   */
+       /* Look for it in the table first, as the padlist may have ended up
+          as an element of @DB::args (or theoretically even @_), so it may
+          may have been cloned already. */
        dstpad = (AV*)ptr_table_fetch(PL_ptr_table, srcpad);
 
        if (dstpad)
-           return dstpad;
+           return (AV *)SvREFCNT_inc_simple_NN(dstpad);
 
        dstpad = newAV();
        ptr_table_store(PL_ptr_table, srcpad, dstpad);
-       AvREAL_off(dstpad);
        av_extend(dstpad, 1);
        AvARRAY(dstpad)[0] = MUTABLE_SV(av_dup_inc(AvARRAY(srcpad)[0], param));
        names = AvARRAY(AvARRAY(dstpad)[0]);
@@ -2010,14 +2342,14 @@ Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
     return dstpad;
 }
 
-#endif
+#endif /* USE_ITHREADS */
 
 /*
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */