* levels..."
*/
+/* This file contains functions to manipulate several of Perl's stacks;
+ * in particular it contains code to push various types of things onto
+ * the savestack, then to pop them off and perform the correct restorative
+ * action for each one. This corresponds to the cleanup Perl does at
+ * each scope exit.
+ */
+
#include "EXTERN.h"
#define PERL_IN_SCOPE_C
#include "perl.h"
}
void
-Perl_push_return(pTHX_ OP *retop)
-{
- if (PL_retstack_ix == PL_retstack_max) {
- PL_retstack_max = GROW(PL_retstack_max);
- Renew(PL_retstack, PL_retstack_max, OP*);
- }
- PL_retstack[PL_retstack_ix++] = retop;
-}
-
-OP *
-Perl_pop_return(pTHX)
-{
- if (PL_retstack_ix > 0)
- return PL_retstack[--PL_retstack_ix];
- else
- return Nullop;
-}
-
-void
Perl_push_scope(pTHX)
{
if (PL_scopestack_ix == PL_scopestack_max) {
break;
case SVt_PVCV:
Perl_croak(aTHX_ "panic: leave_scope pad code");
- case SVt_RV:
- case SVt_IV:
- case SVt_NV:
- (void)SvOK_off(sv);
- break;
default:
- (void)SvOK_off(sv);
- (void)SvOOK_off(sv);
+ SvOK_off(sv);
break;
}
SvPADSTALE_on(sv); /* mark as no longer live */
AvARRAY((PAD*)ptr)[off] = (SV*)SSPOPPTR;
}
break;
+ case SAVEt_SAVESWITCHSTACK:
+ {
+ dSP;
+ AV* t = (AV*)SSPOPPTR;
+ AV* f = (AV*)SSPOPPTR;
+ SWITCHSTACK(t,f);
+ PL_curstackinfo->si_stack = f;
+ }
+ break;
case SAVEt_SET_SVFLAGS:
{
U32 val = (U32)SSPOPINT;
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_OLDRETSP = %ld\n", (long)cx->blk_oldretsp);
PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%"UVxf"\n",
PTR2UV(cx->blk_oldpm));
PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
PTR2UV(cx->blk_sub.dfoutgv));
PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
(int)cx->blk_sub.hasargs);
+ PerlIO_printf(Perl_debug_log, "BLK_SUB.RETOP = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_sub.retop));
break;
case CXt_SUB:
PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n",
(int)cx->blk_sub.hasargs);
PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n",
(int)cx->blk_sub.lval);
+ PerlIO_printf(Perl_debug_log, "BLK_SUB.RETOP = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_sub.retop));
break;
case CXt_EVAL:
PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
SvPVX(cx->blk_eval.old_namesv));
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",
+ PTR2UV(cx->blk_eval.retop));
break;
case CXt_LOOP: