This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #123223] Make PADNAME a separate type
authorFather Chrysostomos <sprout@cpan.org>
Fri, 28 Nov 2014 06:30:54 +0000 (22:30 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 30 Nov 2014 19:48:42 +0000 (11:48 -0800)
distinct from SV.  This should fix the CPAN modules that were failing
when the PadnameLVALUE flag was added, because it shared the same
bit as SVs_OBJECT and pad names were going through code paths not
designed to handle pad names.

Unfortunately, it will probably break other CPAN modules, but I think
this change is for the better, as it makes both pad names and SVs sim-
pler and makes pad names take less memory.

17 files changed:
dump.c
embed.fnc
embed.h
ext/B/B.xs
ext/B/B/Showlex.pm
ext/B/Makefile.PL
ext/B/t/showlex.t
op.c
pad.c
pad.h
perl.h
pp.c
proto.h
scope.c
scope.h
sv.c
sv.h

diff --git a/dump.c b/dump.c
index 38244e4..2781ada 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1431,15 +1431,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                   (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
                   (int)(PL_dumpindent*level), "");
 
-    if (!((flags & SVpad_NAME) == SVpad_NAME
-         && (type == SVt_PVMG || type == SVt_PVNV))) {
-       if ((flags & SVs_PADSTALE))
+    if ((flags & SVs_PADSTALE))
            sv_catpv(d, "PADSTALE,");
-    }
-    if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
-       if ((flags & SVs_PADTMP))
+    if ((flags & SVs_PADTMP))
            sv_catpv(d, "PADTMP,");
-    }
     append_flags(d, flags, first_sv_flags_names);
     if (flags & SVf_ROK)  {    
                                sv_catpv(d, "ROK,");
@@ -1489,11 +1484,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     case SVt_PVMG:
        if (SvTAIL(sv))         sv_catpv(d, "TAIL,");
        if (SvVALID(sv))        sv_catpv(d, "VALID,");
-       if (SvPAD_TYPED(sv))    sv_catpv(d, "TYPED,");
-       if (SvPAD_OUR(sv))      sv_catpv(d, "OUR,");
        /* FALLTHROUGH */
-    case SVt_PVNV:
-       if (SvPAD_STATE(sv))    sv_catpv(d, "STATE,");
        goto evaled_or_uv;
     case SVt_PVAV:
        break;
@@ -1562,13 +1553,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        PerlIO_putc(file, '\n');
     }
 
-    if ((type == SVt_PVNV || type == SVt_PVMG)
-       && (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
-       Perl_dump_indent(aTHX_ level, file, "  COP_LOW = %"UVuf"\n",
-                        (UV) COP_SEQ_RANGE_LOW(sv));
-       Perl_dump_indent(aTHX_ level, file, "  COP_HIGH = %"UVuf"\n",
-                        (UV) COP_SEQ_RANGE_HIGH(sv));
-    } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
+    if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
                && type != SVt_PVCV && type != SVt_PVFM  && type != SVt_REGEXP
                && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
               || type == SVt_NV) {
@@ -1638,14 +1623,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     }
 
     if (type >= SVt_PVMG) {
-       if (type == SVt_PVMG && SvPAD_OUR(sv)) {
-           HV * const ost = SvOURSTASH(sv);
-           if (ost)
-               do_hv_dump(level, file, "  OURSTASH", ost);
-       } else {
-           if (SvMAGIC(sv))
+       if (SvMAGIC(sv))
                do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
-       }
        if (SvSTASH(sv))
            do_hv_dump(level, file, "  STASH", SvSTASH(sv));
 
index 37638c8..bc776e1 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1000,6 +1000,8 @@ AmdbR     |HV*    |newHV
 ApaR   |HV*    |newHVhv        |NULLOK HV *hv
 Apabm  |IO*    |newIO
 Apda   |OP*    |newLISTOP      |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last
+AMpda  |PADNAME *|newPADNAMEouter|NN PADNAME *outer
+AMpda  |PADNAME *|newPADNAMEpvn|NN const char *s|STRLEN len
 AMpda  |PADNAMELIST *|newPADNAMELIST|size_t max
 #ifdef USE_ITHREADS
 Apda   |OP*    |newPADOP       |I32 type|I32 flags|NN SV* sv
@@ -2588,7 +2590,9 @@ AMpdR     |PADNAME *|padnamelist_fetch|NN PADNAMELIST *pnl|SSize_t key
 Xop    |void   |padnamelist_free|NN PADNAMELIST *pnl
 AMpd   |PADNAME **|padnamelist_store|NN PADNAMELIST *pnl|SSize_t key \
                                     |NULLOK PADNAME *val
+Xop    |void   |padname_free   |NN PADNAME *pn
 #if defined(USE_ITHREADS)
+pdR    |PADNAME *|padname_dup  |NN PADNAME *src|NN CLONE_PARAMS *param
 pR     |PADNAMELIST *|padnamelist_dup|NN PADNAMELIST *srcpad \
                                      |NN CLONE_PARAMS *param
 pdR    |PADLIST *|padlist_dup  |NN PADLIST *srcpad \
diff --git a/embed.h b/embed.h
index 1ea0b1f..491daa4 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define newNULLLIST()          Perl_newNULLLIST(aTHX)
 #define newOP(a,b)             Perl_newOP(aTHX_ a,b)
 #define newPADNAMELIST(a)      Perl_newPADNAMELIST(aTHX_ a)
+#define newPADNAMEouter(a)     Perl_newPADNAMEouter(aTHX_ a)
+#define newPADNAMEpvn(a,b)     Perl_newPADNAMEpvn(aTHX_ a,b)
 #define newPMOP(a,b)           Perl_newPMOP(aTHX_ a,b)
 #define newPROG(a)             Perl_newPROG(aTHX_ a)
 #define newPVOP(a,b,c)         Perl_newPVOP(aTHX_ a,b,c)
 #  if defined(USE_ITHREADS)
 #define mro_meta_dup(a,b)      Perl_mro_meta_dup(aTHX_ a,b)
 #define padlist_dup(a,b)       Perl_padlist_dup(aTHX_ a,b)
+#define padname_dup(a,b)       Perl_padname_dup(aTHX_ a,b)
 #define padnamelist_dup(a,b)   Perl_padnamelist_dup(aTHX_ a,b)
 #  endif
 #  if defined(USE_LOCALE)     && (defined(PERL_IN_LOCALE_C) || defined (PERL_EXT_POSIX))
index def00a0..86bd09c 100644 (file)
@@ -621,6 +621,7 @@ typedef struct refcounted_he        *B__RHE;
 typedef PADLIST        *B__PADLIST;
 #endif
 typedef PADNAMELIST *B__PADNAMELIST;
+typedef PADNAME        *B__PADNAME;
 
 
 #ifdef MULTIPLICITY
@@ -1340,15 +1341,6 @@ MODULE = B       PACKAGE = B::IV
 #define IV_uvx_ix      sv_UVp | STRUCT_OFFSET(struct xpvuv, xuv_uv)
 #define NV_nvx_ix      sv_NVp | STRUCT_OFFSET(struct xpvnv, xnv_u.xnv_nv)
 
-#define NV_cop_seq_range_low_ix \
-                       sv_U32p | STRUCT_OFFSET(struct xpvnv, xnv_u.xpad_cop_seq.xlow)
-#define NV_cop_seq_range_high_ix \
-                       sv_U32p | STRUCT_OFFSET(struct xpvnv, xnv_u.xpad_cop_seq.xhigh)
-#define NV_parent_pad_index_ix \
-                       sv_U32p | STRUCT_OFFSET(struct xpvnv, xnv_u.xpad_cop_seq.xlow)
-#define NV_parent_fakelex_flags_ix \
-                       sv_U32p | STRUCT_OFFSET(struct xpvnv, xnv_u.xpad_cop_seq.xhigh)
-
 #define PV_cur_ix      sv_STRLENp | STRUCT_OFFSET(struct xpv, xpv_cur)
 #define PV_len_ix      sv_STRLENp | STRUCT_OFFSET(struct xpv, xpv_len)
 
@@ -1414,10 +1406,6 @@ IVX(sv)
        B::IV::IVX = IV_ivx_ix
        B::IV::UVX = IV_uvx_ix
        B::NV::NVX = NV_nvx_ix
-       B::NV::COP_SEQ_RANGE_LOW = NV_cop_seq_range_low_ix
-       B::NV::COP_SEQ_RANGE_HIGH = NV_cop_seq_range_high_ix
-       B::NV::PARENT_PAD_INDEX = NV_parent_pad_index_ix
-       B::NV::PARENT_FAKELEX_FLAGS = NV_parent_fakelex_flags_ix
        B::PV::CUR = PV_cur_ix
        B::PV::LEN = PV_len_ix
        B::PVMG::SvSTASH = PVMG_stash_ix
@@ -2127,20 +2115,113 @@ PadnamelistARRAY(pnl)
            PADNAME **padp = PadnamelistARRAY(pnl);
             SSize_t i = 0;
            for (; i <= PadnamelistMAX(pnl); i++)
-               XPUSHs(make_sv_object(aTHX_ padp[i]));
+           {
+               SV *rv = sv_newmortal();
+               sv_setiv(newSVrv(rv,padp[i] ? "B::PADNAME" : "B::SPECIAL"),
+                        PTR2IV(padp[i]));
+               XPUSHs(rv);
+           }
        }
 
-void
+B::PADNAME
 PadnamelistARRAYelt(pnl, idx)
        B::PADNAMELIST  pnl
        SSize_t         idx
-    PPCODE:
+    CODE:
        if (idx < 0 || idx > PadnamelistMAX(pnl))
-           XPUSHs(make_sv_object(aTHX_ NULL));
+           RETVAL = NULL;
        else
-           XPUSHs(make_sv_object(aTHX_
-                                 (SV *)PadnamelistARRAY(pnl)[idx]));
+           RETVAL = PadnamelistARRAY(pnl)[idx];
+    OUTPUT:
+       RETVAL
 
 U32
 PadnamelistREFCNT(pnl)
        B::PADNAMELIST  pnl
+
+MODULE = B     PACKAGE = B::PADNAME    PREFIX = Padname
+
+#define PN_type_ix \
+       sv_SVp | STRUCT_OFFSET(struct padname,xpadn_type_u.xpadn_typestash)
+#define PN_ourstash_ix \
+       sv_SVp | STRUCT_OFFSET(struct padname,xpadn_ourstash)
+#define PN_len_ix \
+       sv_U8p | STRUCT_OFFSET(struct padname,xpadn_len)
+#define PN_refcnt_ix \
+       sv_U32p | STRUCT_OFFSET(struct padname, xpadn_refcnt)
+#define PN_cop_seq_range_low_ix \
+       sv_U32p | STRUCT_OFFSET(struct padname, xpadn_low)
+#define PN_cop_seq_range_high_ix \
+       sv_U32p | STRUCT_OFFSET(struct padname, xpadn_high)
+#define PN_parent_pad_index_ix \
+       sv_U32p | STRUCT_OFFSET(struct padname, xpadn_low)
+#define PN_parent_fakelex_flags_ix \
+       sv_U32p | STRUCT_OFFSET(struct padname, xpadn_high)
+
+void
+PadnameTYPE(pn)
+       B::PADNAME      pn
+    ALIAS:
+       B::PADNAME::TYPE        = PN_type_ix
+       B::PADNAME::OURSTASH    = PN_ourstash_ix
+       B::PADNAME::LEN         = PN_len_ix
+       B::PADNAME::REFCNT      = PN_refcnt_ix
+       B::PADNAME::COP_SEQ_RANGE_LOW    = PN_cop_seq_range_low_ix
+       B::PADNAME::COP_SEQ_RANGE_HIGH   = PN_cop_seq_range_high_ix
+       B::PADNAME::PARENT_PAD_INDEX     = PN_parent_pad_index_ix
+       B::PADNAME::PARENT_FAKELEX_FLAGS = PN_parent_fakelex_flags_ix
+    PREINIT:
+       char *ptr;
+       SV *ret;
+    PPCODE:
+       ptr = (ix & 0xFFFF) + (char *)pn;
+       switch ((U8)(ix >> 16)) {
+       case (U8)(sv_SVp >> 16):
+           ret = make_sv_object(aTHX_ *((SV **)ptr));
+           break;
+       case (U8)(sv_U32p >> 16):
+           ret = sv_2mortal(newSVuv(*((U32 *)ptr)));
+           break;
+       case (U8)(sv_U8p >> 16):
+           ret = sv_2mortal(newSVuv(*((U8 *)ptr)));
+           break;
+       default:
+           NOT_REACHED;
+       }
+       ST(0) = ret;
+       XSRETURN(1);
+
+SV *
+PadnamePV(pn)
+       B::PADNAME      pn
+    PREINIT:
+       dXSTARG;
+    PPCODE:
+       PERL_UNUSED_ARG(RETVAL);
+       sv_setpvn(TARG, PadnamePV(pn), PadnameLEN(pn));
+       SvUTF8_on(TARG);
+       XPUSHTARG;
+
+BOOT:
+{
+    /* Uses less memory than an ALIAS.  */
+    GV *gv = gv_fetchpvs("B::PADNAME::TYPE", 1, SVt_PVGV);
+    sv_setsv((SV *)gv_fetchpvs("B::PADNAME::SvSTASH",1,SVt_PVGV),(SV *)gv);
+    sv_setsv((SV *)gv_fetchpvs("B::PADNAME::PROTOCV",1,SVt_PVGV),(SV *)gv);
+    sv_setsv((SV *)gv_fetchpvs("B::PADNAME::PVX",1,SVt_PVGV),
+            (SV *)gv_fetchpvs("B::PADNAME::PV" ,1,SVt_PVGV));
+}
+
+U32
+PadnameFLAGS(pn)
+       B::PADNAME      pn
+    CODE:
+       RETVAL = PadnameFLAGS(pn);
+       /* backward-compatibility hack, which should be removed if the
+          flags field becomes large enough to hold SVf_FAKE (and
+          PADNAMEt_OUTER should be renumbered to match SVf_FAKE) */
+       assert(SVf_FAKE >= 1<<(sizeof(PadnameFLAGS(pn)) * 8));
+       if (PadnameOUTER(pn))
+           RETVAL |= SVf_FAKE;
+    OUTPUT:
+       RETVAL
index 74b2bef..4ccb26d 100644 (file)
@@ -36,7 +36,8 @@ sub shownamearray {
     for ($i = 0; $i < $count; $i++) {
        my $sv = $els[$i];
        if (class($sv) ne "SPECIAL") {
-           printf $walkHandle "$i: %s (0x%lx) %s\n", class($sv), $$sv, $sv->PVX;
+           printf $walkHandle "$i: (0x%lx) %s\n",
+                               $$sv, $sv->PVX // "undef" || "const";
        } else {
            printf $walkHandle "$i: %s\n", $sv->terse;
            #printf $walkHandle "$i: %s\n", B::Concise::concise_sv($sv);
@@ -64,16 +65,27 @@ sub showlex {
 
 my ($newlex, $nosp1); # rendering state vars
 
+sub padname_terse {
+    my $name = shift;
+    return $name->terse if class($name) eq 'SPECIAL';
+    my $str = $name->PVX;
+    return sprintf "(0x%lx) %s",
+              $$name,
+              length $str ? qq'"$str"' : defined $str ? "const" : 'undef';
+}
+
 sub newlex { # drop-in for showlex
     my ($objname, $names, $vals) = @_;
     my @names = $names->ARRAY;
     my @vals  = $vals->ARRAY;
     my $count = @names;
     print $walkHandle "$objname Pad has $count entries\n";
-    printf $walkHandle "0: %s\n", $names[0]->terse unless $nosp1;
+    printf $walkHandle "0: %s\n", padname_terse($names[0]) unless $nosp1;
     for (my $i = 1; $i < $count; $i++) {
-       printf $walkHandle "$i: %s = %s\n", $names[$i]->terse, $vals[$i]->terse
-           unless $nosp1 and $names[$i]->terse =~ /SPECIAL/;
+       printf $walkHandle "$i: %s = %s\n", padname_terse($names[$i]),
+                                           $vals[$i]->terse,
+           unless $nosp1
+              and class($names[$i]) eq 'SPECIAL' || !$names[$i]->LEN;
     }
 }
 
index cc16ad9..8708c0d 100644 (file)
@@ -15,7 +15,8 @@ if ($core) {
 }
 
 my @names = ({ name => 'HEf_SVKEY', macro => 1, type => "IV" },
-             qw(SVTYPEMASK SVt_PVGV SVt_PVHV PAD_FAKELEX_ANON PAD_FAKELEX_MULTI));
+             qw(SVTYPEMASK SVt_PVGV SVt_PVHV PAD_FAKELEX_ANON
+                PAD_FAKELEX_MULTI SVpad_STATE SVpad_TYPED SVpad_OUR));
 
 my @depend;
 
@@ -29,6 +30,7 @@ foreach my $tuple (['cop.h'],
                    ['op.h'],
                    ['opcode.h', 'OPp'],
                    ['op_reg_common.h','(?:(?:RXf_)?PMf_)'],
+                   ['pad.h','PADNAMEt_'],
                    ['regexp.h','RXf_'],
                    ['sv.h', 'SV(?:[fps]|pad)_'],
                   ) {
index 2871622..dd5cdb7 100644 (file)
@@ -31,7 +31,7 @@ if ($is_thread) {
     ok "# use5005threads: test skipped\n";
 } else {
     $a = `$^X $path "-MO=Showlex" -e "my \@one" 2>&1`;
-    like ($a, qr/sv_undef.*PVNV.*\@one.*Nullsv.*AV/s,
+    like ($a, qr/undef.*: \([^)]*\) \@one.*Nullsv.*AV/s,
          "canonical usage works");
 }
 
@@ -43,8 +43,8 @@ my ($out, $newlex);   # output, option-flag
 sub padrep {
     my ($varname,$newlex) = @_;
     return ($newlex)
-       ? 'PVNV \(0x[0-9a-fA-F]+\) "\\'.$varname.'" = '
-       : "PVNV \\\(0x[0-9a-fA-F]+\\\) \\$varname\n";
+       ? '\(0x[0-9a-fA-F]+\) "\\'.$varname.'" = '
+       : "\\\(0x[0-9a-fA-F]+\\\) \\$varname\n";
 }
 
 for $newlex ('', '-newlex') {
diff --git a/op.c b/op.c
index 411e374..fdf2a03 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7780,7 +7780,7 @@ S_op_const_sv(pTHX_ const OP *o, CV *cv, bool allow_lex)
            SAVEFREESV(sv);
        }
        else if (allow_lex && type == OP_PADSV) {
-               if (PAD_COMPNAME_FLAGS(o->op_targ) & SVf_FAKE)
+               if (PAD_COMPNAME_FLAGS(o->op_targ) & PADNAMEt_OUTER)
                {
                    sv = &PL_sv_undef; /* an arbitrary non-null value */
                    padsv = TRUE;
@@ -7922,9 +7922,6 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     else if (PadnameIsSTATE(name) || CvDEPTH(outcv))
        cv = *spot;
     else {
-       MAGIC *mg;
-       SvUPGRADE((SV *)name, SVt_PVMG);
-       mg = mg_find((SV *)name, PERL_MAGIC_proto);
        assert (SvTYPE(*spot) == SVt_PVCV);
        if (CvNAMED(*spot))
            hek = CvNAME_HEK(*spot);
@@ -7941,15 +7938,8 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            );
            CvLEXICAL_on(*spot);
        }
-       if (mg) {
-           assert(mg->mg_obj);
-           cv = (CV *)mg->mg_obj;
-       }
-       else {
-           sv_magic((SV *)name, &PL_sv_undef, PERL_MAGIC_proto, NULL, 0);
-           mg = mg_find((SV *)name, PERL_MAGIC_proto);
-       }
-       spot = (CV **)(svspot = &mg->mg_obj);
+       cv = PadnamePROTOCV(name);
+       svspot = (SV **)(spot = &PadnamePROTOCV(name));
     }
 
     if (block) {
@@ -11003,11 +10993,8 @@ Perl_find_lexical_cv(pTHX_ PADOFFSET off)
                [off = PARENT_PAD_INDEX(name)];
     }
     assert(!PadnameIsOUR(name));
-    if (!PadnameIsSTATE(name) && SvMAGICAL(name)) {
-       MAGIC * mg = mg_find((SV *)name, PERL_MAGIC_proto);
-       assert(mg);
-       assert(mg->mg_obj);
-       return (CV *)mg->mg_obj;
+    if (!PadnameIsSTATE(name) && PadnamePROTOCV(name)) {
+       return PadnamePROTOCV(name);
     }
     return (CV *)AvARRAY(PadlistARRAY(CvPADLIST(compcv))[1])[off];
 }
diff --git a/pad.c b/pad.c
index 6bcf665..a27c684 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -147,14 +147,12 @@ Points directly to the body of the L</PL_comppad> array.
 #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
+  STMT_START { (sv)->xpadn_low = (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
+  STMT_START { (sv)->xpadn_high = (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 PARENT_PAD_INDEX_set           COP_SEQ_RANGE_LOW_set
+#define PARENT_FAKELEX_FLAGS_set       COP_SEQ_RANGE_HIGH_set
 
 #ifdef DEBUGGING
 void
@@ -242,7 +240,7 @@ Perl_pad_new(pTHX_ int flags)
     else {
        av_store(pad, 0, NULL);
        padname = newPADNAMELIST(0);
-       padnamelist_store(padname, 0, &PL_sv_undef);
+       padnamelist_store(padname, 0, &PL_padname_undef);
     }
 
     /* Most subroutines never recurse, hence only need 2 entries in the padlist
@@ -550,9 +548,9 @@ S_pad_alloc_name(pTHX_ PADNAME *name, U32 flags, HV *typestash,
     ASSERT_CURPAD_ACTIVE("pad_alloc_name");
 
     if (typestash) {
-       assert(SvTYPE(name) == SVt_PVMG);
        SvPAD_TYPED_on(name);
-       SvSTASH_set(name, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
+       PadnameTYPE(name) =
+           MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash)));
     }
     if (ourstash) {
        SvPAD_OUR_on(name);
@@ -563,7 +561,7 @@ S_pad_alloc_name(pTHX_ PADNAME *name, U32 flags, HV *typestash,
        SvPAD_STATE_on(name);
     }
 
-    padnamelist_store(PL_comppad_name, offset, (SV *)name);
+    padnamelist_store(PL_comppad_name, offset, name);
     PadnamelistMAXNAMED(PL_comppad_name) = offset;
     return offset;
 }
@@ -602,18 +600,14 @@ Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
        Perl_croak(aTHX_ "panic: pad_add_name_pvn illegal flag bits 0x%" UVxf,
                   (UV)flags);
 
-    name = (PADNAME *)
-       newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
-    
-    sv_setpvn((SV *)name, namepv, namelen);
-    SvUTF8_on(name);
+    name = newPADNAMEpvn(namepv, namelen);
 
     if ((flags & padadd_NO_DUP_CHECK) == 0) {
        ENTER;
-       SAVEFREESV(name); /* in case of fatal warnings */
+       SAVEFREEPADNAME(name); /* in case of fatal warnings */
        /* check for duplicate declaration */
        pad_check_dup(name, flags & padadd_OUR, ourstash);
-       SvREFCNT_inc_simple_void_NN(name);
+       PadnameREFCNT(name)++;
        LEAVE;
     }
 
@@ -763,7 +757,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
                break;
        }
        if (konst) {
-           padnamelist_store(PL_comppad_name, retval, &PL_sv_no);
+           padnamelist_store(PL_comppad_name, retval, &PL_padname_const);
            tmptype &= ~SVf_READONLY;
            tmptype |= SVs_PADTMP;
        }
@@ -805,16 +799,15 @@ PADOFFSET
 Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
 {
     PADOFFSET ix;
-    SV* const name = newSV_type(SVt_PVNV);
+    PADNAME * const name = newPADNAMEpvn("&", 1);
 
     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);
+     * PERL_PADSEQ_INTRO.  They should be 0 by default.  */
+    assert(COP_SEQ_RANGE_LOW (name) != PERL_PADSEQ_INTRO);
+    assert(COP_SEQ_RANGE_HIGH(name) != PERL_PADSEQ_INTRO);
     ix = pad_alloc(optype, SVs_PADMY);
     padnamelist_store(PL_comppad_name, ix, name);
     /* XXX DAPM use PL_curpad[] ? */
@@ -1317,7 +1310,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
           type as the source, independent of the flags set, and on it being
           "good" and only copying flag bits and pointers that it understands.
        */
-       PADNAME *new_name = (PADNAME *)newSVsv((SV *)*out_name);
+       PADNAME *new_name = newPADNAMEouter(*out_name);
        PADNAMELIST * const ocomppad_name = PL_comppad_name;
        PAD * const ocomppad = PL_comppad;
        PL_comppad_name = PadlistNAMES(padlist);
@@ -1331,7 +1324,6 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
                              PadnameOURSTASH(*out_name)
                              );
 
-       SvFAKE_on(new_name);
        DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                               "Pad addname: %ld \"%.*s\" FAKE\n",
                               (long)new_offset,
@@ -1608,7 +1600,7 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
        if (PadnamelistARRAY(PL_comppad_name)[po]) {
            assert(!PadnameLEN(PadnamelistARRAY(PL_comppad_name)[po]));
        }
-       PadnamelistARRAY(PL_comppad_name)[po] = (PADNAME *)&PL_sv_undef;
+       PadnamelistARRAY(PL_comppad_name)[po] = &PL_padname_undef;
     }
     /* Use PL_constpadix here, not PL_padix.  The latter may have been
        reset by pad_reset.  We don’t want pad_alloc to have to scan the
@@ -1749,10 +1741,10 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
        PADNAME ** const namep = PadnamelistARRAY(PL_comppad_name);
        PADOFFSET ix;
        for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
-           if (!namep[ix]) namep[ix] = &PL_sv_undef;
+           if (!namep[ix]) namep[ix] = &PL_padname_undef;
            if (!PL_curpad[ix] || SvIMMORTAL(PL_curpad[ix]))
                continue;
-           if (SvPADMY(PL_curpad[ix]) && !SvFAKE(namep[ix])) {
+           if (SvPADMY(PL_curpad[ix]) && !PadnameOUTER(namep[ix])) {
                /* This is a work around for how the current implementation of
                   ?{ } blocks in regexps interacts with lexicals.
 
@@ -2315,23 +2307,25 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
     I32 ix;
     PADNAMELIST * const comppad_name = PadlistNAMES(padlist);
     AV * const comppad = PadlistARRAY(padlist)[1];
-    SV ** const namepad = PadnamelistARRAY(comppad_name);
+    PADNAME ** const namepad = PadnamelistARRAY(comppad_name);
     SV ** const curpad = AvARRAY(comppad);
 
     PERL_ARGS_ASSERT_PAD_FIXUP_INNER_ANONS;
     PERL_UNUSED_ARG(old_cv);
 
     for (ix = PadnamelistMAX(comppad_name); ix > 0; ix--) {
-        const SV * const namesv = namepad[ix];
-       if (namesv && namesv != &PL_sv_undef && !SvPAD_STATE(namesv)
-           && *SvPVX_const(namesv) == '&')
+        const PADNAME * const name = namepad[ix];
+       if (name && name != &PL_padname_undef && !PadnameIsSTATE(name)
+           && *PadnamePV(name) == '&')
        {
          if (SvTYPE(curpad[ix]) == SVt_PVCV) {
-           MAGIC * const mg =
-               SvMAGICAL(curpad[ix])
-                   ? mg_find(curpad[ix], PERL_MAGIC_proto)
-                   : NULL;
-           CV * const innercv = MUTABLE_CV(mg ? mg->mg_obj : curpad[ix]);
+           /* XXX 0afba48f added code here to check for a proto CV
+                  attached to the pad entry by magic.  But shortly there-
+                  after 81df9f6f95 moved the magic to the pad name.  The
+                  code here was never updated, so it wasn’t doing anything
+                  and got deleted when PADNAME became a distinct type.  Is
+                  there any bug as a result?  */
+           CV * const innercv = MUTABLE_CV(curpad[ix]);
            if (CvOUTSIDE(innercv) == old_cv) {
                if (!CvWEAKOUTSIDE(innercv)) {
                    SvREFCNT_dec(old_cv);
@@ -2613,7 +2607,8 @@ Perl_padnamelist_store(pTHX_ PADNAMELIST *pnl, SSize_t key, PADNAME *val)
        PadnamelistMAX(pnl) = key;
     }
     ary = PadnamelistARRAY(pnl);
-    SvREFCNT_dec(ary[key]);
+    if (ary[key])
+       PadnameREFCNT_dec(ary[key]);
     ary[key] = val;
     return &ary[key];
 }
@@ -2641,7 +2636,12 @@ Perl_padnamelist_free(pTHX_ PADNAMELIST *pnl)
     PERL_ARGS_ASSERT_PADNAMELIST_FREE;
     if (!--PadnamelistREFCNT(pnl)) {
        while(PadnamelistMAX(pnl) >= 0)
-           SvREFCNT_dec(PadnamelistARRAY(pnl)[PadnamelistMAX(pnl)--]);
+       {
+           PADNAME * const pn =
+               PadnamelistARRAY(pnl)[PadnamelistMAX(pnl)--];
+           if (pn)
+               PadnameREFCNT_dec(pn);
+       }
        Safefree(PadnamelistARRAY(pnl));
        Safefree(pnl);
     }
@@ -2677,14 +2677,136 @@ Perl_padnamelist_dup(pTHX_ PADNAMELIST *srcpad, CLONE_PARAMS *param)
 
     ptr_table_store(PL_ptr_table, srcpad, dstpad);
     for (; max >= 0; max--)
+      if (PadnamelistARRAY(srcpad)[max]) {
        PadnamelistARRAY(dstpad)[max] =
-           sv_dup_inc(PadnamelistARRAY(srcpad)[max], param);
+           padname_dup(PadnamelistARRAY(srcpad)[max], param);
+       PadnameREFCNT(PadnamelistARRAY(dstpad)[max])++;
+      }
 
     return dstpad;
 }
 
 #endif /* USE_ITHREADS */
 
+/*
+=for apidoc newPADNAMEpvn
+
+Constructs and returns a new pad name.  I<s> must be a UTF8 string.  Do not
+use this for pad names that point to outer lexicals.  See
+L</newPADNAMEouter>.
+
+=cut
+*/
+
+PADNAME *
+Perl_newPADNAMEpvn(pTHX_ const char *s, STRLEN len)
+{
+    struct padname_with_str *alloc;
+    char *alloc2; /* for Newxz */
+    PADNAME *pn;
+    PERL_ARGS_ASSERT_NEWPADNAMEPVN;
+    Newxz(alloc2,
+         STRUCT_OFFSET(struct padname_with_str, xpadn_str[0]) + len + 1,
+         char);
+    alloc = (struct padname_with_str *)alloc2;
+    pn = (PADNAME *)alloc;
+    PadnameREFCNT(pn) = 1;
+    PadnamePV(pn) = alloc->xpadn_str;
+    Copy(s, PadnamePV(pn), len, char);
+    *(PadnamePV(pn) + len) = '\0';
+    PadnameLEN(pn) = len;
+    return pn;
+}
+
+/*
+=for apidoc newPADNAMEouter
+
+Constructs and returns a new pad name.  Only use this function for names
+that refer to outer lexicals.  (See also L</newPADNAMEpvn>.)  I<outer> is
+the outer pad name that this one mirrors.  The returned pad name has the
+PADNAMEt_OUTER flag already set.
+
+=cut
+*/
+
+PADNAME *
+Perl_newPADNAMEouter(pTHX_ PADNAME *outer)
+{
+    PADNAME *pn;
+    PERL_ARGS_ASSERT_NEWPADNAMEOUTER;
+    Newxz(pn, 1, PADNAME);
+    PadnameREFCNT(pn) = 1;
+    PadnamePV(pn) = PadnamePV(outer);
+    /* Not PadnameREFCNT(outer), because ‘outer’ may itself close over
+       another entry.  The original pad name owns the buffer.  */
+    PadnameREFCNT(PADNAME_FROM_PV(PadnamePV(outer)))++;
+    PadnameFLAGS(pn) = PADNAMEt_OUTER;
+    PadnameLEN(pn) = PadnameLEN(outer);
+    return pn;
+}
+
+void
+Perl_padname_free(pTHX_ PADNAME *pn)
+{
+    PERL_ARGS_ASSERT_PADNAME_FREE;
+    if (!--PadnameREFCNT(pn)) {
+       if (UNLIKELY(pn == &PL_padname_undef || pn == &PL_padname_const)) {
+           PadnameREFCNT(pn) = SvREFCNT_IMMORTAL;
+           return;
+       }
+       SvREFCNT_dec(PadnameTYPE(pn)); /* Takes care of protocv, too.  */
+       SvREFCNT_dec(PadnameOURSTASH(pn));
+       if (PadnameOUTER(pn))
+           PadnameREFCNT_dec(PADNAME_FROM_PV(PadnamePV(pn)));
+       Safefree(pn);
+    }
+}
+
+#if defined(USE_ITHREADS)
+
+/*
+=for apidoc padname_dup
+
+Duplicates a pad name.
+
+=cut
+*/
+
+PADNAME *
+Perl_padname_dup(pTHX_ PADNAME *src, CLONE_PARAMS *param)
+{
+    PADNAME *dst;
+
+    PERL_ARGS_ASSERT_PADNAME_DUP;
+
+    /* look for it in the table first */
+    dst = (PADNAME *)ptr_table_fetch(PL_ptr_table, src);
+    if (dst)
+       return dst;
+
+    if (!PadnamePV(src)) {
+       dst = &PL_padname_undef;
+       ptr_table_store(PL_ptr_table, src, dst);
+       return dst;
+    }
+
+    dst = PadnameOUTER(src)
+     ? newPADNAMEouter(padname_dup(PADNAME_FROM_PV(PadnamePV(src)), param))
+     : newPADNAMEpvn(PadnamePV(src), PadnameLEN(src));
+    ptr_table_store(PL_ptr_table, src, dst);
+    PadnameLEN(dst) = PadnameLEN(src);
+    PadnameFLAGS(dst) = PadnameFLAGS(src);
+    PadnameREFCNT(dst) = 0; /* The caller will increment it.  */
+    PadnameTYPE   (dst) = (HV *)sv_dup_inc((SV *)PadnameTYPE(src), param);
+    PadnameOURSTASH(dst) = (HV *)sv_dup_inc((SV *)PadnameOURSTASH(src),
+                                           param);
+    dst->xpadn_low  = src->xpadn_low;
+    dst->xpadn_high = src->xpadn_high;
+    dst->xpadn_gen  = src->xpadn_gen;
+    return dst;
+}
+
+#endif /* USE_ITHREADS */
 
 /*
  * Local variables:
diff --git a/pad.h b/pad.h
index 135f1d2..e19c7a8 100644 (file)
--- a/pad.h
+++ b/pad.h
@@ -45,6 +45,29 @@ struct padnamelist {
     U32                xpadnl_refcnt;
 };
 
+struct padname {
+    char *     xpadn_pv;
+    HV *       xpadn_ourstash;
+    union {
+       HV *    xpadn_typestash;
+       CV *    xpadn_protocv;
+    } xpadn_type_u;
+    U32                xpadn_low;
+    U32                xpadn_high;
+    U32                xpadn_refcnt;
+    int                xpadn_gen;
+    U8         xpadn_len;
+    U8         xpadn_flags;
+};
+
+struct padname_with_str {
+    struct padname     xpadn_padname;
+    char               xpadn_str[1];
+};
+
+#define PADNAME_FROM_PV(s) \
+    ((PADNAME *)((s) - STRUCT_OFFSET(struct padname_with_str, xpadn_str)))
+
 
 /* a value that PL_cop_seqmax is guaranteed never to be,
  * flagging that a lexical is being introduced, or has not yet left scope
@@ -59,63 +82,10 @@ struct padnamelist {
 /* Low range end is exclusive (valid from the cop seq after this one) */
 /* High range end is inclusive (valid up to this cop seq) */
 
-#if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-#  define COP_SEQ_RANGE_LOW(sv)                                                \
-       (({ const SV *const _sv_cop_seq_range_low = (const SV *) (sv);  \
-         assert(SvTYPE(_sv_cop_seq_range_low) == SVt_NV                \
-                || SvTYPE(_sv_cop_seq_range_low) >= SVt_PVNV);         \
-         assert(SvTYPE(_sv_cop_seq_range_low) != SVt_PVAV);            \
-         assert(SvTYPE(_sv_cop_seq_range_low) != SVt_PVHV);            \
-         assert(SvTYPE(_sv_cop_seq_range_low) != SVt_PVCV);            \
-         assert(SvTYPE(_sv_cop_seq_range_low) != SVt_PVFM);            \
-         assert(!isGV_with_GP(_sv_cop_seq_range_low));                 \
-         ((XPVNV*) MUTABLE_PTR(SvANY(_sv_cop_seq_range_low)))->xnv_u.xpad_cop_seq.xlow; \
-        }))
-#  define COP_SEQ_RANGE_HIGH(sv)                                       \
-       (({ const SV *const _sv_cop_seq_range_high = (const SV *) (sv); \
-         assert(SvTYPE(_sv_cop_seq_range_high) == SVt_NV               \
-                 || SvTYPE(_sv_cop_seq_range_high) >= SVt_PVNV);       \
-         assert(SvTYPE(_sv_cop_seq_range_high) != SVt_PVAV);           \
-         assert(SvTYPE(_sv_cop_seq_range_high) != SVt_PVHV);           \
-         assert(SvTYPE(_sv_cop_seq_range_high) != SVt_PVCV);           \
-         assert(SvTYPE(_sv_cop_seq_range_high) != SVt_PVFM);           \
-         assert(!isGV_with_GP(_sv_cop_seq_range_high));                \
-         ((XPVNV*) MUTABLE_PTR(SvANY(_sv_cop_seq_range_high)))->xnv_u.xpad_cop_seq.xhigh; \
-        }))
-#  define PARENT_PAD_INDEX(sv)                                         \
-       (({ const SV *const _sv_parent_pad_index = (const SV *) (sv);   \
-         assert(SvTYPE(_sv_parent_pad_index) == SVt_NV                 \
-                || SvTYPE(_sv_parent_pad_index) >= SVt_PVNV);          \
-         assert(SvTYPE(_sv_parent_pad_index) != SVt_PVAV);             \
-         assert(SvTYPE(_sv_parent_pad_index) != SVt_PVHV);             \
-         assert(SvTYPE(_sv_parent_pad_index) != SVt_PVCV);             \
-         assert(SvTYPE(_sv_parent_pad_index) != SVt_PVFM);             \
-         assert(!isGV_with_GP(_sv_parent_pad_index));                  \
-         ((XPVNV*) MUTABLE_PTR(SvANY(_sv_parent_pad_index)))->xnv_u.xpad_cop_seq.xlow; \
-        }))
-#  define PARENT_FAKELEX_FLAGS(sv)                                     \
-       (({ const SV *const _sv_parent_fakelex_flags = (const SV *) (sv); \
-         assert(SvTYPE(_sv_parent_fakelex_flags) == SVt_NV             \
-                || SvTYPE(_sv_parent_fakelex_flags) >= SVt_PVNV);      \
-         assert(SvTYPE(_sv_parent_fakelex_flags) != SVt_PVAV);         \
-         assert(SvTYPE(_sv_parent_fakelex_flags) != SVt_PVHV);         \
-         assert(SvTYPE(_sv_parent_fakelex_flags) != SVt_PVCV);         \
-         assert(SvTYPE(_sv_parent_fakelex_flags) != SVt_PVFM);         \
-         assert(!isGV_with_GP(_sv_parent_fakelex_flags));              \
-         ((XPVNV*) MUTABLE_PTR(SvANY(_sv_parent_fakelex_flags)))->xnv_u.xpad_cop_seq.xhigh; \
-        }))
-#else
-#  define COP_SEQ_RANGE_LOW(sv)                \
-       (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xlow))
-#  define COP_SEQ_RANGE_HIGH(sv)       \
-       (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xhigh))
-
-
-#  define PARENT_PAD_INDEX(sv)         \
-       (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xlow))
-#  define PARENT_FAKELEX_FLAGS(sv)     \
-       (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xhigh))
-#endif
+#define COP_SEQ_RANGE_LOW(pn)          (pn)->xpadn_low
+#define COP_SEQ_RANGE_HIGH(pn)         (pn)->xpadn_high
+#define PARENT_PAD_INDEX(pn)           (pn)->xpadn_low
+#define PARENT_FAKELEX_FLAGS(pn)       (pn)->xpadn_high
 
 /* Flags set in the SvIVX field of FAKE namesvs */
 
