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.

diff --git a/embedvar.h b/embedvar.h
index 63ed46e..609e107 100644 (file)
--- 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 8fe641c..4af88f6 100644 (file)
--- 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 */

diff --git a/perl.c b/perl.c
index 5dad874..7a87120 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -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;

diff --git a/perlapi.h b/perlapi.h
index 54ddab0..5b7c50b 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -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

diff --git a/pp_ctl.c b/pp_ctl.c
index d62d58a..d565f6a 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -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;

diff --git a/sv.c b/sv.c
index 3837958..bc2450d 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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;