#ifndef STRESS_REALLOC
av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128);
#else
- av_extend(curstack, (p - stack_base) + (n) + 1);
+ av_extend(PL_curstack, (p - PL_stack_base) + (n) + 1);
#endif
#if defined(DEBUGGING) && !defined(USE_THREADS)
growing--;
SV* sv = PL_tmps_stack[PL_tmps_ix];
PL_tmps_stack[PL_tmps_ix--] = Nullsv;
if (sv) {
-#ifdef DEBUGGING
SvTEMP_off(sv);
-#endif
SvREFCNT_dec(sv); /* note, can modify tmps_ix!!! */
}
}
return save_scalar_at(sptr);
}
+/* Like save_svref(), but doesn't deal with magic. Can be used to
+ * restore a global SV to its prior contents, freeing new value. */
+void
+save_generic_svref(SV **sptr)
+{
+ dTHR;
+ SSCHECK(3);
+ SSPUSHPTR(sptr);
+ SSPUSHPTR(SvREFCNT_inc(*sptr));
+ SSPUSHINT(SAVEt_GENERIC_SVREF);
+}
+
void
save_gp(GV *gv, I32 empty)
{
#ifdef USE_THREADS
dTHR;
SV **svp = &THREADSV(i); /* XXX Change to save by offset */
- DEBUG_L(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n",
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n",
i, svp, *svp, SvPEEK(*svp)));
save_svref(svp);
return svp;
{
dTHR;
SSCHECK(2);
- SSPUSHPTR(op);
+ SSPUSHPTR(PL_op);
SSPUSHINT(SAVEt_OP);
}
+I32
+save_alloc(I32 size, I32 pad)
+{
+ dTHR;
+ register I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
+ - (char*)PL_savestack);
+ register I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
+
+ /* SSCHECK may not be good enough */
+ while (PL_savestack_ix + elems + 2 > PL_savestack_max)
+ savestack_grow();
+
+ PL_savestack_ix += elems;
+ SSPUSHINT(elems);
+ SSPUSHINT(SAVEt_ALLOC);
+ return start;
+}
+
void
leave_scope(I32 base)
{
ptr = &GvSV(gv);
SvREFCNT_dec(gv);
goto restore_sv;
+ case SAVEt_GENERIC_SVREF: /* generic sv */
+ value = (SV*)SSPOPPTR;
+ ptr = SSPOPPTR;
+ if (ptr) {
+ sv = *(SV**)ptr;
+ *(SV**)ptr = value;
+ SvREFCNT_dec(sv);
+ }
+ SvREFCNT_dec(value);
+ break;
case SAVEt_SVREF: /* scalar reference */
value = (SV*)SSPOPPTR;
ptr = SSPOPPTR;
restore_sv:
sv = *(SV**)ptr;
- DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
"restore svref: %p %p:%s -> %p:%s\n",
ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
case SAVEt_GP: /* scalar reference */
ptr = SSPOPPTR;
gv = (GV*)SSPOPPTR;
- if (SvPOK(gv) && SvLEN(gv) > 0) {
+ if (SvPVX(gv) && SvLEN(gv) > 0) {
Safefree(SvPVX(gv));
}
SvPVX(gv) = (char *)SSPOPPTR;
(CALLDESTRUCTOR)(ptr);
break;
case SAVEt_REGCONTEXT:
+ case SAVEt_ALLOC:
i = SSPOPINT;
PL_savestack_ix -= i; /* regexp must have croaked */
break;
if (ptr) {
sv = *(SV**)ptr;
if (sv && sv != &PL_sv_undef) {
- if (SvRMAGICAL(av) && mg_find((SV*)av, 'P'))
+ if (SvTIED_mg((SV*)av, 'P'))
(void)SvREFCNT_inc(sv);
SvREFCNT_dec(av);
goto restore_sv;
SV *oval = HeVAL((HE*)ptr);
if (oval && oval != &PL_sv_undef) {
ptr = &HeVAL((HE*)ptr);
- if (SvRMAGICAL(hv) && mg_find((SV*)hv, 'P'))
+ if (SvTIED_mg((SV*)hv, 'P'))
(void)SvREFCNT_inc(*(SV**)ptr);
SvREFCNT_dec(hv);
SvREFCNT_dec(sv);
SvREFCNT_dec(value);
break;
case SAVEt_OP:
- op = (OP*)SSPOPPTR;
+ PL_op = (OP*)SSPOPPTR;
break;
case SAVEt_HINTS:
if (GvHV(PL_hintgv)) {
{
#ifdef DEBUGGING
dTHR;
- PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[cx->cx_type]);
- if (cx->cx_type != CXt_SUBST) {
+ PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]);
+ if (CxTYPE(cx) != CXt_SUBST) {
PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
}
- switch (cx->cx_type) {
+ switch (CxTYPE(cx)) {
case CXt_NULL:
case CXt_BLOCK:
break;
PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
(long)cx->blk_eval.old_in_eval);
PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n",
- op_name[cx->blk_eval.old_op_type],
- op_desc[cx->blk_eval.old_op_type]);
+ PL_op_name[cx->blk_eval.old_op_type],
+ PL_op_desc[cx->blk_eval.old_op_type]);
PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
cx->blk_eval.old_name);
PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n",
(long)cx->sb_iters);
PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n",
(long)cx->sb_maxiters);
- PerlIO_printf(Perl_debug_log, "SB_SAFEBASE = %ld\n",
- (long)cx->sb_safebase);
+ PerlIO_printf(Perl_debug_log, "SB_RFLAGS = %ld\n",
+ (long)cx->sb_rflags);
PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n",
(long)cx->sb_once);
PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",