diff options
| -rw-r--r-- | cop.h | 4 | ||||
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | ext/List/Util/Util.xs | 16 | ||||
| -rw-r--r-- | global.sym | 4 | ||||
| -rw-r--r-- | op.c | 2 | ||||
| -rw-r--r-- | pad.c | 53 | ||||
| -rw-r--r-- | pad.h | 86 | ||||
| -rw-r--r-- | perl.c | 2 | ||||
| -rw-r--r-- | perlapi.h | 32 | ||||
| -rw-r--r-- | pod/perlintern.pod | 48 | ||||
| -rw-r--r-- | pp_ctl.c | 5 | ||||
| -rw-r--r-- | proto.h | 2 | ||||
| -rw-r--r-- | regcomp.c | 29 | ||||
| -rw-r--r-- | regexec.c | 6 | ||||
| -rw-r--r-- | scope.c | 18 | ||||
| -rw-r--r-- | scope.h | 12 | ||||
| -rw-r--r-- | sv.c | 6 | ||||
| -rwxr-xr-x | t/op/closure.t | 15 |
18 files changed, 188 insertions, 154 deletions
@@ -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 @@ -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 diff --git a/ext/List/Util/Util.xs b/ext/List/Util/Util.xs index 92ee08499e..c26c484057 100644 --- a/ext/List/Util/Util.xs +++ b/ext/List/Util/Util.xs @@ -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); diff --git a/global.sym b/global.sym index b4bdf25139..84b9b7e838 100644 --- a/global.sym +++ b/global.sym @@ -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 @@ -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; @@ -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) @@ -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; \ @@ -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; } @@ -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 diff --git a/pod/perlintern.pod b/pod/perlintern.pod index a9915d2fc7..de1f4b21e5 100644 --- a/pod/perlintern.pod +++ b/pod/perlintern.pod @@ -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()). @@ -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); @@ -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); @@ -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; @@ -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. */ @@ -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: @@ -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 @@ -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); diff --git a/t/op/closure.t b/t/op/closure.t index 99c3216397..d93292b925 100755 --- a/t/op/closure.t +++ b/t/op/closure.t @@ -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}; + |