This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PL_curpad == AvARRAY(PL_comppad) always
authorDave Mitchell <davem@fdisolutions.com>
Fri, 18 Oct 2002 13:36:40 +0000 (14:36 +0100)
committerhv <hv@crypt.org>
Tue, 22 Oct 2002 17:04:26 +0000 (17:04 +0000)
Message-ID: <20021018133640.A19172@fdgroup.com>

p4raw-id: //depot/perl@18048

18 files changed:
cop.h
embed.fnc
ext/List/Util/Util.xs
global.sym
op.c
pad.c
pad.h
perl.c
perlapi.h
pod/perlintern.pod
pp_ctl.c
proto.h
regcomp.c
regexec.c
scope.c
scope.h
sv.c
t/op/closure.t

diff --git a/cop.h b/cop.h
index e6fbfe7..fe0ca8a 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -112,7 +112,7 @@ struct block_sub {
     long       olddepth;
     U8         hasargs;
     U8         lval;           /* XXX merge lval and hasargs? */
-    PAD                oldcurpad;
+    PAD                *oldcomppad;
 };
 
 #define PUSHSUB(cx)                                                    \
@@ -214,7 +214,7 @@ struct block_loop {
     OP *       last_op;
 #ifdef USE_ITHREADS
     void *     iterdata;
-    PAD                oldcurpad;
+    PAD                *oldcomppad;
 #else
     SV **      itervar;
 #endif
index 04920ee..5090f6b 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -716,7 +716,7 @@ Apd |I32    |sv_cmp_locale  |SV* sv1|SV* sv2
 #if defined(USE_LOCALE_COLLATE)
 Apd    |char*  |sv_collxfrm    |SV* sv|STRLEN* nxp
 #endif
-Ap     |OP*    |sv_compile_2op |SV* sv|OP** startp|char* code|AV** avp
+Ap     |OP*    |sv_compile_2op |SV* sv|OP** startp|char* code|PAD** padp
 Apd    |int    |getcwd_sv      |SV* sv
 Apd    |void   |sv_dec         |SV* sv
 Ap     |void   |sv_dump        |SV* sv
index 92ee084..c26c484 100644 (file)
@@ -212,8 +212,12 @@ CODE:
     reducecop = CvSTART(cv);
     SAVESPTR(CvROOT(cv)->op_ppaddr);
     CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL];
+#ifdef PAD_SET_CUR
+    PAD_SET_CUR(CvPADLIST(cv),1);
+#else
     SAVESPTR(PL_curpad);
     PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
+#endif
     SAVETMPS;
     SAVESPTR(PL_op);
     ret = ST(1);
@@ -256,8 +260,12 @@ CODE:
     reducecop = CvSTART(cv);
     SAVESPTR(CvROOT(cv)->op_ppaddr);
     CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL];
+#ifdef PAD_SET_CUR
+    PAD_SET_CUR(CvPADLIST(cv),1);
+#else
     SAVESPTR(PL_curpad);
     PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
+#endif
     SAVETMPS;
     SAVESPTR(PL_op);
     CATCH_SET(TRUE);
@@ -286,20 +294,16 @@ CODE:
     int index;
     struct op dmy_op;
     struct op *old_op = PL_op;
-    SV *my_pad[2];
-    SV **old_curpad = PL_curpad;
 
     /* We call pp_rand here so that Drand01 get initialized if rand()
        or srand() has not already been called
     */
-    my_pad[1] = sv_newmortal();
     memzero((char*)(&dmy_op), sizeof(struct op));
-    dmy_op.op_targ = 1;
+    /* we let pp_rand() borrow the TARG allocated for this XS sub */
+    dmy_op.op_targ = PL_op->op_targ;
     PL_op = &dmy_op;
-    PL_curpad = (SV **)&my_pad;
     (void)*(PL_ppaddr[OP_RAND])(aTHX);
     PL_op = old_op;
-    PL_curpad = old_curpad;
     for (index = items ; index > 1 ; ) {
        int swap = (int)(Drand01() * (double)(index--));
        SV *tmp = ST(swap);
index b4bdf25..84b9b7e 100644 (file)
@@ -51,7 +51,6 @@ Perl_cast_i32
 Perl_cast_iv
 Perl_cast_uv
 Perl_my_chsize
-Perl_condpair_magic
 Perl_croak
 Perl_vcroak
 Perl_croak_nocontext
@@ -325,7 +324,6 @@ Perl_vcmp
 Perl_ninstr
 Perl_op_free
 Perl_pad_sv
-Perl_new_struct_thread
 Perl_reentrant_size
 Perl_reentrant_init
 Perl_reentrant_free
@@ -505,7 +503,6 @@ Perl_to_utf8_upper
 Perl_to_utf8_title
 Perl_to_utf8_fold
 Perl_unlnk
-Perl_unlock_condpair
 Perl_unpack_str
 Perl_unsharepvn
 Perl_utf16_to_utf8
@@ -540,7 +537,6 @@ Perl_safesysfree
 Perl_GetVars
 Perl_runops_standard
 Perl_runops_debug
-Perl_sv_lock
 Perl_sv_catpvf_mg
 Perl_sv_vcatpvf_mg
 Perl_sv_catpv_mg
diff --git a/op.c b/op.c
index e3640ad..8c947b7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3763,7 +3763,7 @@ Perl_cv_undef(pTHX_ CV *cv)
            Perl_croak(aTHX_ "Can't undef active subroutine");
        ENTER;
 
-       PAD_SAVE_SETNULLPAD;
+       PAD_SAVE_SETNULLPAD();
 
        op_free(CvROOT(cv));
        CvROOT(cv) = Nullop;
diff --git a/pad.c b/pad.c
index e79110f..590aad8 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -34,7 +34,7 @@ but that is really the callers pad (a slot of which is allocated by
 every entersub).
 
 The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
-is managed "manual" (mostly in op.c) rather than normal av.c rules.
+is managed "manual" (mostly in pad.c) rather than normal av.c rules.
 The items in the AV are not SVs as for a normal AV, but other AVs:
 
 0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
@@ -50,7 +50,10 @@ C<PL_comppad_name> is set the the the names AV.
 C<PL_comppad> is set the the frame AV for the frame CvDEPTH == 1.
 C<PL_curpad> is set the body of the frame AV (i.e. AvARRAY(PL_comppad)).
 
-Itterating over the names AV itterates over all possible pad
+During execution, C<PL_comppad> and C<PL_curpad> refer to the live
+frame of the currently executing sub.
+
+Iterating over the names AV 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()).
 
