#include "EXTERN.h"
#define PERL_IN_SCOPE_C
#include "perl.h"
+#include "feature.h"
SV**
Perl_stack_grow(pTHX_ SV **sp, SV **p, SSize_t n)
if (UNLIKELY(n < 0))
Perl_croak(aTHX_
- "panic: stack_grow() negative count (%"IVdf")", (IV)n);
+ "panic: stack_grow() negative count (%" IVdf ")", (IV)n);
PL_stack_sp = sp;
extra =
Perl_croak(aTHX_ "Out of memory during stack extend");
av_extend(PL_curstack, current + n + extra);
+#ifdef DEBUGGING
+ PL_curstackinfo->si_stack_hwm = current + n + extra;
+#endif
+
return PL_stack_sp;
}
si->si_next = 0;
si->si_cxmax = cxitems - 1;
si->si_cxix = -1;
+ si->si_cxsubix = -1;
si->si_type = PERLSI_UNDEF;
Newx(si->si_cxstack, cxitems, PERL_CONTEXT);
/* Without any kind of initialising CX_PUSHSUBST()
Perl_cxinc(pTHX)
{
const IV old_max = cxstack_max;
- cxstack_max = GROW(cxstack_max);
- Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);
+ const IV new_max = GROW(cxstack_max);
+ Renew(cxstack, new_max + 1, PERL_CONTEXT);
+ cxstack_max = new_max;
/* Without any kind of initialising deep enough recursion
* will end up reading uninitialised PERL_CONTEXTs. */
- PoisonNew(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
+ PoisonNew(cxstack + old_max + 1, new_max - old_max, PERL_CONTEXT);
return cxstack_ix + 1;
}
Perl_push_scope(pTHX)
{
if (UNLIKELY(PL_scopestack_ix == PL_scopestack_max)) {
- PL_scopestack_max = GROW(PL_scopestack_max);
- Renew(PL_scopestack, PL_scopestack_max, I32);
+ const IV new_max = GROW(PL_scopestack_max);
+ Renew(PL_scopestack, new_max, I32);
#ifdef DEBUGGING
- Renew(PL_scopestack_name, PL_scopestack_max, const char*);
+ Renew(PL_scopestack_name, new_max, const char*);
#endif
+ PL_scopestack_max = new_max;
}
#ifdef DEBUGGING
PL_scopestack_name[PL_scopestack_ix] = "unknown";
PL_markstack_max = PL_markstack + newmax;
PL_markstack_ptr = PL_markstack + oldmax;
DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,
- "MARK grow %p %"IVdf" by %"IVdf"\n",
+ "MARK grow %p %" IVdf " by %" IVdf "\n",
PL_markstack_ptr, (IV)*PL_markstack_ptr, (IV)oldmax)));
return PL_markstack_ptr;
}
void
Perl_savestack_grow(pTHX)
{
+ IV new_max;
#ifdef STRESS_REALLOC
- PL_savestack_max += SS_MAXPUSH;
+ new_max = PL_savestack_max + SS_MAXPUSH;
#else
- PL_savestack_max = GROW(PL_savestack_max);
+ new_max = GROW(PL_savestack_max);
#endif
/* Note that we allocate SS_MAXPUSH slots higher than ss_max
* so that SS_ADD_END(), SSGROW() etc can do a simper check */
- Renew(PL_savestack, PL_savestack_max + SS_MAXPUSH, ANY);
+ Renew(PL_savestack, new_max + SS_MAXPUSH, ANY);
+ PL_savestack_max = new_max;
}
void
Perl_savestack_grow_cnt(pTHX_ I32 need)
{
- PL_savestack_max = PL_savestack_ix + need;
+ const IV new_max = PL_savestack_ix + need;
/* Note that we allocate SS_MAXPUSH slots higher than ss_max
* so that SS_ADD_END(), SSGROW() etc can do a simper check */
- Renew(PL_savestack, PL_savestack_max + SS_MAXPUSH, ANY);
+ Renew(PL_savestack, new_max + SS_MAXPUSH, ANY);
+ PL_savestack_max = new_max;
}
#undef GROW
if (ix - PL_tmps_max < 128)
extend_to += (PL_tmps_max < 512) ? 128 : 512;
#endif
+ Renew(PL_tmps_stack, extend_to + 1, SV*);
PL_tmps_max = extend_to + 1;
- Renew(PL_tmps_stack, PL_tmps_max, SV*);
return ix;
}
}
/*
+
+=head1 GV Functions
+
=for apidoc save_gp
Saves the current GP of gv on the save stack to be restored on scope exit.
{
PERL_ARGS_ASSERT_SAVE_GP;
+ /* XXX For now, we just upgrade any coderef in the stash to a full GV
+ during localisation. Maybe at some point we could make localis-
+ ation work without needing the upgrade. (In which case our
+ callers should probably call a different function, not save_gp.)
+ */
+ if (!isGV(gv)) {
+ assert(isGV_or_RVCV(gv));
+ (void)CvGV(SvRV((SV *)gv)); /* CvGV does the upgrade */
+ assert(isGV(gv));
+ }
+
save_pushptrptr(SvREFCNT_inc(gv), GvGP(gv), SAVEt_GP);
if (empty) {
bool isa_changed = 0;
if (stash && HvENAME(stash)) {
- if (GvNAMELEN(gv) == 3 && strnEQ(GvNAME(gv), "ISA", 3))
+ if (memEQs(GvNAME(gv), GvNAMELEN(gv), "ISA"))
isa_changed = TRUE;
else if (GvCVu(gv))
/* taking a method out of circulation ("local")*/
ASSERT_CURPAD_ACTIVE("save_clearsv");
SvPADSTALE_off(*svp); /* mark lexical as active */
if (UNLIKELY((offset_shifted >> SAVE_TIGHT_SHIFT) != offset)) {
- Perl_croak(aTHX_ "panic: pad offset %"UVuf" out of range (%p-%p)",
+ Perl_croak(aTHX_ "panic: pad offset %" UVuf " out of range (%p-%p)",
offset, svp, PL_curpad);
}
save_pushptri32ptr(oldhh, PL_hints, save_cophh, SAVEt_HINTS);
GvHV(PL_hintgv) = NULL; /* in case copying dies */
GvHV(PL_hintgv) = hv_copy_hints_hv(oldhh);
+ SAVEFEATUREBITS();
} else {
save_pushi32ptr(PL_hints, save_cophh, SAVEt_HINTS);
}
if (UNLIKELY((elems_shifted >> SAVE_TIGHT_SHIFT) != elems))
Perl_croak(aTHX_
- "panic: save_alloc elems %"UVuf" out of range (%"IVdf"-%"IVdf")",
+ "panic: save_alloc elems %" UVuf " out of range (%" IVdf "-%" IVdf ")",
elems, (IV)size, (IV)pad);
SSGROW(elems + 1);
}
-static U8 arg_counts[] = {
+static const U8 arg_counts[] = {
0, /* SAVEt_ALLOC */
0, /* SAVEt_CLEARPADRANGE */
0, /* SAVEt_CLEARSV */
while (PL_savestack_ix > base) {
UV uv;
U8 type;
- SV **svp;
- I32 i;
ANY *ap; /* arg pointer */
ANY a0, a1, a2; /* up to 3 args */
function, S_save_scalar_at(), so has to stay in this file. */
case SAVEt_SVREF: /* scalar reference */
a0 = ap[0]; a1 = ap[1];
- svp = a0.any_svp;
+ a2.any_svp = a0.any_svp;
a0.any_sv = NULL; /* what to refcnt_dec */
goto restore_sv;
case SAVEt_SV: /* scalar reference */
a0 = ap[0]; a1 = ap[1];
- svp = &GvSV(a0.any_gv);
+ a2.any_svp = &GvSV(a0.any_gv);
restore_sv:
{
- /* do *svp = a1 and free a0 */
- SV * const sv = *svp;
- *svp = a1.any_sv;
+ /* do *a2.any_svp = a1 and free a0 */
+ SV * const sv = *a2.any_svp;
+ *a2.any_svp = a1.any_sv;
SvREFCNT_dec(sv);
if (UNLIKELY(SvSMAGICAL(a1.any_sv))) {
/* mg_set could die, skipping the freeing of a0 and
case SAVEt_GVSV: /* scalar slot in GV */
a0 = ap[0]; a1 = ap[1];
- svp = &GvSV(a0.any_gv);
+ a0.any_svp = &GvSV(a0.any_gv);
goto restore_svp;
case SAVEt_GENERIC_SVREF: /* generic sv */
a0 = ap[0]; a1 = ap[1];
- svp = a0.any_svp;
restore_svp:
{
- /* do *svp = a1 */
- SV * const sv = *svp;
- *svp = a1.any_sv;
+ /* do *a0.any_svp = a1 */
+ SV * const sv = *a0.any_svp;
+ *a0.any_svp = a1.any_sv;
SvREFCNT_dec(sv);
SvREFCNT_dec(a1.any_sv);
break;
HV * hv;
a0 = ap[0]; a1 = ap[1]; a2 = ap[2];
hv = GvSTASH(a0.any_gv);
- svp = a1.any_svp;
if (hv && HvENAME(hv) && (
(a2.any_sv && SvTYPE(a2.any_sv) == SVt_PVCV)
- || (*svp && SvTYPE(*svp) == SVt_PVCV)
+ || (*a1.any_svp && SvTYPE(*a1.any_svp) == SVt_PVCV)
))
{
- if ((char *)svp < (char *)GvGP(a0.any_gv)
- || (char *)svp > (char *)GvGP(a0.any_gv) + sizeof(struct gp)
+ if ((char *)a1.any_svp < (char *)GvGP(a0.any_gv)
+ || (char *)a1.any_svp > (char *)GvGP(a0.any_gv) + sizeof(struct gp)
|| GvREFCNT(a0.any_gv) > 2) /* "> 2" to ignore savestack's ref */
PL_sub_generation++;
else mro_method_changed_in(hv);
}
- a1.any_sv = a2.any_sv;
+ a0.any_svp = a1.any_svp;
+ a1.any_sv = a2.any_sv;
goto restore_svp;
}
break;
case SAVEt_SPTR: /* SV* reference */
- a0 = ap[0]; a1 = ap[1];
- *a1.any_svp= a0.any_sv;
- break;
-
case SAVEt_VPTR: /* random* reference */
case SAVEt_PPTR: /* char* reference */
- a0 = ap[0]; a1 = ap[1];
- *a1.any_pvp = a0.any_pv;
- break;
-
case SAVEt_HPTR: /* HV* reference */
- a0 = ap[0]; a1 = ap[1];
- *(HV**)a1.any_ptr = a0.any_hv;
- break;
-
case SAVEt_APTR: /* AV* reference */
a0 = ap[0]; a1 = ap[1];
- *(AV**)a1.any_ptr = a0.any_av;
+ *a1.any_svp= a0.any_sv;
break;
case SAVEt_GP: /* scalar reference */
gp_free(a0.any_gv);
GvGP_set(a0.any_gv, (GP*)a1.any_ptr);
if ((hv=GvSTASH(a0.any_gv)) && HvENAME_get(hv)) {
- if ( GvNAMELEN(a0.any_gv) == 3
- && strnEQ(GvNAME(a0.any_gv), "ISA", 3)
- )
+ if (memEQs(GvNAME(a0.any_gv), GvNAMELEN(a0.any_gv), "ISA"))
mro_isa_changed_in(hv);
else if (had_method || GvCVu(a0.any_gv))
/* putting a method back into circulation ("local")*/
case SAVEt_FREEOP:
a0 = ap[0];
ASSERT_CURPAD_LEGAL("SAVEt_FREEOP");
- op_free((OP*)a0.any_ptr);
+ op_free(a0.any_op);
break;
case SAVEt_FREEPV:
break;
case SAVEt_CLEARPADRANGE:
+ {
+ I32 i;
+ SV **svp;
i = (I32)((uv >> SAVE_TIGHT_SHIFT) & OPpPADRANGE_COUNTMASK);
- svp = &PL_curpad[uv >>
+ svp = &PL_curpad[uv >>
(OPpPADRANGE_COUNTSHIFT + SAVE_TIGHT_SHIFT)] + i - 1;
goto clearsv;
case SAVEt_CLEARSV:
SV *sv = *svp;
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
- "Pad 0x%"UVxf"[0x%"UVxf"] clearsv: %ld sv=0x%"UVxf"<%"IVdf"> %s\n",
+ "Pad 0x%" UVxf "[0x%" UVxf "] clearsv: %ld sv=0x%" UVxf "<%" IVdf "> %s\n",
PTR2UV(PL_comppad), PTR2UV(PL_curpad),
(long)(svp-PL_curpad), PTR2UV(sv), (IV)SvREFCNT(sv),
(SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) ? "clear" : "abandon"
break;
case SVt_PVCV:
{
- HEK *hek =
- CvNAMED(sv)
- ? CvNAME_HEK((CV *)sv)
- : GvNAME_HEK(CvGV(sv));
+ HEK *hek = CvGvNAME_HEK(sv);
assert(hek);
(void)share_hek_hek(hek);
cv_undef((CV *)sv);
case SVt_PVHV: *svp = MUTABLE_SV(newHV()); break;
case SVt_PVCV:
{
- HEK * const hek = CvNAMED(sv)
- ? CvNAME_HEK((CV *)sv)
- : GvNAME_HEK(CvGV(sv));
+ HEK * const hek = CvGvNAME_HEK(sv);
/* Create a stub */
*svp = newSV_type(SVt_PVCV);
}
}
break;
+ }
case SAVEt_DELETE:
a0 = ap[0]; a1 = ap[1]; a2 = ap[2];
+ /* hv_delete could die, so free the key and SvREFCNT_dec the
+ * hv by pushing new save actions
+ */
+ /* ap[0] is the key */
+ ap[1].any_uv = SAVEt_FREEPV; /* was len */
+ /* ap[2] is the hv */
+ ap[3].any_uv = SAVEt_FREESV; /* was SAVEt_DELETE */
+ PL_savestack_ix += 4;
(void)hv_delete(a2.any_hv, a0.any_pv, a1.any_i32, G_DISCARD);
- SvREFCNT_dec(a2.any_hv);
- Safefree(a0.any_ptr);
break;
case SAVEt_ADELETE:
a0 = ap[0]; a1 = ap[1];
+ /* av_delete could die, so SvREFCNT_dec the av by pushing a
+ * new save action
+ */
+ ap[0].any_av = a1.any_av;
+ ap[1].any_uv = SAVEt_FREESV;
+ PL_savestack_ix += 2;
(void)av_delete(a1.any_av, a0.any_iv, G_DISCARD);
- SvREFCNT_dec(a1.any_av);
break;
case SAVEt_DESTRUCTOR_X:
break;
case SAVEt_AELEM: /* array element */
+ {
+ SV **svp;
a0 = ap[0]; a1 = ap[1]; a2 = ap[2];
svp = av_fetch(a0.any_av, a1.any_iv, 1);
if (UNLIKELY(!AvREAL(a0.any_av) && AvREIFY(a0.any_av))) /* undo reify guard */
if (LIKELY(sv && sv != &PL_sv_undef)) {
if (UNLIKELY(SvTIED_mg((const SV *)a0.any_av, PERL_MAGIC_tied)))
SvREFCNT_inc_void_NN(sv);
- a1.any_sv = a2.any_sv;
+ a1.any_sv = a2.any_sv;
+ a2.any_svp = svp;
goto restore_sv;
}
}
SvREFCNT_dec(a0.any_av);
SvREFCNT_dec(a2.any_sv);
break;
+ }
case SAVEt_HELEM: /* hash element */
{
if (LIKELY(he)) {
const SV * const oval = HeVAL(he);
if (LIKELY(oval && oval != &PL_sv_undef)) {
- svp = &HeVAL(he);
+ SV **svp = &HeVAL(he);
if (UNLIKELY(SvTIED_mg((const SV *)a0.any_hv, PERL_MAGIC_tied)))
SvREFCNT_inc_void(*svp);
- a1.any_sv = a2.any_sv;
+ a1.any_sv = a2.any_sv;
+ a2.any_svp = svp;
goto restore_sv;
}
}
SvREFCNT_dec(a2.any_sv);
break;
}
+
case SAVEt_OP:
a0 = ap[0];
PL_op = (OP*)a0.any_ptr;
break;
default:
- Perl_croak(aTHX_ "panic: leave_scope inconsistency %u", type);
+ Perl_croak(aTHX_ "panic: leave_scope inconsistency %u",
+ (U8)uv & SAVE_MASK);
}
}
if (CxTYPE(cx) != CXt_SUBST) {
const char *gimme_text;
PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
- PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%" UVxf "\n",
PTR2UV(cx->blk_oldcop));
PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
PerlIO_printf(Perl_debug_log, "BLK_OLDSAVEIX = %ld\n", (long)cx->blk_oldsaveix);
- PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%" UVxf "\n",
PTR2UV(cx->blk_oldpm));
switch (cx->blk_gimme) {
case G_VOID:
case CXt_BLOCK:
break;
case CXt_FORMAT:
- PerlIO_printf(Perl_debug_log, "BLK_FORMAT.CV = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "BLK_FORMAT.CV = 0x%" UVxf "\n",
PTR2UV(cx->blk_format.cv));
- PerlIO_printf(Perl_debug_log, "BLK_FORMAT.GV = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "BLK_FORMAT.GV = 0x%" UVxf "\n",
PTR2UV(cx->blk_format.gv));
- PerlIO_printf(Perl_debug_log, "BLK_FORMAT.DFOUTGV = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "BLK_FORMAT.DFOUTGV = 0x%" UVxf "\n",
PTR2UV(cx->blk_format.dfoutgv));
PerlIO_printf(Perl_debug_log, "BLK_FORMAT.HASARGS = %d\n",
(int)CxHASARGS(cx));
- PerlIO_printf(Perl_debug_log, "BLK_FORMAT.RETOP = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "BLK_FORMAT.RETOP = 0x%" UVxf "\n",
PTR2UV(cx->blk_format.retop));
break;
case CXt_SUB:
- PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%" UVxf "\n",
PTR2UV(cx->blk_sub.cv));
PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n",
(long)cx->blk_sub.olddepth);
PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
(int)CxHASARGS(cx));
PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n", (int)CxLVAL(cx));
- PerlIO_printf(Perl_debug_log, "BLK_SUB.RETOP = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "BLK_SUB.RETOP = 0x%" UVxf "\n",
PTR2UV(cx->blk_sub.retop));
break;
case CXt_EVAL:
if (cx->blk_eval.old_namesv)
PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
SvPVX_const(cx->blk_eval.old_namesv));
- PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%" UVxf "\n",
PTR2UV(cx->blk_eval.old_eval_root));
- PerlIO_printf(Perl_debug_log, "BLK_EVAL.RETOP = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "BLK_EVAL.RETOP = 0x%" UVxf "\n",
PTR2UV(cx->blk_eval.retop));
break;
case CXt_LOOP_LIST:
case CXt_LOOP_ARY:
PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n", CxLABEL(cx));
- PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%" UVxf "\n",
PTR2UV(cx->blk_loop.my_op));
if (CxTYPE(cx) != CXt_LOOP_PLAIN) {
- PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%" UVxf "\n",
PTR2UV(CxITERVAR(cx)));
- PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%" UVxf "\n",
PTR2UV(cx->blk_loop.itersave));
- /* XXX: not accurate for LAZYSV/IV/LIST */
- PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",
+ }
+ if (CxTYPE(cx) == CXt_LOOP_ARY) {
+ PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%" UVxf "\n",
PTR2UV(cx->blk_loop.state_u.ary.ary));
PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n",
(long)cx->blk_loop.state_u.ary.ix);
(long)CxONCE(cx));
PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",
cx->sb_orig);
- PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%" UVxf "\n",
PTR2UV(cx->sb_dstr));
- PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%" UVxf "\n",
PTR2UV(cx->sb_targ));
- PerlIO_printf(Perl_debug_log, "SB_S = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "SB_S = 0x%" UVxf "\n",
PTR2UV(cx->sb_s));
- PerlIO_printf(Perl_debug_log, "SB_M = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "SB_M = 0x%" UVxf "\n",
PTR2UV(cx->sb_m));
- PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%" UVxf "\n",
PTR2UV(cx->sb_strend));
- PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%" UVxf "\n",
PTR2UV(cx->sb_rxres));
break;
}
https://perl5.git.perl.org / perl5.git / blobdiff