@@ -236,8 +206,7 @@ The length of the name.
 Whether PadnamePV is in UTF8.  Currently, this is always true.
 
 =for apidoc Amx|SV *|PadnameSV|PADNAME pn
-Returns the pad name as an SV.  This is currently just C<pn>.  It will
-begin returning a new mortal SV if pad names ever stop being SVs.
+Returns the pad name as a mortal SV.
 
 =for apidoc m|bool|PadnameIsOUR|PADNAME pn
 Whether this is an "our" variable.
@@ -256,6 +225,12 @@ Whether this is a "state" variable.
 The stash associated with a typed lexical.  This returns the %Foo:: hash
 for C<my Foo $bar>.
 
+=for apidoc Amx|SSize_t|PadnameREFCNT|PADNAME pn
+The reference count of the pad name.
+
+=for apidoc Amx|void|PadnameREFCNT_dec|PADNAME pn
+Lowers the reference count of the pad name.
+
 
 =for apidoc m|SV *|PAD_SETSV   |PADOFFSET po|SV* sv
 Set the slot at offset C<po> in the current pad to C<sv>
@@ -313,19 +288,45 @@ Restore the old pad saved into the local variable opad by PAD_SAVE_LOCAL()
 #define PadARRAY(pad)          AvARRAY(pad)
 #define PadMAX(pad)            AvFILLp(pad)
 
