diff options
| -rw-r--r-- | cop.h | 10 | ||||
| -rw-r--r-- | pp_ctl.c | 73 | ||||
| -rw-r--r-- | pp_hot.c | 5 | ||||
| -rw-r--r-- | pp_sort.c | 14 | ||||
| -rw-r--r-- | pp_sys.c | 7 | ||||
| -rw-r--r-- | regcomp.h | 2 |
6 files changed, 64 insertions, 47 deletions
@@ -939,7 +939,6 @@ struct block { /* Exit a block (RETURN and LAST). */ #define POPBLOCK(cx,pm) \ DEBUG_CX("POP"); \ - cx = &cxstack[cxstack_ix--], \ PL_curcop = cx->blk_oldcop, \ PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \ PL_scopestack_ix = cx->blk_oldscopesp, \ @@ -1311,15 +1310,16 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>. STMT_START { \ cx = &cxstack[cxstack_ix]; \ CvDEPTH(multicall_cv) = cx->blk_sub.olddepth; \ - POPBLOCK(cx,PL_curpm); \ - /* these two set for backcompat by callers */ \ - newsp = PL_stack_base + cx->blk_oldsp; \ - gimme = cx->blk_gimme; \ /* includes partial unrolled POPSUB(): */ \ CX_LEAVE_SCOPE(cx); \ PL_comppad = cx->blk_sub.prevcomppad; \ PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; \ SvREFCNT_dec_NN(multicall_cv); \ + /* these two set for backcompat by callers */ \ + newsp = PL_stack_base + cx->blk_oldsp; \ + gimme = cx->blk_gimme; \ + POPBLOCK(cx,PL_curpm); \ + cxstack_ix--; \ POPSTACK; \ CATCH_SET(multicall_oldcatch); \ SPAGAIN; \ @@ -1656,8 +1656,9 @@ Perl_die_unwind(pTHX_ SV *msv) my_exit(1); } - POPBLOCK(cx,PL_curpm); POPEVAL(cx); + POPBLOCK(cx,PL_curpm); + cxstack_ix--; namesv = cx->blk_eval.old_namesv; #ifdef DEBUGGING oldcop = cx->blk_oldcop; @@ -2076,13 +2077,12 @@ PP(pp_leave) PMOP *newpm; I32 gimme; - if (PL_op->op_flags & OPf_SPECIAL) { - cx = &cxstack[cxstack_ix]; - cx->blk_oldpm = PL_curpm; /* fake block should preserve $1 et al */ - } - cx = &cxstack[cxstack_ix]; assert(CxTYPE(cx) == CXt_BLOCK); + + if (PL_op->op_flags & OPf_SPECIAL) + cx->blk_oldpm = PL_curpm; /* fake block should preserve $1 et al */ + newsp = PL_stack_base + cx->blk_oldsp; gimme = cx->blk_gimme; @@ -2092,10 +2092,10 @@ PP(pp_leave) leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, PL_op->op_private & OPpLVALUE); - POPBLOCK(cx,newpm); POPBASICBLK(cx); - + POPBLOCK(cx,newpm); PL_curpm = newpm; /* Don't pop $1 et al till now */ + cxstack_ix--; return NORMAL; } @@ -2270,9 +2270,10 @@ PP(pp_leaveloop) leave_common(newsp, MARK, gimme, SVs_PADTMP|SVs_TEMP, PL_op->op_private & OPpLVALUE); - POPBLOCK(cx,newpm); POPLOOP(cx); /* Stack values are safe: release loop vars ... */ + POPBLOCK(cx,newpm); PL_curpm = newpm; /* ... and pop $1 et al */ + cxstack_ix--; return NORMAL; } @@ -2399,11 +2400,10 @@ PP(pp_leavesublv) } PUTBACK; - POPBLOCK(cx,newpm); - cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */ POPSUB(cx); /* Stack values are safe: release CV and @_ ... */ - cxstack_ix--; + POPBLOCK(cx,newpm); PL_curpm = newpm; /* ... and pop $1 et al */ + cxstack_ix--; return cx->blk_sub.retop; } @@ -2551,13 +2551,12 @@ S_unwind_loop(pTHX_ const char * const opname) PP(pp_last) { PERL_CONTEXT *cx; - OP *nextop = NULL; PMOP *newpm; S_unwind_loop(aTHX_ "last"); - POPBLOCK(cx,newpm); - cxstack_ix++; /* temporarily protect top context */ + cx = &cxstack[cxstack_ix]; + assert( CxTYPE(cx) == CXt_LOOP_LAZYIV || CxTYPE(cx) == CXt_LOOP_LAZYSV @@ -2565,16 +2564,16 @@ PP(pp_last) || CxTYPE(cx) == CXt_LOOP_PLAIN ); PL_stack_sp = PL_stack_base + cx->blk_loop.resetsp; - nextop = cx->blk_loop.my_op->op_lastop->op_next; TAINT_NOT; - cxstack_ix--; /* Stack values are safe: */ POPLOOP(cx); /* release loop vars ... */ + POPBLOCK(cx,newpm); PL_curpm = newpm; /* ... and pop $1 et al */ + cxstack_ix--; - return nextop; + return cx->blk_loop.my_op->op_lastop->op_next; } PP(pp_next) @@ -3431,8 +3430,10 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh) PL_eval_root = NULL; } SP = PL_stack_base + POPMARK; /* pop original mark */ - POPBLOCK(cx,PL_curpm); + cx = &cxstack[cxstack_ix]; POPEVAL(cx); + POPBLOCK(cx,PL_curpm); + cxstack_ix--; namesv = cx->blk_eval.old_namesv; } @@ -4270,13 +4271,21 @@ PP(pp_leaveeval) leave_common(newsp, newsp, gimme, SVs_TEMP, FALSE); SPAGAIN; } - POPBLOCK(cx,newpm); + /* the POPEVAL does a leavescope, which frees the optree associated + * with eval, which if it frees the nextstate associated with + * PL_curcop, sets PL_curcop to NULL. Which can mess up freeing a + * regex when running under 'use re Debug' because it needs PL_curcop + * to get the current hints. So restore it early. + */ + PL_curcop = cx->blk_oldcop; POPEVAL(cx); + POPBLOCK(cx,newpm); + PL_curpm = newpm; /* Don't pop $1 et al till now */ + cxstack_ix--; namesv = cx->blk_eval.old_namesv; retop = cx->blk_eval.retop; evalcv = cx->blk_eval.cv; - PL_curpm = newpm; /* Don't pop $1 et al till now */ #ifdef DEBUGGING assert(CvDEPTH(evalcv) == 1); @@ -4312,9 +4321,11 @@ Perl_delete_eval_scope(pTHX) PERL_CONTEXT *cx; I32 optype; - POPBLOCK(cx,newpm); + cx = &cxstack[cxstack_ix]; POPEVAL(cx); + POPBLOCK(cx,newpm); PL_curpm = newpm; + cxstack_ix--; PERL_UNUSED_VAR(optype); } @@ -4368,9 +4379,10 @@ PP(pp_leavetry) PL_stack_sp = newsp; else leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE); + POPEVAL(cx); POPBLOCK(cx,newpm); + cxstack_ix--; retop = cx->blk_eval.retop; - POPEVAL(cx); PERL_UNUSED_VAR(optype); PL_curpm = newpm; /* Don't pop $1 et al till now */ @@ -4413,11 +4425,10 @@ PP(pp_leavegiven) PL_stack_sp = newsp; else leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE); - POPBLOCK(cx,newpm); POPGIVEN(cx); - assert(CxTYPE(cx) == CXt_GIVEN); - + POPBLOCK(cx,newpm); PL_curpm = newpm; /* Don't pop $1 et al till now */ + cxstack_ix--; return NORMAL; } @@ -5021,7 +5032,6 @@ PP(pp_leavewhen) PP(pp_continue) { - dSP; I32 cxix; PERL_CONTEXT *cx; PMOP *newpm; @@ -5034,14 +5044,15 @@ PP(pp_continue) if (cxix < cxstack_ix) dounwind(cxix); - POPBLOCK(cx,newpm); + cx = &cxstack[cxstack_ix]; assert(CxTYPE(cx) == CXt_WHEN); + PL_stack_sp = PL_stack_base + cx->blk_oldsp; POPWHEN(cx); - - SP = PL_stack_base + cx->blk_oldsp; + POPBLOCK(cx,newpm); PL_curpm = newpm; /* pop $1 et al */ + cxstack_ix--; - RETURNOP(cx->blk_givwhen.leave_op->op_next); + return cx->blk_givwhen.leave_op->op_next; } PP(pp_break) @@ -3337,11 +3337,10 @@ PP(pp_leavesub) } PUTBACK; - POPBLOCK(cx,newpm); - cxstack_ix++; /* temporarily protect top context */ POPSUB(cx); /* Stack values are safe: release CV and @_ ... */ - cxstack_ix--; + POPBLOCK(cx,newpm); PL_curpm = newpm; /* ... and pop $1 et al */ + cxstack_ix--; return cx->blk_sub.retop; } @@ -1706,18 +1706,22 @@ PP(pp_sort) (is_xsub ? S_sortcv_xsub : hasargs ? S_sortcv_stacked : S_sortcv), sort_flags); + /* Reset cx, in case the context stack has been reallocated. */ + cx = &cxstack[cxstack_ix]; + + PL_stack_sp = PL_stack_base + cx->blk_oldsp; + if (!(flags & OPf_SPECIAL)) { - /* Reset cx, in case the context stack has been - reallocated. */ - cx = &cxstack[cxstack_ix]; - POPSUB(cx); + assert(CxTYPE(cx) == CXt_SUB); + POPSUB(cx); } else + assert(CxTYPE(cx) == CXt_NULL); /* mimic POPSUB */ PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor; POPBLOCK(cx,PL_curpm); - PL_stack_sp = PL_stack_base + cx->blk_oldsp; + cxstack_ix--; POPSTACK; CATCH_SET(oldcatch); } @@ -1520,10 +1520,13 @@ PP(pp_leavewrite) } forget_top: + cx = &cxstack[cxstack_ix]; + assert(CxTYPE(cx) == CXt_FORMAT); + SP = PL_stack_base + cx->blk_oldsp; /* ignore retval of formline */ + POPFORMAT(cx); POPBLOCK(cx,PL_curpm); retop = cx->blk_sub.retop; - POPFORMAT(cx); - SP = PL_stack_base + cx->blk_oldsp; /* ignore retval of formline */ + cxstack_ix--; if (is_return) /* XXX the semantics of doing 'return' in a format aren't documented. @@ -1055,7 +1055,7 @@ re.pm, especially to the documentation. /* get_sv() can return NULL during global destruction. */ #define GET_RE_DEBUG_FLAGS DEBUG_r({ \ SV * re_debug_flags_sv = NULL; \ - re_debug_flags_sv = get_sv(RE_DEBUG_FLAGS, 1); \ + re_debug_flags_sv = PL_curcop ? get_sv(RE_DEBUG_FLAGS, 1) : NULL; \ if (re_debug_flags_sv) { \ if (!SvIOK(re_debug_flags_sv)) \ sv_setuv(re_debug_flags_sv, RE_DEBUG_COMPILE_DUMP | RE_DEBUG_EXECUTE_MASK ); \ |