@@ -110,6 +113,8 @@ Perl_pad_new(pTHX_ padnew_flags flags)
 {
     AV *padlist, *padname, *pad, *a0;
 
+    ASSERT_CURPAD_LEGAL("pad_new");
+
     /* XXX DAPM really need a new SAVEt_PAD which restores all or most
      * vars (based on flags) rather than storing vals + addresses for
      * each individually. Also see pad_block_start.
@@ -249,7 +254,7 @@ Perl_pad_undef(pTHX_ CV* cv, CV* outercv)
        if (sv == (SV*)PL_comppad_name)
            PL_comppad_name = Nullav;
        else if (sv == (SV*)PL_comppad) {
-           PL_comppad = Nullav;
+           PL_comppad = Null(PAD*);
            PL_curpad = Null(SV**);
        }
        SvREFCNT_dec(sv);
@@ -291,6 +296,8 @@ Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
     SV* namesv = NEWSV(1102, 0);
     U32 min, max;
 
+    ASSERT_CURPAD_ACTIVE("pad_add_name");
+
     if (fake) {
        min = PL_curcop->cop_seq;
        max = PAD_MAX;
@@ -329,6 +336,8 @@ Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
        if (!PL_min_intro_pending)
            PL_min_intro_pending = offset;
        PL_max_intro_pending = offset;
+       /* XXX DAPM since slot has been allocated, replace
+        * av_store with PL_curpad[offset] ? */
        if (*name == '@')
            av_store(PL_comppad, offset, (SV*)newAV());
        else if (*name == '%')
@@ -362,6 +371,8 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
     SV *sv;
     I32 retval;
 
+    ASSERT_CURPAD_ACTIVE("pad_alloc");
+
     if (AvARRAY(PL_comppad) != PL_curpad)
        Perl_croak(aTHX_ "panic: pad_alloc");
     if (PL_pad_reset_pending)
@@ -423,6 +434,7 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
     SvNVX(name) = 1;
     ix = pad_alloc(op_type, SVs_PADMY);
     av_store(PL_comppad_name, ix, name);
+    /* XXX DAPM use PL_curpad[] ? */
     av_store(PL_comppad, ix, sv);
     SvPADMY_on(sv);
     return ix;
@@ -450,6 +462,7 @@ Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
     SV         **svp, *sv;
     PADOFFSET  top, off;
 
+    ASSERT_CURPAD_ACTIVE("pad_check_dup");
     if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
        return; /* nothing to check */
 
@@ -519,6 +532,7 @@ Perl_pad_findmy(pTHX_ char *name)
     PERL_CONTEXT *cx;
     CV *outside;
 
+    ASSERT_CURPAD_ACTIVE("pad_findmy");
     DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad findmy:  \"%s\"\n", name));
 
     /* The one we're looking for is probably just before comppad_name_fill. */
@@ -584,6 +598,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
     register I32 i;
     register PERL_CONTEXT *cx;
 
+    ASSERT_CURPAD_ACTIVE("pad_findlex");
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
        "Pad findlex: \"%s\" off=%ld seq=%lu cv=0x%"UVxf
            " ix=%ld saweval=%d flags=%lu\n",
@@ -668,8 +683,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
                                /* install the missing pad entry in intervening
                                 * nested subs and mark them cloneable. */
                                AV *ocomppad_name = PL_comppad_name;
-                               AV *ocomppad = PL_comppad;
-                               SV **ocurpad = PL_curpad;
+                               PAD *ocomppad = PL_comppad;
                                AV *padlist = CvPADLIST(bcv);
                                PL_comppad_name = (AV*)AvARRAY(padlist)[0];
                                PL_comppad = (AV*)AvARRAY(padlist)[1];
@@ -685,7 +699,8 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 
                                PL_comppad_name = ocomppad_name;
                                PL_comppad = ocomppad;
-                               PL_curpad = ocurpad;
+                               PL_curpad = ocomppad ?
+                                       AvARRAY(ocomppad) : Null(SV **);
                                CvCLONE_on(bcv);
                            }
                            else {
@@ -711,6 +726,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
                }
            }
            av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
+           ASSERT_CURPAD_ACTIVE("pad_findlex 2");
            DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                        "Pad findlex: set offset %ld to sv 0x%"UVxf"\n",
                        (long)newoff, PTR2UV(oldsv)
@@ -789,19 +805,13 @@ Use macro PAD_SV instead of calling this function directly.
 SV *
 Perl_pad_sv(pTHX_ PADOFFSET po)
 {
-#ifdef DEBUGGING
-    /* for display purposes, try to guess the AV corresponding to
-     * Pl_curpad */
-    AV *cp = PL_comppad;
-    if (cp && AvARRAY(cp) != PL_curpad)
-       cp = Nullav;
-#endif
+    ASSERT_CURPAD_ACTIVE("pad_sv");
 
     if (!po)
        Perl_croak(aTHX_ "panic: pad_sv po");
     DEBUG_X(PerlIO_printf(Perl_debug_log,
        "Pad 0x%"UVxf"[0x%"UVxf"] sv:      %ld sv=0x%"UVxf"\n",
-       PTR2UV(cp), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
+       PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
     );
     return PL_curpad[po];
 }
@@ -820,15 +830,11 @@ Use the macro PAD_SETSV() rather than calling this function directly.
 void
 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
 {
-    /* for display purposes, try to guess the AV corresponding to
-     * Pl_curpad */
-    AV *cp = PL_comppad;
-    if (cp && AvARRAY(cp) != PL_curpad)
-       cp = Nullav;
+    ASSERT_CURPAD_ACTIVE("pad_setsv");
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
        "Pad 0x%"UVxf"[0x%"UVxf"] setsv:   %ld sv=0x%"UVxf"\n",
-       PTR2UV(cp), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
+       PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
     );
     PL_curpad[po] = sv;
 }
@@ -853,6 +859,7 @@ Update the pad compilation state variables on entry to a new block
 void
 Perl_pad_block_start(pTHX_ int full)
 {
+    ASSERT_CURPAD_ACTIVE("pad_block_start");
     SAVEI32(PL_comppad_name_floor);
     PL_comppad_name_floor = AvFILLp(PL_comppad_name);
     if (full)
@@ -884,6 +891,7 @@ Perl_intro_my(pTHX)
     SV *sv;
     I32 i;
 
+    ASSERT_CURPAD_ACTIVE("intro_my");
     if (! PL_min_intro_pending)
        return PL_cop_seqmax;
 
@@ -925,6 +933,7 @@ Perl_pad_leavemy(pTHX)
 
     PL_pad_reset_pending = FALSE;
 
+    ASSERT_CURPAD_ACTIVE("pad_leavemy");
     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--) {
            if ((sv = svp[off]) && sv != &PL_sv_undef && ckWARN_d(WARN_INTERNAL))
@@ -961,6 +970,7 @@ new one.
 void
 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
 {
+    ASSERT_CURPAD_LEGAL("pad_swipe");
     if (!PL_curpad)
        return;
     if (AvARRAY(PL_comppad) != PL_curpad)
@@ -1047,6 +1057,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 {
     PADOFFSET ix;
 
+    ASSERT_CURPAD_ACTIVE("pad_tidy");
     /* extend curpad to match namepad */
     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
        av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
@@ -1097,6 +1108,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
                SvPADTMP_on(PL_curpad[ix]);
        }
     }
+    PL_curpad = AvARRAY(PL_comppad);
 }
 
 
@@ -1112,6 +1124,7 @@ Free the SV at offet po in the current pad.
 void
 Perl_pad_free(pTHX_ PADOFFSET po)
 {
+    ASSERT_CURPAD_LEGAL("pad_free");
     if (!PL_curpad)
        return;
     if (AvARRAY(PL_comppad) != PL_curpad)
diff --git a/pad.h b/pad.h
index 39b77d4..f8a777e 100644 (file)
--- a/pad.h
+++ b/pad.h
@@ -17,7 +17,7 @@
  * so hide the type. Ditto a pad.  */
 
 typedef AV PADLIST;
-typedef SV** PAD;
+typedef AV PAD;
 
 
 /* offsets within a pad */
@@ -48,22 +48,42 @@ typedef enum {
        padtidy_FORMAT          /* or a format */
 } padtidy_type;
 
+/* ASSERT_CURPAD_LEGAL and ASSERT_CURPAD_ACTIVE respectively determine
+ * whether PL_comppad and PL_curpad are consistent and whether they have
+ * active values */
 
-/* Note: the following four macros are actually defined in scope.h, but
+#ifdef DEBUGGING
+#  define ASSERT_CURPAD_LEGAL(label) \
+    if (PL_comppad ? (AvARRAY(PL_comppad) != PL_curpad) : (PL_curpad != 0))  \
+       Perl_croak(aTHX_ "panic: illegal pad in %s: 0x%"UVxf"[0x%"UVxf"]",\
+           label, PTR2UV(PL_comppad), PTR2UV(PL_curpad));
+
+
+#  define ASSERT_CURPAD_ACTIVE(label) \
+    if (!PL_comppad || (AvARRAY(PL_comppad) != PL_curpad))               \
+       Perl_croak(aTHX_ "panic: invalid pad in %s: 0x%"UVxf"[0x%"UVxf"]",\
+           label, PTR2UV(PL_comppad), PTR2UV(PL_curpad));
+#else
+#  define ASSERT_CURPAD_LEGAL(label)
+#  define ASSERT_CURPAD_ACTIVE(label)
+#endif
+
+
+
+/* Note: the following three macros are actually defined in scope.h, but
  * they are documented here for completeness, since they directly or
  * indirectly affect pads.
 
 =for apidoc m|void|SAVEPADSV   |PADOFFSET po
 Save a pad slot (used to restore after an iteration)
 
+XXX DAPM it would make more sense to make the arg a PADOFFSET
 =for apidoc m|void|SAVECLEARSV |SV **svp
 Clear the pointed to pad value on scope exit. (ie the runtime action of 'my')
 
 =for apidoc m|void|SAVECOMPPAD
 save PL_comppad and PL_curpad
 
-=for apidoc m|void|SAVEFREEOP  |OP *o
-Free the op on scope exit. At the same time, reset PL_curpad
 
 
 
@@ -90,8 +110,12 @@ the previous current pad.
 =for apidoc m|void|PAD_SAVE_SETNULLPAD
 Save the current pad then set it to null.
 
-=for apidoc m|void|PAD_UPDATE_CURPAD
-Set PL_curpad from the value of PL_comppad.
+=for apidoc m|void|PAD_SAVE_LOCAL|PAD *opad|PAD *npad
+Save the current pad to the local variable opad, then make the
+current pad equal to npad
+
+=for apidoc m|void|PAD_RESTORE_LOCAL|PAD *opad
+Restore the old pad saved into the local variable opad by PAD_SAVE_LOCAL()
 
 =cut
 */
@@ -112,28 +136,47 @@ Set PL_curpad from the value of PL_comppad.
     
 
 #define PAD_SET_CUR(padlist,n) \
-       SAVEVPTR(PL_curpad);   \
-       PL_curpad = AvARRAY((AV*)*av_fetch((padlist),(n),FALSE))
-
-#define PAD_SAVE_SETNULLPAD    SAVEVPTR(PL_curpad); PL_curpad = 0;
-
-#define PAD_UPDATE_CURPAD \
-    PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : Null(PAD)
+       SAVECOMPPAD();                                          \
+       PL_comppad = (PAD*) (AvARRAY(padlist)[n]);              \
+       PL_curpad = AvARRAY(PL_comppad);                        \
+       DEBUG_Xv(PerlIO_printf(Perl_debug_log,                  \
+             "Pad 0x%"UVxf"[0x%"UVxf"] set_cur    depth=%d\n", \
+             PTR2UV(PL_comppad), PTR2UV(PL_curpad), (int)(n)));
+
+
+#define PAD_SAVE_SETNULLPAD()  SAVECOMPPAD(); \
+       PL_comppad = Null(PAD*); PL_curpad = Null(SV**);        \
+       DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad set_null\n"));
+
+#define PAD_SAVE_LOCAL(opad,npad) \
+       opad = PL_comppad;                                      \
+       PL_comppad = (npad);                                    \
+       PL_curpad =  PL_comppad ? AvARRAY(PL_comppad) : Null(SV**); \
+       DEBUG_Xv(PerlIO_printf(Perl_debug_log,                  \
+             "Pad 0x%"UVxf"[0x%"UVxf"] save_local\n",          \
+             PTR2UV(PL_comppad), PTR2UV(PL_curpad)));
+
+#define PAD_RESTORE_LOCAL(opad) \
+       PL_comppad = opad;                                      \
+       PL_curpad =  PL_comppad ? AvARRAY(PL_comppad) : Null(SV**); \
+       DEBUG_Xv(PerlIO_printf(Perl_debug_log,                  \
+             "Pad 0x%"UVxf"[0x%"UVxf"] restore_local\n",       \
+             PTR2UV(PL_comppad), PTR2UV(PL_curpad)));
 
 
 /*
 =for apidoc m|void|CX_CURPAD_SAVE|struct context
 Save the current pad in the given context block structure.
 
-=for apidoc m|PAD *|CX_CURPAD_SV|struct context|PADOFFSET po
+=for apidoc m|SV *|CX_CURPAD_SV|struct context|PADOFFSET po
 Access the SV at offset po in the saved current pad in the given
 context block structure (can be used as an lvalue).
 
 =cut
 */
 
-#define CX_CURPAD_SAVE(block)  (block).oldcurpad = PL_curpad
-#define CX_CURPAD_SV(block,po) ((block).oldcurpad[po])
+#define CX_CURPAD_SAVE(block)  (block).oldcomppad = PL_comppad
+#define CX_CURPAD_SV(block,po) (AvARRAY((AV*)((block).oldcomppad))[po])
 
 
 /*
@@ -199,13 +242,18 @@ Clone the state variables associated with running and compiling pads.
     else                                                       \
        (dstpad) = av_dup_inc((srcpad), param);                 
 
+/* note - we set comp/curpad to null rather than duping - otherwise
+ * we may dup a pad but not the whole padlist, and be left with
+ * leaked pad. We assume that a sub will get called very soon hereafter
+ * and comp/curpad will get set to something sensible. DAPM 16-Oct02 */
+/* XXX DAPM -does the same logic appply to comppad_name ? */
+
 #define PAD_CLONE_VARS(proto_perl, param)                              \
-    PL_comppad                 = av_dup(proto_perl->Icomppad, param);  \
+    PL_comppad                 = Null(PAD*);                           \
+    PL_curpad                  = Null(SV **);                          \
     PL_comppad_name            = av_dup(proto_perl->Icomppad_name, param); \
     PL_comppad_name_fill       = proto_perl->Icomppad_name_fill;       \
     PL_comppad_name_floor      = proto_perl->Icomppad_name_floor;      \
-    PL_curpad                  = (SV**)ptr_table_fetch(PL_ptr_table,   \
-                                               proto_perl->Tcurpad);   \
     PL_min_intro_pending       = proto_perl->Imin_intro_pending;       \
     PL_max_intro_pending       = proto_perl->Imax_intro_pending;       \
     PL_padix                   = proto_perl->Ipadix;                   \
diff --git a/perl.c b/perl.c
index 60a2f49..d18b0da 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -349,7 +349,6 @@ perl_destruct(pTHXx)
 
     /* Destroy the main CV and syntax tree */
     if (PL_main_root) {
-       PAD_UPDATE_CURPAD;
        op_free(PL_main_root);
        PL_main_root = Nullop;
     }
@@ -909,7 +908,6 @@ setuid perl scripts securely.\n");
     }
 
     if (PL_main_root) {
-       PAD_UPDATE_CURPAD;
        op_free(PL_main_root);
        PL_main_root = Nullop;
     }