-#define PadnamePV(pn)          (SvPOKp(pn) ? SvPVX_const(pn) : NULL)
-#define PadnameLEN(pn)         ((SV*)(pn) == &PL_sv_undef ? 0 : SvCUR(pn))
-#define PadnameUTF8(pn)                (assert_(SvUTF8(pn)) 1)
-#define PadnameSV(pn)          pn
-#define PadnameIsOUR(pn)       !!SvPAD_OUR(pn)
-#define PadnameOURSTASH(pn)    SvOURSTASH(pn)
-#define PadnameOUTER(pn)       !!SvFAKE(pn)
-#define PadnameIsSTATE(pn)     !!SvPAD_STATE(pn)
-#define PadnameTYPE(pn)                (SvPAD_TYPED(pn) ? SvSTASH(pn) : NULL)
-#define PadnameLVALUE(pn) \
-    ((SvFLAGS(pn) & (SVpad_NAME|SVpad_LVALUE))==(SVpad_NAME|SVpad_LVALUE))
-
-#define PadnameLVALUE_on(pn)   (SvFLAGS(pn) |= SVpad_NAME|SVpad_LVALUE)
+#define PadnamePV(pn)          (pn)->xpadn_pv
+#define PadnameLEN(pn)         (pn)->xpadn_len
+#define PadnameUTF8(pn)                1
+#define PadnameSV(pn) \
+       newSVpvn_flags(PadnamePV(pn), PadnameLEN(pn), SVs_TEMP|SVf_UTF8)
+#define PadnameFLAGS(pn)       (pn)->xpadn_flags
+#define PadnameIsOUR(pn)       (!!(pn)->xpadn_ourstash)
+#define PadnameOURSTASH(pn)    (pn)->xpadn_ourstash
+#define PadnameTYPE(pn)                (pn)->xpadn_type_u.xpadn_typestash
+#define PadnamePROTOCV(pn)     (pn)->xpadn_type_u.xpadn_protocv
+#define PadnameREFCNT(pn)      (pn)->xpadn_refcnt
+#define PadnameREFCNT_dec(pn)  Perl_padname_free(aTHX_ pn)
+#define PadnameOURSTASH_set(pn,s) (PadnameOURSTASH(pn) = (s))
+#define PadnameTYPE_set(pn,s)    (PadnameTYPE(pn) = (s))
+#define PadnameOUTER(pn)       (PadnameFLAGS(pn) & PADNAMEt_OUTER)
+#define PadnameIsSTATE(pn)     (PadnameFLAGS(pn) & PADNAMEt_STATE)
+#define PadnameLVALUE(pn)      (PadnameFLAGS(pn) & PADNAMEt_LVALUE)
+
+#define PadnameLVALUE_on(pn)   (PadnameFLAGS(pn) |= PADNAMEt_LVALUE)
+#define PadnameIsSTATE_on(pn)  (PadnameFLAGS(pn) |= PADNAMEt_STATE)
+
+#define PADNAMEt_OUTER 1       /* outer lexical var */
+#define PADNAMEt_STATE 2       /* state var */
+#define PADNAMEt_LVALUE        4       /* used as lvalue */
+#define PADNAMEt_TYPED 8       /* for B; unused by core */
+#define PADNAMEt_OUR   16      /* for B; unused by core */
+
+/* backward compatibility */
+#define SvPAD_STATE            PadnameIsSTATE
+#define SvPAD_TYPED(pn)                (!!PadnameTYPE(pn))
+#define SvPAD_OUR(pn)          (!!PadnameOURSTASH(pn))
+#define SvPAD_STATE_on         PadnameIsSTATE_on
+#define SvPAD_TYPED_on(pn)     (PadnameFLAGS(pn) |= PADNAMEt_TYPED)
+#define SvPAD_OUR_on(pn)       (PadnameFLAGS(pn) |= PADNAMEt_OUR)
+#define SvOURSTASH             PadnameOURSTASH
+#define SvOURSTASH_set         PadnameOURSTASH_set
+#define SVpad_STATE            PADNAMEt_STATE
+#define SVpad_TYPED            PADNAMEt_TYPED
+#define SVpad_OUR              PADNAMEt_OUR
 
 #ifdef DEBUGGING
 #  define PAD_SV(po)      pad_sv(po)
