switch (ret) { \
case 0: \
PL_op = ppaddr(aTHX); \
- PL_retstack[PL_retstack_ix - 1] = Nullop; \
+ /* XXX PL_retstack[PL_retstack_ix - 1] = Nullop; */ \
if (PL_op != nxt) CALLRUNOPS(); \
JMPENV_POP; \
break; \
U8 hasargs;
U8 lval; /* XXX merge lval and hasargs? */
PAD *oldcomppad;
+ OP * retop; /* op to execute on exit from sub */
};
/* base for the next two macros. Don't use directly.
cx->blk_sub.cv = cv; \
cx->blk_sub.olddepth = CvDEPTH(cv); \
cx->blk_sub.hasargs = hasargs; \
+ cx->blk_sub.retop = Nullop; \
if (!CvDEPTH(cv)) { \
(void)SvREFCNT_inc(cv); \
(void)SvREFCNT_inc(cv); \
#define PUSHFORMAT(cx) \
cx->blk_sub.cv = cv; \
cx->blk_sub.gv = gv; \
+ cx->blk_sub.retop = Nullop; \
cx->blk_sub.hasargs = 0; \
cx->blk_sub.dfoutgv = PL_defoutgv; \
(void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
OP * old_eval_root;
SV * cur_text;
CV * cv;
+ OP * retop; /* op to execute on exit from eval */
};
#define PUSHEVAL(cx,n,fgv) \
cx->blk_eval.old_eval_root = PL_eval_root; \
cx->blk_eval.cur_text = PL_linestr; \
cx->blk_eval.cv = Nullcv; /* set by doeval(), as applicable */ \
+ cx->blk_eval.retop = Nullop; \
} STMT_END
#define POPEVAL(cx) \
struct block {
I32 blku_oldsp; /* stack pointer to copy stuff down to */
COP * blku_oldcop; /* old curcop pointer */
- I32 blku_oldretsp; /* return stack index */
+ I32 blku_SPARE1; /* XXX for BINCOMPAT 5.8.x */
I32 blku_oldmarksp; /* mark stack index */
I32 blku_oldscopesp; /* scope stack index */
PMOP * blku_oldpm; /* values of pattern match vars */
};
#define blk_oldsp cx_u.cx_blk.blku_oldsp
#define blk_oldcop cx_u.cx_blk.blku_oldcop
-#define blk_oldretsp cx_u.cx_blk.blku_oldretsp
#define blk_oldmarksp cx_u.cx_blk.blku_oldmarksp
#define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp
#define blk_oldpm cx_u.cx_blk.blku_oldpm
cx->blk_oldcop = PL_curcop, \
cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \
cx->blk_oldscopesp = PL_scopestack_ix, \
- cx->blk_oldretsp = PL_retstack_ix, \
cx->blk_oldpm = PL_curpm, \
cx->blk_gimme = (U8)gimme; \
DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n", \
PL_curcop = cx->blk_oldcop, \
PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
PL_scopestack_ix = cx->blk_oldscopesp, \
- PL_retstack_ix = cx->blk_oldretsp, \
pm = cx->blk_oldpm, \
gimme = cx->blk_gimme; \
DEBUG_SCOPE("POPBLOCK"); \
PL_stack_sp = PL_stack_base + cx->blk_oldsp, \
PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
PL_scopestack_ix = cx->blk_oldscopesp, \
- PL_retstack_ix = cx->blk_oldretsp, \
PL_curpm = cx->blk_oldpm; \
DEBUG_SCOPE("TOPBLOCK");
*/
I32 i, stack_min, stack_max, mark_min, mark_max;
- I32 ret_min, ret_max;
PERL_CONTEXT *cx_n;
PERL_SI *si_n;
+ OP *retop;
cx_n = Null(PERL_CONTEXT*);
}
mark_min = cx->blk_oldmarksp;
- ret_min = cx->blk_oldretsp;
if (cx_n) {
mark_max = cx_n->blk_oldmarksp;
- ret_max = cx_n->blk_oldretsp;
}
else {
mark_max = PL_markstack_ptr - PL_markstack;
- ret_max = PL_retstack_ix;
}
deb_stack_n(AvARRAY(si->si_stack),
stack_min, stack_max, mark_min, mark_max);
- if (ret_max > ret_min) {
+ if (CxTYPE(cx) == CXt_EVAL || CxTYPE(cx) == CXt_SUB
+ || CxTYPE(cx) == CXt_FORMAT)
+ {
+ retop = (CxTYPE(cx) == CXt_EVAL)
+ ? cx->blk_eval.retop : cx->blk_sub.retop;
+
PerlIO_printf(Perl_debug_log, " retop=%s\n",
- PL_retstack[ret_min]
- ? OP_NAME(PL_retstack[ret_min])
- : "(null)"
+ retop ? OP_NAME(retop) : "(null)"
);
}
-
}
} /* next context */
flags |= 1;
if (PL_markstack_ptr < PL_markstack_max - 2)
flags |= 4;
- if (PL_retstack_ix < PL_retstack_max - 2)
- flags |= 8;
if (PL_scopestack_ix < PL_scopestack_max - 3)
flags |= 16;
}
if (flags & 4)
PL_markstack_ptr++; /* Protect mark. */
- if (flags & 8) {
- PL_retstack_ix++;
- PL_retstack[PL_retstack_ix] = NULL;
- }
if (flags & 16)
PL_scopestack_ix += 1;
/* sv_2cv is too complicated, try a simpler variant first: */
PL_savestack_ix -= 8; /* Unprotect save in progress. */
if (flags & 4)
PL_markstack_ptr--;
- if (flags & 8)
- PL_retstack_ix--;
if (flags & 16)
PL_scopestack_ix -= 1;
if (flags & 64)
ENTER;
SAVETMPS;
- push_return(Nullop);
PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
PUSHEVAL(cx, 0, 0);
PL_eval_root = PL_op; /* Only needed so that goto works right. */
POPBLOCK(cx,newpm);
POPEVAL(cx);
- pop_return();
PL_curpm = newpm;
LEAVE;
}
New(54,PL_savestack,REASONABLE(128),ANY);
PL_savestack_ix = 0;
PL_savestack_max = REASONABLE(128);
-
- New(54,PL_retstack,REASONABLE(16),OP*);
- PL_retstack_ix = 0;
- PL_retstack_max = REASONABLE(16);
}
#undef REASONABLE
Safefree(PL_markstack);
Safefree(PL_scopestack);
Safefree(PL_savestack);
- Safefree(PL_retstack);
}
STATIC void
DIE(aTHX_ "%sCompilation failed in require",
*msg ? msg : "Unknown error\n");
}
- return pop_return();
+ assert(CxTYPE(cx) == CXt_EVAL);
+ return cx->blk_eval.retop;
}
}
if (!message)
hasargs = 0;
SPAGAIN;
- push_return(PL_op->op_next);
PUSHBLOCK(cx, CXt_SUB, SP);
PUSHSUB_DB(cx);
+ cx->blk_sub.retop = PL_op->op_next;
CvDEPTH(cv)++;
PAD_SET_CUR(CvPADLIST(cv),1);
RETURNOP(CvSTART(cv));
PMOP *newpm;
I32 optype = 0;
SV *sv;
+ OP *retop;
if (PL_curstackinfo->si_type == PERLSI_SORT) {
if (cxstack_ix == PL_sortcxix
switch (CxTYPE(cx)) {
case CXt_SUB:
popsub2 = TRUE;
+ retop = cx->blk_sub.retop;
cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
break;
case CXt_EVAL:
if (!(PL_in_eval & EVAL_KEEPERR))
clear_errsv = TRUE;
POPEVAL(cx);
+ retop = cx->blk_eval.retop;
if (CxTRYBLOCK(cx))
break;
lex_end();
break;
case CXt_FORMAT:
POPFORMAT(cx);
+ retop = cx->blk_sub.retop;
break;
default:
DIE(aTHX_ "panic: return");
LEAVESUB(sv);
if (clear_errsv)
sv_setpv(ERRSV,"");
- return pop_return();
+ return retop;
}
PP(pp_last)
break;
case CXt_SUB:
pop2 = CXt_SUB;
- nextop = pop_return();
+ nextop = cx->blk_sub.retop;
break;
case CXt_EVAL:
POPEVAL(cx);
- nextop = pop_return();
+ nextop = cx->blk_eval.retop;
break;
case CXt_FORMAT:
POPFORMAT(cx);
- nextop = pop_return();
+ nextop = cx->blk_sub.retop;
break;
default:
DIE(aTHX_ "panic: last");
/* Do _not_ use PUTBACK, keep the XSUB's return stack! */
}
LEAVE;
- return pop_return();
+ assert(CxTYPE(cx) == CXt_SUB);
+ return cx->blk_sub.retop;
}
else {
AV* padlist = CvPADLIST(cv);
* the op to Nullop, we force an exit from the inner runops()
* loop. DAPM.
*/
- retop = pop_return();
- push_return(Nullop);
+ assert(cxstack_ix >= 0);
+ assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
+ retop = cxstack[cxstack_ix].blk_eval.retop;
+ cxstack[cxstack_ix].blk_eval.retop = Nullop;
#ifdef PERL_FLEXIBLE_EXCEPTIONS
redo_body:
if (!startop) {
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
- pop_return();
}
lex_end();
LEAVE;
}
/* switch to eval mode */
- push_return(PL_op->op_next);
PUSHBLOCK(cx, CXt_EVAL, SP);
PUSHEVAL(cx, name, Nullgv);
+ cx->blk_eval.retop = PL_op->op_next;
SAVECOPLINE(&PL_compiling);
CopLINE_set(&PL_compiling, 0);
* to do the dirty work for us */
runcv = find_runcv(&seq);
- push_return(PL_op->op_next);
PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
PUSHEVAL(cx, 0, Nullgv);
+ cx->blk_eval.retop = PL_op->op_next;
/* prepare to compile string */
POPBLOCK(cx,newpm);
POPEVAL(cx);
- retop = pop_return();
+ retop = cx->blk_eval.retop;
TAINT_NOT;
if (gimme == G_VOID)
ENTER;
SAVETMPS;
- push_return(cLOGOP->op_other->op_next);
PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), SP);
PUSHEVAL(cx, 0, 0);
+ cx->blk_eval.retop = cLOGOP->op_other->op_next;
PL_in_eval = EVAL_INEVAL;
sv_setpv(ERRSV,"");
POPBLOCK(cx,newpm);
POPEVAL(cx);
- retop = pop_return();
+ retop = cx->blk_eval.retop;
TAINT_NOT;
if (gimme == G_VOID)
PL_curpm = newpm; /* ... and pop $1 et al */
LEAVESUB(sv);
- return pop_return();
+ return cx->blk_sub.retop;
}
/* This duplicates the above code because the above code must not
PL_curpm = newpm; /* ... and pop $1 et al */
LEAVESUB(sv);
- return pop_return();
+ return cx->blk_sub.retop;
}
dMARK;
register I32 items = SP - MARK;
AV* padlist = CvPADLIST(cv);
- push_return(PL_op->op_next);
PUSHBLOCK(cx, CXt_SUB, MARK);
PUSHSUB(cx);
+ cx->blk_sub.retop = PL_op->op_next;
CvDEPTH(cv)++;
/* XXX This would be a natural place to set C<PL_compcv = cv> so
* that eval'' ops within this sub know the correct lexical space.
ENTER;
SAVETMPS;
- push_return(retop);
PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
PUSHFORMAT(cx);
+ cx->blk_sub.retop = retop;
PAD_SET_CUR(CvPADLIST(cv), 1);
setdefout(gv); /* locally select filehandle so $% et al work */
/* bad_ofp: */
PL_formtarget = PL_bodytarget;
PUTBACK;
- return pop_return();
+ return cx->blk_sub.retop;
}
PP(pp_prtf)
return cxstack_ix + 1;
}
+/* XXX for 5.8.X BINCOMPAT only */
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;
+ Perl_croak(aTHX_ "panic: obsolete function push_return() called");
}
+/* XXX for 5.8.X BINCOMPAT only */
OP *
Perl_pop_return(pTHX)
{
- if (PL_retstack_ix > 0)
- return PL_retstack[--PL_retstack_ix];
- else
- return Nullop;
+ Perl_croak(aTHX_ "panic: obsolete function pop_return() called");
}
void
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:
else {
ncx->blk_oldsp = cx->blk_oldsp;
ncx->blk_oldcop = cx->blk_oldcop;
- ncx->blk_oldretsp = cx->blk_oldretsp;
ncx->blk_oldmarksp = cx->blk_oldmarksp;
ncx->blk_oldscopesp = cx->blk_oldscopesp;
ncx->blk_oldpm = cx->blk_oldpm;
ncx->blk_sub.olddepth = cx->blk_sub.olddepth;
ncx->blk_sub.hasargs = cx->blk_sub.hasargs;
ncx->blk_sub.lval = cx->blk_sub.lval;
+ ncx->blk_sub.retop = cx->blk_sub.retop;
break;
case CXt_EVAL:
ncx->blk_eval.old_in_eval = cx->blk_eval.old_in_eval;
ncx->blk_eval.old_namesv = sv_dup_inc(cx->blk_eval.old_namesv, param);
ncx->blk_eval.old_eval_root = cx->blk_eval.old_eval_root;
ncx->blk_eval.cur_text = sv_dup(cx->blk_eval.cur_text, param);
+ ncx->blk_eval.retop = cx->blk_eval.retop;
break;
case CXt_LOOP:
ncx->blk_loop.label = cx->blk_loop.label;
ncx->blk_sub.gv = gv_dup(cx->blk_sub.gv, param);
ncx->blk_sub.dfoutgv = gv_dup_inc(cx->blk_sub.dfoutgv, param);
ncx->blk_sub.hasargs = cx->blk_sub.hasargs;
+ ncx->blk_sub.retop = cx->blk_sub.retop;
break;
case CXt_BLOCK:
case CXt_NULL:
PL_savestack = 0;
PL_savestack_ix = 0;
PL_savestack_max = -1;
- PL_retstack = 0;
PL_sig_pending = 0;
Zero(&PL_debug_pad, 1, struct perl_debug_pad);
# else /* !DEBUGGING */
PL_savestack = 0;
PL_savestack_ix = 0;
PL_savestack_max = -1;
- PL_retstack = 0;
PL_sig_pending = 0;
Zero(&PL_debug_pad, 1, struct perl_debug_pad);
# else /* !DEBUGGING */
Newz(54, PL_scopestack, PL_scopestack_max, I32);
Copy(proto_perl->Tscopestack, PL_scopestack, PL_scopestack_ix, I32);
- /* next push_return() sets PL_retstack[PL_retstack_ix]
- * NOTE: unlike the others! */
- PL_retstack_ix = proto_perl->Tretstack_ix;
- PL_retstack_max = proto_perl->Tretstack_max;
- Newz(54, PL_retstack, PL_retstack_max, OP*);
- Copy(proto_perl->Tretstack, PL_retstack, PL_retstack_ix, OP*);
-
/* NOTE: si_dup() looks at PL_markstack */
PL_curstackinfo = si_dup(proto_perl->Tcurstackinfo, param);
PERLVAR(Tmarkstack_ptr, I32 *)
PERLVAR(Tmarkstack_max, I32 *)
-PERLVAR(Tretstack, OP **) /* OPs we have postponed executing */
-PERLVAR(Tretstack_ix, I32)
-PERLVAR(Tretstack_max, I32)
+PERLVAR(Tretstack, OP **) /* XXX for 5.8.x BINCOMPAT */
+PERLVAR(Tretstack_ix, I32) /* XXX for 5.8.x BINCOMPAT */
+PERLVAR(Tretstack_max, I32) /* XXX for 5.8.x BINCOMPAT */
PERLVAR(TSv, SV *) /* used to hold temporary values */
PERLVAR(TXpv, XPV *) /* used to hold temporary values */
projects / p5sagit/p5-mst-13.2.git / commitdiff