Re-instate all the warnings checks that don't work on Win32, but with

[perl5.git] / pad.c

diff --git a/pad.c b/pad.c
index 80e930e..b5e39fa 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -1,6 +1,6 @@
 /*    pad.c
  *
 /*    pad.c
  *

- *    Copyright (C) 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 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.


@@ -72,19 +72,19 @@ 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 also SVt_PVGV, with the MAGIC slot
-pointing 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.  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.
 


@@ -102,6 +102,8 @@ to be generated in evals, such as
 
     { my $x = 1; sub f { eval '$x'} } f();
 
 
     { my $x = 1; sub f { eval '$x'} } f();
 

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

 =cut
 */
 
 =cut
 */
 


@@ -109,13 +111,26 @@ 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
+#define PAD_MAX I32_MAX

 
 #ifdef PERL_MAD
 void pad_peg(const char* s) {
     static int pegcnt;
 
 #ifdef PERL_MAD
 void pad_peg(const char* s) {
     static int pegcnt;

+
+    PERL_ARGS_ASSERT_PAD_PEG;
+

     pegcnt++;
 }
 #endif
     pegcnt++;
 }
 #endif


@@ -158,7 +173,7 @@ 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) {
                SAVEI32(PL_pad_reset_pending);
            }
            if (flags & padnew_SAVESUB) {
                SAVEI32(PL_pad_reset_pending);
            }


@@ -238,6 +253,8 @@ Perl_pad_undef(pTHX_ CV* cv)
     I32 ix;
     const PADLIST * const padlist = CvPADLIST(cv);
 
     I32 ix;
     const PADLIST * const padlist = CvPADLIST(cv);
 

+    PERL_ARGS_ASSERT_PAD_UNDEF;
+

     pad_peg("pad_undef");
     if (!padlist)
        return;
     pad_peg("pad_undef");
     if (!padlist)
        return;


@@ -245,8 +262,8 @@ Perl_pad_undef(pTHX_ CV* cv)
        return;
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
        return;
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,

-         "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf"\n",
-           PTR2UV(cv), PTR2UV(padlist))
+         "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
     );
 
     /* detach any '&' anon children in the pad; if afterwards they


@@ -325,7 +342,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

-OURSTASH 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
 


@@ -333,27 +350,32 @@ 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, HV* typestash, HV* ourstash, bool fake, bool state)

 {
     dVAR;
     const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
 {
     dVAR;
     const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);

-    SV* const namesv = newSV(0);
+    SV* const namesv
+       = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);

 
 

-    ASSERT_CURPAD_ACTIVE("pad_add_name");
+    PERL_ARGS_ASSERT_PAD_ADD_NAME;

 
 

+    ASSERT_CURPAD_ACTIVE("pad_add_name");

 
 

-    sv_upgrade(namesv, (ourstash || typestash) ? SVt_PVMG : SVt_PVNV);

     sv_setpv(namesv, name);
 
     if (typestash) {
     sv_setpv(namesv, name);
 
     if (typestash) {

+       assert(SvTYPE(namesv) == SVt_PVMG);

        SvPAD_TYPED_on(namesv);
        SvSTASH_set(namesv, (HV*)SvREFCNT_inc_simple_NN((SV*)typestash));
     }
     if (ourstash) {
        SvPAD_OUR_on(namesv);
        SvPAD_TYPED_on(namesv);
        SvSTASH_set(namesv, (HV*)SvREFCNT_inc_simple_NN((SV*)typestash));
     }
     if (ourstash) {
        SvPAD_OUR_on(namesv);

-       OURSTASH_set(namesv, ourstash);
+       SvOURSTASH_set(namesv, ourstash);

        SvREFCNT_inc_simple_void_NN(ourstash);
     }
        SvREFCNT_inc_simple_void_NN(ourstash);
     }

+    else if (state) {
+       SvPAD_STATE_on(namesv);
+    }

 
     av_store(PL_comppad_name, offset, namesv);
     if (fake) {
 
     av_store(PL_comppad_name, offset, namesv);
     if (fake) {


@@ -363,8 +385,8 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake
     }
     else {
        /* not yet introduced */
     }
     else {
        /* not yet introduced */

-       SvNV_set(namesv, (NV)PAD_MAX);  /* min */
-       SvIV_set(namesv, 0);            /* max */
+       COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX); /* min */
+       COP_SEQ_RANGE_HIGH_set(namesv, 0);              /* max */

 
        if (!PL_min_intro_pending)
            PL_min_intro_pending = offset;
 
        if (!PL_min_intro_pending)
            PL_min_intro_pending = offset;


@@ -403,8 +425,6 @@ 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
 */
 
    NWC
 */
 