@@ -423,7 +424,7 @@ ling pad (lvalue) to C<gen>.  Note that C<SvUV_set> is hijacked for this purpose
 
 #define PAD_COMPNAME(po)       PAD_COMPNAME_SV(po)
 #define PAD_COMPNAME_SV(po)    (PadnamelistARRAY(PL_comppad_name)[(po)])
-#define PAD_COMPNAME_FLAGS(po) SvFLAGS(PAD_COMPNAME_SV(po))
+#define PAD_COMPNAME_FLAGS(po) PadnameFLAGS(PAD_COMPNAME(po))
 #define PAD_COMPNAME_FLAGS_isOUR(po) SvPAD_OUR(PAD_COMPNAME_SV(po))
 #define PAD_COMPNAME_PV(po)    PadnamePV(PAD_COMPNAME(po))
 
@@ -433,10 +434,10 @@ ling pad (lvalue) to C<gen>.  Note that C<SvUV_set> is hijacked for this purpose
     (SvOURSTASH(PAD_COMPNAME_SV(po)))
 
 #define PAD_COMPNAME_GEN(po) \
-    ((STRLEN)SvUVX(PadnamelistARRAY(PL_comppad_name)[po]))
+    ((STRLEN)PadnamelistARRAY(PL_comppad_name)[po]->xpadn_gen)
 
 #define PAD_COMPNAME_GEN_set(po, gen) \
-    SvUV_set(PadnamelistARRAY(PL_comppad_name)[po], (UV)(gen))
+    (PadnamelistARRAY(PL_comppad_name)[po]->xpadn_gen = (gen))
 
 
 /*
diff --git a/perl.h b/perl.h
index 2ebf1ec..55918d0 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -2652,12 +2652,12 @@ typedef struct ptr_tbl_ent PTR_TBL_ENT_t;
 typedef struct ptr_tbl PTR_TBL_t;
 typedef struct clone_params CLONE_PARAMS;
 
-/* a pad or name pad is currently just an AV; but that might change,
+/* a pad is currently just an AV; but that might change,
  * so hide the type.  */
 typedef struct padlist PADLIST;
 typedef AV PAD;
 typedef struct padnamelist PADNAMELIST;
-typedef SV PADNAME;
+typedef struct padname PADNAME;
 
 /* enable PERL_NEW_COPY_ON_WRITE by default */
 #if !defined(PERL_OLD_COPY_ON_WRITE) && !defined(PERL_NEW_COPY_ON_WRITE) && !defined(PERL_NO_COW)
@@ -3407,8 +3407,8 @@ typedef pthread_key_t     perl_key;
 #endif
 #define UTF8fARG(u,l,p) (int)cBOOL(u), (UV)(l), (void*)(p)
 
-#define PNf SVf
-#define PNfARG SVfARG
+#define PNf UTF8f
+#define PNfARG(pn) (int)1, (UV)PadnameLEN(pn), (void *)PadnamePV(pn)
 
 #ifdef PERL_CORE
 /* not used; but needed for backward compatibility with XS code? - RMB */
