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.

diff --git a/embedvar.h b/embedvar.h
index 712c259..9e4a910 100644 (file)
--- 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 6397eb6..39eac06 100644 (file)
--- 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 18fdfb1..9511c39 100644 (file)
--- 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 207823a..555bc65 100644 (file)
--- 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 0b7a6ec..018bb4c 100644 (file)
--- 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 065d964..ae832c0 100644 (file)
--- 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;
 }