sundry cleanups for cloned interpreters (only known failure mode

is due to regexps keeping non-constant data in their compiled
structures)

p4raw-id: //depot/perl@4579

diff --git a/cop.h b/cop.h
index d5f7f42..af29ff6 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -39,6 +39,10 @@ struct cop {
 #  define CopSTASH(c)          (CopSTASHPV(c) \
                                 ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
 #  define CopSTASH_set(c,hv)   CopSTASHPV_set(c, HvNAME(hv))
+#  define CopSTASH_eq(c,hv)    (hv                                     \
+                                && (CopSTASHPV(c) == HvNAME(hv)        \
+                                    || (CopSTASHPV(c) && HvNAME(hv)    \
+                                        && strEQ(CopSTASHPV(c), HvNAME(hv)))))
 #else
 #  define CopFILEGV(c)         ((c)->cop_filegv)
 #  define CopFILEGV_set(c,gv)  ((c)->cop_filegv = gv)
@@ -50,8 +54,10 @@ struct cop {
 #  define CopSTASH_set(c,hv)   ((c)->cop_stash = hv)
 #  define CopSTASHPV(c)                (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
 #  define CopSTASHPV_set(c,pv) CopSTASH_set(c, gv_stashpv(pv,GV_ADD))
+#  define CopSTASH_eq(c,hv)    (CopSTASH(c) == hv)
 #endif /* USE_ITHREADS */
 
+#define CopSTASH_ne(c,hv)      (!CopSTASH_eq(c,hv))
 #define CopLINE(c)             ((c)->cop_line)
 #define CopLINE_inc(c)         (++CopLINE(c))
 #define CopLINE_dec(c)         (--CopLINE(c))

diff --git a/dump.c b/dump.c
index f08f765..38778d6 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -539,8 +539,12 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
     case OP_DBSTATE:
        if (CopLINE(cCOPo))
            Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",CopLINE(cCOPo));
+       if (CopSTASHPV(cCOPo))
+           Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
+                            CopSTASHPV(cCOPo));
        if (cCOPo->cop_label)
-           Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",cCOPo->cop_label);
+           Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
+                            cCOPo->cop_label);
        break;
     case OP_ENTERLOOP:
        Perl_dump_indent(aTHX_ level, file, "REDO ===> ");

diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs
index 9b6e016..63ff8aa 100644 (file)
--- a/ext/Opcode/Opcode.xs
+++ b/ext/Opcode/Opcode.xs
@@ -253,6 +253,8 @@ PPCODE:
     save_hptr(&PL_defstash);           /* save current default stack   */
     /* the assignment to global defstash changes our sense of 'main'   */
     PL_defstash = gv_stashpv(Package, GV_ADDWARN); /* should exist already     */
+    save_hptr(&PL_curstash);
+    PL_curstash = PL_defstash;
 
     /* defstash must itself contain a main:: so we'll add that now     */
     /* take care with the ref counts (was cause of long standing bug)  */

diff --git a/gv.c b/gv.c
index 25e5b36..f6c9744 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -59,6 +59,9 @@ Perl_gv_fetchfile(pTHX_ const char *name)
     STRLEN tmplen;
     GV *gv;
 
+    if (!PL_defstash)
+       return Nullgv;
+
     tmplen = strlen(name) + 2;
     if (tmplen < sizeof smallbuf)
        tmpbuf = smallbuf;