diff --git a/pp.c b/pp.c
index 6d575f7..e51d907 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -170,25 +170,24 @@ PP(pp_introcv)
 PP(pp_clonecv)
 {
     dTARGET;
-    MAGIC * const mg =
-       mg_find(PadlistNAMESARRAY(CvPADLIST(find_runcv(NULL)))[ARGTARG],
-               PERL_MAGIC_proto);
+    CV * const protocv = PadnamePROTOCV(
+       PadlistNAMESARRAY(CvPADLIST(find_runcv(NULL)))[ARGTARG]
+    );
     assert(SvTYPE(TARG) == SVt_PVCV);
-    assert(mg);
-    assert(mg->mg_obj);
-    if (CvISXSUB(mg->mg_obj)) { /* constant */
+    assert(protocv);
+    if (CvISXSUB(protocv)) { /* constant */
        /* XXX Should we clone it here? */
        /* If this changes to use SAVECLEARSV, we can move the SAVECLEARSV
           to introcv and remove the SvPADSTALE_off. */
        SAVEPADSVANDMORTALIZE(ARGTARG);
-       PAD_SVl(ARGTARG) = SvREFCNT_inc_simple_NN(mg->mg_obj);
+       PAD_SVl(ARGTARG) = SvREFCNT_inc_simple_NN(protocv);
     }
     else {
-       if (CvROOT(mg->mg_obj)) {
-           assert(CvCLONE(mg->mg_obj));
-           assert(!CvCLONED(mg->mg_obj));
+       if (CvROOT(protocv)) {
+           assert(CvCLONE(protocv));
+           assert(!CvCLONED(protocv));
        }
-       cv_clone_into((CV *)mg->mg_obj,(CV *)TARG);
+       cv_clone_into(protocv,(CV *)TARG);
        SAVECLEARSV(PAD_SVl(ARGTARG));
     }
     return NORMAL;
diff --git a/proto.h b/proto.h
index 61e52ec..d6a855a 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2985,6 +2985,20 @@ PERL_CALLCONV PADNAMELIST *      Perl_newPADNAMELIST(pTHX_ size_t max)
                        __attribute__malloc__
                        __attribute__warn_unused_result__;
 
+PERL_CALLCONV PADNAME *        Perl_newPADNAMEouter(pTHX_ PADNAME *outer)
+                       __attribute__malloc__
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_NEWPADNAMEOUTER       \
+       assert(outer)
+
+PERL_CALLCONV PADNAME *        Perl_newPADNAMEpvn(pTHX_ const char *s, STRLEN len)
+                       __attribute__malloc__
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_NEWPADNAMEPVN \
+       assert(s)
+
 PERL_CALLCONV OP*      Perl_newPMOP(pTHX_ I32 type, I32 flags)
                        __attribute__malloc__
                        __attribute__warn_unused_result__;
@@ -3353,6 +3367,11 @@ PERL_CALLCONV PAD **     Perl_padlist_store(pTHX_ PADLIST *padlist, I32 key, PAD *va
 #define PERL_ARGS_ASSERT_PADLIST_STORE \
        assert(padlist)
 
+PERL_CALLCONV void     Perl_padname_free(pTHX_ PADNAME *pn)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_PADNAME_FREE  \
+       assert(pn)
+
 PERL_CALLCONV PADNAME *        Perl_padnamelist_fetch(pTHX_ PADNAMELIST *pnl, SSize_t key)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
@@ -8038,6 +8057,13 @@ PERL_CALLCONV PADLIST *  Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *pa
 #define PERL_ARGS_ASSERT_PADLIST_DUP   \
        assert(srcpad); assert(param)
 
+PERL_CALLCONV PADNAME *        Perl_padname_dup(pTHX_ PADNAME *src, CLONE_PARAMS *param)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_PADNAME_DUP   \
+       assert(src); assert(param)
+
 PERL_CALLCONV PADNAMELIST *    Perl_padnamelist_dup(pTHX_ PADNAMELIST *srcpad, CLONE_PARAMS *param)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1)
diff --git a/scope.c b/scope.c
index a1aa3f5..89b4e6e 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -972,6 +972,9 @@ Perl_leave_scope(pTHX_ I32 base)
        case SAVEt_FREESV:
            SvREFCNT_dec(ARG0_SV);
            break;
+       case SAVEt_FREEPADNAME:
+           PadnameREFCNT_dec((PADNAME *)ARG0_PTR);
+           break;
        case SAVEt_FREECOPHH:
            cophh_free((COPHH *)ARG0_PTR);
            break;
diff --git a/scope.h b/scope.h
index cad02cd..c6a44ba 100644 (file)
--- a/scope.h
+++ b/scope.h
 #define SAVEt_PARSER           19
 #define SAVEt_STACK_POS                20
 #define SAVEt_READONLY_OFF     21
+#define SAVEt_FREEPADNAME      22
 
-#define SAVEt_ARG1_MAX         21
+#define SAVEt_ARG1_MAX         22
 
 /* two args */
 
-#define SAVEt_APTR             22
 #define SAVEt_AV               23
 #define SAVEt_DESTRUCTOR       24
 #define SAVEt_DESTRUCTOR_X     25
 #define SAVEt_SVREF            44
 #define SAVEt_VPTR             45
 #define SAVEt_ADELETE          46
+#define SAVEt_APTR             47
 
-#define SAVEt_ARG2_MAX         46
+#define SAVEt_ARG2_MAX         47
 
 /* three args */
 
-#define SAVEt_DELETE           47
 #define SAVEt_HELEM            48
 #define SAVEt_PADSV_AND_MORTALIZE 49
 #define SAVEt_SET_SVFLAGS      50
 #define SAVEt_GVSLOT           51
 #define SAVEt_AELEM            52
+#define SAVEt_DELETE           53
+
 
 #define SAVEf_SETMAGIC         1
 #define SAVEf_KEEPOLDELEM      2
@@ -240,6 +242,7 @@ scope has the given name. Name must be a literal string.
 #define SAVEVPTR(s)    save_vptr((void*)&(s))
 #define SAVEPADSVANDMORTALIZE(s)       save_padsv_and_mortalize(s)
 #define SAVEFREESV(s)  save_freesv(MUTABLE_SV(s))
+#define SAVEFREEPADNAME(s) save_pushptr((void *)(s), SAVEt_FREEPADNAME)
 #define SAVEMORTALIZESV(s)     save_mortalizesv(MUTABLE_SV(s))
 #define SAVEFREEOP(o)  save_freeop((OP*)(o))
 #define SAVEFREEPV(p)  save_freepv((char*)(p))
diff --git a/sv.c b/sv.c
index ec2f5e2..318e941 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -638,8 +638,6 @@ do_curse(pTHX_ SV * const sv) {
     if ((PL_stderrgv && GvGP(PL_stderrgv) && (SV*)GvIO(PL_stderrgv) == sv)
      || (PL_defoutgv && GvGP(PL_defoutgv) && (SV*)GvIO(PL_defoutgv) == sv))
        return;
-    if (SvPAD_NAME(sv))
-       return;
     (void)curse(sv, 0);
 }
 
@@ -1332,10 +1330,6 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type)
           there's no way that it can be safely upgraded, because perl.c
           expects to Safefree(SvANY(PL_mess_sv))  */
        assert(sv != PL_mess_sv);
-       /* This flag bit is used to mean other things in other scalar types.
-          Given that it only has meaning inside the pad, it shouldn't be set
-          on anything that can get upgraded.  */
-       assert(!SvPAD_TYPED(sv));
        break;
     default:
        if (UNLIKELY(old_type_details->cant_upgrade))
@@ -6493,10 +6487,10 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
 
        /* objs are always >= MG, but pad names use the SVs_OBJECT flag
           for another purpose  */
-       assert(!SvOBJECT(sv) || type >= SVt_PVMG || SvPAD_NAME(sv));
+       assert(!SvOBJECT(sv) || type >= SVt_PVMG);
 
        if (type >= SVt_PVMG) {
-           if (SvOBJECT(sv) && !SvPAD_NAME(sv)) {
+           if (SvOBJECT(sv)) {
                if (!curse(sv, 1)) goto get_next_sv;
                type = SvTYPE(sv); /* destructor may have changed it */
            }
@@ -6507,16 +6501,12 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
                if (SvMAGIC(sv))
                    mg_free(sv);
            }
-           else if (type == SVt_PVMG && SvPAD_OUR(sv)) {
-               SvREFCNT_dec(SvOURSTASH(sv));
-           } else if (SvMAGIC(sv)) {
+           else if (SvMAGIC(sv)) {
                /* Free back-references before other types of magic. */
                sv_unmagic(sv, PERL_MAGIC_backref);
                mg_free(sv);
            }
            SvMAGICAL_off(sv);
-           if (type == SVt_PVMG && SvPAD_TYPED(sv))
-               SvREFCNT_dec(SvSTASH(sv));
        }
        switch (type) {
            /* case SVt_INVLIST: */
@@ -13402,7 +13392,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 #endif
 
     /* don't clone objects whose class has asked us not to */
-    if (SvOBJECT(sstr) && !SvPAD_NAME(sstr)
+    if (SvOBJECT(sstr)
      && ! (SvFLAGS(SvSTASH(sstr)) & SVphv_CLONEABLE))
     {
        SvFLAGS(dstr) = 0;
@@ -13489,11 +13479,9 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
               missing by always going for the destination.
               FIXME - instrument and check that assumption  */
            if (sv_type >= SVt_PVMG) {
-               if ((sv_type == SVt_PVMG) && SvPAD_OUR(dstr)) {
-                   SvOURSTASH_set(dstr, hv_dup_inc(SvOURSTASH(dstr), param));
-               } else if (SvMAGIC(dstr))
+               if (SvMAGIC(dstr))
                    SvMAGIC_set(dstr, mg_dup(SvMAGIC(dstr), param));
-               if (SvOBJECT(dstr) && !SvPAD_NAME(dstr) && SvSTASH(dstr))
+               if (SvOBJECT(dstr) && SvSTASH(dstr))
                    SvSTASH_set(dstr, hv_dup_inc(SvSTASH(dstr), param));
                else SvSTASH_set(dstr, 0); /* don't copy DESTROY cache */
            }
@@ -14007,6 +13995,11 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            sv = (const SV *)POPPTR(ss,ix);
            TOPPTR(nss,ix) = sv_dup_inc(sv, param);
            break;
+       case SAVEt_FREEPADNAME:
+           ptr = POPPTR(ss,ix);
+           TOPPTR(nss,ix) = padname_dup((PADNAME *)ptr, param);
+           PadnameREFCNT((PADNAME *)TOPPTR(nss,ix))++;
+           break;
        case SAVEt_SHARED_PVREF:                /* char* in shared space */
            c = (char*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = savesharedpv(c);
@@ -14376,6 +14369,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_sig_pending = 0;
     PL_parser = NULL;
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
+    Zero(&PL_padname_undef, 1, PADNAME);
+    Zero(&PL_padname_const, 1, PADNAME);
 #  ifdef DEBUG_LEAKING_SCALARS
     PL_sv_serial = (((UV)my_perl >> 2) & 0xfff) * 1000000;
 #  endif
@@ -14656,6 +14651,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_undef, &PL_sv_undef);
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_no, &PL_sv_no);
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
+    ptr_table_store(PL_ptr_table, &proto_perl->Ipadname_const,
+                   &PL_padname_const);
 
     /* create (a non-shared!) shared string table */
     PL_strtab          = newHV();
@@ -15166,6 +15163,8 @@ Perl_init_constants(pTHX)
     SvLEN_set(&PL_sv_yes, 0);
     SvIV_set(&PL_sv_yes, 1);
     SvNV_set(&PL_sv_yes, 1);
+
+    PadnamePV(&PL_padname_const) = (char *)PL_No;
 }
 
 /*
@@ -15403,14 +15402,15 @@ Perl_varname(pTHX_ const GV *const gv, const char gvtype, PADOFFSET targ,
     }
     else {
        CV * const cv = gv ? ((CV *)gv) : find_runcv(NULL);
-       SV *sv;
+       PADNAME *sv;
 
        assert(!cv || SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM);
 
        if (!cv || !CvPADLIST(cv))
            return NULL;
        sv = padnamelist_fetch(PadlistNAMES(CvPADLIST(cv)), targ);
-       sv_setsv_flags(name, sv, 0);
+       sv_setpvn(name, PadnamePV(sv), PadnameLEN(sv));
+       SvUTF8_on(name);
     }
 
     if (subscript_type == FUV_SUBSCRIPT_HASH) {
diff --git a/sv.h b/sv.h
index f2d6aba..ec5726d 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -373,13 +373,10 @@ perform the upgrade if necessary.  See C<svtype>.
                                       expanded to a real GV */
 #define SVf_PROTECT    0x00010000  /* very read-only */
 #define SVs_PADTMP     0x00020000  /* in use as tmp */
-#define SVpad_TYPED    0x00020000  /* pad name is a Typed Lexical */
 #define SVs_PADSTALE   0x00040000  /* lexical has gone out of scope;
                                        only used when !PADTMP */
-#define SVpad_OUR      0x00040000  /* pad name is "our" instead of "my" */
 #define SVs_TEMP       0x00080000  /* mortal (implies string is stealable) */
 #define SVs_OBJECT     0x00100000  /* is "blessed" */
-#define SVpad_LVALUE   0x00100000  /* pad name is used as lvalue */
 #define SVs_GMG                0x00200000  /* has magical get method */
 #define SVs_SMG                0x00400000  /* has magical set method */
 #define SVs_RMG                0x00800000  /* has random magical methods */
@@ -389,10 +386,7 @@ perform the upgrade if necessary.  See C<svtype>.
                                       2: For PVCV, whether CvUNIQUE(cv)
                                          refers to an eval or once only
                                          [CvEVAL(cv), CvSPECIAL(cv)]
-                                      3: On a pad name SV, that slot in the
-                                         frame AV is a REFCNT'ed reference
-                                         to a lexical from "outside".
-                                       4: HV: informally reserved by DAPM
+                                       3: HV: informally reserved by DAPM
                                           for vtables */
 #define SVf_OOK                0x02000000  /* has valid offset value. For a PVHV this
                                       means that a hv_aux struct is present
@@ -436,22 +430,19 @@ perform the upgrade if necessary.  See C<svtype>.
 /* Some private flags. */
 
 
-/* PVNV, PVMG only, and only used in pads. Should be safe to test on any scalar
-   SV, as the core is careful to avoid setting both.
+/* The SVp_SCREAM|SVpbm_VALID (0x40008000) combination is up for grabs.
+   Formerly it was used for pad names, but now it is available.  The core
+   is careful to avoid setting both flags.
 
    SVf_POK, SVp_POK also set:
    0x00004400   Normal
    0x0000C400   method name for DOES (SvSCREAM)
    0x40004400   FBM compiled (SvVALID)
-   0x4000C400   pad name.
+   0x4000C400   *** Formerly used for pad names ***
 
    0x00008000   GV with GP
    0x00008800   RV with PCS imported
 */
-#define SVpad_NAME     (SVp_SCREAM|SVpbm_VALID)
-                                   /* This SV is a name in the PAD, so
-                                      SVpad_TYPED, SVpad_OUR and SVpad_STATE
-                                      apply */
 /* PVAV */
 #define SVpav_REAL     0x40000000  /* free old entries */
 /* PVHV */
@@ -473,7 +464,6 @@ perform the upgrade if necessary.  See C<svtype>.
 /* RV upwards. However, SVf_ROK and SVp_IOK are exclusive  */
 #define SVprv_WEAKREF   0x80000000  /* Weak reference */
 /* pad name vars only */
-#define SVpad_STATE    0x80000000  /* pad name is a "state" var */
 
 #define _XPV_HEAD                                                      \
     HV*                xmg_stash;      /* class package */                     \
@@ -503,7 +493,6 @@ union _xivu {
 
 union _xmgu {
     MAGIC*  xmg_magic;         /* linked list of magicalness */
-    HV*            xmg_ourstash;       /* Stash for our (when SvPAD_OUR is true) */
     STRLEN  xmg_hash_index;    /* used while freeing hash entries */
 };
 
@@ -1143,47 +1132,6 @@ sv_force_normal does nothing.
 #define SvTAIL_on(sv)          (SvFLAGS(sv) |= SVpbm_TAIL)
 #define SvTAIL_off(sv)         (SvFLAGS(sv) &= ~SVpbm_TAIL)
 
-#define SvPAD_NAME(sv) ((SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME)
-
-#define SvPAD_TYPED(sv) \
-       ((SvFLAGS(sv) & (SVpad_NAME|SVpad_TYPED)) == (SVpad_NAME|SVpad_TYPED))
-
-#define SvPAD_OUR(sv)  \
-       ((SvFLAGS(sv) & (SVpad_NAME|SVpad_OUR)) == (SVpad_NAME|SVpad_OUR))
-
-#define SvPAD_STATE(sv)        \
-       ((SvFLAGS(sv) & (SVpad_NAME|SVpad_STATE)) == (SVpad_NAME|SVpad_STATE))
-
-#if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-#  define SvPAD_TYPED_on(sv)   ({                                      \
-           SV *const _svpad = MUTABLE_SV(sv);                          \
-           assert(SvTYPE(_svpad) == SVt_PVMG);                         \
-           (SvFLAGS(_svpad) |= SVpad_NAME|SVpad_TYPED);                \
-       })
-#define SvPAD_OUR_on(sv)       ({                                      \
-           SV *const _svpad = MUTABLE_SV(sv);                          \
-           assert(SvTYPE(_svpad) == SVt_PVMG);                         \
-           (SvFLAGS(_svpad) |= SVpad_NAME|SVpad_OUR);                  \
-       })
-#define SvPAD_STATE_on(sv)     ({                                      \
-           SV *const _svpad = MUTABLE_SV(sv);                          \
-           assert(SvTYPE(_svpad) == SVt_PVNV || SvTYPE(_svpad) == SVt_PVMG); \
-           (SvFLAGS(_svpad) |= SVpad_NAME|SVpad_STATE);                \
-       })
-#else
-#  define SvPAD_TYPED_on(sv)   (SvFLAGS(sv) |= SVpad_NAME|SVpad_TYPED)
-#  define SvPAD_OUR_on(sv)     (SvFLAGS(sv) |= SVpad_NAME|SVpad_OUR)
-#  define SvPAD_STATE_on(sv)   (SvFLAGS(sv) |= SVpad_NAME|SVpad_STATE)
-#endif
-
-#define SvOURSTASH(sv) \
-       (SvPAD_OUR(sv) ? ((XPVMG*) SvANY(sv))->xmg_u.xmg_ourstash : NULL)
-#define SvOURSTASH_set(sv, st)                                 \
-        STMT_START {                                           \
-           assert(SvTYPE(sv) == SVt_PVMG);                     \
-           ((XPVMG*) SvANY(sv))->xmg_u.xmg_ourstash = st;      \
-       } STMT_END
-
 #define SvRVx(sv) SvRV(sv)
 
 #ifdef PERL_DEBUG_COW
@@ -1266,8 +1214,6 @@ sv_force_normal does nothing.
 #    define SvMAGIC(sv)                                                        \
        (*({ const SV *const _svmagic = (const SV *)(sv);               \
            assert(SvTYPE(_svmagic) >= SVt_PVMG);                       \
-           if(SvTYPE(_svmagic) == SVt_PVMG)                            \
-               assert(!SvPAD_OUR(_svmagic));                           \
            &(((XPVMG*) MUTABLE_PTR(SvANY(_svmagic)))->xmg_u.xmg_magic); \
          }))
 #    define SvSTASH(sv)                                                        \
@@ -2204,14 +2150,12 @@ C<SvUTF8_on> on the new SV.  Implemented as a wrapper around C<newSVpvn_flags>.
 /*
 =for apidoc Amx|SV*|newSVpadname|PADNAME *pn
 
-Creates a new SV containing the pad name.  This is currently identical
-to C<newSVsv>, but pad names may cease being SVs at some point, so
-C<newSVpadname> is preferable.
+Creates a new SV containing the pad name.
 
 =cut
 */
 
-#define newSVpadname(pn) newSVsv((SV *)(pn))
+#define newSVpadname(pn) newSVpvn_utf8(PadnamePV(pn), PadnameLEN(pn), TRUE)
 
 /*
 =for apidoc Am|void|SvOOK_offset|NN SV*sv|STRLEN len