Revert ‘Used pad name lists for pad ids’

This reverts commit 8771da69db30134352181c38401c7e50753a7ee8.

Pad lists need to carry IDs around with them, so that when something
tries to close over a pad, it is possible to confirm that the right
pad is being closed over (either the original outer pad, or a clone of
it).  (See the commit message of db4cf31d1, in which commit I added an
ID to the padlist struct.)

In 8771da69 I found that I could use the memory address of the pad’s
name list (name lists are shared) and avoid the extra field.

Some time after 8771da69 I realised that a pad list could be freed,
and the same address reused for another pad list, so using a memory
address may not be so wise.  I thought it highly unlikely, though, and
put it on the back burner.

I have just run into that.  t/comp/form_scope.t is now failing
for me with test 13, added by db4cf31d1.  It bisects to 3d6de2cd1
(PERL_PADNAME_MINIMAL), but that’s a red herring.  Trivial changes
to the script make the problem go away.  And it only happens on non-
debugging builds, and only on my machine.  Stepping through with gdb
shows that the format-cloning is following the format prototype’s out-
side pointer and confirming that it is has the correct pad (yes, the
memory addresses are the same), which I know it doesn’t, because I can
see what the test is doing.

While generation numbers can still fall afoul of the same problem, it
is much less likely.

Anyway, the worst thing about 8771da69 is the typo in the first word
of the commit message.

6 files changed, 11 insertions, 8 deletions

diff --git a/embedvar.h b/embedvar.h
index 712c259022..9e4a910a57 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -230,6 +230,7 @@
 #define PL_pad_reset_pending	(vTHX->Ipad_reset_pending)
 #define PL_padix		(vTHX->Ipadix)
 #define PL_padix_floor		(vTHX->Ipadix_floor)
+#define PL_padlist_generation	(vTHX->Ipadlist_generation)
 #define PL_padname_const	(vTHX->Ipadname_const)
 #define PL_padname_undef	(vTHX->Ipadname_undef)
 #define PL_parser		(vTHX->Iparser)
diff --git a/intrpvar.h b/intrpvar.h
index 6397eb634b..39eac06454 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -744,6 +744,8 @@ PERLVAR(I, debug_pad,	struct perl_debug_pad)	/* always needed because of the re
 /* Hook for File::Glob */
 PERLVARI(I, globhook,	globhook_t, NULL)
 
+PERLVARI(I, padlist_generation, U32, 1)	/* id to identify padlist clones */
+
 /* The last unconditional member of the interpreter structure when 5.21.7 was
    released. The offset of the end of this is baked into a global variable in 
    any shared perl library which will allow a sanity test in future perl
diff --git a/pad.c b/pad.c
index 18fdfb1ca4..9511c39b13 100644
--- a/pad.c
+++ b/pad.c
@@ -236,6 +236,7 @@ Perl_pad_new(pTHX_ int flags)
 	PadnamelistREFCNT(padname = PL_comppad_name)++;
     }
     else {
+	padlist->xpadl_id = PL_padlist_generation++;
 	av_store(pad, 0, NULL);
 	padname = newPADNAMELIST(0);
 	padnamelist_store(padname, 0, &PL_padname_undef);
@@ -1964,8 +1965,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
 	outside = CvOUTSIDE(proto);
 	if ((CvCLONE(outside) && ! CvCLONED(outside))
 	    || !CvPADLIST(outside)
-	    || PadlistNAMES(CvPADLIST(outside))
-		 != protopadlist->xpadl_outid) {
+	    || CvPADLIST(outside)->xpadl_id != protopadlist->xpadl_outid) {
 	    outside = find_runcv_where(
 		FIND_RUNCV_padid_eq, PTR2IV(protopadlist->xpadl_outid), NULL
 	    );
@@ -1988,6 +1988,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
     SAVESPTR(PL_comppad_name);
     PL_comppad_name = protopad_name;
     CvPADLIST_set(cv, pad_new(padnew_CLONE|padnew_SAVE));
+    CvPADLIST(cv)->xpadl_id = protopadlist->xpadl_id;
 
     av_fill(PL_comppad, fpad);
 
@@ -1996,8 +1997,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
     outpad = outside && CvPADLIST(outside)
 	? AvARRAY(PadlistARRAY(CvPADLIST(outside))[depth])
 	: NULL;
-    if (outpad)
-	CvPADLIST(cv)->xpadl_outid = PadlistNAMES(CvPADLIST(outside));
+    if (outpad) CvPADLIST(cv)->xpadl_outid = CvPADLIST(outside)->xpadl_id;
 
     for (ix = fpad; ix > 0; ix--) {
 	PADNAME* const namesv = (ix <= fname) ? pname[ix] : NULL;
diff --git a/pad.h b/pad.h
index 207823af6a..555bc6513c 100644
--- a/pad.h
+++ b/pad.h
@@ -34,7 +34,8 @@ typedef U64TYPE PADOFFSET;
 struct padlist {
     SSize_t	xpadl_max;	/* max index for which array has space */
     PAD **	xpadl_alloc;	/* pointer to beginning of array of AVs */
-    PADNAMELIST*xpadl_outid;	/* Padnamelist of outer pad; used as ID */
+    U32		xpadl_id;	/* Semi-unique ID, shared between clones */
+    U32		xpadl_outid;	/* ID of outer pad */
 };
 
 struct padnamelist {
diff --git a/pp_ctl.c b/pp_ctl.c
index 0b7a6ecad4..018bb4cdd4 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3297,7 +3297,7 @@ Perl_find_runcv_where(pTHX_ U8 cond, IV arg, U32 *db_seqp)
 		switch (cond) {
 		case FIND_RUNCV_padid_eq:
 		    if (!CvPADLIST(cv)
-		     || PadlistNAMES(CvPADLIST(cv)) != INT2PTR(PADNAMELIST *, arg))
+		     || CvPADLIST(cv)->xpadl_id != (U32)arg)
 			continue;
 		    return cv;
 		case FIND_RUNCV_level_eq:
diff --git a/toke.c b/toke.c
index 065d964bd0..ae832c0745 100644
--- a/toke.c
+++ b/toke.c
@@ -10557,8 +10557,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
     CvOUTSIDE(PL_compcv) = MUTABLE_CV(SvREFCNT_inc_simple(outsidecv));
     CvOUTSIDE_SEQ(PL_compcv) = PL_cop_seqmax;
     if (outsidecv && CvPADLIST(outsidecv))
-	CvPADLIST(PL_compcv)->xpadl_outid =
-	    PadlistNAMES(CvPADLIST(outsidecv));
+	CvPADLIST(PL_compcv)->xpadl_outid = CvPADLIST(outsidecv)->xpadl_id;
 
     return oldsavestack_ix;
 }