long olddepth;
U8 hasargs;
U8 lval; /* XXX merge lval and hasargs? */
- PAD oldcurpad;
+ PAD *oldcomppad;
};
#define PUSHSUB(cx) \
OP * last_op;
#ifdef USE_ITHREADS
void * iterdata;
- PAD oldcurpad;
+ PAD *oldcomppad;
#else
SV ** itervar;
#endif
#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
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);
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);
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);
Perl_cast_iv
Perl_cast_uv
Perl_my_chsize
-Perl_condpair_magic
Perl_croak
Perl_vcroak
Perl_croak_nocontext
Perl_ninstr
Perl_op_free
Perl_pad_sv
-Perl_new_struct_thread
Perl_reentrant_size
Perl_reentrant_init
Perl_reentrant_free
Perl_to_utf8_title
Perl_to_utf8_fold
Perl_unlnk
-Perl_unlock_condpair
Perl_unpack_str
Perl_unsharepvn
Perl_utf16_to_utf8
Perl_GetVars
Perl_runops_standard
Perl_runops_debug
-Perl_sv_lock
Perl_sv_catpvf_mg
Perl_sv_vcatpvf_mg
Perl_sv_catpv_mg
Perl_croak(aTHX_ "Can't undef active subroutine");
ENTER;
- PAD_SAVE_SETNULLPAD;
+ PAD_SAVE_SETNULLPAD();
op_free(CvROOT(cv));
CvROOT(cv) = Nullop;
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
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()).
{
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.
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);
SV* namesv = NEWSV(1102, 0);
U32 min, max;
+ ASSERT_CURPAD_ACTIVE("pad_add_name");
+
if (fake) {
min = PL_curcop->cop_seq;
max = PAD_MAX;
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 == '%')
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)
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;
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 */
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. */
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",
/* 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];
PL_comppad_name = ocomppad_name;
PL_comppad = ocomppad;
- PL_curpad = ocurpad;
+ PL_curpad = ocomppad ?
+ AvARRAY(ocomppad) : Null(SV **);
CvCLONE_on(bcv);
}
else {
}
}
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)
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];
}
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;
}
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)
SV *sv;
I32 i;
+ ASSERT_CURPAD_ACTIVE("intro_my");
if (! PL_min_intro_pending)
return PL_cop_seqmax;
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))
void
Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
{
+ ASSERT_CURPAD_LEGAL("pad_swipe");
if (!PL_curpad)
return;
if (AvARRAY(PL_comppad) != PL_curpad)
{
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);
SvPADTMP_on(PL_curpad[ix]);
}
}
+ PL_curpad = AvARRAY(PL_comppad);
}
void
Perl_pad_free(pTHX_ PADOFFSET po)
{
+ ASSERT_CURPAD_LEGAL("pad_free");
if (!PL_curpad)
return;
if (AvARRAY(PL_comppad) != PL_curpad)
* so hide the type. Ditto a pad. */
typedef AV PADLIST;
-typedef SV** PAD;
+typedef AV PAD;
/* offsets within a pad */
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
=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
*/
#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])
/*
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; \
/* Destroy the main CV and syntax tree */
if (PL_main_root) {
- PAD_UPDATE_CURPAD;
op_free(PL_main_root);
PL_main_root = Nullop;
}
}
if (PL_main_root) {
- PAD_UPDATE_CURPAD;
op_free(PL_main_root);
PL_main_root = Nullop;
}
#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
#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
#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
#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
#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
#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
#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
#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
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
=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.
=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')
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
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
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
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()).
}
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. */
(*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);
#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);
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);
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);
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 */
}
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 */
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;
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;
{
}
PL_op = oop;
- PL_curpad = ocurpad;
+ PAD_RESTORE_LOCAL(old_comppad);
PL_curcop = ocurcop;
if (logical) {
if (logical == 2) { /* Postponed subexpression. */
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);
}
void
Perl_save_clearsv(pTHX_ SV **svp)
{
+ ASSERT_CURPAD_ACTIVE("save_clearsv");
SSCHECK(2);
SSPUSHLONG((long)(svp-PL_curpad));
SSPUSHINT(SAVEt_CLEARSV);
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:
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"
));
*(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
PADOFFSET off = (PADOFFSET)SSPOPLONG;
ptr = SSPOPPTR;
if (ptr)
- ((PAD)ptr)[off] = (SV*)SSPOPPTR;
+ AvARRAY((PAD*)ptr)[off] = (SV*)SSPOPPTR;
}
break;
default:
#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
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);
use Config;
-print "1..172\n";
+print "1..173\n";
my $test = 1;
sub test (&) {
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};
+
projects / p5sagit/p5-mst-13.2.git / commitdiff