perlhist: add 5.15.0 and 5.14.1 entries

[perl5.git] / pad.c

diff --git a/pad.c b/pad.c
index 7fb8921..b5ee2bf 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -1,16 +1,21 @@
 /*    pad.c
  *
 /*    pad.c
  *

- *    Copyright (C) 2002, 2003, 2004, 2005 by Larry Wall and others
+ *    Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ *    by Larry Wall and others

  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.

+ */
+
+/*
+ *  'Anyway: there was this Mr. Frodo left an orphan and stranded, as you
+ *   might say, among those queer Bucklanders, being brought up anyhow in
+ *   Brandy Hall.  A regular warren, by all accounts.  Old Master Gorbadoc
+ *   never had fewer than a couple of hundred relations in the place.
+ *   Mr. Bilbo never did a kinder deed than when he brought the lad back
+ *   to live among decent folk.'                           --the Gaffer

  *
  *

- *  "Anyway: there was this Mr Frodo left an orphan and stranded, as you
- *  might say, among those queer Bucklanders, being brought up anyhow in
- *  Brandy Hall. A regular warren, by all accounts. Old Master Gorbadoc
- *  never had fewer than a couple of hundred relations in the place. Mr
- *  Bilbo never did a kinder deed than when he brought the lad back to
- *  live among decent folk." --the Gaffer
+ *     [p.23 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]

  */
 
 /* XXX DAPM
  */
 
 /* XXX DAPM


@@ -72,19 +77,29 @@ but only by their index allocated at compile time (which is usually
 in PL_op->op_targ), wasting a name SV for them doesn't make sense.
 
 The SVs in the names AV have their PV being the name of the variable.
 in PL_op->op_targ), wasting a name SV for them doesn't make sense.
 
 The SVs in the names AV have their PV being the name of the variable.

-NV+1..IV inclusive is a range of cop_seq numbers for which the name is
-valid.  For typed lexicals name SV is SVt_PVMG and SvSTASH points at the
-type.  For C<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
-stash of the associated global (so that duplicate C<our> declarations in the
-same package can be detected).  SvCUR is sometimes hijacked to
-store the generation number during compilation.
+xlow+1..xhigh inclusive in the NV union is a range of cop_seq numbers for
+which the name is valid (accessed through the macros COP_SEQ_RANGE_LOW and
+_HIGH).  During compilation, these fields may hold the special value
+PERL_PADSEQ_INTRO to indicate various stages:
+
+   COP_SEQ_RANGE_LOW        _HIGH
+   -----------------        -----
+   PERL_PADSEQ_INTRO            0   variable not yet introduced:   { my ($x
+   valid-seq#   PERL_PADSEQ_INTRO   variable in scope:             { my ($x)
+   valid-seq#          valid-seq#   compilation of scope complete: { my ($x) }
+
+For typed lexicals name SV is SVt_PVMG and SvSTASH
+points at the type.  For C<our> lexicals, the type is also SVt_PVMG, with the
+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.

 
 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 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 NVX and IVX to store a cop_seq range, since it is
-in scope throughout. Instead IVX stores some flags containing info about
+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

 the real lexical (is it declared in an anon, and is it capable of being
 the real lexical (is it declared in an anon, and is it capable of being

-instantiated multiple times?), and for fake ANONs, NVX contains the index
+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
 cloning quicker.
 
 within the parent's pad where the lexical's value is stored, to make
 cloning quicker.
 


@@ -96,12 +111,14 @@ become so if C<my sub foo {}> is implemented.)
 Note that formats are treated as anon subs, and are cloned each time
 write is called (if necessary).
 
 Note that formats are treated as anon subs, and are cloned each time
 write is called (if necessary).
 

-The flag SVf_PADSTALE is cleared on lexicals each time the my() is executed,
+The flag SVs_PADSTALE is cleared on lexicals each time the my() is executed,

 and set on scope exit. This allows the 'Variable $x is not available' warning
 to be generated in evals, such as 
 
     { my $x = 1; sub f { eval '$x'} } f();
 
 and set on scope exit. This allows the 'Variable $x is not available' warning
 to be generated in evals, such as 
 
     { my $x = 1; sub f { eval '$x'} } f();
 

+For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'
+

 =cut
 */
 
 =cut
 */
 


@@ -109,11 +126,28 @@ to be generated in evals, such as
 #include "EXTERN.h"
 #define PERL_IN_PAD_C
 #include "perl.h"
 #include "EXTERN.h"
 #define PERL_IN_PAD_C
 #include "perl.h"

+#include "keywords.h"
+
+#define COP_SEQ_RANGE_LOW_set(sv,val)          \
+  STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
+#define COP_SEQ_RANGE_HIGH_set(sv,val)         \
+  STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END

 
 

+#define PARENT_PAD_INDEX_set(sv,val)           \
+  STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
+#define PARENT_FAKELEX_FLAGS_set(sv,val)       \
+  STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END

 
 

-#define PAD_MAX 999999999
+#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

 
 /*
 =for apidoc pad_new
 
 /*
 =for apidoc pad_new


@@ -132,7 +166,9 @@ can be OR'ed together:
 PADLIST *
 Perl_pad_new(pTHX_ int flags)
 {
 PADLIST *
 Perl_pad_new(pTHX_ int flags)
 {

+    dVAR;

     AV *padlist, *padname, *pad;
     AV *padlist, *padname, *pad;

+    SV **ary;

 
     ASSERT_CURPAD_LEGAL("pad_new");
 
 
     ASSERT_CURPAD_LEGAL("pad_new");
 


@@ -152,9 +188,9 @@ Perl_pad_new(pTHX_ int flags)
            SAVEI32(PL_comppad_name_fill);
            SAVEI32(PL_min_intro_pending);
            SAVEI32(PL_max_intro_pending);
            SAVEI32(PL_comppad_name_fill);
            SAVEI32(PL_min_intro_pending);
            SAVEI32(PL_max_intro_pending);

-           SAVEI32(PL_cv_has_eval);
+           SAVEBOOL(PL_cv_has_eval);

            if (flags & padnew_SAVESUB) {
            if (flags & padnew_SAVESUB) {

-               SAVEI32(PL_pad_reset_pending);
+               SAVEBOOL(PL_pad_reset_pending);

            }
        }
     }
            }
        }
     }


@@ -174,23 +210,31 @@ Perl_pad_new(pTHX_ int flags)
         */
 
         AV * const a0 = newAV();                       /* will be @_ */
         */
 
         AV * const a0 = newAV();                       /* will be @_ */

-       av_extend(a0, 0);
-       av_store(pad, 0, (SV*)a0);
+       av_store(pad, 0, MUTABLE_SV(a0));

        AvREIFY_only(a0);
     }
     else {
        AvREIFY_only(a0);
     }
     else {

-       av_store(pad, 0, Nullsv);
+       av_store(pad, 0, NULL);

     }
 
     AvREAL_off(padlist);
     }
 
     AvREAL_off(padlist);

-    av_store(padlist, 0, (SV*)padname);
-    av_store(padlist, 1, (SV*)pad);
+    /* 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
+       up, so we inline the allocation of the array here.  */
+    Newx(ary, 2, SV*);
+    AvFILLp(padlist) = 1;
+    AvMAX(padlist) = 1;
+    AvALLOC(padlist) = ary;
+    AvARRAY(padlist) = ary;
+    ary[0] = MUTABLE_SV(padname);
+    ary[1] = MUTABLE_SV(pad);

 
     /* ... then update state variables */
 
 
     /* ... then update state variables */
 

-    PL_comppad_name    = (AV*)(*av_fetch(padlist, 0, FALSE));
-    PL_comppad         = (AV*)(*av_fetch(padlist, 1, FALSE));
-    PL_curpad          = AvARRAY(PL_comppad);
+    PL_comppad_name    = padname;
+    PL_comppad         = pad;
+    PL_curpad          = AvARRAY(pad);

 
     if (! (flags & padnew_CLONE)) {
        PL_comppad_name_fill = 0;
 
     if (! (flags & padnew_CLONE)) {
        PL_comppad_name_fill = 0;


@@ -210,106 +254,190 @@ Perl_pad_new(pTHX_ int flags)
     return (PADLIST*)padlist;
 }
 
     return (PADLIST*)padlist;
 }
 

+

 /*
 /*

-=for apidoc pad_undef
+=head1 Embedding Functions

 
 

-Free the padlist associated with a CV.
-If parts of it happen to be current, we null the relevant
-PL_*pad* global vars so that we don't have any dangling references left.
-We also repoint the CvOUTSIDE of any about-to-be-orphaned
-inner subs to the outer of this cv.
+=for apidoc cv_undef

 
 

-(This function should really be called pad_free, but the name was already
-taken)
+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.

 
 =cut
 */
 
 void
 
 =cut
 */
 
 void

-Perl_pad_undef(pTHX_ CV* cv)
+Perl_cv_undef(pTHX_ CV *cv)

 {
 {

-    I32 ix;
-    const PADLIST * const padlist = CvPADLIST(cv);
+    dVAR;
+    const PADLIST *padlist = CvPADLIST(cv);

 
 

-    if (!padlist)
-       return;
-    if (SvIS_FREED(padlist)) /* may be during global destruction */
-       return;
+    PERL_ARGS_ASSERT_CV_UNDEF;

 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,

-         "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf"\n",
-           PTR2UV(cv), PTR2UV(padlist))
+         "CV undef: cv=0x%"UVxf" comppad=0x%"UVxf"\n",
+           PTR2UV(cv), PTR2UV(PL_comppad))

     );
 
     );
 

