more thorough cleanup in perl_destroy()

[p5sagit/p5-mst-13.2.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 746cb80..746f483 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1187,6 +1187,7 @@ Perl_dounwind(pTHX_ I32 cxix)
     I32 optype;
 
     while (cxstack_ix > cxix) {
+       SV *sv;
        cx = &cxstack[cxstack_ix];
        DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
                              (long) cxstack_ix, PL_block_type[CxTYPE(cx)]));
@@ -1196,7 +1197,8 @@ Perl_dounwind(pTHX_ I32 cxix)
            POPSUBST(cx);
            continue;  /* not break */
        case CXt_SUB:
-           POPSUB(cx);
+           POPSUB(cx,sv);
+           LEAVESUB(sv);
            break;
        case CXt_EVAL:
            POPEVAL(cx);
@@ -1443,8 +1445,7 @@ PP(pp_caller)
        PUSHs(&PL_sv_undef);
     else
        PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0)));
-    PUSHs(sv_2mortal(newSVpvn(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)),
-                             SvCUR(GvSV(cx->blk_oldcop->cop_filegv)))));
+    PUSHs(sv_2mortal(newSVsv(CopFILESV(cx->blk_oldcop))));
     PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
     if (!MAXARG)
        RETURN;
@@ -1700,6 +1701,7 @@ PP(pp_return)
     SV **newsp;
     PMOP *newpm;
     I32 optype = 0;
+    SV *sv;
 
     if (PL_curstackinfo->si_type == PERLSI_SORT) {
        if (cxstack_ix == PL_sortcxix || dopoptosub(cxstack_ix) <= PL_sortcxix) {
@@ -1771,11 +1773,14 @@ PP(pp_return)
 
     /* Stack values are safe: */
     if (popsub2) {
-       POPSUB(cx);     /* release CV and @_ ... */
+       POPSUB(cx,sv);  /* release CV and @_ ... */
     }
+    else
+       sv = Nullsv;
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
     LEAVE;
+    LEAVESUB(sv);
     return pop_return();
 }
 
@@ -1791,6 +1796,7 @@ PP(pp_last)
     SV **newsp;
     PMOP *newpm;
     SV **mark;
+    SV *sv = Nullsv;
 
     if (PL_op->op_flags & OPf_SPECIAL) {
        cxix = dopoptoloop(cxstack_ix);
@@ -1850,12 +1856,13 @@ PP(pp_last)
        LEAVE;
        break;
     case CXt_SUB:
-       POPSUB(cx);     /* release CV and @_ ... */
+       POPSUB(cx,sv);  /* release CV and @_ ... */
        break;
     }
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
     LEAVE;
+    LEAVESUB(sv);
     return nextop;
 }
 
@@ -2428,18 +2435,20 @@ S_docatch(pTHX_ OP *o)
     dTHR;
     int ret;
     OP *oldop = PL_op;
+    volatile PERL_SI *cursi = PL_curstackinfo;
+    dJMPENV;
 
 #ifdef DEBUGGING
     assert(CATCH_GET == TRUE);
 #endif
     PL_op = o;
  redo_body:
-    CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_docatch_body));
+    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body));
     switch (ret) {
     case 0:
        break;
     case 3:
-       if (PL_restartop) {
+       if (PL_restartop && cursi == PL_curstackinfo) {
            PL_op = PL_restartop;
            PL_restartop = 0;
            goto redo_body;
@@ -2479,10 +2488,10 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
        SAVESPTR(PL_compiling.cop_stash);
        PL_compiling.cop_stash = PL_curstash;
     }
-    SAVESPTR(PL_compiling.cop_filegv);
+    SAVESPTR(CopFILEGV(&PL_compiling));
     SAVEI16(PL_compiling.cop_line);
     sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq);
-    PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
+    CopFILEGV_set(&PL_compiling, gv_fetchfile(tmpbuf+2));
     PL_compiling.cop_line = 1;
     /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
        deleting the eval's FILEGV from the stash before gv_check() runs
@@ -2503,7 +2512,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
     PL_op->op_type = OP_ENTEREVAL;
     PL_op->op_flags = 0;                       /* Avoid uninit warning. */
     PUSHBLOCK(cx, CXt_EVAL, SP);
-    PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
+    PUSHEVAL(cx, 0, Nullgv);
     rop = doeval(G_SCALAR, startop);
     POPBLOCK(cx,PL_curpm);
     POPEVAL(cx);
@@ -2681,7 +2690,7 @@ S_doeval(pTHX_ int gimme, OP** startop)
        if (cv) {
            dSP;
            PUSHMARK(SP);
-           XPUSHs((SV*)PL_compiling.cop_filegv);
+           XPUSHs((SV*)CopFILEGV(&PL_compiling));
            PUTBACK;
            call_sv((SV*)cv, G_DISCARD);
        }
@@ -2809,8 +2818,8 @@ PP(pp_require)
                        loader = *av_fetch((AV *)SvRV(loader), 0, TRUE);
                    }
 
-                   Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%lx/%s",
-                                  SvANY(loader), name);
+                   Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s",
+                                  PTR2UV(SvANY(loader)), name);
                    tryname = SvPVX(namesv);
                    tryrsfp = 0;
 
@@ -2928,8 +2937,8 @@ PP(pp_require)
            }
        }
     }
-    SAVESPTR(PL_compiling.cop_filegv);
-    PL_compiling.cop_filegv = gv_fetchfile(tryrsfp ? tryname : name);
+    SAVESPTR(CopFILEGV(&PL_compiling));
+    CopFILEGV_set(&PL_compiling, gv_fetchfile(tryrsfp ? tryname : name));
     SvREFCNT_dec(namesv);
     if (!tryrsfp) {
        if (PL_op->op_type == OP_REQUIRE) {
@@ -2964,7 +2973,7 @@ PP(pp_require)
 
     /* Assume success here to prevent recursive requirement. */
     (void)hv_store(GvHVn(PL_incgv), name, strlen(name),
-       newSVsv(GvSV(PL_compiling.cop_filegv)), 0 );
+                  newSVsv(CopFILESV(&PL_compiling)), 0 );
 
     ENTER;
     SAVETMPS;
@@ -2996,7 +3005,7 @@ PP(pp_require)
     /* switch to eval mode */
     push_return(PL_op->op_next);
     PUSHBLOCK(cx, CXt_EVAL, SP);
-    PUSHEVAL(cx, name, PL_compiling.cop_filegv);
+    PUSHEVAL(cx, name, Nullgv);
 
     SAVEI16(PL_compiling.cop_line);
     PL_compiling.cop_line = 0;
@@ -3039,9 +3048,9 @@ PP(pp_entereval)
  
     /* switch to eval mode */
 
-    SAVESPTR(PL_compiling.cop_filegv);
+    SAVESPTR(CopFILEGV(&PL_compiling));
     sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
-    PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
+    CopFILEGV_set(&PL_compiling, gv_fetchfile(tmpbuf+2));
     PL_compiling.cop_line = 1;
     /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
        deleting the eval's FILEGV from the stash before gv_check() runs
@@ -3060,12 +3069,12 @@ PP(pp_entereval)
 
     push_return(PL_op->op_next);
     PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
-    PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
+    PUSHEVAL(cx, 0, Nullgv);
 
     /* prepare to compile string */
 
     if (PERLDB_LINE && PL_curstash != PL_debstash)
-       save_lines(GvAV(PL_compiling.cop_filegv), PL_linestr);
+       save_lines(CopFILEAV(&PL_compiling), PL_linestr);
     PUTBACK;
 #ifdef USE_THREADS
     MUTEX_LOCK(&PL_eval_mutex);
@@ -3114,6 +3123,7 @@ PP(pp_leaveeval)
            MEXTEND(mark,0);
            *MARK = &PL_sv_undef;
        }
+       SP = MARK;
     }
     else {
        /* in case LEAVE wipes old return values */
@@ -4079,7 +4089,6 @@ S_qsortsv(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
 
 
 #ifdef PERL_OBJECT
-#define NO_XSLOCKS
 #undef this
 #define this pPerl
 #include "XSUB.h"