pad.c: Use &PL_sv_no for const pad names

Currently &PL_sv_undef as a pad name can indicate either a free slot
available for use by pad_alloc or a slot used by an op target (or,
under ithreads, a constant or GV).

Currently pad_alloc distinguishes between free slots and unnamed slots
based on whether the value in the pad has PADMY or PADTMP set.  If
neither is set, then the slot is free.  If either is set, the slot
is in use.

This makes it rather difficult to distinguish between constants stored
in the pad (under ithreads) and targets.  The latter need to be copied
when referenced, to give the impression that a new scalar is being
returned by an operator each time.  (So \"$a" has to return a refer-
ence to a new scalar each time, but \1 should return the same one.)
Also, constants are shared between recursion levels.  Currently, if
the value is marked READONLY or is a shared hash key scalar, it is
shared.  But targets can also me shared hash keys, resulting in bugs.

It also makes it impossible for the same constant to be shared by mul-
tiple pad slots, as freeing one const op will turn off the PADTMP flag
while the other slot still uses it, making the latter appear to be
free.  Hence a lot of copying occurs under ithreads.  (Actually, that
may not be true any more since 3b1c21fabed, as freed const ops swipe
their constants from the pad.  But right now, a lot of copying does
still happen.)

Also, XS modules may want to create const ops that return the same
mutable SV each time.  That is currently not possible without
various workarounds including custom ops and references.  (See
<https://rt.perl.org/rt3/Ticket/Display.html?id=105906#txn-1075354>.)

This commit changes pad_alloc and pad_free to use &PL_sv_no for con-
stants and updates other code to keep all tests passing.  Subsequent
commits will actually use that information to fix bugs.

This will probably break PadWalker, but I think it is an acceptable
trade-off.  The alternative would be to make PadnamePV forever more
complex than necessary, by giving it a special case for &PL_sv_no and
having it return NULL.

I gave PadnameLEN a special case for &PL_sv_undef, so it may appear
that I have simply shifted the complexity around.  But if pad names
stop being SVs, then this exception will simply disappear, since the
global &PL_padname_undef will have 0 in its length field.

6 files changed, 33 insertions, 18 deletions

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 3f76dd787f..8eaabdb66a 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -3295,7 +3295,7 @@ CV* cv
   for ( i = PadnamelistMAX(pad_namelist); i >= 0; i-- ) {
     PADNAME* name = PadnamelistARRAY(pad_namelist)[i];
 
-    if (SvPOKp(name)) {
+    if (PadnameLEN(name)) {
         av_push(retav, newSVpadname(name));
     }
   }
diff --git a/op.c b/op.c
index 65d3955fe6..bc62048944 100644
--- a/op.c
+++ b/op.c
@@ -1751,7 +1751,7 @@ S_finalize_op(pTHX_ OP* o)
 	 * Despite being a "constant", the SV is written to,
 	 * for reference counts, sv_upgrade() etc. */
 	if (cSVOPo->op_sv) {
-	    const PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP);
+	    const PADOFFSET ix = pad_alloc(OP_CONST, SVf_READONLY);
 	    if (o->op_type != OP_METHOD_NAMED &&
 		(SvPADTMP(cSVOPo->op_sv) || SvPADMY(cSVOPo->op_sv)))
 	    {
diff --git a/pad.c b/pad.c
index ec3ad84857..2bbf866a04 100644
--- a/pad.c
+++ b/pad.c
@@ -56,8 +56,9 @@ at that depth of recursion into the CV.  The 0th slot of a frame AV is an
 AV which is @_.  Other entries are storage for variables and op targets.
 
 Iterating over the PADNAMELIST iterates over all possible pad
-items.  Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
-&PL_sv_undef "names" (see pad_alloc()).
+items.  Pad slots for targets (SVs_PADTMP) and GVs end up having &PL_sv_no
+"names", while slots for constants have &PL_sv_no "names" (see
+pad_alloc()).
 
 Only my/our variable (SvPADMY/PADNAME_isOUR) slots get valid names.
 The rest are op targets/GVs/constants which are statically allocated
@@ -711,6 +712,10 @@ which will be set in the value SV for the allocated pad entry:
 
     SVs_PADMY    named lexical variable ("my", "our", "state")
     SVs_PADTMP   unnamed temporary store
+    SVf_READONLY constant shared between recursion levels
+
+C<SVf_READONLY> has been supported here only since perl 5.20.  To work with
+earlier versions as well, use C<SVf_READONLY|SVs_PADTMP>.
 
 I<optype> should be an opcode indicating the type of operation that the
 pad entry is to support.  This doesn't affect operational semantics,
@@ -763,6 +768,11 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 		!IS_PADGV(sv) && !IS_PADCONST(sv))
 		break;
 	}
+	if (tmptype & SVf_READONLY) {
+	    av_store(PL_comppad_name, PL_padix, &PL_sv_no);
+	    tmptype &= ~SVf_READONLY;
+	    tmptype |= SVs_PADTMP;
+	}
 	retval = PL_padix;
     }
     SvFLAGS(sv) |= tmptype;
