diff options
| -rw-r--r-- | embedvar.h | 2 | ||||
| -rw-r--r-- | intrpvar.h | 1 | ||||
| -rw-r--r-- | perl.c | 4 | ||||
| -rw-r--r-- | perlapi.h | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 14 | ||||
| -rw-r--r-- | sv.c | 1 |
6 files changed, 13 insertions, 11 deletions
diff --git a/embedvar.h b/embedvar.h index 63ed46ee2a..609e107ff0 100644 --- a/embedvar.h +++ b/embedvar.h @@ -254,6 +254,7 @@ #define PL_rehash_seed (vTHX->Irehash_seed) #define PL_rehash_seed_set (vTHX->Irehash_seed_set) #define PL_replgv (vTHX->Ireplgv) +#define PL_restartjmpenv (vTHX->Irestartjmpenv) #define PL_restartop (vTHX->Irestartop) #define PL_rs (vTHX->Irs) #define PL_runops (vTHX->Irunops) @@ -581,6 +582,7 @@ #define PL_Irehash_seed PL_rehash_seed #define PL_Irehash_seed_set PL_rehash_seed_set #define PL_Ireplgv PL_replgv +#define PL_Irestartjmpenv PL_restartjmpenv #define PL_Irestartop PL_restartop #define PL_Irs PL_rs #define PL_Irunops PL_runops diff --git a/intrpvar.h b/intrpvar.h index 8fe641c29c..4af88f686e 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -126,6 +126,7 @@ PERLVAR(Idefstash, HV *) /* main symbol table */ PERLVAR(Icurstash, HV *) /* symbol table for current package */ PERLVAR(Irestartop, OP *) /* propagating an error from croak? */ +PERLVAR(Irestartjmpenv, JMPENV *) /* target frame for longjmp in die */ PERLVAR(Icurcop, COP *) PERLVAR(Icurstack, AV *) /* THE STACK */ PERLVAR(Icurstackinfo, PERL_SI *) /* current stack + context */ @@ -2193,6 +2193,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) #endif ENTER; + PL_restartjmpenv = NULL; PL_restartop = 0; return NULL; } @@ -2298,6 +2299,7 @@ S_run_body(pTHX_ I32 oldscope) /* do it */ if (PL_restartop) { + PL_restartjmpenv = NULL; PL_op = PL_restartop; PL_restartop = 0; CALLRUNOPS(aTHX); @@ -2620,6 +2622,7 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags) /* NOTREACHED */ case 3: if (PL_restartop) { + PL_restartjmpenv = NULL; PL_op = PL_restartop; PL_restartop = 0; goto redo_body; @@ -2720,6 +2723,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) /* NOTREACHED */ case 3: if (PL_restartop) { + PL_restartjmpenv = NULL; PL_op = PL_restartop; PL_restartop = 0; goto redo_body; @@ -544,6 +544,8 @@ END_EXTERN_C #define PL_rehash_seed_set (*Perl_Irehash_seed_set_ptr(aTHX)) #undef PL_replgv #define PL_replgv (*Perl_Ireplgv_ptr(aTHX)) +#undef PL_restartjmpenv +#define PL_restartjmpenv (*Perl_Irestartjmpenv_ptr(aTHX)) #undef PL_restartop #define PL_restartop (*Perl_Irestartop_ptr(aTHX)) #undef PL_rs @@ -1664,6 +1664,7 @@ Perl_die_where(pTHX_ SV *msv) *msg ? msg : "Unknown error\n"); } assert(CxTYPE(cx) == CXt_EVAL); + PL_restartjmpenv = cx->blk_eval.cur_top_env; PL_restartop = cx->blk_eval.retop; JMPENV_JUMP(3); /* NOTREACHED */ @@ -2881,17 +2882,8 @@ S_docatch(pTHX_ OP *o) break; case 3: /* die caught by an inner eval - continue inner loop */ - - /* NB XXX we rely on the old popped CxEVAL still being at the top - * of the stack; the way die_where() currently works, this - * assumption is valid. In theory The cur_top_env value should be - * returned in another global, the way retop (aka PL_restartop) - * is. */ - assert(CxTYPE(&cxstack[cxstack_ix+1]) == CXt_EVAL); - - if (PL_restartop - && cxstack[cxstack_ix+1].blk_eval.cur_top_env == PL_top_env) - { + if (PL_restartop && PL_restartjmpenv == PL_top_env) { + PL_restartjmpenv = NULL; PL_op = PL_restartop; PL_restartop = 0; goto redo_body; @@ -12475,6 +12475,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_bodytarget = sv_dup_inc(proto_perl->Ibodytarget, param); PL_formtarget = sv_dup(proto_perl->Iformtarget, param); + PL_restartjmpenv = proto_perl->Irestartjmpenv; PL_restartop = proto_perl->Irestartop; PL_in_eval = proto_perl->Iin_eval; PL_delaymagic = proto_perl->Idelaymagic; |