@@ -445,8 +448,8 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
        name++;
 
     for (namend = name; *namend; namend++) {
-       if ((*namend == '\'' && namend[1]) ||
-           (*namend == ':' && namend[1] == ':'))
+       if ((*namend == ':' && namend[1] == ':')
+           || (*namend == '\'' && namend[1]))
        {
            if (!stash)
                stash = PL_defstash;

diff --git a/op.c b/op.c
index 282027a..775b03a 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4455,8 +4455,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            CV *cv;
            HV *hv;
 
-           Perl_sv_setpvf(aTHX_ sv, "%_:%ld-%ld",
-                          CopFILESV(PL_curcop),
+           Perl_sv_setpvf(aTHX_ sv, "%s:%ld-%ld",
+                          CopFILE(PL_curcop),
                           (long)PL_subline, (long)CopLINE(PL_curcop));
            gv_efullname3(tmpstr, gv, Nullch);
            hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
@@ -4475,6 +4475,10 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            s++;
        else
            s = name;
+
+       if (*s != 'B' && *s != 'E' && *s != 'S' && *s != 'I')
+           goto done;
+
        if (strEQ(s, "BEGIN")) {
            I32 oldscope = PL_scopestack_ix;
            ENTER;
@@ -4486,7 +4490,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            if (!PL_beginav)
                PL_beginav = newAV();
            DEBUG_x( dump_sub(gv) );
-           av_push(PL_beginav, (SV *)cv);
+           av_push(PL_beginav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
            call_list(oldscope, PL_beginav);
 
@@ -4497,20 +4501,23 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        else if (strEQ(s, "END") && !PL_error_count) {
            if (!PL_endav)
                PL_endav = newAV();
+           DEBUG_x( dump_sub(gv) );
            av_unshift(PL_endav, 1);
-           av_store(PL_endav, 0, (SV *)cv);
+           av_store(PL_endav, 0, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "STOP") && !PL_error_count) {
            if (!PL_stopav)
                PL_stopav = newAV();
+           DEBUG_x( dump_sub(gv) );
            av_unshift(PL_stopav, 1);
-           av_store(PL_stopav, 0, (SV *)cv);
+           av_store(PL_stopav, 0, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "INIT") && !PL_error_count) {
            if (!PL_initav)
                PL_initav = newAV();
+           DEBUG_x( dump_sub(gv) );
            av_push(PL_initav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
@@ -4614,36 +4621,41 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
            s++;
        else
            s = name;
+
+       if (*s != 'B' && *s != 'E' && *s != 'S' && *s != 'I')
+           goto done;
+
        if (strEQ(s, "BEGIN")) {
            if (!PL_beginav)
                PL_beginav = newAV();
-           av_push(PL_beginav, (SV *)cv);
+           av_push(PL_beginav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "END")) {
            if (!PL_endav)
                PL_endav = newAV();
            av_unshift(PL_endav, 1);
-           av_store(PL_endav, 0, (SV *)cv);
+           av_store(PL_endav, 0, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "STOP")) {
            if (!PL_stopav)
                PL_stopav = newAV();
            av_unshift(PL_stopav, 1);
-           av_store(PL_stopav, 0, (SV *)cv);
+           av_store(PL_stopav, 0, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "INIT")) {
            if (!PL_initav)
                PL_initav = newAV();
-           av_push(PL_initav, (SV *)cv);
+           av_push(PL_initav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
     }
     else
        CvANON_on(cv);
 
+done:
     return cv;
 }
 

diff --git a/perl.c b/perl.c
index 5eb8338..093ac2f 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1689,10 +1689,10 @@ Perl_moreswitches(pTHX_ char *s)
            my_setenv("PERL5DB", Perl_form(aTHX_ "use Devel::%s;", ++s));
            s += strlen(s);
        }
-       if (!PL_perldb)
+       if (!PL_perldb) {
            PL_perldb = PERLDB_ALL;
-       if (!PL_debstash)
            init_debugger();
+       }
        return s;
     case 'D':
     {  
@@ -2086,6 +2086,7 @@ S_init_main_stash(pTHX)
     sv_setpvn(ERRSV, "", 0);
     PL_curstash = PL_defstash;
     CopSTASH_set(&PL_compiling, PL_defstash);
+    PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
     PL_globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
     /* We must init $/ before switches are processed. */
     sv_setpvn(get_sv("/", TRUE), "\n", 1);
@@ -2644,7 +2645,6 @@ Perl_init_debugger(pTHX)
     dTHR;
     HV *ostash = PL_curstash;
 
-    PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
     PL_curstash = PL_debstash;
     PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
     AvREAL_off(PL_dbargs);

diff --git a/pp_ctl.c b/pp_ctl.c
index 22c83aa..bc2a361 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1392,7 +1392,7 @@ PP(pp_caller)
     PERL_SI *top_si = PL_curstackinfo;
     I32 dbcxix;
     I32 gimme;
-    HV *hv;
+    char *stashname;
     SV *sv;
     I32 count = 0;
 
@@ -1428,23 +1428,23 @@ PP(pp_caller)
            cx = &ccstack[dbcxix];
     }
 
-    hv = CopSTASH(cx->blk_oldcop);
+    stashname = CopSTASHPV(cx->blk_oldcop);
     if (GIMME != G_ARRAY) {
-       if (!hv)
+       if (!stashname)
            PUSHs(&PL_sv_undef);
        else {
            dTARGET;
-           sv_setpv(TARG, HvNAME(hv));
+           sv_setpv(TARG, stashname);
            PUSHs(TARG);
        }
        RETURN;
     }
 
-    if (!hv)
+    if (!stashname)
        PUSHs(&PL_sv_undef);
     else
-       PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0)));
-    PUSHs(sv_2mortal(newSVsv(CopFILESV(cx->blk_oldcop))));
+       PUSHs(sv_2mortal(newSVpv(stashname, 0)));
+    PUSHs(sv_2mortal(newSVpv(CopFILE(cx->blk_oldcop), 0)));
     PUSHs(sv_2mortal(newSViv((I32)CopLINE(cx->blk_oldcop))));
     if (!MAXARG)
        RETURN;
@@ -1479,7 +1479,7 @@ PP(pp_caller)
        PUSHs(&PL_sv_undef);
     }
     if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs
-       && CopSTASH(PL_curcop) == PL_debstash)
+       && CopSTASH_eq(PL_curcop, PL_debstash))
     {
        AV *ary = cx->blk_sub.argarray;
        int off = AvARRAY(ary) - AvALLOC(ary);
@@ -2538,7 +2538,6 @@ S_doeval(pTHX_ int gimme, OP** startop)
 {
     dSP;
     OP *saveop = PL_op;
-    HV *newstash;
     CV *caller;
     AV* comppadlist;
     I32 i;
@@ -2604,10 +2603,9 @@ S_doeval(pTHX_ int gimme, OP** startop)
 
     /* make sure we compile in the right package */
 
-    newstash = CopSTASH(PL_curcop);
-    if (PL_curstash != newstash) {
+    if (CopSTASH_ne(PL_curcop, PL_curstash)) {
        SAVESPTR(PL_curstash);
-       PL_curstash = newstash;
+       PL_curstash = CopSTASH(PL_curcop);
     }
     SAVESPTR(PL_beginav);
     PL_beginav = newAV();
@@ -2963,7 +2961,7 @@ PP(pp_require)
 
     /* Assume success here to prevent recursive requirement. */
     (void)hv_store(GvHVn(PL_incgv), name, strlen(name),
-                  newSVsv(CopFILESV(&PL_compiling)), 0 );
+                  newSVpv(CopFILE(&PL_compiling), 0), 0 );
 
     ENTER;
     SAVETMPS;

diff --git a/pp_sys.c b/pp_sys.c
index e4ec41e..b2495a0 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -475,7 +475,7 @@ PP(pp_die)
                HV *stash = SvSTASH(SvRV(error));
                GV *gv = gv_fetchmethod(stash, "PROPAGATE");
                if (gv) {
-                   SV *file = sv_2mortal(newSVsv(CopFILESV(PL_curcop)));
+                   SV *file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
                    SV *line = sv_2mortal(newSViv(CopLINE(PL_curcop)));
                    EXTEND(SP, 3);
                    PUSHMARK(SP);

diff --git a/sv.c b/sv.c
index 2c14064..475bd22 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2370,7 +2370,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
            sstr = SvRV(sstr);
            if (sstr == dstr) {
                if (GvIMPORTED(dstr) != GVf_IMPORTED
-                   && CopSTASH(PL_curcop) != GvSTASH(dstr))
+                   && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
                {
                    GvIMPORTED_on(dstr);
                }
@@ -2428,7 +2428,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
            GvGP(dstr) = gp_ref(GvGP(sstr));
            SvTAINT(dstr);
            if (GvIMPORTED(dstr) != GVf_IMPORTED
-               && CopSTASH(PL_curcop) != GvSTASH(dstr))
+               && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
            {
                GvIMPORTED_on(dstr);
            }
@@ -2463,7 +2463,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 
                if (intro) {
                    GP *gp;
-                   GvGP(dstr)->gp_refcnt--;
+                   gp_free((GV*)dstr);
                    GvINTRO_off(dstr);  /* one-shot flag */
                    Newz(602,gp, 1, GP);
                    GvGP(dstr) = gp_ref(gp);
@@ -2480,7 +2480,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
                        dref = (SV*)GvAV(dstr);
                    GvAV(dstr) = (AV*)sref;
                    if (GvIMPORTED_AV_off(dstr)
-                       && CopSTASH(PL_curcop) != GvSTASH(dstr))
+                       && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
                    {
                        GvIMPORTED_AV_on(dstr);
                    }
@@ -2492,7 +2492,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
                        dref = (SV*)GvHV(dstr);
                    GvHV(dstr) = (HV*)sref;
                    if (GvIMPORTED_HV_off(dstr)
-                       && CopSTASH(PL_curcop) != GvSTASH(dstr))
+                       && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
                    {
                        GvIMPORTED_HV_on(dstr);
                    }
@@ -2548,7 +2548,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
                        PL_sub_generation++;
                    }
                    if (GvIMPORTED_CV_off(dstr)
-                       && CopSTASH(PL_curcop) != GvSTASH(dstr))
+                       && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
                    {
                        GvIMPORTED_CV_on(dstr);
                    }
@@ -2567,7 +2567,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
                        dref = (SV*)GvSV(dstr);
                    GvSV(dstr) = sref;
                    if (GvIMPORTED_SV_off(dstr)
-                       && CopSTASH(PL_curcop) != GvSTASH(dstr))
+                       && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
                    {
                        GvIMPORTED_SV_on(dstr);
                    }
@@ -5674,18 +5674,18 @@ Perl_gp_dup(pTHX_ GP *gp)
     sv_table_store(PL_sv_table, (SV*)gp, (SV*)ret);
 
     /* clone */
+    ret->gp_refcnt     = 0;                    /* must be before any other dups! */
     ret->gp_sv         = sv_dup_inc(gp->gp_sv);
     ret->gp_io         = io_dup_inc(gp->gp_io);
     ret->gp_form       = cv_dup_inc(gp->gp_form);
     ret->gp_av         = av_dup_inc(gp->gp_av);
     ret->gp_hv         = hv_dup_inc(gp->gp_hv);
-    ret->gp_egv                = 0;
+    ret->gp_egv                = gv_dup(gp->gp_egv);   /* GvEGV is not refcounted */
     ret->gp_cv         = cv_dup_inc(gp->gp_cv);
     ret->gp_cvgen      = gp->gp_cvgen;
     ret->gp_flags      = gp->gp_flags;
     ret->gp_line       = gp->gp_line;
     ret->gp_file       = gp->gp_file;          /* points to COP.cop_file */
-    ret->gp_refcnt     = 0;
     return ret;
 }
 
@@ -5847,7 +5847,7 @@ Perl_sv_dup(pTHX_ SV *sstr)
     /* clone */
     SvFLAGS(dstr)      = SvFLAGS(sstr);
     SvFLAGS(dstr)      &= ~SVf_OOK;            /* don't propagate OOK hack */
-    SvREFCNT(dstr)     = 0;
+    SvREFCNT(dstr)     = 0;                    /* must be before any other dups! */
 
 #ifdef DEBUGGING
     if (SvANY(sstr) && PL_watch_pvx && SvPVX(sstr) == PL_watch_pvx)
@@ -5979,10 +5979,6 @@ Perl_sv_dup(pTHX_ SV *sstr)
        GvFLAGS(dstr)   = GvFLAGS(sstr);
        GvGP(dstr)      = gp_dup(GvGP(sstr));
        (void)GpREFCNT_inc(GvGP(dstr));
-       if (GvEGV(sstr) == (GV*)sstr)
-           GvEGV(dstr) = (GV*)dstr;
-       else
-           GvEGV(dstr) = gv_dup_inc(GvEGV(sstr));
        break;
     case SVt_PVIO:
        SvANY(dstr)     = new_XPVIO();
@@ -6032,11 +6028,11 @@ Perl_sv_dup(pTHX_ SV *sstr)
        SvSTASH(dstr)   = hv_dup_inc(SvSTASH(sstr));
        AvARYLEN((AV*)dstr) = sv_dup_inc(AvARYLEN((AV*)sstr));
        AvFLAGS((AV*)dstr) = AvFLAGS((AV*)sstr);
-       if (AvALLOC((AV*)sstr)) {
+       if (AvARRAY((AV*)sstr)) {
            SV **dst_ary, **src_ary;
            SSize_t items = AvFILLp((AV*)sstr) + 1;
 
-           src_ary = AvALLOC((AV*)sstr);
+           src_ary = AvARRAY((AV*)sstr);
            Newz(0, dst_ary, AvMAX((AV*)sstr)+1, SV*);
            SvPVX(dstr) = (char*)dst_ary;
            AvALLOC((AV*)dstr) = dst_ary;
@@ -6105,6 +6101,7 @@ Perl_sv_dup(pTHX_ SV *sstr)
        break;
     case SVt_PVFM:
        SvANY(dstr)     = new_XPVFM();
+       FmLINES(dstr)   = FmLINES(sstr);
        goto dup_pvcv;
        /* NOTREACHED */
     case SVt_PVCV:
@@ -6144,7 +6141,7 @@ dup_pvcv:
        break;
     }
 
-    if (SvOBJECT(dstr))
+    if (SvOBJECT(dstr) && SvTYPE(dstr) != SVt_PVIO)
        ++PL_sv_objcount;
 
     return dstr;

diff --git a/toke.c b/toke.c
index a33f3b7..4053c81 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -3729,7 +3729,7 @@ Perl_yylex(pTHX)
 
        case KEY___FILE__:
            yylval.opval = (OP*)newSVOP(OP_CONST, 0,
-                                       newSVsv(CopFILESV(PL_curcop)));
+                                       newSVpv(CopFILE(PL_curcop),0));
            TERM(THING);
 
        case KEY___LINE__:
@@ -6989,8 +6989,8 @@ Perl_yyerror(pTHX_ char *s)
        where = SvPVX(where_sv);
     }
     msg = sv_2mortal(newSVpv(s, 0));
-    Perl_sv_catpvf(aTHX_ msg, " at %_ line %"IVdf", ",
-                  CopFILESV(PL_curcop), (IV)CopLINE(PL_curcop));
+    Perl_sv_catpvf(aTHX_ msg, " at %s line %"IVdf", ",
+                  CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
     if (context)
        Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context);
     else
@@ -7006,7 +7006,7 @@ Perl_yyerror(pTHX_ char *s)
     else
        qerror(msg);
     if (PL_error_count >= 10)
-       Perl_croak(aTHX_ "%_ has too many errors.\n", CopFILESV(PL_curcop));
+       Perl_croak(aTHX_ "%s has too many errors.\n", CopFILE(PL_curcop));
     PL_in_my = 0;
     PL_in_my_stash = Nullhv;
     return 0;

diff --git a/util.c b/util.c
index 650fc31..e131a5b 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1420,8 +1420,8 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
     if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
        dTHR;
        if (CopLINE(PL_curcop))
-           Perl_sv_catpvf(aTHX_ sv, " at %_ line %"IVdf,
-                          CopFILESV(PL_curcop), (IV)CopLINE(PL_curcop));
+           Perl_sv_catpvf(aTHX_ sv, " at %s line %"IVdf,
+                          CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
        if (GvIO(PL_last_in_gv) && IoLINES(GvIOp(PL_last_in_gv))) {
            bool line_mode = (RsSIMPLE(PL_rs) &&
                              SvCUR(PL_rs) == 1 && *SvPVX(PL_rs) == '\n');

diff --git a/win32/perllib.c b/win32/perllib.c
index 22ac61d..2b4d778 100644 (file)
--- a/win32/perllib.c
+++ b/win32/perllib.c
@@ -549,7 +549,7 @@ PerlLIOIsatty(struct IPerlLIO *I, int fd)
 }
 
 int
-PerlLIOLink(struct IPerlLIO*, const char*oldname, const char *newname)
+PerlLIOLink(struct IPerlLIO *I, const char*oldname, const char *newname)
 {
     return win32_link(oldname, newname);
 }
@@ -1527,7 +1527,7 @@ EXTERN_C DllExport int
 RunPerl(int argc, char **argv, char **env)
 {
     int exitstatus;
-    PerlInterpreter *my_perl;
+    PerlInterpreter *my_perl, *new_perl = NULL;
     struct perl_thread *thr;
 
 #ifndef __BORLANDC__
@@ -1564,12 +1564,11 @@ RunPerl(int argc, char **argv, char **env)
     exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
     if (!exitstatus) {
 #ifdef USE_ITHREADS            /* XXXXXX testing */
-extern PerlInterpreter * perl_clone(pTHXx_ IV flags);
+       extern PerlInterpreter * perl_clone(pTHXx_ IV flags);
 
-       PerlInterpreter *new_perl = perl_clone(my_perl, 0);
+       new_perl = perl_clone(my_perl, 0);
        Perl_push_scope(new_perl); /* ENTER; (hack in lieu of perl_destruct()) */
        exitstatus = perl_run( new_perl );
-       perl_destruct(new_perl); perl_free(new_perl);
        SetPerlInterpreter(my_perl);
 #else
        exitstatus = perl_run( my_perl );
@@ -1578,6 +1577,13 @@ extern PerlInterpreter * perl_clone(pTHXx_ IV flags);
 
     perl_destruct( my_perl );
     perl_free( my_perl );
+#ifdef USE_ITHREADS
+    if (new_perl) {
+       SetPerlInterpreter(new_perl);
+       perl_destruct(new_perl);
+       perl_free(new_perl);
+    }
+#endif
 
     PERL_SYS_TERM();