-    /* detach any '&' anon children in the pad; if afterwards they
-     * are still live, fix up their CvOUTSIDEs to point to our outside,
-     * bypassing us. */
-    /* XXX DAPM for efficiency, we should only do this if we know we have
-     * children, or integrate this loop with general cleanup */
-
-    if (!PL_dirty) { /* don't bother during global destruction */
-       CV * const outercv = CvOUTSIDE(cv);
-        const U32 seq = CvOUTSIDE_SEQ(cv);
-       AV *  const comppad_name = (AV*)AvARRAY(padlist)[0];
-       SV ** const namepad = AvARRAY(comppad_name);
-       AV *  const comppad = (AV*)AvARRAY(padlist)[1];
-       SV ** const curpad = AvARRAY(comppad);
-       for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
-           SV * const namesv = namepad[ix];
-           if (namesv && namesv != &PL_sv_undef
-               && *SvPVX_const(namesv) == '&')
-           {
-               CV * const innercv = (CV*)curpad[ix];
-               U32 inner_rc = SvREFCNT(innercv);
-               assert(inner_rc);
-               namepad[ix] = Nullsv;
-               SvREFCNT_dec(namesv);
-
-               if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
-                   curpad[ix] = Nullsv;
-                   SvREFCNT_dec(innercv);
-                   inner_rc--;
-               }
-               if (inner_rc /* in use, not just a prototype */
-                   && CvOUTSIDE(innercv) == cv)
-               {
-                   assert(CvWEAKOUTSIDE(innercv));
-                   /* don't relink to grandfather if he's being freed */
-                   if (outercv && SvREFCNT(outercv)) {
-                       CvWEAKOUTSIDE_off(innercv);
-                       CvOUTSIDE(innercv) = outercv;
-                       CvOUTSIDE_SEQ(innercv) = seq;
-                       (void)SvREFCNT_inc(outercv);
-                   }
-                   else {
-                       CvOUTSIDE(innercv) = Nullcv;
+#ifdef USE_ITHREADS
+    if (CvFILE(cv) && !CvISXSUB(cv)) {
+       /* for XSUBs CvFILE point directly to static memory; __FILE__ */
+       Safefree(CvFILE(cv));
+    }
+    CvFILE(cv) = NULL;
+#endif
+
+    if (!CvISXSUB(cv) && CvROOT(cv)) {
+       if (SvTYPE(cv) == SVt_PVCV && CvDEPTH(cv))
+           Perl_croak(aTHX_ "Can't undef active subroutine");
+       ENTER;
+
+       PAD_SAVE_SETNULLPAD();
+
+       op_free(CvROOT(cv));
+       CvROOT(cv) = NULL;
+       CvSTART(cv) = NULL;
+       LEAVE;
+    }
+    SvPOK_off(MUTABLE_SV(cv));         /* forget prototype */
+    CvGV_set(cv, NULL);
+
+    /* This statement and the subsequence if block was pad_undef().  */
+    pad_peg("pad_undef");
+
+    if (padlist && !SvIS_FREED(padlist) /* may be during global destruction */
+       ) {
+       I32 ix;
+
+       /* Free the padlist associated with a CV.
+          If parts of it happen to be current, we null the relevant PL_*pad*
+          global vars so that we don't have any dangling references left.
+          We also repoint the CvOUTSIDE of any about-to-be-orphaned inner
+          subs to the outer of this cv.  */
+
+       DEBUG_X(PerlIO_printf(Perl_debug_log,
+                             "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf" comppad=0x%"UVxf"\n",
+                             PTR2UV(cv), PTR2UV(padlist), PTR2UV(PL_comppad))
+               );
+
+       /* detach any '&' anon children in the pad; if afterwards they
+        * are still live, fix up their CvOUTSIDEs to point to our outside,
+        * bypassing us. */
+       /* XXX DAPM for efficiency, we should only do this if we know we have
+        * children, or integrate this loop with general cleanup */
+
+       if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */
+           CV * const outercv = CvOUTSIDE(cv);
+           const U32 seq = CvOUTSIDE_SEQ(cv);
+           AV *  const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
+           SV ** const namepad = AvARRAY(comppad_name);
+           AV *  const comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
+           SV ** const curpad = AvARRAY(comppad);
+           for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
+               SV * const namesv = namepad[ix];
+               if (namesv && namesv != &PL_sv_undef
+                   && *SvPVX_const(namesv) == '&')
+                   {
+                       CV * const innercv = MUTABLE_CV(curpad[ix]);
+                       U32 inner_rc = SvREFCNT(innercv);
+                       assert(inner_rc);
+                       namepad[ix] = NULL;
+                       SvREFCNT_dec(namesv);
+
+                       if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
+                           curpad[ix] = NULL;
+                           SvREFCNT_dec(innercv);
+                           inner_rc--;
+                       }
+
+                       /* in use, not just a prototype */
+                       if (inner_rc && (CvOUTSIDE(innercv) == cv)) {
+                           assert(CvWEAKOUTSIDE(innercv));
+                           /* don't relink to grandfather if he's being freed */
+                           if (outercv && SvREFCNT(outercv)) {
+                               CvWEAKOUTSIDE_off(innercv);
+                               CvOUTSIDE(innercv) = outercv;
+                               CvOUTSIDE_SEQ(innercv) = seq;
+                               SvREFCNT_inc_simple_void_NN(outercv);
+                           }
+                           else {
+                               CvOUTSIDE(innercv) = NULL;
+                           }
+                       }

                    }
                    }

+           }
+       }

 
 

+       ix = AvFILLp(padlist);
+       while (ix > 0) {
+           SV* const sv = AvARRAY(padlist)[ix--];
+           if (sv) {
+               if (sv == (const SV *)PL_comppad) {
+                   PL_comppad = NULL;
+                   PL_curpad = NULL;

                }
                }

-
+               SvREFCNT_dec(sv);

            }
        }
            }
        }

+       {
+           SV *const sv = AvARRAY(padlist)[0];
+           if (sv == (const SV *)PL_comppad_name)
+               PL_comppad_name = NULL;
+           SvREFCNT_dec(sv);
+       }
+       SvREFCNT_dec(MUTABLE_SV(CvPADLIST(cv)));
+       CvPADLIST(cv) = NULL;

     }
 
     }
 

-    ix = AvFILLp(padlist);
-    while (ix >= 0) {
-       SV* const sv = AvARRAY(padlist)[ix--];
-       if (!sv)
-           continue;
-       if (sv == (SV*)PL_comppad_name)
-           PL_comppad_name = NULL;
-       else if (sv == (SV*)PL_comppad) {
-           PL_comppad = Null(PAD*);
-           PL_curpad = Null(SV**);
-       }
-       SvREFCNT_dec(sv);
+
+    /* remove CvOUTSIDE unless this is an undef rather than a free */
+    if (!SvREFCNT(cv) && CvOUTSIDE(cv)) {
+       if (!CvWEAKOUTSIDE(cv))
+           SvREFCNT_dec(CvOUTSIDE(cv));
+       CvOUTSIDE(cv) = NULL;
+    }
+    if (CvCONST(cv)) {
+       SvREFCNT_dec(MUTABLE_SV(CvXSUBANY(cv).any_ptr));
+       CvCONST_off(cv);

     }
     }

-    SvREFCNT_dec((SV*)CvPADLIST(cv));
-    CvPADLIST(cv) = Null(PADLIST*);
+    if (CvISXSUB(cv) && CvXSUB(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);

 }
 
 }
 

+static PADOFFSET
+S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash,
+                 HV *ourstash)
+{
+    dVAR;
+    const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
+
+    PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;

 
 

+    ASSERT_CURPAD_ACTIVE("pad_add_name");
+
+    if (typestash) {
+       assert(SvTYPE(namesv) == SVt_PVMG);
+       SvPAD_TYPED_on(namesv);
+       SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
+    }
+    if (ourstash) {
+       SvPAD_OUR_on(namesv);
+       SvOURSTASH_set(namesv, ourstash);
+       SvREFCNT_inc_simple_void_NN(ourstash);
+    }
+    else if (flags & padadd_STATE) {
+       SvPAD_STATE_on(namesv);
+    }

 
 

+    av_store(PL_comppad_name, offset, namesv);
+    return offset;
+}

 
 /*
 =for apidoc pad_add_name
 
 /*
 =for apidoc pad_add_name


@@ -319,7 +447,7 @@ 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
 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

-GvSTASH to that value
+SvOURSTASH to that value

 
 If fake, it means we're cloning an existing entry
 
 
 If fake, it means we're cloning an existing entry
 


@@ -327,53 +455,53 @@ If fake, it means we're cloning an existing entry
 */
 
 PADOFFSET
 */
 
 PADOFFSET

-Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake)
+Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags,
+                 HV *typestash, HV *ourstash)

 {
 {

-    const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
-    SV* const namesv = NEWSV(1102, 0);
+    dVAR;
+    PADOFFSET offset;
+    SV *namesv;

 
 

-    ASSERT_CURPAD_ACTIVE("pad_add_name");
+    PERL_ARGS_ASSERT_PAD_ADD_NAME;
+
+    if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK))
+       Perl_croak(aTHX_ "panic: pad_add_name illegal flag bits 0x%" UVxf,
+                  (UV)flags);
+
+    namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);

 
 

+    /* 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_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV);

     sv_setpv(namesv, name);
 
     sv_setpv(namesv, name);
 

-    if (typestash) {
-       SvFLAGS(namesv) |= SVpad_TYPED;
-       SvSTASH_set(namesv, (HV*)SvREFCNT_inc((SV*) typestash));
-    }
-    if (ourstash) {
-       SvFLAGS(namesv) |= SVpad_OUR;
-       GvSTASH(namesv) = ourstash;
-       Perl_sv_add_backref(aTHX_ (SV*)ourstash, namesv);
+    if ((flags & padadd_NO_DUP_CHECK) == 0) {
+       /* check for duplicate declaration */
+       pad_check_dup(namesv, flags & padadd_OUR, ourstash);

     }
 
     }
 

-    av_store(PL_comppad_name, offset, namesv);
-    if (fake) {
-       SvFAKE_on(namesv);
-       DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-           "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
-    }
-    else {
-       /* not yet introduced */
-       SvNV_set(namesv, (NV)PAD_MAX);  /* min */
-       SvIV_set(namesv, 0);            /* max */
-
-       if (!PL_min_intro_pending)
-           PL_min_intro_pending = offset;
-       PL_max_intro_pending = offset;
-       /* if it's not a simple scalar, replace with an AV or HV */
-       /* XXX DAPM since slot has been allocated, replace
-        * av_store with PL_curpad[offset] ? */
-       if (*name == '@')
-           av_store(PL_comppad, offset, (SV*)newAV());
-       else if (*name == '%')
-           av_store(PL_comppad, offset, (SV*)newHV());
-       SvPADMY_on(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])));
-    }
+    offset = pad_add_name_sv(namesv, flags, typestash, ourstash);
+
+    /* not yet introduced */
+    COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
+    COP_SEQ_RANGE_HIGH_set(namesv, 0);
+
+    if (!PL_min_intro_pending)
+       PL_min_intro_pending = offset;
+    PL_max_intro_pending = offset;
+    /* 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 == '@')
+       sv_upgrade(PL_curpad[offset], SVt_PVAV);
+    else if (*name == '%')
+       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])));

 
     return offset;
 }
 
     return offset;
 }


@@ -396,17 +524,17 @@ for a slot which has no name and no active value.
 /* 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.
 /* And flag whether the incoming name is UTF8 or 8 bit?
    Could do this either with the +ve/-ve hack of the HV code, or expanding
    the flag bits. Either way, this makes proper Unicode safe pad support.

-   Also could change the sv structure to make the NV a union with 2 U32s,
-   so that SvCUR() could stop being overloaded in pad SVs.

    NWC
 */
 
 PADOFFSET
 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 {
    NWC
 */
 
 PADOFFSET
 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 {

+    dVAR;

     SV *sv;
     I32 retval;
 
     SV *sv;
     I32 retval;
 

+    PERL_UNUSED_ARG(optype);

     ASSERT_CURPAD_ACTIVE("pad_alloc");
 
     if (AvARRAY(PL_comppad) != PL_curpad)
     ASSERT_CURPAD_ACTIVE("pad_alloc");
 
     if (AvARRAY(PL_comppad) != PL_curpad)


@@ -462,12 +590,18 @@ Add an anon code entry to the current compiling pad
 PADOFFSET
 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
 {
 PADOFFSET
 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
 {

+    dVAR;

     PADOFFSET ix;
     PADOFFSET ix;

-    SV* const name = NEWSV(1106, 0);
-    sv_upgrade(name, SVt_PVNV);
-    sv_setpvn(name, "&", 1);
-    SvIV_set(name, -1);
-    SvNV_set(name, 1);
+    SV* const name = newSV_type(SVt_PVNV);
+
+    PERL_ARGS_ASSERT_PAD_ADD_ANON;
+
+    pad_peg("add_anon");
+    sv_setpvs(name, "&");
+    /* These two aren't used; just make sure they're not equal to
+     * PERL_PADSEQ_INTRO */
+    COP_SEQ_RANGE_LOW_set(name, 0);
+    COP_SEQ_RANGE_HIGH_set(name, 0);

     ix = pad_alloc(op_type, SVs_PADMY);
     av_store(PL_comppad_name, ix, name);
     /* XXX DAPM use PL_curpad[] ? */
     ix = pad_alloc(op_type, SVs_PADMY);
     av_store(PL_comppad_name, ix, name);
     /* XXX DAPM use PL_curpad[] ? */


@@ -476,10 +610,10 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
 
     /* to avoid ref loops, we never have parent + child referencing each
      * other simultaneously */
 
     /* to avoid ref loops, we never have parent + child referencing each
      * other simultaneously */

-    if (CvOUTSIDE((CV*)sv)) {
-       assert(!CvWEAKOUTSIDE((CV*)sv));
-       CvWEAKOUTSIDE_on((CV*)sv);
-       SvREFCNT_dec(CvOUTSIDE((CV*)sv));
+    if (CvOUTSIDE((const CV *)sv)) {
+       assert(!CvWEAKOUTSIDE((const CV *)sv));
+       CvWEAKOUTSIDE_on(MUTABLE_CV(sv));
+       SvREFCNT_dec(CvOUTSIDE(MUTABLE_CV(sv)));

     }
     return ix;
 }
     }
     return ix;
 }


@@ -498,15 +632,20 @@ C<is_our> indicates that the name to check is an 'our' declaration
 =cut
 */
 
 =cut
 */
 

-/* XXX DAPM integrate this into pad_add_name ??? */
-
-void
-Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
+STATIC void
+S_pad_check_dup(pTHX_ SV *name, const U32 flags, const HV *ourstash)

 {
 {

+    dVAR;

     SV         **svp;
     PADOFFSET  top, off;
     SV         **svp;
     PADOFFSET  top, off;

+    const U32  is_our = flags & padadd_OUR;
+
+    PERL_ARGS_ASSERT_PAD_CHECK_DUP;

 
     ASSERT_CURPAD_ACTIVE("pad_check_dup");
 
     ASSERT_CURPAD_ACTIVE("pad_check_dup");

+
+    assert((flags & ~padadd_OUR) == 0);
+

     if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
        return; /* nothing to check */
 
     if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
        return; /* nothing to check */
 


@@ -520,39 +659,43 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
        if (sv
            && sv != &PL_sv_undef
            && !SvFAKE(sv)
        if (sv
            && sv != &PL_sv_undef
            && !SvFAKE(sv)

-           && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
-           && strEQ(name, SvPVX_const(sv)))
+           && (   COP_SEQ_RANGE_LOW(sv)  == PERL_PADSEQ_INTRO
+               || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
+           && sv_eq(name, sv))

        {
        {

-           if (is_our && (SvFLAGS(sv) & SVpad_OUR))
+           if (is_our && (SvPAD_OUR(sv)))

                break; /* "our" masking "our" */
            Perl_warner(aTHX_ packWARN(WARN_MISC),
                break; /* "our" masking "our" */
            Perl_warner(aTHX_ packWARN(WARN_MISC),

-               "\"%s\" variable %s masks earlier declaration in same %s",
-               (is_our ? "our" : "my"),
-               name,
-               (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
+               "\"%s\" variable %"SVf" masks earlier declaration in same %s",
+               (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
+               sv,
+               (COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO
+                   ? "scope" : "statement"));

            --off;
            break;
        }
     }
     /* check the rest of the pad */
     if (is_our) {
            --off;
            break;
        }
     }
     /* check the rest of the pad */
     if (is_our) {

-       do {
+       while (off > 0) {

            SV * const sv = svp[off];
            if (sv
                && sv != &PL_sv_undef
                && !SvFAKE(sv)
            SV * const sv = svp[off];
            if (sv
                && sv != &PL_sv_undef
                && !SvFAKE(sv)

-               && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
-               && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
-               && strEQ(name, SvPVX_const(sv)))
+               && (   COP_SEQ_RANGE_LOW(sv)  == PERL_PADSEQ_INTRO
+                   || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
+               && SvOURSTASH(sv) == ourstash
+               && sv_eq(name, sv))

            {
                Perl_warner(aTHX_ packWARN(WARN_MISC),
            {
                Perl_warner(aTHX_ packWARN(WARN_MISC),

-                   "\"our\" variable %s redeclared", name);
+                   "\"our\" variable %"SVf" redeclared", sv);

                if ((I32)off <= PL_comppad_name_floor)
                    Perl_warner(aTHX_ packWARN(WARN_MISC),
                        "\t(Did you mean \"local\" instead of \"our\"?)\n");
                break;
            }
                if ((I32)off <= PL_comppad_name_floor)
                    Perl_warner(aTHX_ packWARN(WARN_MISC),
                        "\t(Did you mean \"local\" instead of \"our\"?)\n");
                break;
            }

-       } while ( off-- > 0 );
+           --off;
+       }

     }
 }
 
     }
 }
 


@@ -570,32 +713,52 @@ Returns the offset in the current pad, or NOT_IN_PAD on failure.
 */
 
 PADOFFSET
 */
 
 PADOFFSET

-Perl_pad_findmy(pTHX_ const char *name)
+Perl_pad_findmy(pTHX_ const char *name, STRLEN len, U32 flags)

 {
 {

+    dVAR;

     SV *out_sv;
     int out_flags;
     I32 offset;
     const AV *nameav;
     SV **name_svp;
 
     SV *out_sv;
     int out_flags;
     I32 offset;
     const AV *nameav;
     SV **name_svp;
 

-    offset =  pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
-               Null(SV**), &out_sv, &out_flags);
-    if (offset != NOT_IN_PAD) 
+    PERL_ARGS_ASSERT_PAD_FINDMY;
+
+    pad_peg("pad_findmy");
+
+    if (flags)
+       Perl_croak(aTHX_ "panic: pad_findmy 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;
+
+    /* But until we're using the length for real, cross check that we're being
+       told the truth.  */
+    assert(strlen(name) == len);
+
+    offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
+               NULL, &out_sv, &out_flags);
+    if ((PADOFFSET)offset != NOT_IN_PAD) 

        return offset;
 
     /* look for an our that's being introduced; this allows
      *    our $foo = 0 unless defined $foo;
      * to not give a warning. (Yes, this is a hack) */
 
        return offset;
 
     /* look for an our that's being introduced; this allows
      *    our $foo = 0 unless defined $foo;
      * to not give a warning. (Yes, this is a hack) */
 

-    nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0];
+    nameav = MUTABLE_AV(AvARRAY(CvPADLIST(PL_compcv))[0]);

     name_svp = AvARRAY(nameav);
     for (offset = AvFILLp(nameav); offset > 0; offset--) {
         const SV * const namesv = name_svp[offset];
        if (namesv && namesv != &PL_sv_undef
            && !SvFAKE(namesv)
     name_svp = AvARRAY(nameav);
     for (offset = AvFILLp(nameav); offset > 0; offset--) {
         const SV * const namesv = name_svp[offset];
        if (namesv && namesv != &PL_sv_undef
            && !SvFAKE(namesv)

-           && (SvFLAGS(namesv) & SVpad_OUR)
+           && (SvPAD_OUR(namesv))

            && strEQ(SvPVX_const(namesv), name)
            && strEQ(SvPVX_const(namesv), name)

-           && U_32(SvNVX(namesv)) == PAD_MAX /* min */
+           && COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO

        )
            return offset;
     }
        )
            return offset;
     }


@@ -610,10 +773,32 @@ Perl_pad_findmy(pTHX_ const char *name)
 PADOFFSET
 Perl_find_rundefsvoffset(pTHX)
 {
 PADOFFSET
 Perl_find_rundefsvoffset(pTHX)
 {

+    dVAR;

     SV *out_sv;
     int out_flags;
     return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
     SV *out_sv;
     int out_flags;
     return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,

-           Null(SV**), &out_sv, &out_flags);
+           NULL, &out_sv, &out_flags);
+}
+
+/*
+ * Returns a lexical $_, if there is one, at run time ; or the global one
+ * otherwise.
+ */
+
+SV *
+Perl_find_rundefsv(pTHX)
+{
+    SV *namesv;
+    int flags;
+    PADOFFSET po;
+
+    po = pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
+           NULL, &namesv, &flags);
+
+    if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
+       return DEFSV;
+
+    return PAD_SVl(po);

 }
 
 /*
 }
 
 /*


@@ -633,17 +818,12 @@ 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
 
 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

-because fake namesvs in anon protoypes have to store in NVX the index into
+because fake namesvs in anon protoypes have to store in xlow the index into

 the parent pad.
 
 =cut
 */
 
 the parent pad.
 
 =cut
 */
 

-/* Flags set in the SvIVX field of FAKE namesvs */
-
-#define PAD_FAKELEX_ANON   1 /* the lex is declared in an ANON, or ... */
-#define PAD_FAKELEX_MULTI  2 /* the lex can be instantiated multiple times */
-

 /* the CV has finished being compiled. This is not a sufficient test for
  * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
 #define CvCOMPILED(cv) CvROOT(cv)
 /* the CV has finished being compiled. This is not a sufficient test for
  * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
 #define CvCOMPILED(cv) CvROOT(cv)


@@ -656,11 +836,14 @@ 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 *name, const CV* cv, U32 seq, int warn,
        SV** out_capture, SV** out_name_sv, int *out_flags)
 {

+    dVAR;

     I32 offset, new_offset;
     SV *new_capture;
     SV **new_capturep;
     const AV * const padlist = CvPADLIST(cv);
 
     I32 offset, new_offset;
     SV *new_capture;
     SV **new_capturep;
     const AV * const padlist = CvPADLIST(cv);
 

+    PERL_ARGS_ASSERT_PAD_FINDLEX;
+

     *out_flags = 0;
 
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
     *out_flags = 0;
 
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,


@@ -671,7 +854,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
 
     if (padlist) { /* not an undef CV */
        I32 fake_offset = 0;
 
     if (padlist) { /* not an undef CV */
        I32 fake_offset = 0;

-        const AV * const nameav = (AV*)AvARRAY(padlist)[0];
+        const AV * const nameav = MUTABLE_AV(AvARRAY(padlist)[0]);

        SV * const * const name_svp = AvARRAY(nameav);
 
        for (offset = AvFILLp(nameav); offset > 0; offset--) {
        SV * const * const name_svp = AvARRAY(nameav);
 
        for (offset = AvFILLp(nameav); offset > 0; offset--) {


@@ -679,11 +862,35 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
            if (namesv && namesv != &PL_sv_undef
                    && strEQ(SvPVX_const(namesv), name))
            {
            if (namesv && namesv != &PL_sv_undef
                    && strEQ(SvPVX_const(namesv), name))
            {

-               if (SvFAKE(namesv))
+               if (SvFAKE(namesv)) {

                    fake_offset = offset; /* in case we don't find a real one */
                    fake_offset = offset; /* in case we don't find a real one */

-               else if (  seq >  U_32(SvNVX(namesv))   /* min */
-                       && seq <= (U32)SvIVX(namesv))   /* max */
-                   break;
+                   continue;
+               }
+               /* is seq within the range _LOW to _HIGH ?
+                * This is complicated by the fact that PL_cop_seqmax
+                * may have wrapped around at some point */
+               if (COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO)
+                   continue; /* not yet introduced */
+
+               if (COP_SEQ_RANGE_HIGH(namesv) == PERL_PADSEQ_INTRO) {
+                   /* in compiling scope */
+                   if (
+                       (seq >  COP_SEQ_RANGE_LOW(namesv))
+                       ? (seq - COP_SEQ_RANGE_LOW(namesv) < (U32_MAX >> 1))
+                       : (COP_SEQ_RANGE_LOW(namesv) - seq > (U32_MAX >> 1))
+                   )
+                      break;
+               }
+               else if (
+                   (COP_SEQ_RANGE_LOW(namesv) > COP_SEQ_RANGE_HIGH(namesv))
+                   ?
+                       (  seq >  COP_SEQ_RANGE_LOW(namesv)
+                       || seq <= COP_SEQ_RANGE_HIGH(namesv))
+
+                   :    (  seq >  COP_SEQ_RANGE_LOW(namesv)
+                        && seq <= COP_SEQ_RANGE_HIGH(namesv))
+               )
+               break;

            }
        }
 
            }
        }
 


@@ -696,7 +903,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                 * instances. For now, we just test !CvUNIQUE(cv), but
                 * ideally, we should detect my's declared within loops
                 * etc - this would allow a wider range of 'not stayed
                 * instances. For now, we just test !CvUNIQUE(cv), but
                 * ideally, we should detect my's declared within loops
                 * etc - this would allow a wider range of 'not stayed

-                * shared' warnings. We also treated alreadly-compiled
+                * shared' warnings. We also treated already-compiled

                 * lexes as not multi as viewed from evals. */
 
                *out_flags = CvANON(cv) ?
                 * lexes as not multi as viewed from evals. */
 
                *out_flags = CvANON(cv) ?


@@ -705,18 +912,19 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                                ? PAD_FAKELEX_MULTI : 0;
 
                DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                                ? PAD_FAKELEX_MULTI : 0;
 
                DEBUG_Xv(PerlIO_printf(Perl_debug_log,

-                   "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%ld,%ld)\n",
-                   PTR2UV(cv), (long)offset, (long)U_32(SvNVX(*out_name_sv)),
-                   (long)SvIVX(*out_name_sv)));
+                   "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n",
+                   PTR2UV(cv), (long)offset,
+                   (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv),
+                   (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv)));

            }
            else { /* fake match */
                offset = fake_offset;
                *out_name_sv = name_svp[offset]; /* return the namesv */
            }
            else { /* fake match */
                offset = fake_offset;
                *out_name_sv = name_svp[offset]; /* return the namesv */

-               *out_flags = SvIVX(*out_name_sv);
+               *out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv);

                DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                    "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
                    PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
                DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                    "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
                    PTR2UV(cv), (long)offset, (unsigned long)*out_flags,

-                       (unsigned long)SvNVX(*out_name_sv) 
+                   (unsigned long) PARENT_PAD_INDEX(*out_name_sv) 

                ));
            }
 
                ));
            }
 


@@ -725,8 +933,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
            if (out_capture) {
 
                /* our ? */
            if (out_capture) {
 
                /* our ? */

-               if ((SvFLAGS(*out_name_sv) & SVpad_OUR)) {
-                   *out_capture = Nullsv;
+               if (SvPAD_OUR(*out_name_sv)) {
+                   *out_capture = NULL;

                    return offset;
                }
 
                    return offset;
                }
 


@@ -735,16 +943,17 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                        ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
                        : *out_flags & PAD_FAKELEX_ANON)
                {
                        ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
                        : *out_flags & PAD_FAKELEX_ANON)
                {

-                   if (warn && ckWARN(WARN_CLOSURE))
-                       Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-                           "Variable \"%s\" is not available", name);
-                   *out_capture = Nullsv;
+                   if (warn)
+                       Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+                                      "Variable \"%s\" is not available", name);
+                   *out_capture = NULL;

                }
 
                /* real value */
                else {
                    int newwarn = warn;
                    if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
                }
 
                /* real value */
                else {
                    int newwarn = warn;
                    if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)

+                        && !SvPAD_STATE(name_svp[offset])

                         && warn && ckWARN(WARN_CLOSURE)) {
                        newwarn = 0;
                        Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
                         && warn && ckWARN(WARN_CLOSURE)) {
                        newwarn = 0;
                        Perl_warner(aTHX_ packWARN(WARN_CLOSURE),


@@ -767,24 +976,25 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                        return offset;
                    }
 
                        return offset;
                    }
 

-                   *out_capture = AvARRAY((AV*)AvARRAY(padlist)[
-                                   CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
+                   *out_capture = AvARRAY(MUTABLE_AV(AvARRAY(padlist)[
+                                   CvDEPTH(cv) ? CvDEPTH(cv) : 1]))[offset];

                    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                        "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
                        PTR2UV(cv), PTR2UV(*out_capture)));
 
                    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                        "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
                        PTR2UV(cv), PTR2UV(*out_capture)));
 

-                   if (SvPADSTALE(*out_capture)) {
-                       if (ckWARN(WARN_CLOSURE))
-                           Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-                               "Variable \"%s\" is not available", name);
-                       *out_capture = Nullsv;
+                   if (SvPADSTALE(*out_capture)
+                       && !SvPAD_STATE(name_svp[offset]))
+                   {
+                       Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+                                      "Variable \"%s\" is not available", name);
+                       *out_capture = NULL;

                    }
                }
                if (!*out_capture) {
                    if (*name == '@')
                    }
                }
                if (!*out_capture) {
                    if (*name == '@')

-                       *out_capture = sv_2mortal((SV*)newAV());
+                       *out_capture = sv_2mortal(MUTABLE_SV(newAV()));

                    else if (*name == '%')
                    else if (*name == '%')

-                       *out_capture = sv_2mortal((SV*)newHV());
+                       *out_capture = sv_2mortal(MUTABLE_SV(newHV()));

                    else
                        *out_capture = sv_newmortal();
                }
                    else
                        *out_capture = sv_newmortal();
                }


@@ -798,17 +1008,17 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
 
     if (!CvOUTSIDE(cv))
        return NOT_IN_PAD;
 
     if (!CvOUTSIDE(cv))
        return NOT_IN_PAD;

-    
+

     /* out_capture non-null means caller wants us to capture lex; in
      * addition we capture ourselves unless it's an ANON/format */
     new_capturep = out_capture ? out_capture :
     /* out_capture non-null means caller wants us to capture lex; in
      * addition we capture ourselves unless it's an ANON/format */
     new_capturep = out_capture ? out_capture :

-               CvLATE(cv) ? Null(SV**) : &new_capture;
+               CvLATE(cv) ? NULL : &new_capture;

 
     offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
                new_capturep, out_name_sv, out_flags);
 
     offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
                new_capturep, out_name_sv, out_flags);

-    if (offset == NOT_IN_PAD)
+    if ((PADOFFSET)offset == NOT_IN_PAD)

        return NOT_IN_PAD;
        return NOT_IN_PAD;

-    
+

     /* found in an outer CV. Add appropriate fake entry to this pad */
 
     /* don't add new fake entries (via eval) to CVs that we have already
     /* found in an outer CV. Add appropriate fake entry to this pad */
 
     /* don't add new fake entries (via eval) to CVs that we have already


@@ -817,32 +1027,39 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
        return 0; /* this dummy (and invalid) value isnt used by the caller */
 
     {
        return 0; /* this dummy (and invalid) value isnt used by the caller */
 
     {

-       SV *new_namesv;
+       /* This relies on sv_setsv_flags() upgrading the destination to the same
+          type as the source, independent of the flags set, and on it being
+          "good" and only copying flag bits and pointers that it understands.
+       */
+       SV *new_namesv = newSVsv(*out_name_sv);

        AV *  const ocomppad_name = PL_comppad_name;
        PAD * const ocomppad = PL_comppad;
        AV *  const ocomppad_name = PL_comppad_name;
        PAD * const ocomppad = PL_comppad;

-       PL_comppad_name = (AV*)AvARRAY(padlist)[0];
-       PL_comppad = (AV*)AvARRAY(padlist)[1];
+       PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
+       PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]);

        PL_curpad = AvARRAY(PL_comppad);
 
        PL_curpad = AvARRAY(PL_comppad);
 

-       new_offset = pad_add_name(
-           SvPVX_const(*out_name_sv),
-           (SvFLAGS(*out_name_sv) & SVpad_TYPED)
-                   ? SvSTASH(*out_name_sv) : Nullhv,
-           (SvFLAGS(*out_name_sv) & SVpad_OUR)
-                   ? GvSTASH(*out_name_sv) : Nullhv,
-           1  /* fake */
-       );
-
-       new_namesv = AvARRAY(PL_comppad_name)[new_offset];
-       SvIV_set(new_namesv, *out_flags);
-
-       SvNV_set(new_namesv, (NV)0);
-       if (SvFLAGS(new_namesv) & SVpad_OUR) {
-          /* do nothing */
+       new_offset
+           = pad_add_name_sv(new_namesv,
+                             (SvPAD_STATE(*out_name_sv) ? padadd_STATE : 0),
+                             SvPAD_TYPED(*out_name_sv)
+                             ? SvSTASH(*out_name_sv) : NULL,
+                             SvOURSTASH(*out_name_sv)
+                             );
+
+       SvFAKE_on(new_namesv);
+       DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+                              "Pad addname: %ld \"%.*s\" FAKE\n",
+                              (long)new_offset,
+                              (int) SvCUR(new_namesv), SvPVX(new_namesv)));
+       PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
+
+       PARENT_PAD_INDEX_set(new_namesv, 0);
+       if (SvPAD_OUR(new_namesv)) {
+           NOOP;   /* do nothing */

        }
        else if (CvLATE(cv)) {
            /* delayed creation - just note the offset within parent pad */
        }
        else if (CvLATE(cv)) {
            /* delayed creation - just note the offset within parent pad */

-           SvNV_set(new_namesv, (NV)offset);
+           PARENT_PAD_INDEX_set(new_namesv, offset);

            CvCLONE_on(cv);
        }
        else {
            CvCLONE_on(cv);
        }
        else {


@@ -853,11 +1070,11 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
        }
        *out_name_sv = new_namesv;
                PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
        }
        *out_name_sv = new_namesv;

-       *out_flags = SvIVX(new_namesv);
+       *out_flags = PARENT_FAKELEX_FLAGS(new_namesv);

 
        PL_comppad_name = ocomppad_name;
        PL_comppad = ocomppad;
 
        PL_comppad_name = ocomppad_name;
        PL_comppad = ocomppad;

-       PL_curpad = ocomppad ? AvARRAY(ocomppad) : Null(SV **);
+       PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;

     }
     return new_offset;
 }
     }
     return new_offset;
 }


@@ -877,6 +1094,7 @@ 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)


@@ -901,6 +1119,10 @@ 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");
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
     ASSERT_CURPAD_ACTIVE("pad_setsv");
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,


@@ -930,6 +1152,7 @@ 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);


@@ -958,8 +1181,10 @@ Perl_pad_block_start(pTHX_ int full)
 U32
 Perl_intro_my(pTHX)
 {
 U32
 Perl_intro_my(pTHX)
 {

+    dVAR;

     SV **svp;
     I32 i;
     SV **svp;
     I32 i;

+    U32 seq;

 
     ASSERT_CURPAD_ACTIVE("intro_my");
     if (! PL_min_intro_pending)
 
     ASSERT_CURPAD_ACTIVE("intro_my");
     if (! PL_min_intro_pending)


@@ -969,22 +1194,29 @@ 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) && !SvIVX(sv)) {
-           SvIV_set(sv, PAD_MAX);      /* Don't know scope end yet. */
-           SvNV_set(sv, (NV)PL_cop_seqmax);
+       if (sv && sv != &PL_sv_undef && !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_set(sv, PL_cop_seqmax);

            DEBUG_Xv(PerlIO_printf(Perl_debug_log,
            DEBUG_Xv(PerlIO_printf(Perl_debug_log,

-               "Pad intromy: %ld \"%s\", (%ld,%ld)\n",
+               "Pad intromy: %ld \"%s\", (%lu,%lu)\n",

                (long)i, SvPVX_const(sv),
                (long)i, SvPVX_const(sv),

-               (long)U_32(SvNVX(sv)), (long)SvIVX(sv))
+               (unsigned long)COP_SEQ_RANGE_LOW(sv),
+               (unsigned long)COP_SEQ_RANGE_HIGH(sv))

            );
        }
     }
            );
        }
     }