index b9822a6..c65a4c6 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -178,8 +178,6 @@ END_EXTERN_C
 #define PL_cop_seqmax          (*Perl_Icop_seqmax_ptr(aTHX))
 #undef  PL_copline
 #define PL_copline             (*Perl_Icopline_ptr(aTHX))
-#undef  PL_cred_mutex
-#define PL_cred_mutex          (*Perl_Icred_mutex_ptr(aTHX))
 #undef  PL_cryptseen
 #define PL_cryptseen           (*Perl_Icryptseen_ptr(aTHX))
 #undef  PL_cshlen
@@ -190,8 +188,6 @@ END_EXTERN_C
 #define PL_curcopdb            (*Perl_Icurcopdb_ptr(aTHX))
 #undef  PL_curstname
 #define PL_curstname           (*Perl_Icurstname_ptr(aTHX))
-#undef  PL_curthr
-#define PL_curthr              (*Perl_Icurthr_ptr(aTHX))
 #undef  PL_custom_op_descs
 #define PL_custom_op_descs     (*Perl_Icustom_op_descs_ptr(aTHX))
 #undef  PL_custom_op_names
@@ -232,12 +228,6 @@ END_EXTERN_C
 #define PL_error_count         (*Perl_Ierror_count_ptr(aTHX))
 #undef  PL_euid
 #define PL_euid                        (*Perl_Ieuid_ptr(aTHX))
-#undef  PL_eval_cond
-#define PL_eval_cond           (*Perl_Ieval_cond_ptr(aTHX))
-#undef  PL_eval_mutex
-#define PL_eval_mutex          (*Perl_Ieval_mutex_ptr(aTHX))
-#undef  PL_eval_owner
-#define PL_eval_owner          (*Perl_Ieval_owner_ptr(aTHX))
 #undef  PL_eval_root
 #define PL_eval_root           (*Perl_Ieval_root_ptr(aTHX))
 #undef  PL_eval_start
@@ -254,8 +244,6 @@ END_EXTERN_C
 #define PL_expect              (*Perl_Iexpect_ptr(aTHX))
 #undef  PL_fdpid
 #define PL_fdpid               (*Perl_Ifdpid_ptr(aTHX))
-#undef  PL_fdpid_mutex
-#define PL_fdpid_mutex         (*Perl_Ifdpid_mutex_ptr(aTHX))
 #undef  PL_filemode
 #define PL_filemode            (*Perl_Ifilemode_ptr(aTHX))
 #undef  PL_forkprocess
@@ -408,10 +396,6 @@ END_EXTERN_C
 #define PL_nice_chunk_size     (*Perl_Inice_chunk_size_ptr(aTHX))
 #undef  PL_nomemok
 #define PL_nomemok             (*Perl_Inomemok_ptr(aTHX))
-#undef  PL_nthreads
-#define PL_nthreads            (*Perl_Inthreads_ptr(aTHX))
-#undef  PL_nthreads_cond
-#define PL_nthreads_cond       (*Perl_Inthreads_cond_ptr(aTHX))
 #undef  PL_numeric_compat1
 #define PL_numeric_compat1     (*Perl_Inumeric_compat1_ptr(aTHX))
 #undef  PL_numeric_local
@@ -522,8 +506,6 @@ END_EXTERN_C
 #define PL_stdingv             (*Perl_Istdingv_ptr(aTHX))
 #undef  PL_strtab
 #define PL_strtab              (*Perl_Istrtab_ptr(aTHX))
-#undef  PL_strtab_mutex
-#define PL_strtab_mutex                (*Perl_Istrtab_mutex_ptr(aTHX))
 #undef  PL_sub_generation
 #define PL_sub_generation      (*Perl_Isub_generation_ptr(aTHX))
 #undef  PL_sublex_info
@@ -536,10 +518,6 @@ END_EXTERN_C
 #define PL_sv_arenaroot                (*Perl_Isv_arenaroot_ptr(aTHX))
 #undef  PL_sv_count
 #define PL_sv_count            (*Perl_Isv_count_ptr(aTHX))
-#undef  PL_sv_lock_mutex
-#define PL_sv_lock_mutex       (*Perl_Isv_lock_mutex_ptr(aTHX))
-#undef  PL_sv_mutex
-#define PL_sv_mutex            (*Perl_Isv_mutex_ptr(aTHX))
 #undef  PL_sv_no
 #define PL_sv_no               (*Perl_Isv_no_ptr(aTHX))
 #undef  PL_sv_objcount