@@ -874,7 +884,7 @@ S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
     for (off = top; (I32)off > PL_comppad_name_floor; off--) {
 	SV * const sv = svp[off];
 	if (sv
-	    && sv != &PL_sv_undef
+	    && PadnameLEN(sv)
 	    && !SvFAKE(sv)
 	    && (   COP_SEQ_RANGE_LOW(sv)  == PERL_PADSEQ_INTRO
 		|| COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
@@ -899,7 +909,7 @@ S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
 	while (off > 0) {
 	    SV * const sv = svp[off];
 	    if (sv
-		&& sv != &PL_sv_undef
+		&& PadnameLEN(sv)
 		&& !SvFAKE(sv)
 		&& (   COP_SEQ_RANGE_LOW(sv)  == PERL_PADSEQ_INTRO
 		    || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
@@ -975,10 +985,9 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
     name_svp = AvARRAY(nameav);
     for (offset = AvFILLp(nameav); offset > 0; offset--) {
         const SV * const namesv = name_svp[offset];
-	if (namesv && namesv != &PL_sv_undef
+	if (namesv && PadnameLEN(namesv) == namelen
 	    && !SvFAKE(namesv)
 	    && (SvPAD_OUR(namesv))
-	    && SvCUR(namesv) == namelen
             && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
                                 flags & padadd_UTF8_NAME ? SVf_UTF8 : 0 )
 	    && COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO
@@ -1167,8 +1176,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
 
 	for (offset = AvFILLp(nameav); offset > 0; offset--) {
             const SV * const namesv = name_svp[offset];
-	    if (namesv && namesv != &PL_sv_undef
-		    && SvCUR(namesv) == namelen
+	    if (namesv && PadnameLEN(namesv) == namelen
                     && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
                                     flags & padadd_UTF8_NAME ? SVf_UTF8 : 0))
 	    {
@@ -1517,7 +1525,7 @@ Perl_intro_my(pTHX)
     for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
 	SV * const sv = svp[i];
 
-	if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
+	if (sv && PadnameLEN(sv) && !SvFAKE(sv)
 	    && COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO)
 	{
 	    COP_SEQ_RANGE_HIGH_set(sv, PERL_PADSEQ_INTRO); /* Don't know scope end yet. */
@@ -1565,7 +1573,7 @@ Perl_pad_leavemy(pTHX)
     if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
 	for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
 	    const SV * const sv = svp[off];
-	    if (sv && sv != &PL_sv_undef && !SvFAKE(sv))
+	    if (sv && PadnameLEN(sv) && !SvFAKE(sv))
 		Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
 				 "%"SVf" never introduced",
 				 SVfARG(sv));
@@ -1574,7 +1582,7 @@ Perl_pad_leavemy(pTHX)
     /* "Deintroduce" my variables that are leaving with this scope. */
     for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
 	SV * const sv = svp[off];
-	if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
+	if (sv && PadnameLEN(sv) && !SvFAKE(sv)
 	    && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
 	{
 	    COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);
@@ -1641,6 +1649,11 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
 #else
     PL_curpad[po] = &PL_sv_undef;
 #endif
+    if (PadnamelistMAX(PL_comppad_name) != -1
+     && PadnamelistMAX(PL_comppad_name) >= po) {
+	assert(!PadnameLEN(PadnamelistARRAY(PL_comppad_name)[po]));
+	PadnamelistARRAY(PL_comppad_name)[po] = &PL_sv_undef;
+    }
     if ((I32)po < PL_padix)
 	PL_padix = po - 1;
 }
@@ -1882,7 +1895,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) {
+	if (namesv && !PadnameLEN(namesv)) {
 	    namesv = NULL;
 	}
 	if (namesv) {
@@ -2048,7 +2061,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
     for (ix = fpad; ix > 0; ix--) {
 	SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
 	SV *sv = NULL;
-	if (namesv && namesv != &PL_sv_undef) { /* lexical */
+	if (namesv && PadnameLEN(namesv)) { /* lexical */
 	    if (SvFAKE(namesv)) {   /* lexical from outside? */
 		/* formats may have an inactive, or even undefined, parent;
 		   but state vars are always available. */
@@ -2291,7 +2304,7 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 	AV *av;
 
 	for ( ;ix > 0; ix--) {
-	    if (names_fill >= ix && names[ix] != &PL_sv_undef) {
+	    if (names_fill >= ix && PadnameLEN(names[ix])) {
 		const char sigil = SvPVX_const(names[ix])[0];
 		if ((SvFLAGS(names[ix]) & SVf_FAKE)
 			|| (SvFLAGS(names[ix]) & SVpad_STATE)
@@ -2419,7 +2432,7 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param)
 	    for ( ;ix > 0; ix--) {
 		if (!oldpad[ix]) {
 		    pad1a[ix] = NULL;
-		} else if (names_fill >= ix && names[ix] != &PL_sv_undef) {
+		} else if (names_fill >= ix && PadnameLEN(names[ix])) {
 		    const char sigil = SvPVX_const(names[ix])[0];
 		    if ((SvFLAGS(names[ix]) & SVf_FAKE)
 			|| (SvFLAGS(names[ix]) & SVpad_STATE)
diff --git a/pad.h b/pad.h
index 26e183ccd8..f6f3455148 100644
--- a/pad.h
+++ b/pad.h
@@ -290,7 +290,7 @@ Restore the old pad saved into the local variable opad by PAD_SAVE_LOCAL()
 #define PadMAX(pad)		AvFILLp(pad)
 
 #define PadnamePV(pn)		(SvPOKp(pn) ? SvPVX(pn) : NULL)
-#define PadnameLEN(pn)		SvCUR(pn)
+#define PadnameLEN(pn)		((pn) == &PL_sv_undef ? 0 : SvCUR(pn))
 #define PadnameUTF8(pn)		!!SvUTF8(pn)
 #define PadnameSV(pn)		pn
 #define PadnameIsOUR(pn)	!!SvPAD_OUR(pn)
diff --git a/perl.c b/perl.c
index 5458c1d59d..57d51e6f3e 100644
--- a/perl.c
+++ b/perl.c
@@ -758,6 +758,7 @@ perl_destruct(pTHXx)
 	/* ensure comppad/curpad to refer to main's pad */
 	if (CvPADLIST(PL_main_cv)) {
 	    PAD_SET_CUR_NOSAVE(CvPADLIST(PL_main_cv), 1);
+	    PL_comppad_name = PadlistNAMES(CvPADLIST(PL_main_cv));
 	}
 	op_free(PL_main_root);
 	PL_main_root = NULL;
diff --git a/perly.c b/perly.c
index d17f19b78a..d7d9ea34c6 100644
--- a/perly.c
+++ b/perly.c
@@ -221,6 +221,7 @@ S_clear_yystack(pTHX_  const yy_parser *parser)
 	    if (ps->compcv != PL_compcv) {
 		PL_compcv = ps->compcv;
 		PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
+		PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv));
 	    }
 	    YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 	    op_free(ps->val.opval);