+    seq = PL_cop_seqmax;
+    PL_cop_seqmax++;
+    if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
+       PL_cop_seqmax++;

     PL_min_intro_pending = 0;
     PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
     PL_min_intro_pending = 0;
     PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,

-               "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
+               "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax)));

 
 

-    return PL_cop_seqmax++;
+    return seq;

 }
 
 /*
 }
 
 /*


@@ -999,6 +1231,7 @@ lexicals in this scope and warn of any lexicals that never got introduced.
 void
 Perl_pad_leavemy(pTHX)
 {
 void
 Perl_pad_leavemy(pTHX)
 {

+    dVAR;

     I32 off;
     SV * const * const svp = AvARRAY(PL_comppad_name);
 
     I32 off;
     SV * const * const svp = AvARRAY(PL_comppad_name);
 


@@ -1008,25 +1241,30 @@ 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) && ckWARN_d(WARN_INTERNAL))
-               Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                                       "%"SVf" never introduced", sv);
+           if (sv && sv != &PL_sv_undef && !SvFAKE(sv))
+               Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+                                "%"SVf" never introduced",
+                                SVfARG(sv));

        }
     }
     /* "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];
        }
     }
     /* "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) && SvIVX(sv) == PAD_MAX) {
-           SvIV_set(sv, PL_cop_seqmax);
+       if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
+           && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
+       {
+           COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);

            DEBUG_Xv(PerlIO_printf(Perl_debug_log,
            DEBUG_Xv(PerlIO_printf(Perl_debug_log,

-               "Pad leavemy: %ld \"%s\", (%ld,%ld)\n",
+               "Pad leavemy: %ld \"%s\", (%lu,%lu)\n",

                (long)off, SvPVX_const(sv),
                (long)off, SvPVX_const(sv),

-               (long)U_32(SvNVX(sv)), (long)SvIVX(sv))
+               (unsigned long)COP_SEQ_RANGE_LOW(sv),
+               (unsigned long)COP_SEQ_RANGE_HIGH(sv))

            );
        }
     }
     PL_cop_seqmax++;
            );
        }
     }
     PL_cop_seqmax++;

+    if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
+       PL_cop_seqmax++;

     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
            "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
 }
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
            "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
 }


@@ -1044,6 +1282,7 @@ 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;


@@ -1065,7 +1304,7 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
     /* if pad tmps aren't shared between ops, then there's no need to
      * create a new tmp when an existing op is freed */
 #ifdef USE_BROKEN_PAD_RESET
     /* if pad tmps aren't shared between ops, then there's no need to
      * create a new tmp when an existing op is freed */
 #ifdef USE_BROKEN_PAD_RESET

-    PL_curpad[po] = NEWSV(1107,0);
+    PL_curpad[po] = newSV(0);

     SvPADTMP_on(PL_curpad[po]);
 #else
     PL_curpad[po] = &PL_sv_undef;
     SvPADTMP_on(PL_curpad[po]);
 #else
     PL_curpad[po] = &PL_sv_undef;


@@ -1089,9 +1328,10 @@ Mark all the current temporaries for reuse
  * to  a shared TARG.  Such an alias will change randomly and unpredictably.
  * We avoid doing this until we can think of a Better Way.
  * GSAR 97-10-29 */
  * to  a shared TARG.  Such an alias will change randomly and unpredictably.
  * We avoid doing this until we can think of a Better Way.
  * GSAR 97-10-29 */

-void
-Perl_pad_reset(pTHX)
+static void
+S_pad_reset(pTHX)

 {
 {

+    dVAR;

 #ifdef USE_BROKEN_PAD_RESET
     if (AvARRAY(PL_comppad) != PL_curpad)
        Perl_croak(aTHX_ "panic: pad_reset curpad");
 #ifdef USE_BROKEN_PAD_RESET
     if (AvARRAY(PL_comppad) != PL_curpad)
        Perl_croak(aTHX_ "panic: pad_reset curpad");


@@ -1145,7 +1385,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
      * 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
      * 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

-     * excuted within it.
+     * executed within it.

      */
 
     if (PL_cv_has_eval || PL_perldb) {
      */
 
     if (PL_cv_has_eval || PL_perldb) {


@@ -1163,7 +1403,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 
     /* extend curpad to match namepad */
     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
 
     /* extend curpad to match namepad */
     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))

-       av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
+       av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);

 
     if (type == padtidy_SUBCLONE) {
        SV * const * const namep = AvARRAY(PL_comppad_name);
 
     if (type == padtidy_SUBCLONE) {
        SV * const * const namep = AvARRAY(PL_comppad_name);


@@ -1179,39 +1419,49 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
             * pad are anonymous subs.
             * The rest are created anew during cloning.
             */
             * pad are anonymous subs.
             * The rest are created anew during cloning.
             */

-           if (!((namesv = namep[ix]) != Nullsv &&
+           if (!((namesv = namep[ix]) != NULL &&

                  namesv != &PL_sv_undef &&
                   *SvPVX_const(namesv) == '&'))
            {
                SvREFCNT_dec(PL_curpad[ix]);
                  namesv != &PL_sv_undef &&
                   *SvPVX_const(namesv) == '&'))
            {
                SvREFCNT_dec(PL_curpad[ix]);

-               PL_curpad[ix] = Nullsv;
+               PL_curpad[ix] = NULL;

            }
        }
     }
     else if (type == padtidy_SUB) {
        /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
        AV * const av = newAV();                        /* Will be @_ */
            }
        }
     }
     else if (type == padtidy_SUB) {
        /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
        AV * const av = newAV();                        /* Will be @_ */

-       av_extend(av, 0);
-       av_store(PL_comppad, 0, (SV*)av);
+       av_store(PL_comppad, 0, MUTABLE_SV(av));

        AvREIFY_only(av);
     }
 
        AvREIFY_only(av);
     }
 

-    /* XXX DAPM rationalise these two similar branches */
-
-    if (type == padtidy_SUB) {
+    if (type == padtidy_SUB || type == padtidy_FORMAT) {
+       SV * const * const namep = AvARRAY(PL_comppad_name);

        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]))
                continue;
        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]))
                continue;

-           if (!SvPADMY(PL_curpad[ix]))
-               SvPADTMP_on(PL_curpad[ix]);
-       }
-    }
-    else if (type == padtidy_FORMAT) {
-       PADOFFSET ix;
-       for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
-           if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
+           if (!SvPADMY(PL_curpad[ix])) {

                SvPADTMP_on(PL_curpad[ix]);
                SvPADTMP_on(PL_curpad[ix]);

+           } else if (!SvFAKE(namep[ix])) {
+               /* This is a work around for how the current implementation of
+                  ?{ } blocks in regexps interacts with lexicals.
+
+                  One of our lexicals.
+                  Can't do this on all lexicals, otherwise sub baz() won't
+                  compile in
+
+                  my $foo;
+
+                  sub bar { ++$foo; }
+
+                  sub baz { ++$foo; }
+
+                  because completion of compiling &bar calling pad_tidy()
+                  would cause (top level) $foo to be marked as stale, and
+                  "no longer available".  */
+               SvPADSTALE_on(PL_curpad[ix]);
+           }

        }
     }
     PL_curpad = AvARRAY(PL_comppad);
        }
     }
     PL_curpad = AvARRAY(PL_comppad);


@@ -1230,6 +1480,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;

     ASSERT_CURPAD_LEGAL("pad_free");
     if (!PL_curpad)
        return;
     ASSERT_CURPAD_LEGAL("pad_free");
     if (!PL_curpad)
        return;


@@ -1245,17 +1496,6 @@ Perl_pad_free(pTHX_ PADOFFSET po)
 
     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
        SvPADTMP_off(PL_curpad[po]);
 
     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
        SvPADTMP_off(PL_curpad[po]);

-#ifdef USE_ITHREADS
-       /* SV could be a shared hash key (eg bugid #19022) */
-       if (
-#ifdef PERL_OLD_COPY_ON_WRITE
-           !SvIsCOW(PL_curpad[po])
-#else
-           !SvFAKE(PL_curpad[po])
-#endif
-           )
-           SvREADONLY_off(PL_curpad[po]);      /* could be a freed constant */
-#endif

     }
     if ((I32)po < PL_padix)
        PL_padix = po - 1;
     }
     if ((I32)po < PL_padix)
        PL_padix = po - 1;


@@ -1274,17 +1514,20 @@ 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;
     SV **ppad;
     I32 ix;
 
     const AV *pad_name;
     const AV *pad;
     SV **pname;
     SV **ppad;
     I32 ix;
 

+    PERL_ARGS_ASSERT_DO_DUMP_PAD;
+

     if (!padlist) {
        return;
     }
     if (!padlist) {
        return;
     }

-    pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
-    pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
+    pad_name = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 0, FALSE));
+    pad = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 1, FALSE));

     pname = AvARRAY(pad_name);
     ppad = AvARRAY(pad);
     Perl_dump_indent(aTHX_ level, file,
     pname = AvARRAY(pad_name);
     ppad = AvARRAY(pad);
     Perl_dump_indent(aTHX_ level, file,


@@ -1295,7 +1538,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];
        if (namesv && namesv == &PL_sv_undef) {
     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
         const SV *namesv = pname[ix];
        if (namesv && namesv == &PL_sv_undef) {

-           namesv = Nullsv;
+           namesv = NULL;

        }
        if (namesv) {
            if (SvFAKE(namesv))
        }
        if (namesv) {
            if (SvFAKE(namesv))


@@ -1305,18 +1548,18 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
                    PTR2UV(ppad[ix]),
                    (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
                    SvPVX_const(namesv),
                    PTR2UV(ppad[ix]),
                    (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
                    SvPVX_const(namesv),

-                   (unsigned long)SvIVX(namesv),
-                   (unsigned long)SvNVX(namesv)
+                   (unsigned long)PARENT_FAKELEX_FLAGS(namesv),
+                   (unsigned long)PARENT_PAD_INDEX(namesv)

 
                );
            else
                Perl_dump_indent(aTHX_ level+1, file,
 
                );
            else
                Perl_dump_indent(aTHX_ level+1, file,

-                   "%2d. 0x%"UVxf"<%lu> (%ld,%ld) \"%s\"\n",
+                   "%2d. 0x%"UVxf"<%lu> (%lu,%lu) \"%s\"\n",

                    (int) ix,
                    PTR2UV(ppad[ix]),
                    (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
                    (int) ix,
                    PTR2UV(ppad[ix]),
                    (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),

-                   (long)U_32(SvNVX(namesv)),
-                   (long)SvIVX(namesv),
+                   (unsigned long)COP_SEQ_RANGE_LOW(namesv),
+                   (unsigned long)COP_SEQ_RANGE_HIGH(namesv),

                    SvPVX_const(namesv)
                );
        }
                    SvPVX_const(namesv)
                );
        }


@@ -1345,9 +1588,12 @@ 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);
     AV* const padlist = CvPADLIST(cv);
 
     const CV * const outside = CvOUTSIDE(cv);
     AV* const padlist = CvPADLIST(cv);
 

+    PERL_ARGS_ASSERT_CV_DUMP;
+

     PerlIO_printf(Perl_debug_log,
                  "  %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
                  title,
     PerlIO_printf(Perl_debug_log,
                  "  %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
                  title,


@@ -1390,8 +1636,8 @@ Perl_cv_clone(pTHX_ CV *proto)
     dVAR;
     I32 ix;
     AV* const protopadlist = CvPADLIST(proto);
     dVAR;
     I32 ix;
     AV* const protopadlist = CvPADLIST(proto);

-    const AV* const protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
-    const AV* const protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
+    const AV *const protopad_name = (const AV *)*av_fetch(protopadlist, 0, FALSE);
+    const AV *const protopad = (const AV *)*av_fetch(protopadlist, 1, FALSE);

     SV** const pname = AvARRAY(protopad_name);
     SV** const ppad = AvARRAY(protopad);
     const I32 fname = AvFILLp(protopad_name);
     SV** const pname = AvARRAY(protopad_name);
     SV** const ppad = AvARRAY(protopad);
     const I32 fname = AvFILLp(protopad_name);


@@ -1401,6 +1647,8 @@ Perl_cv_clone(pTHX_ CV *proto)
     CV* outside;
     long depth;
 
     CV* outside;
     long depth;
 

+    PERL_ARGS_ASSERT_CV_CLONE;
+

     assert(!CvUNIQUE(proto));
 
     /* Since cloneable anon subs can be nested, CvOUTSIDE may point
     assert(!CvUNIQUE(proto));
 
     /* Since cloneable anon subs can be nested, CvOUTSIDE may point


@@ -1419,33 +1667,32 @@ Perl_cv_clone(pTHX_ CV *proto)
     ENTER;
     SAVESPTR(PL_compcv);
 
     ENTER;
     SAVESPTR(PL_compcv);
 

-    cv = PL_compcv = (CV*)NEWSV(1104, 0);
-    sv_upgrade((SV *)cv, SvTYPE(proto));
-    CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
+    cv = PL_compcv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
+    CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC);

     CvCLONED_on(cv);
 
 #ifdef USE_ITHREADS
     CvCLONED_on(cv);
 
 #ifdef USE_ITHREADS

-    CvFILE(cv)         = CvXSUB(proto) ? CvFILE(proto)
-                                       : savepv(CvFILE(proto));
+    CvFILE(cv)         = CvISXSUB(proto) ? CvFILE(proto)
+                                         : savepv(CvFILE(proto));

 #else
     CvFILE(cv)         = CvFILE(proto);
 #endif
 #else
     CvFILE(cv)         = CvFILE(proto);
 #endif

-    CvGV(cv)           = CvGV(proto);
-    CvSTASH(cv)                = CvSTASH(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);
     OP_REFCNT_LOCK;
     CvROOT(cv)         = OpREFCNT_inc(CvROOT(proto));
     OP_REFCNT_UNLOCK;
     CvSTART(cv)                = CvSTART(proto);

-    CvOUTSIDE(cv)      = (CV*)SvREFCNT_inc(outside);
+    CvOUTSIDE(cv)      = MUTABLE_CV(SvREFCNT_inc_simple(outside));

     CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
 
     if (SvPOK(proto))
     CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
 
     if (SvPOK(proto))

-       sv_setpvn((SV*)cv, SvPVX_const(proto), SvCUR(proto));
+       sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto));

 
     CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
 
     av_fill(PL_comppad, fpad);
 
     CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
 
     av_fill(PL_comppad, fpad);

-    for (ix = fname; ix >= 0; ix--)
+    for (ix = fname; ix > 0; ix--)

        av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
 
     PL_curpad = AvARRAY(PL_comppad);
        av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
 
     PL_curpad = AvARRAY(PL_comppad);


@@ -1453,42 +1700,44 @@ Perl_cv_clone(pTHX_ CV *proto)
     outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
 
     for (ix = fpad; ix > 0; ix--) {
     outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
 
     for (ix = fpad; ix > 0; ix--) {

-       SV* const namesv = (ix <= fname) ? pname[ix] : Nullsv;
-       SV *sv = Nullsv;
+       SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
+       SV *sv = NULL;

        if (namesv && namesv != &PL_sv_undef) { /* lexical */
            if (SvFAKE(namesv)) {   /* lexical from outside? */
        if (namesv && namesv != &PL_sv_undef) { /* lexical */
            if (SvFAKE(namesv)) {   /* lexical from outside? */

-               sv = outpad[(I32)SvNVX(namesv)];
+               sv = outpad[PARENT_PAD_INDEX(namesv)];

                assert(sv);
                assert(sv);

-               /* formats may have an inactive parent */
-               if (SvTYPE(proto) == SVt_PVFM && SvPADSTALE(sv)) {
-                   if (ckWARN(WARN_CLOSURE))
-                       Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-                           "Variable \"%s\" is not available", SvPVX_const(namesv));
-                   sv = Nullsv;
-               }
-               else {
-                   assert(!SvPADSTALE(sv));
-                   sv = SvREFCNT_inc(sv);
+               /* formats may have an inactive 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)) {
+                   Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+                                  "Variable \"%s\" is not available", SvPVX_const(namesv));
+                   sv = NULL;

                }
                }

+               else 
+                   SvREFCNT_inc_simple_void_NN(sv);

            }
            if (!sv) {
                 const char sigil = SvPVX_const(namesv)[0];
                 if (sigil == '&')
                    sv = SvREFCNT_inc(ppad[ix]);
                 else if (sigil == '@')
            }
            if (!sv) {
                 const char sigil = SvPVX_const(namesv)[0];
                 if (sigil == '&')
                    sv = SvREFCNT_inc(ppad[ix]);
                 else if (sigil == '@')

-                   sv = (SV*)newAV();
+                   sv = MUTABLE_SV(newAV());

                 else if (sigil == '%')
                 else if (sigil == '%')

-                   sv = (SV*)newHV();
+                   sv = MUTABLE_SV(newHV());

                else
                else

-                   sv = NEWSV(0, 0);
+                   sv = newSV(0);

                SvPADMY_on(sv);
                SvPADMY_on(sv);

+               /* reset the 'assign only once' flag on each state var */
+               if (SvPAD_STATE(namesv))
+                   SvPADSTALE_on(sv);

            }
        }
        else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
            }
        }
        else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {

-           sv = SvREFCNT_inc(ppad[ix]);
+           sv = SvREFCNT_inc_NN(ppad[ix]);

        }
        else {
        }
        else {

-           sv = NEWSV(0, 0);
+           sv = newSV(0);

            SvPADTMP_on(sv);
        }
        PL_curpad[ix] = sv;
            SvPADTMP_on(sv);
        }
        PL_curpad[ix] = sv;


@@ -1512,7 +1761,7 @@ Perl_cv_clone(pTHX_ CV *proto)
        SV* const const_sv = op_const_sv(CvSTART(cv), cv);
        if (const_sv) {
            SvREFCNT_dec(cv);
        SV* const const_sv = op_const_sv(CvSTART(cv), cv);
        if (const_sv) {
            SvREFCNT_dec(cv);

-           cv = newCONSTSUB(CvSTASH(proto), Nullch, const_sv);
+           cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);

        }
        else {
            CvCONST_off(cv);
        }
        else {
            CvCONST_off(cv);


@@ -1536,17 +1785,22 @@ 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 = (AV*)AvARRAY(padlist)[0];
-    AV * const comppad = (AV*)AvARRAY(padlist)[1];
+    AV * const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
+    AV * const comppad = MUTABLE_AV(AvARRAY(padlist)[1]);

     SV ** const namepad = AvARRAY(comppad_name);
     SV ** const curpad = AvARRAY(comppad);
     SV ** const namepad = AvARRAY(comppad_name);
     SV ** const curpad = AvARRAY(comppad);

+
+    PERL_ARGS_ASSERT_PAD_FIXUP_INNER_ANONS;
+    PERL_UNUSED_ARG(old_cv);
+

     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
         const SV * const namesv = namepad[ix];
        if (namesv && namesv != &PL_sv_undef
            && *SvPVX_const(namesv) == '&')
        {
     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
         const SV * const namesv = namepad[ix];
        if (namesv && namesv != &PL_sv_undef
            && *SvPVX_const(namesv) == '&')
        {

-           CV * const innercv = (CV*)curpad[ix];
+           CV * const innercv = MUTABLE_CV(curpad[ix]);

            assert(CvWEAKOUTSIDE(innercv));
            assert(CvOUTSIDE(innercv) == old_cv);
            CvOUTSIDE(innercv) = new_cv;
            assert(CvWEAKOUTSIDE(innercv));
            assert(CvOUTSIDE(innercv) == old_cv);
            CvOUTSIDE(innercv) = new_cv;


@@ -1568,53 +1822,56 @@ 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)
 {

-    if (depth <= AvFILLp(padlist))
-       return;
+    dVAR;

 
 

-    {
+    PERL_ARGS_ASSERT_PAD_PUSH;
+
+    if (depth > AvFILLp(padlist)) {

        SV** const svp = AvARRAY(padlist);
        AV* const newpad = newAV();
        SV** const oldpad = AvARRAY(svp[depth-1]);
        SV** const svp = AvARRAY(padlist);
        AV* const newpad = newAV();
        SV** const oldpad = AvARRAY(svp[depth-1]);

-       I32 ix = AvFILLp((AV*)svp[1]);
-        const I32 names_fill = AvFILLp((AV*)svp[0]);
+       I32 ix = AvFILLp((const AV *)svp[1]);
+        const I32 names_fill = AvFILLp((const AV *)svp[0]);

        SV** const names = AvARRAY(svp[0]);
        AV *av;
 
        for ( ;ix > 0; ix--) {
            if (names_fill >= ix && names[ix] != &PL_sv_undef) {
                const char sigil = SvPVX_const(names[ix])[0];
        SV** const names = AvARRAY(svp[0]);
        AV *av;
 
        for ( ;ix > 0; ix--) {
            if (names_fill >= ix && names[ix] != &PL_sv_undef) {
                const char sigil = SvPVX_const(names[ix])[0];

-               if ((SvFLAGS(names[ix]) & SVf_FAKE) || sigil == '&') {
+               if ((SvFLAGS(names[ix]) & SVf_FAKE)
+                       || (SvFLAGS(names[ix]) & SVpad_STATE)
+                       || sigil == '&')
+               {

                    /* outer lexical or anon code */
                    av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
                }
                else {          /* our own lexical */
                    SV *sv; 
                    if (sigil == '@')
                    /* outer lexical or anon code */
                    av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
                }
                else {          /* our own lexical */
                    SV *sv; 
                    if (sigil == '@')

-                       sv = (SV*)newAV();
+                       sv = MUTABLE_SV(newAV());

                    else if (sigil == '%')
                    else if (sigil == '%')

-                       sv = (SV*)newHV();
+                       sv = MUTABLE_SV(newHV());

                    else
                    else

-                       sv = NEWSV(0, 0);
+                       sv = newSV(0);

                    av_store(newpad, ix, sv);
                    SvPADMY_on(sv);
                }
            }
            else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
                    av_store(newpad, ix, sv);
                    SvPADMY_on(sv);
                }
            }
            else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {

-               av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
+               av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));

            }
            else {
                /* save temporaries on recursion? */
            }
            else {
                /* save temporaries on recursion? */

-               SV * const sv = NEWSV(0, 0);
+               SV * const sv = newSV(0);

                av_store(newpad, ix, sv);
                SvPADTMP_on(sv);
            }
        }
        av = newAV();
                av_store(newpad, ix, sv);
                SvPADTMP_on(sv);
            }
        }
        av = newAV();

-       av_extend(av, 0);
-       av_store(newpad, 0, (SV*)av);
+       av_store(newpad, 0, MUTABLE_SV(av));

        AvREIFY_only(av);
 
        AvREIFY_only(av);
 

-       av_store(padlist, depth, (SV*)newpad);
+       av_store(padlist, depth, MUTABLE_SV(newpad));

        AvFILLp(padlist) = depth;
     }
 }
        AvFILLp(padlist) = depth;
     }
 }


@@ -1623,13 +1880,137 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 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);
     SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);

-    if ( SvFLAGS(*av) & SVpad_TYPED ) {
+    if ( SvPAD_TYPED(*av) ) {

         return SvSTASH(*av);
     }
         return SvSTASH(*av);
     }

-    return Nullhv;
+    return NULL;
+}
+
+#if defined(USE_ITHREADS)
+
+#  define av_dup_inc(s,t)      MUTABLE_AV(sv_dup_inc((const SV *)s,t))
+
+AV *
+Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
+{
+    AV *dstpad;
+    PERL_ARGS_ASSERT_PADLIST_DUP;
+
+    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
+          to build anything other than the first level of pads.  */
+
+       I32 ix = AvFILLp((const AV *)AvARRAY(srcpad)[1]);
+       AV *pad1;
+       const I32 names_fill = AvFILLp((const AV *)(AvARRAY(srcpad)[0]));
+       const AV *const srcpad1 = (const AV *) AvARRAY(srcpad)[1];
+       SV **oldpad = AvARRAY(srcpad1);
+       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" :-(   */
+       dstpad = (AV*)ptr_table_fetch(PL_ptr_table, srcpad);
+
+       if (dstpad)
+           return 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]);
+
+       pad1 = newAV();
+
+       av_extend(pad1, ix);
+       AvARRAY(dstpad)[1] = MUTABLE_SV(pad1);
+       pad1a = AvARRAY(pad1);
+       AvFILLp(dstpad) = 1;
+
+       if (ix > -1) {
+           AvFILLp(pad1) = ix;
+
+           for ( ;ix > 0; ix--) {
+               if (!oldpad[ix]) {
+                   pad1a[ix] = NULL;
+               } else if (names_fill >= ix && names[ix] != &PL_sv_undef) {
+                   const char sigil = SvPVX_const(names[ix])[0];
+                   if ((SvFLAGS(names[ix]) & SVf_FAKE)
+                       || (SvFLAGS(names[ix]) & SVpad_STATE)
+                       || sigil == '&')
+                       {
+                           /* outer lexical or anon code */
+                           pad1a[ix] = sv_dup_inc(oldpad[ix], param);
+                       }
+                   else {              /* our own lexical */
+                       if(SvPADSTALE(oldpad[ix]) && SvREFCNT(oldpad[ix]) > 1) {
+                           /* This is a work around for how the current
+                              implementation of ?{ } blocks in regexps
+                              interacts with lexicals.  */
+                           pad1a[ix] = sv_dup_inc(oldpad[ix], param);
+                       } else {
+                           SV *sv; 
+                           
+                           if (sigil == '@')
+                               sv = MUTABLE_SV(newAV());
+                           else if (sigil == '%')
+                               sv = MUTABLE_SV(newHV());
+                           else
+                               sv = newSV(0);
+                           pad1a[ix] = sv;
+                           SvPADMY_on(sv);
+                       }
+                   }
+               }
+               else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
+                   pad1a[ix] = sv_dup_inc(oldpad[ix], param);
+               }
+               else {
+                   /* save temporaries on recursion? */
+                   SV * const sv = newSV(0);
+                   pad1a[ix] = sv;
+
+                   /* SvREFCNT(oldpad[ix]) != 1 for some code in threads.xs
+                      FIXTHAT before merging this branch.
+                      (And I know how to) */
+                   if (SvPADMY(oldpad[ix]))
+                       SvPADMY_on(sv);
+                   else
+                       SvPADTMP_on(sv);
+               }
+           }
+
+           if (oldpad[0]) {
+               args = newAV();                 /* Will be @_ */
+               AvREIFY_only(args);
+               pad1a[0] = (SV *)args;
+           }
+       }
+    }
+
+    return dstpad;

 }
 
 }
 

+#endif
+

 /*
  * Local variables:
  * c-indentation-style: bsd
 /*
  * Local variables:
  * c-indentation-style: bsd