@@ -550,22 +528,12 @@ END_EXTERN_C
 #define PL_sv_undef            (*Perl_Isv_undef_ptr(aTHX))
 #undef  PL_sv_yes
 #define PL_sv_yes              (*Perl_Isv_yes_ptr(aTHX))
-#undef  PL_svref_mutex
-#define PL_svref_mutex         (*Perl_Isvref_mutex_ptr(aTHX))
 #undef  PL_sys_intern
 #define PL_sys_intern          (*Perl_Isys_intern_ptr(aTHX))
 #undef  PL_taint_warn
 #define PL_taint_warn          (*Perl_Itaint_warn_ptr(aTHX))
 #undef  PL_tainting
 #define PL_tainting            (*Perl_Itainting_ptr(aTHX))
-#undef  PL_threadnum
-#define PL_threadnum           (*Perl_Ithreadnum_ptr(aTHX))
-#undef  PL_threads_mutex
-#define PL_threads_mutex       (*Perl_Ithreads_mutex_ptr(aTHX))
-#undef  PL_threadsv_names
-#define PL_threadsv_names      (*Perl_Ithreadsv_names_ptr(aTHX))
-#undef  PL_thrsv
-#define PL_thrsv               (*Perl_Ithrsv_ptr(aTHX))
 #undef  PL_tokenbuf
 #define PL_tokenbuf            (*Perl_Itokenbuf_ptr(aTHX))
 #undef  PL_uid
index a9915d2..de1f4b2 100644 (file)
@@ -30,7 +30,7 @@ Found in file pad.h
 Access the SV at offset po in the saved current pad in the given
 context block structure (can be used as an lvalue).
 
-       PAD *   CX_CURPAD_SV(struct context, PADOFFSET po)
+       SV *    CX_CURPAD_SV(struct context, PADOFFSET po)
 
 =for hackers
 Found in file pad.h
@@ -113,6 +113,25 @@ Clone a padlist.
 =for hackers
 Found in file pad.h
 
+=item PAD_RESTORE_LOCAL
+
+Restore the old pad saved into the local variable opad by PAD_SAVE_LOCAL()
+
+       void    PAD_RESTORE_LOCAL(PAD *opad)
+
+=for hackers
+Found in file pad.h
+
+=item PAD_SAVE_LOCAL
+
+Save the current pad to the local variable opad, then make the
+current pad equal to npad
+
+       void    PAD_SAVE_LOCAL(PAD *opad, PAD *npad)
+
+=for hackers
+Found in file pad.h
+
 =item PAD_SAVE_SETNULLPAD
 
 Save the current pad then set it to null.
@@ -162,15 +181,6 @@ For internal use only.
 =for hackers
 Found in file pad.h
 
-=item PAD_UPDATE_CURPAD
-
-Set PL_curpad from the value of PL_comppad.
-
-       void    PAD_UPDATE_CURPAD()
-
-=for hackers
-Found in file pad.h
-
 =item SAVECLEARSV      
 
 Clear the pointed to pad value on scope exit. (ie the runtime action of 'my')
@@ -184,19 +194,11 @@ Found in file pad.h
 
 save PL_comppad and PL_curpad
 
-       void    SAVECOMPPAD()
 
-=for hackers
-Found in file pad.h
-
-=item SAVEFREEOP       
-
-Free the op on scope exit. At the same time, reset PL_curpad
 
 
 
-
-       void    SAVEFREEOP      (OP *o)
+       void    SAVECOMPPAD()
 
 =for hackers
 Found in file pad.h
@@ -205,6 +207,7 @@ Found in file pad.h
 
 Save a pad slot (used to restore after an iteration)
 
+XXX DAPM it would make more sense to make the arg a PADOFFSET
        void    SAVEPADSV       (PADOFFSET po)
 
 =for hackers
@@ -350,7 +353,7 @@ but that is really the callers pad (a slot of which is allocated by
 every entersub).
 
 The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
-is managed "manual" (mostly in op.c) rather than normal av.c rules.
+is managed "manual" (mostly in pad.c) rather than normal av.c rules.
 The items in the AV are not SVs as for a normal AV, but other AVs:
 
 0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
@@ -366,7 +369,10 @@ C<PL_comppad_name> is set the the the names AV.
 C<PL_comppad> is set the the frame AV for the frame CvDEPTH == 1.
 C<PL_curpad> is set the body of the frame AV (i.e. AvARRAY(PL_comppad)).
 
-Itterating over the names AV itterates over all possible pad
+During execution, C<PL_comppad> and C<PL_curpad> refer to the live
+frame of the currently executing sub.
+
+Iterating over the names AV 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()).
 
index 4756ec3..07069ca 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2553,7 +2553,7 @@ S_docatch(pTHX_ OP *o)
 }
 
 OP *
-Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
+Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, PAD** padp)
 /* sv Text to convert to OP tree. */
 /* startop op_free() this to undo. */
 /* code Short string id of the caller. */
@@ -2618,7 +2618,8 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
     (*startop)->op_type = OP_NULL;
     (*startop)->op_ppaddr = PL_ppaddr[OP_NULL];
     lex_end();
