diff options
author | Zefram <zefram@fysh.org> | 2010-04-21 00:00:09 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2010-04-25 13:24:29 +0100 |
commit | febb3a6d221072614a4dcfef3d3953e212e5cf6c (patch) | |
tree | 77ef0076d97be14c024406d9012b49db19234ad2 | |
parent | db93c0c46b34e8b2e37c671b7362d0fa2550f5f7 (diff) | |
download | perl-febb3a6d221072614a4dcfef3d3953e212e5cf6c.tar.gz |
unwinding target nominated by separate global
When unwinding due to die, the new global PL_restartjmpenv points
to the JMP_ENV at which longjmping should stop and control should
be transferred to PL_restartop. This replaces the previous
use of cxstack[cxstack_ix+1].blk_eval.cur_top_env, located in a
nominally-discarded context frame.
-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; |