@@ -473,12 +493,15 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
 {
     dVAR;
     PADOFFSET ix;
 {
     dVAR;
     PADOFFSET ix;

-    SV* const name = newSV(0);
+    SV* const name = newSV_type(SVt_PVNV);
+
+    PERL_ARGS_ASSERT_PAD_ADD_ANON;
+

     pad_peg("add_anon");
     pad_peg("add_anon");

-    sv_upgrade(name, SVt_PVNV);

     sv_setpvn(name, "&", 1);
     sv_setpvn(name, "&", 1);

-    SvIV_set(name, -1);
-    SvNV_set(name, 1);
+    /* Are these two actually ever read? */
+    COP_SEQ_RANGE_HIGH_set(name, ~0);
+    COP_SEQ_RANGE_LOW_set(name, 1);

     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[] ? */


@@ -518,6 +541,8 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
     SV         **svp;
     PADOFFSET  top, off;
 
     SV         **svp;
     PADOFFSET  top, off;
 

+    PERL_ARGS_ASSERT_PAD_CHECK_DUP;
+

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


@@ -532,16 +557,16 @@ 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)
+           && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)

            && strEQ(name, SvPVX_const(sv)))
        {
            if (is_our && (SvPAD_OUR(sv)))
                break; /* "our" masking "our" */
            Perl_warner(aTHX_ packWARN(WARN_MISC),
                "\"%s\" variable %s masks earlier declaration in same %s",
            && strEQ(name, SvPVX_const(sv)))
        {
            if (is_our && (SvPAD_OUR(sv)))
                break; /* "our" masking "our" */
            Perl_warner(aTHX_ packWARN(WARN_MISC),
                "\"%s\" variable %s masks earlier declaration in same %s",

-               (is_our ? "our" : "my"),
+               (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),

                name,
                name,

-               (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
+               (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX ? "scope" : "statement"));

            --off;
            break;
        }
            --off;
            break;
        }


@@ -553,8 +578,8 @@ 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)
-               && OURSTASH(sv) == ourstash
+               && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
+               && SvOURSTASH(sv) == ourstash

                && strEQ(name, SvPVX_const(sv)))
            {
                Perl_warner(aTHX_ packWARN(WARN_MISC),
                && strEQ(name, SvPVX_const(sv)))
            {
                Perl_warner(aTHX_ packWARN(WARN_MISC),


@@ -591,6 +616,8 @@ Perl_pad_findmy(pTHX_ const char *name)
     const AV *nameav;
     SV **name_svp;
 
     const AV *nameav;
     SV **name_svp;
 

+    PERL_ARGS_ASSERT_PAD_FINDMY;
+

     pad_peg("pad_findmy");
     offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
                NULL, &out_sv, &out_flags);
     pad_peg("pad_findmy");
     offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
                NULL, &out_sv, &out_flags);


@@ -609,7 +636,7 @@ Perl_pad_findmy(pTHX_ const char *name)
            && !SvFAKE(namesv)
            && (SvPAD_OUR(namesv))
            && strEQ(SvPVX_const(namesv), name)
            && !SvFAKE(namesv)
            && (SvPAD_OUR(namesv))
            && strEQ(SvPVX_const(namesv), name)

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

        )
            return offset;
     }
        )
            return offset;
     }


@@ -648,17 +675,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)


@@ -677,6 +699,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
     SV **new_capturep;
     const AV * const padlist = CvPADLIST(cv);
 
     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,


@@ -697,8 +721,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
            {
                if (SvFAKE(namesv))
                    fake_offset = offset; /* in case we don't find a real one */
            {
                if (SvFAKE(namesv))
                    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 */
+               else if (  seq >  COP_SEQ_RANGE_LOW(namesv)     /* min */
+                       && seq <= COP_SEQ_RANGE_HIGH(namesv))   /* max */

                    break;
            }
        }
                    break;
            }
        }


@@ -721,18 +745,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) 

                ));
            }
 
                ));
            }
 


@@ -761,6 +786,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                else {
                    int newwarn = warn;
                    if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
                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),


@@ -789,7 +815,9 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                        "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
                        PTR2UV(cv), PTR2UV(*out_capture)));
 
                        "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
                        PTR2UV(cv), PTR2UV(*out_capture)));
 

-                   if (SvPADSTALE(*out_capture)) {
+                   if (SvPADSTALE(*out_capture)
+                       && !SvPAD_STATE(name_svp[offset]))
+                   {

                        if (ckWARN(WARN_CLOSURE))
                            Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
                                "Variable \"%s\" is not available", name);
                        if (ckWARN(WARN_CLOSURE))
                            Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
                                "Variable \"%s\" is not available", name);


@@ -844,20 +872,21 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
            SvPVX_const(*out_name_sv),
            SvPAD_TYPED(*out_name_sv)
                    ? SvSTASH(*out_name_sv) : NULL,
            SvPVX_const(*out_name_sv),
            SvPAD_TYPED(*out_name_sv)
                    ? SvSTASH(*out_name_sv) : NULL,

-           OURSTASH(*out_name_sv),
-           1  /* fake */
+           SvOURSTASH(*out_name_sv),
+           1,  /* fake */
+           SvPAD_STATE(*out_name_sv) ? 1 : 0 /* state variable ? */

        );
 
        new_namesv = AvARRAY(PL_comppad_name)[new_offset];
        );
 
        new_namesv = AvARRAY(PL_comppad_name)[new_offset];

-       SvIV_set(new_namesv, *out_flags);
+       PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);

 
 

-       SvNV_set(new_namesv, (NV)0);
+       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 */
        if (SvPAD_OUR(new_namesv)) {
            NOOP;   /* do nothing */
        }
        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 {


@@ -868,7 +897,7 @@ 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;


@@ -918,6 +947,9 @@ void
 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
 {
     dVAR;
 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,


@@ -988,13 +1020,14 @@ 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_HIGH(sv)) {
+           COP_SEQ_RANGE_HIGH_set(sv, PAD_MAX);        /* 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))

            );
        }
     }
            );
        }
     }


@@ -1032,18 +1065,19 @@ Perl_pad_leavemy(pTHX)
                    && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
                Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
                            "%"SVf" never introduced",
                    && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
                Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
                            "%"SVf" never introduced",

-                           (void*)sv);
+                           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) == PAD_MAX) {
+           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))

            );
        }
     }
            );
        }
     }


@@ -1305,6 +1339,8 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
     SV **ppad;
     I32 ix;
 
     SV **ppad;
     I32 ix;
 

+    PERL_ARGS_ASSERT_DO_DUMP_PAD;
+

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


@@ -1330,18 +1366,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)
                );
        }


@@ -1374,6 +1410,8 @@ S_cv_dump(pTHX_ const CV *cv, const char *title)
     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,


@@ -1427,6 +1465,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


@@ -1445,8 +1485,7 @@ Perl_cv_clone(pTHX_ CV *proto)
     ENTER;
     SAVESPTR(PL_compcv);
 
     ENTER;
     SAVESPTR(PL_compcv);
 

-    cv = PL_compcv = (CV*)newSV(0);
-    sv_upgrade((SV *)cv, SvTYPE(proto));
+    cv = PL_compcv = (CV*)newSV_type(SvTYPE(proto));

     CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
     CvCLONED_on(cv);
 
     CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
     CvCLONED_on(cv);
 


@@ -1483,19 +1522,19 @@ Perl_cv_clone(pTHX_ CV *proto)
        SV *sv = NULL;
        if (namesv && namesv != &PL_sv_undef) { /* lexical */
            if (SvFAKE(namesv)) {   /* lexical from outside? */
        SV *sv = NULL;
        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)) {
+               /* 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)) {

                    if (ckWARN(WARN_CLOSURE))
                        Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
                            "Variable \"%s\" is not available", SvPVX_const(namesv));
                    sv = NULL;
                }
                    if (ckWARN(WARN_CLOSURE))
                        Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
                            "Variable \"%s\" is not available", SvPVX_const(namesv));
                    sv = NULL;
                }

-               else {
-                   assert(!SvPADSTALE(sv));
+               else 

                    SvREFCNT_inc_simple_void_NN(sv);
                    SvREFCNT_inc_simple_void_NN(sv);

-               }

            }
            if (!sv) {
                 const char sigil = SvPVX_const(namesv)[0];
            }
            if (!sv) {
                 const char sigil = SvPVX_const(namesv)[0];


@@ -1508,6 +1547,9 @@ Perl_cv_clone(pTHX_ CV *proto)
                else
                    sv = newSV(0);
                SvPADMY_on(sv);
                else
                    sv = newSV(0);
                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])) {


@@ -1568,6 +1610,8 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
     AV * const comppad = (AV*)AvARRAY(padlist)[1];
     SV ** const namepad = AvARRAY(comppad_name);
     SV ** const curpad = AvARRAY(comppad);
     AV * const comppad = (AV*)AvARRAY(padlist)[1];
     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--) {
     PERL_UNUSED_ARG(old_cv);
 
     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {


@@ -1598,6 +1642,9 @@ void
 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 {
     dVAR;
 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 {
     dVAR;

+
+    PERL_ARGS_ASSERT_PAD_PUSH;
+

     if (depth > AvFILLp(padlist)) {
        SV** const svp = AvARRAY(padlist);
        AV* const newpad = newAV();
     if (depth > AvFILLp(padlist)) {
        SV** const svp = AvARRAY(padlist);
        AV* const newpad = newAV();


@@ -1610,7 +1657,10 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
        for ( ;ix > 0; ix--) {
            if (names_fill >= ix && names[ix] != &PL_sv_undef) {
                const char sigil = SvPVX_const(names[ix])[0];
        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]));
                }
                    /* outer lexical or anon code */
                    av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
                }