-    *avp = (AV*)SvREFCNT_inc(PL_comppad);
+    /* XXX DAPM do this properly one year */
+    *padp = (AV*)SvREFCNT_inc(PL_comppad);
     LEAVE;
     if (PL_curcop == &PL_compiling)
        PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
diff --git a/proto.h b/proto.h
index 04ffb6a..027cda6 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -752,7 +752,7 @@ PERL_CALLCONV I32   Perl_sv_cmp_locale(pTHX_ SV* sv1, SV* sv2);
 #if defined(USE_LOCALE_COLLATE)
 PERL_CALLCONV char*    Perl_sv_collxfrm(pTHX_ SV* sv, STRLEN* nxp);
 #endif
-PERL_CALLCONV OP*      Perl_sv_compile_2op(pTHX_ SV* sv, OP** startp, char* code, AV** avp);
+PERL_CALLCONV OP*      Perl_sv_compile_2op(pTHX_ SV* sv, OP** startp, char* code, PAD** padp);
 PERL_CALLCONV int      Perl_getcwd_sv(pTHX_ SV* sv);
 PERL_CALLCONV void     Perl_sv_dec(pTHX_ SV* sv);
 PERL_CALLCONV void     Perl_sv_dump(pTHX_ SV* sv);
index 8afb8ab..c8b5d76 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -2218,7 +2218,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
                    vFAIL("Sequence (?{...}) not terminated or not {}-balanced");
                }
                if (!SIZE_ONLY) {
-                   AV *av;
+                   PAD *pad;
                
                    if (RExC_parse - 1 - s)
                        sv = newSVpvn(s, RExC_parse - 1 - s);
@@ -2227,7 +2227,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
 
                    ENTER;
                    Perl_save_re_context(aTHX);
-                   rop = sv_compile_2op(sv, &sop, "re", &av);
+                   rop = sv_compile_2op(sv, &sop, "re", &pad);
                    sop->op_private |= OPpREFCOUNTED;
                    /* re_dup will OpREFCNT_inc */
                    OpREFCNT_set(sop, 1);
@@ -2236,7 +2236,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
                    n = add_data(pRExC_state, 3, "nop");
                    RExC_rx->data->data[n] = (void*)rop;
                    RExC_rx->data->data[n+1] = (void*)sop;
-                   RExC_rx->data->data[n+2] = (void*)av;
+                   RExC_rx->data->data[n+2] = (void*)pad;
                    SvREFCNT_dec(sv);
                }
                else {                                          /* First pass */
@@ -4918,9 +4918,8 @@ Perl_pregfree(pTHX_ struct regexp *r)
     }
     if (r->data) {
        int n = r->data->count;
-       AV* new_comppad = NULL;
-       AV* old_comppad;
-       SV** old_curpad;
+       PAD* new_comppad = NULL;
+       PAD* old_comppad;
 
        while (--n >= 0) {
           /* If you add a ->what type here, update the comment in regcomp.h */
@@ -4937,22 +4936,16 @@ Perl_pregfree(pTHX_ struct regexp *r)
            case 'o':
                if (new_comppad == NULL)
                    Perl_croak(aTHX_ "panic: pregfree comppad");
-               old_comppad = PL_comppad;
-               old_curpad = PL_curpad;
-               /* Watch out for global destruction's random ordering. */
-               if (SvTYPE(new_comppad) == SVt_PVAV) {
-                   PL_comppad = new_comppad;
-                   PL_curpad = AvARRAY(new_comppad);
-               }
-               else
-                   PL_curpad = NULL;
-
+               PAD_SAVE_LOCAL(old_comppad,
+                   /* Watch out for global destruction's random ordering. */
+                   (SvTYPE(new_comppad) == SVt_PVAV) ?
+                               new_comppad : Null(PAD *)
+               );
                if (!OpREFCNT_dec((OP_4tree*)r->data->data[n])) {
                     op_free((OP_4tree*)r->data->data[n]);
                }
 
-               PL_comppad = old_comppad;
-               PL_curpad = old_curpad;
+               PAD_RESTORE_LOCAL(old_comppad);
                SvREFCNT_dec((SV*)new_comppad);
                new_comppad = NULL;
                break;
index c93df5d..55cc437 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -2791,13 +2791,13 @@ S_regmatch(pTHX_ regnode *prog)
            dSP;
            OP_4tree *oop = PL_op;
            COP *ocurcop = PL_curcop;
-           SV **ocurpad = PL_curpad;
+           PAD *old_comppad;
            SV *ret;
        
            n = ARG(scan);
            PL_op = (OP_4tree*)PL_regdata->data[n];
            DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
-           PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 2]);
+           PAD_SAVE_LOCAL(old_comppad, (PAD*)PL_regdata->data[n + 2]);
            PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
 
            {
@@ -2813,7 +2813,7 @@ S_regmatch(pTHX_ regnode *prog)
            }
 
            PL_op = oop;
