SV**
Perl_stack_grow(pTHX_ SV **sp, SV **p, SSize_t n)
{
+ SSize_t extra;
+ SSize_t current = (p - PL_stack_base);
+
PERL_ARGS_ASSERT_STACK_GROW;
+ if (UNLIKELY(n < 0))
+ Perl_croak(aTHX_
+ "panic: stack_grow() negative count (%"IVdf")", (IV)n);
+
PL_stack_sp = sp;
-#ifndef STRESS_REALLOC
- av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128);
+ extra =
+#ifdef STRESS_REALLOC
+ 1;
#else
- av_extend(PL_curstack, (p - PL_stack_base) + (n) + 1);
+ 128;
#endif
+ /* If the total might wrap, panic instead. This is really testing
+ * that (current + n + extra < SSize_t_MAX), but done in a way that
+ * can't wrap */
+ if (UNLIKELY( current > SSize_t_MAX - extra
+ || current + extra > SSize_t_MAX - n
+ ))
+ /* diag_listed_as: Out of memory during %s extend */
+ Perl_croak(aTHX_ "Out of memory during stack extend");
+
+ av_extend(PL_curstack, current + n + extra);
return PL_stack_sp;
}
Renew(PL_markstack, newmax, I32);
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",
+ PL_markstack_ptr, (IV)*PL_markstack_ptr, (IV)oldmax)));
return PL_markstack_ptr;
}
#ifdef PERL_POISON
PoisonWith(PL_tmps_stack + PL_tmps_ix + 1, 1, SV *, 0xAB);
#endif
- if (LIKELY(sv && sv != &PL_sv_undef)) {
+ if (LIKELY(sv)) {
SvTEMP_off(sv);
SvREFCNT_dec_NN(sv); /* note, can modify tmps_ix!!! */
}
PERL_ARGS_ASSERT_SAVE_SCALAR_AT;
osv = *sptr;
- sv = (flags & SAVEf_KEEPOLDELEM) ? osv : (*sptr = newSV(0));
-
- if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv)) {
- if (SvGMAGICAL(osv)) {
- SvFLAGS(osv) |= (SvFLAGS(osv) &
- (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
- }
- if (!(flags & SAVEf_KEEPOLDELEM))
- mg_localize(osv, sv, cBOOL(flags & SAVEf_SETMAGIC));
+ if (flags & SAVEf_KEEPOLDELEM)
+ sv = osv;
+ else {
+ sv = (*sptr = newSV(0));
+ if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv))
+ mg_localize(osv, sv, cBOOL(flags & SAVEf_SETMAGIC));
}
return sv;
SS_ADD_END(4);
}
+/*
+=for apidoc save_gp
+
+Saves the current GP of gv on the save stack to be restored on scope exit.
+
+If empty is true, replace the GP with a new GP.
+
+If empty is false, mark gv with GVf_INTRO so the next reference
+assigned is localized, which is how C< local *foo = $someref; > works.
+
+=cut
+*/
+
void
Perl_save_gp(pTHX_ GV *gv, I32 empty)
{
return start;
}
-void
-Perl_save_aliased_sv(pTHX_ GV *gv)
-{
- dSS_ADD;
- PERL_ARGS_ASSERT_SAVE_ALIASED_SV;
- SS_ADD_PTR(gp_ref(GvGP(gv)));
- SS_ADD_UV(SAVEt_GP_ALIASED_SV | cBOOL(GvALIASED_SV(gv)) << 8);
- SS_ADD_END(2);
-}
-
#define ARG0_SV MUTABLE_SV(arg0.any_ptr)
/* Localise the effects of the TAINT_NOT inside the loop. */
bool was = TAINT_get;
+ I32 i;
+ SV *sv;
+
ANY arg0, arg1, arg2;
/* these initialisations are logically unnecessary, but they shut up
*svp = ARG0_SV;
SvREFCNT_dec(sv);
if (UNLIKELY(SvSMAGICAL(ARG0_SV))) {
+ /* mg_set could die, skipping the freeing of ARG0_SV and
+ * refsv; Ensure that they're always freed in that case */
+ dSS_ADD;
+ SS_ADD_PTR(ARG0_SV);
+ SS_ADD_UV(SAVEt_FREESV);
+ SS_ADD_PTR(refsv);
+ SS_ADD_UV(SAVEt_FREESV);
+ SS_ADD_END(4);
PL_localizing = 2;
mg_set(ARG0_SV);
PL_localizing = 0;
+ break;
}
SvREFCNT_dec_NN(ARG0_SV);
SvREFCNT_dec(refsv);
case SAVEt_AV: /* array reference */
SvREFCNT_dec(GvAV(ARG1_GV));
GvAV(ARG1_GV) = ARG0_AV;
+ avhv_common:
if (UNLIKELY(SvSMAGICAL(ARG0_SV))) {
+ /* mg_set might die, so make sure ARG1 isn't leaked */
+ dSS_ADD;
+ SS_ADD_PTR(ARG1_SV);
+ SS_ADD_UV(SAVEt_FREESV);
+ SS_ADD_END(2);
PL_localizing = 2;
mg_set(ARG0_SV);
PL_localizing = 0;
+ break;
}
SvREFCNT_dec_NN(ARG1_GV);
break;
case SAVEt_HV: /* hash reference */
SvREFCNT_dec(GvHV(ARG1_GV));
GvHV(ARG1_GV) = ARG0_HV;
- if (UNLIKELY(SvSMAGICAL(ARG0_SV))) {
- PL_localizing = 2;
- mg_set(ARG0_SV);
- PL_localizing = 0;
- }
- SvREFCNT_dec_NN(ARG1_GV);
- break;
+ goto avhv_common;
+
case SAVEt_INT_SMALL:
*(int*)ARG0_PTR = (int)(uv >> SAVE_TIGHT_SHIFT);
break;
case SAVEt_FREESV:
SvREFCNT_dec(ARG0_SV);
break;
+ case SAVEt_FREEPADNAME:
+ PadnameREFCNT_dec((PADNAME *)ARG0_PTR);
+ break;
case SAVEt_FREECOPHH:
cophh_free((COPHH *)ARG0_PTR);
break;
Safefree(ARG0_PTR);
break;
- {
- SV **svp;
- I32 i;
- SV *sv;
-
case SAVEt_CLEARPADRANGE:
i = (I32)((uv >> SAVE_TIGHT_SHIFT) & OPpPADRANGE_COUNTMASK);
svp = &PL_curpad[uv >>
SvFLAGS(sv) &=~ (SVf_OK|SVf_IVisUV|SVf_UTF8);
break;
}
+ SvPADTMP_off(sv);
SvPADSTALE_on(sv); /* mark as no longer live */
}
else { /* Someone has a claim on this, so abandon it. */
- assert(!(SvFLAGS(sv) & SVs_PADTMP));
switch (SvTYPE(sv)) { /* Console ourselves with a new value */
case SVt_PVAV: *svp = MUTABLE_SV(newAV()); break;
case SVt_PVHV: *svp = MUTABLE_SV(newHV()); break;
}
}
break;
- }
case SAVEt_DELETE:
(void)hv_delete(ARG0_HV, ARG2_PV, ARG1_I32, G_DISCARD);
SvREFCNT_dec(ARG0_HV);
SV **svp;
assert (ARG1_PTR);
svp = AvARRAY((PAD*)ARG1_PTR) + (PADOFFSET)arg0.any_uv;
- /* This mortalizing used to be done by POPLOOP() via itersave.
- But as we have all the information here, we can do it here,
- save even having to have itersave in the struct. */
+ /* This mortalizing used to be done by CX_POOPLOOP() via
+ itersave. But as we have all the information here, we
+ can do it here, save even having to have itersave in
+ the struct.
+ */
sv_2mortal(*svp);
*svp = ARG2_SV;
}
case SAVEt_READONLY_OFF:
SvREADONLY_off(ARG0_SV);
break;
- case SAVEt_GP_ALIASED_SV: {
- /* The GP may have been abandoned, leaving the savestack with
- the only remaining reference to it. */
- GP * const gp = (GP *)ARG0_PTR;
- if (gp->gp_refcnt == 1) {
- GV * const gv = (GV *)sv_2mortal(newSV_type(SVt_PVGV));
- isGV_with_GP_on(gv);
- GvGP_set(gv,gp);
- gp_free(gv);
- isGV_with_GP_off(gv);
- }
- else {
- gp->gp_refcnt--;
- if (uv >> 8) gp->gp_flags |= GPf_ALIASED_SV;
- else gp->gp_flags &= ~GPf_ALIASED_SV;
- }
- break;
- }
default:
Perl_croak(aTHX_ "panic: leave_scope inconsistency %u", type);
}
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",
PTR2UV(cx->blk_oldpm));
switch (cx->blk_gimme) {
PTR2UV(cx->blk_eval.retop));
break;
+ case CXt_LOOP_PLAIN:
case CXt_LOOP_LAZYIV:
case CXt_LOOP_LAZYSV:
- case CXt_LOOP_FOR:
- case CXt_LOOP_PLAIN:
+ 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.RESETSP = %ld\n",
- (long)cx->blk_loop.resetsp);
PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%"UVxf"\n",
PTR2UV(cx->blk_loop.my_op));
- /* XXX: not accurate for LAZYSV/IV */
- 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);
- PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%"UVxf"\n",
- PTR2UV(CxITERVAR(cx)));
+ if (CxTYPE(cx) != CXt_LOOP_PLAIN) {
+ 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",
+ PTR2UV(cx->blk_loop.itersave));
+ /* XXX: not accurate for LAZYSV/IV/LIST */
+ 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);
+ }
break;
case CXt_SUBST:
}
/*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
* ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff