#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)
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";
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")*/
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);
}
}
-static U8 arg_counts[] = {
+static const U8 arg_counts[] = {
0, /* SAVEt_ALLOC */
0, /* SAVEt_CLEARPADRANGE */
0, /* SAVEt_CLEARSV */
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")*/
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);
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:
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 */
+ }
+ 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",
https://perl5.git.perl.org / perl5.git / blobdiff