/* scope.c
*
- * Copyright (c) 1991-2002, Larry Wall
+ * Copyright (c) 1991-2003, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
si->si_cxmax = cxitems - 1;
si->si_cxix = -1;
si->si_type = PERLSI_UNDEF;
- /* Needs to be Newz() because PUSHSUBST() in pp_subst()
- * might otherwise read uninitialized heap. */
- Newz(56, si->si_cxstack, cxitems, PERL_CONTEXT);
+ New(56, si->si_cxstack, cxitems, PERL_CONTEXT);
+ /* Without any kind of initialising PUSHSUBST()
+ * in pp_subst() will read uninitialised heap. */
+ Poison(si->si_cxstack, cxitems, PERL_CONTEXT);
return si;
}
I32
Perl_cxinc(pTHX)
{
+ IV old_max = cxstack_max;
cxstack_max = GROW(cxstack_max);
Renew(cxstack, cxstack_max + 1, PERL_CONTEXT); /* XXX should fix CXINC macro */
+ /* Without any kind of initialising deep enough recursion
+ * will end up reading uninitialised PERL_CONTEXTs. */
+ Poison(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
return cxstack_ix + 1;
}
}
void
+Perl_save_bool(pTHX_ bool *boolp)
+{
+ SSCHECK(3);
+ SSPUSHBOOL(*boolp);
+ SSPUSHPTR(boolp);
+ SSPUSHINT(SAVEt_BOOL);
+}
+
+void
Perl_save_I32(pTHX_ I32 *intp)
{
SSCHECK(3);
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);
}
SV **
Perl_save_threadsv(pTHX_ PADOFFSET i)
{
-#ifdef USE_5005THREADS
- SV **svp = &THREADSV(i); /* XXX Change to save by offset */
- DEBUG_S(PerlIO_printf(Perl_debug_log, "save_threadsv %"UVuf": %p %p:%s\n",
- (UV)i, svp, *svp, SvPEEK(*svp)));
- save_svref(svp);
- return svp;
-#else
Perl_croak(aTHX_ "panic: save_threadsv called in non-threaded perl");
return 0;
-#endif /* USE_5005THREADS */
}
void
void
Perl_save_clearsv(pTHX_ SV **svp)
{
+ ASSERT_CURPAD_ACTIVE("save_clearsv");
SSCHECK(2);
SSPUSHLONG((long)(svp-PL_curpad));
SSPUSHINT(SAVEt_CLEARSV);
+ SvPADSTALE_off(*svp); /* mark lexical as active */
}
void
SSPUSHINT(idx);
SSPUSHPTR(SvREFCNT_inc(*sptr));
SSPUSHINT(SAVEt_AELEM);
+ /* if it gets reified later, the restore will have the wrong refcnt */
+ if (!AvREAL(av) && AvREIFY(av))
+ SvREFCNT_inc(*sptr);
save_scalar_at(sptr);
sv = *sptr;
/* If we're localizing a tied array element, this new sv
value = (SV*)SSPOPPTR;
gv = (GV*)SSPOPPTR;
ptr = &GvSV(gv);
- SvREFCNT_dec(gv);
+ av = (AV*)gv; /* what to refcnt_dec */
goto restore_sv;
case SAVEt_GENERIC_PVREF: /* generic pv */
str = (char*)SSPOPPTR;
case SAVEt_SVREF: /* scalar reference */
value = (SV*)SSPOPPTR;
ptr = SSPOPPTR;
+ av = Nullav; /* what to refcnt_dec */
restore_sv:
sv = *(SV**)ptr;
DEBUG_S(PerlIO_printf(Perl_debug_log,
SvSETMAGIC(value);
PL_localizing = 0;
SvREFCNT_dec(value);
+ if (av) /* actually an av, hv or gv */
+ SvREFCNT_dec(av);
break;
case SAVEt_AV: /* array reference */
av = (AV*)SSPOPPTR;
ptr = SSPOPPTR;
*(long*)ptr = (long)SSPOPLONG;
break;
+ case SAVEt_BOOL: /* bool reference */
+ ptr = SSPOPPTR;
+ *(bool*)ptr = (bool)SSPOPBOOL;
+ break;
case SAVEt_I32: /* I32 reference */
ptr = SSPOPPTR;
*(I32*)ptr = (I32)SSPOPINT;
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:
case SAVEt_CLEARSV:
ptr = (void*)&PL_curpad[SSPOPLONG];
sv = *(SV**)ptr;
+
+ DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+ "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"
+ ));
+
/* Can clear pad variable in place? */
if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
/*
(void)SvOOK_off(sv);
break;
}
+ SvPADSTALE_on(sv); /* mark as no longer live */
}
else { /* Someone has a claim on this, so abandon it. */
- U32 padflags = SvFLAGS(sv) & (SVs_PADBUSY|SVs_PADMY|SVs_PADTMP);
+ U32 padflags = SvFLAGS(sv) & (SVs_PADMY|SVs_PADTMP);
switch (SvTYPE(sv)) { /* Console ourselves with a new value */
case SVt_PVAV: *(SV**)ptr = (SV*)newAV(); break;
case SVt_PVHV: *(SV**)ptr = (SV*)newHV(); break;
default: *(SV**)ptr = NEWSV(0,0); break;
}
SvREFCNT_dec(sv); /* Cast current value to the winds. */
- SvFLAGS(*(SV**)ptr) |= padflags; /* preserve pad nature */
+ /* preserve pad nature, but also mark as not live
+ * for any closure capturing */
+ SvFLAGS(*(SV**)ptr) |= padflags & SVs_PADSTALE;
}
break;
case SAVEt_DELETE:
value = (SV*)SSPOPPTR;
i = SSPOPINT;
av = (AV*)SSPOPPTR;
+ if (!AvREAL(av) && AvREIFY(av)) /* undo reify guard */
+ SvREFCNT_dec(value);
ptr = av_fetch(av,i,1);
if (ptr) {
sv = *(SV**)ptr;
if (sv && sv != &PL_sv_undef) {
if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
(void)SvREFCNT_inc(sv);
- SvREFCNT_dec(av);
goto restore_sv;
}
}
ptr = &HeVAL((HE*)ptr);
if (SvTIED_mg((SV*)hv, PERL_MAGIC_tied))
(void)SvREFCNT_inc(*(SV**)ptr);
- SvREFCNT_dec(hv);
SvREFCNT_dec(sv);
+ av = (AV*)hv; /* what to refcnt_dec */
goto restore_sv;
}
}
*(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)
- ((SV**)ptr)[off] = (SV*)SSPOPPTR;
+ AvARRAY((PAD*)ptr)[off] = (SV*)SSPOPPTR;
}
break;
default: