Integrate with Sarathy.

p4raw-id: //depot/cfgperl@4582

16 files changed, 95 insertions, 65 deletions

diff --git a/cop.h b/cop.h
index d5f7f423a6..af29ff6678 100644
--- 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 f08f765cbd..38778d6eed 100644
--- 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 9b6e016bb8..63ff8aa711 100644
--- 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 25e5b3677a..f6c9744847 100644
--- 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 282027a7dd..775b03a3d0 100644
--- 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 5eb83387dc..093ac2fab1 100644
--- 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/perly.c b/perly.c
index f9734b3631..2e47b11aba 100644
--- a/perly.c
+++ b/perly.c
@@ -1826,7 +1826,7 @@ case 59:
 #line 338 "perly.y"
 { STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv,n_a);
 			  if (strEQ(name, "BEGIN") || strEQ(name, "END")
-			      || strEQ(name, "INIT"))
+			      || strEQ(name, "STOP") || strEQ(name, "INIT"))
 			      CvSPECIAL_on(PL_compcv);
 			  yyval.opval = yyvsp[0].opval; }
 break;
diff --git a/perly.y b/perly.y
index c8163e135e..b238276229 100644
--- a/perly.y
+++ b/perly.y
@@ -337,7 +337,7 @@ startformsub:	/* NULL */	/* start a format subroutine scope */
 
 subname	:	WORD	{ STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv,n_a);
 			  if (strEQ(name, "BEGIN") || strEQ(name, "END")
-			      || strEQ(name, "INIT"))
+			      || strEQ(name, "STOP") || strEQ(name, "INIT"))
 			      CvSPECIAL_on(PL_compcv);
 			  $$ = $1; }
 	;
diff --git a/pp_ctl.c b/pp_ctl.c
index 22c83aa8d0..bc2a361267 100644
--- 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 e4ec41ef03..b2495a06dc 100644
--- 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 2c140648d5..475bd22548 100644
--- 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/t/op/misc.t b/t/op/misc.t
index adfcd174fc..ab849777da 100755
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -353,16 +353,18 @@ Unmatched right curly bracket at (re_eval 1) line 1, at end of line
 syntax error at (re_eval 1) line 1, near ""{"}"
 Compilation failed in regexp at - line 1.
 ########
-BEGIN { @ARGV = qw(a b c) }
+BEGIN { @ARGV = qw(a b c d e) }
 BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" }
 END { print "end <",shift,">\nargv <@ARGV>\n" }
 INIT { print "init <",shift,">\n" }
+STOP { print "stop <",shift,">\n" }
 EXPECT
-argv <a b c>
+argv <a b c d e>
 begin <a>
-init <b>
-end <c>
-argv <>
+stop <b>
+init <c>
+end <d>
+argv <e>
 ########
 -l
 # fdopen from a system descriptor to a system descriptor used to close
diff --git a/toke.c b/toke.c
index a33f3b727d..4053c81378 100644
--- 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 650fc3155c..e131a5bf77 100644
--- 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/vms/perly_c.vms b/vms/perly_c.vms
index 4787247429..ebc7d57cc3 100644
--- a/vms/perly_c.vms
+++ b/vms/perly_c.vms
@@ -1828,7 +1828,7 @@ case 59:
 #line 338 "perly.y"
 { STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv,n_a);
 			  if (strEQ(name, "BEGIN") || strEQ(name, "END")
-			      || strEQ(name, "INIT"))
+			      || strEQ(name, "STOP") || strEQ(name, "INIT"))
 			      CvSPECIAL_on(PL_compcv);
 			  yyval.opval = yyvsp[0].opval; }
 break;
diff --git a/win32/perllib.c b/win32/perllib.c
index 22ac61d489..2b4d778914 100644
--- 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();