This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Used pad name lists for pad ids
authorFather Chrysostomos <sprout@cpan.org>
Wed, 17 Oct 2012 01:04:28 +0000 (18:04 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 17 Oct 2012 04:51:46 +0000 (21:51 -0700)
I added pad IDs so that a pad could record which pad it closes over,
to avoid problems with closures closing over the wrong pad, resulting
in crashes or bizarre copies.  These pad IDs were shared between
clones of the same pad.

In commit 9ef8d56, for efficiency I made clones of the same closure
share the same pad name list.

It has just occurred to be that each padlist containing the same pad
name list also has the same pad ID, so we can just use the pad name
list itself as the ID.

This makes padlists 32 bits smaller and eliminates PL_pad_generation
from the interpreter struct.

embedvar.h
intrpvar.h
pad.c
pad.h
pp_ctl.c
toke.c

index dc2583d..65c2ff1 100644 (file)
 #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_parser              (vTHX->Iparser)
 #define PL_patchlevel          (vTHX->Ipatchlevel)
 #define PL_peepp               (vTHX->Ipeepp)
index 3978dc1..9cff6e4 100644 (file)
@@ -768,7 +768,6 @@ PERLVAR(I, custom_ops,      HV *)           /* custom op registrations */
 PERLVARI(I, globhook,  globhook_t, NULL)
 
 PERLVARI(I, glob_index,        int,    0)
-PERLVARI(I, padlist_generation, U32, 1)        /* id to identify padlist clones */
 PERLVAR(I, reentrant_retint, int)      /* Integer return value from reentrant functions */
 
 /* The last unconditional member of the interpreter structure when 5.10.0 was
diff --git a/pad.c b/pad.c
index 8823566..673f8c7 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -280,7 +280,6 @@ Perl_pad_new(pTHX_ int flags)
        padname = (PAD *)SvREFCNT_inc_simple_NN(PL_comppad_name);
     }
     else {
-       padlist->xpadl_id = PL_padlist_generation++;
        av_store(pad, 0, NULL);
        padname = newAV();
     }
@@ -1994,7 +1993,8 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
        outside = CvOUTSIDE(proto);
        if ((CvCLONE(outside) && ! CvCLONED(outside))
            || !CvPADLIST(outside)
-           || CvPADLIST(outside)->xpadl_id != protopadlist->xpadl_outid) {
+           || PadlistNAMES(CvPADLIST(outside))
+                != protopadlist->xpadl_outid) {
            outside = find_runcv_where(
                FIND_RUNCV_padid_eq, (IV)protopadlist->xpadl_outid, NULL
            );
@@ -2016,7 +2016,6 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
     SAVESPTR(PL_comppad_name);
     PL_comppad_name = protopad_name;
     CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
-    CvPADLIST(cv)->xpadl_id = protopadlist->xpadl_id;
 
     av_fill(PL_comppad, fpad);
 
@@ -2025,7 +2024,8 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
     outpad = outside && CvPADLIST(outside)
        ? AvARRAY(PadlistARRAY(CvPADLIST(outside))[depth])
        : NULL;
-    if (outpad) CvPADLIST(cv)->xpadl_outid = CvPADLIST(outside)->xpadl_id;
+    if (outpad)
+       CvPADLIST(cv)->xpadl_outid = PadlistNAMES(CvPADLIST(outside));
 
     for (ix = fpad; ix > 0; ix--) {
        SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
diff --git a/pad.h b/pad.h
index f65af17..26e183c 100644 (file)
--- a/pad.h
+++ b/pad.h
@@ -31,8 +31,7 @@ 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 */
-    U32                xpadl_id;       /* Semi-unique ID, shared between clones */
-    U32                xpadl_outid;    /* ID of outer pad */
+    PADNAMELIST*xpadl_outid;   /* Padnamelist of outer pad; used as ID */
 };
 
 
index 1aaa261..bc9b647 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3273,7 +3273,8 @@ Perl_find_runcv_where(pTHX_ U8 cond, IV arg, U32 *db_seqp)
                switch (cond) {
                case FIND_RUNCV_padid_eq:
                    if (!CvPADLIST(cv)
-                    || CvPADLIST(cv)->xpadl_id != (U32)arg) continue;
+                    || PadlistNAMES(CvPADLIST(cv)) != (PADNAMELIST *)arg)
+                       continue;
                    return cv;
                case FIND_RUNCV_level_eq:
                    if (level++ != arg) continue;
diff --git a/toke.c b/toke.c
index 80144b7..61f1e04 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -10985,7 +10985,8 @@ 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 = CvPADLIST(outsidecv)->xpadl_id;
+       CvPADLIST(PL_compcv)->xpadl_outid =
+           PadlistNAMES(CvPADLIST(outsidecv));
 
     return oldsavestack_ix;
 }