-           PL_curpad = ocurpad;
+           PAD_RESTORE_LOCAL(old_comppad);
            PL_curcop = ocurcop;
            if (logical) {
                if (logical == 2) {     /* Postponed subexpression. */
diff --git a/scope.c b/scope.c
index a1da83b..8691057 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -460,8 +460,9 @@ void
 Perl_save_padsv(pTHX_ PADOFFSET off)
 {
     SSCHECK(4);
+    ASSERT_CURPAD_ACTIVE("save_padsv");
     SSPUSHPTR(PL_curpad[off]);
-    SSPUSHPTR(PL_curpad);
+    SSPUSHPTR(PL_comppad);
     SSPUSHLONG((long)off);
     SSPUSHINT(SAVEt_PADSV);
 }
@@ -534,6 +535,7 @@ Perl_save_freepv(pTHX_ char *pv)
 void
 Perl_save_clearsv(pTHX_ SV **svp)
 {
+    ASSERT_CURPAD_ACTIVE("save_clearsv");
     SSCHECK(2);
     SSPUSHLONG((long)(svp-PL_curpad));
     SSPUSHINT(SAVEt_CLEARSV);
@@ -849,8 +851,7 @@ Perl_leave_scope(pTHX_ I32 base)
            break;
        case SAVEt_FREEOP:
            ptr = SSPOPPTR;
-           if (PL_comppad)
-               PL_curpad = AvARRAY(PL_comppad);
+           ASSERT_CURPAD_LEGAL("SAVEt_FREEOP"); /* XXX DAPM tmp */
            op_free((OP*)ptr);
            break;
        case SAVEt_FREEPV:
@@ -862,10 +863,9 @@ Perl_leave_scope(pTHX_ I32 base)
            sv = *(SV**)ptr;
 
            DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-               "Pad [0x%"UVxf"] clearsv: %ld sv=0x%"UVxf"<%"IVdf"> %s\n",
-               PTR2UV(PL_curpad), (long)((SV **)ptr-PL_curpad),
-               PTR2UV(sv),
-               (IV)SvREFCNT(sv),
+            "Pad 0x%"UVxf"[0x%"UVxf"] clearsv: %ld sv=0x%"UVxf"<%"IVdf"> %s\n",
+               PTR2UV(PL_comppad), PTR2UV(PL_curpad),
+               (long)((SV **)ptr-PL_curpad), PTR2UV(sv), (IV)SvREFCNT(sv),
                (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) ? "clear" : "abandon"
            ));
 
@@ -990,7 +990,7 @@ Perl_leave_scope(pTHX_ I32 base)
            *(I32*)&PL_hints = (I32)SSPOPINT;
            break;
        case SAVEt_COMPPAD:
-           PL_comppad = (AV*)SSPOPPTR;
+           PL_comppad = (PAD*)SSPOPPTR;
            if (PL_comppad)
                PL_curpad = AvARRAY(PL_comppad);
            else
@@ -1001,7 +1001,7 @@ Perl_leave_scope(pTHX_ I32 base)
                PADOFFSET off = (PADOFFSET)SSPOPLONG;
                ptr = SSPOPPTR;
                if (ptr)
-                   ((PAD)ptr)[off] = (SV*)SSPOPPTR;
+                   AvARRAY((PAD*)ptr)[off] = (SV*)SSPOPPTR;
            }
            break;
        default:
diff --git a/scope.h b/scope.h
index 6cfe124..b15e5f1 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -158,15 +158,9 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 
 #define SAVECOMPPAD() \
     STMT_START {                                               \
-       if (PL_comppad && PL_curpad == AvARRAY(PL_comppad)) {   \
-           SSCHECK(2);                                         \
-           SSPUSHPTR((SV*)PL_comppad);                         \
-           SSPUSHINT(SAVEt_COMPPAD);                           \
-       }                                                       \
-       else {                                                  \
-           SAVEVPTR(PL_curpad);                                \
-           SAVESPTR(PL_comppad);                               \
-       }                                                       \
+       SSCHECK(2);                                             \
+       SSPUSHPTR((SV*)PL_comppad);                             \
+       SSPUSHINT(SAVEt_COMPPAD);                               \
     } STMT_END
 
 #ifdef USE_ITHREADS
diff --git a/sv.c b/sv.c
index fb31c81..35a7bd8 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9647,9 +9647,9 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
                ncx->blk_loop.iterdata  = (CxPADLOOP(cx)
                                           ? cx->blk_loop.iterdata
                                           : gv_dup((GV*)cx->blk_loop.iterdata, param));
-               ncx->blk_loop.oldcurpad
-                   = (SV**)ptr_table_fetch(PL_ptr_table,
-                                           cx->blk_loop.oldcurpad);
+               ncx->blk_loop.oldcomppad
+                   = (PAD*)ptr_table_fetch(PL_ptr_table,
+                                           cx->blk_loop.oldcomppad);
                ncx->blk_loop.itersave  = sv_dup_inc(cx->blk_loop.itersave, param);
                ncx->blk_loop.iterlval  = sv_dup_inc(cx->blk_loop.iterlval, param);
                ncx->blk_loop.iterary   = av_dup_inc(cx->blk_loop.iterary, param);
index 99c3216..d93292b 100755 (executable)
@@ -13,7 +13,7 @@ BEGIN {
 
 use Config;
 
-print "1..172\n";
+print "1..173\n";
 
 my $test = 1;
 sub test (&) {
@@ -514,3 +514,16 @@ END
 BEGIN { $vanishing_pad = sub { eval $_[0] } }
 $some_var = 123;
 test { $vanishing_pad->( '$some_var' ) == 123 };
+
+# this coredumped on <= 5.8.0 because evaling the closure caused
+# an SvFAKE to be added to the outer anon's pad, which was then grown.
+my $outer;
+sub {
+    my $x;
+    $x = eval 'sub { $outer }';
+    $x->();
+    $a = [ 99 ];
+    $x->();
+}->();
+test {1};
+