fix small eval"" memory leaks under USE_ITHREADS

p4raw-id: //depot/perl@6194

16 files changed, 125 insertions, 40 deletions

diff --git a/cop.h b/cop.h
index 3b3c3edbdb..d6fdd23ab2 100644
--- a/cop.h
+++ b/cop.h
@@ -29,32 +29,33 @@ struct cop {
 #  define CopFILE(c)		((c)->cop_file)
 #  define CopFILEGV(c)		(CopFILE(c) \
 				 ? gv_fetchfile(CopFILE(c)) : Nullgv)
-#  define CopFILE_set(c,pv)	((c)->cop_file = savepv(pv))	/* XXX */
+#  define CopFILE_set(c,pv)	((c)->cop_file = savepv(pv))
 #  define CopFILESV(c)		(CopFILE(c) \
 				 ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
 #  define CopFILEAV(c)		(CopFILE(c) \
 				 ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
 #  define CopSTASHPV(c)		((c)->cop_stashpv)
-#  define CopSTASHPV_set(c,pv)	((c)->cop_stashpv = savepv(pv))	/* XXX */
+#  define CopSTASHPV_set(c,pv)	((c)->cop_stashpv = savepv(pv))
 #  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 					\
+#  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)
-#  define CopFILE_set(c,pv)	((c)->cop_filegv = gv_fetchfile(pv))
+#  define CopFILEGV_set(c,gv)	((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
+#  define CopFILE_set(c,pv)	CopFILEGV_set((c), gv_fetchfile(pv))
 #  define CopFILESV(c)		(CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
 #  define CopFILEAV(c)		(CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
 #  define CopFILE(c)		(CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
 #  define CopSTASH(c)		((c)->cop_stash)
-#  define CopSTASH_set(c,hv)	((c)->cop_stash = hv)
+#  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)
+   /* cop_stash is not refcounted */
+#  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))
diff --git a/embed.h b/embed.h
index 76ff0dc9e6..33ef720e9d 100644
--- a/embed.h
+++ b/embed.h
@@ -571,6 +571,7 @@
 #define save_freeop		Perl_save_freeop
 #define save_freepv		Perl_save_freepv
 #define save_generic_svref	Perl_save_generic_svref
+#define save_generic_pvref	Perl_save_generic_pvref
 #define save_gp			Perl_save_gp
 #define save_hash		Perl_save_hash
 #define save_helem		Perl_save_helem
@@ -2019,6 +2020,7 @@
 #define save_freeop(a)		Perl_save_freeop(aTHX_ a)
 #define save_freepv(a)		Perl_save_freepv(aTHX_ a)
 #define save_generic_svref(a)	Perl_save_generic_svref(aTHX_ a)
+#define save_generic_pvref(a)	Perl_save_generic_pvref(aTHX_ a)
 #define save_gp(a,b)		Perl_save_gp(aTHX_ a,b)
 #define save_hash(a)		Perl_save_hash(aTHX_ a)
 #define save_helem(a,b,c)	Perl_save_helem(aTHX_ a,b,c)
@@ -3954,6 +3956,8 @@
 #define save_freepv		Perl_save_freepv
 #define Perl_save_generic_svref	CPerlObj::Perl_save_generic_svref
 #define save_generic_svref	Perl_save_generic_svref
+#define Perl_save_generic_pvref	CPerlObj::Perl_save_generic_pvref
+#define save_generic_pvref	Perl_save_generic_pvref
 #define Perl_save_gp		CPerlObj::Perl_save_gp
 #define save_gp			Perl_save_gp
 #define Perl_save_hash		CPerlObj::Perl_save_hash
diff --git a/embed.pl b/embed.pl
index 43dbde5924..8a89103380 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1886,6 +1886,7 @@ Ap	|void	|save_freesv	|SV* sv
 p	|void	|save_freeop	|OP* o
 Ap	|void	|save_freepv	|char* pv
 Ap	|void	|save_generic_svref|SV** sptr
+Ap	|void	|save_generic_pvref|char** str
 Ap	|void	|save_gp	|GV* gv|I32 empty
 Ap	|HV*	|save_hash	|GV* gv
 Ap	|void	|save_helem	|HV* hv|SV *key|SV **sptr
diff --git a/objXSUB.h b/objXSUB.h
index 97e9ba4098..25536e902f 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -1345,6 +1345,10 @@
 #define Perl_save_generic_svref	pPerl->Perl_save_generic_svref
 #undef  save_generic_svref
 #define save_generic_svref	Perl_save_generic_svref
+#undef  Perl_save_generic_pvref
+#define Perl_save_generic_pvref	pPerl->Perl_save_generic_pvref
+#undef  save_generic_pvref
+#define save_generic_pvref	Perl_save_generic_pvref
 #undef  Perl_save_gp
 #define Perl_save_gp		pPerl->Perl_save_gp
 #undef  save_gp
diff --git a/op.c b/op.c
index 57b35ea733..affb5974f2 100644
--- a/op.c
+++ b/op.c
@@ -844,8 +844,8 @@ S_cop_free(pTHX_ COP* cop)
 {
     Safefree(cop->cop_label);
 #ifdef USE_ITHREADS
-    Safefree(CopFILE(cop));		/* XXXXX share in a pvtable? */
-    Safefree(CopSTASHPV(cop));		/* XXXXX share in a pvtable? */
+    Safefree(CopFILE(cop));		/* XXX share in a pvtable? */
+    Safefree(CopSTASHPV(cop));		/* XXX share in a pvtable? */
 #else
     /* NOTE: COP.cop_stash is not refcounted */
     SvREFCNT_dec(CopFILEGV(cop));
@@ -3499,9 +3499,9 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
         PL_copline = NOLINE;
     }
 #ifdef USE_ITHREADS
-    CopFILE_set(cop, CopFILE(PL_curcop));	/* XXXXX share in a pvtable? */
+    CopFILE_set(cop, CopFILE(PL_curcop));	/* XXX share in a pvtable? */
 #else
-    CopFILEGV_set(cop, (GV*)SvREFCNT_inc(CopFILEGV(PL_curcop)));
+    CopFILEGV_set(cop, CopFILEGV(PL_curcop));
 #endif
     CopSTASH_set(cop, PL_curstash);
 
@@ -4709,10 +4709,11 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
     dTHR;
 
     ENTER;
-    SAVECOPLINE(PL_curcop);
-    SAVEHINTS();
 
+    SAVECOPLINE(PL_curcop);
     CopLINE_set(PL_curcop, PL_copline);
+
+    SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
 
     if (stash) {
diff --git a/perl.c b/perl.c
index 5df462db9d..801dbe15f2 100644
--- a/perl.c
+++ b/perl.c
@@ -600,9 +600,14 @@ perl_destruct(pTHXx)
     if (!specialWARN(PL_compiling.cop_warnings))
 	SvREFCNT_dec(PL_compiling.cop_warnings);
     PL_compiling.cop_warnings = Nullsv;
-#ifndef USE_ITHREADS
+#ifdef USE_ITHREADS
+    Safefree(CopFILE(&PL_compiling));
+    CopFILE(&PL_compiling) = Nullch;
+    Safefree(CopSTASHPV(&PL_compiling));
+#else
     SvREFCNT_dec(CopFILEGV(&PL_compiling));
-    CopFILEGV_set(&PL_compiling, Nullgv);
+    CopFILEGV(&PL_compiling) = Nullgv;
+    /* cop_stash is not refcounted */
 #endif
 
     /* Prepare to destruct main symbol table.  */
@@ -2511,6 +2516,11 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
 	}
     }
 
+#ifdef USE_ITHREADS
+    Safefree(CopFILE(PL_curcop));
+#else
+    SvREFCNT_dec(CopFILEGV(PL_curcop));
+#endif
     CopFILE_set(PL_curcop, PL_origfilename);
     if (strEQ(PL_origfilename,"-"))
 	scriptname = "";
diff --git a/perlapi.c b/perlapi.c
index 125c6e1003..10a7a37c40 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -2458,6 +2458,13 @@ Perl_save_generic_svref(pTHXo_ SV** sptr)
     ((CPerlObj*)pPerl)->Perl_save_generic_svref(sptr);
 }
 
+#undef  Perl_save_generic_pvref
+void
+Perl_save_generic_pvref(pTHXo_ char** str)
+{
+    ((CPerlObj*)pPerl)->Perl_save_generic_pvref(str);
+}
+
 #undef  Perl_save_gp
 void
 Perl_save_gp(pTHXo_ GV* gv, I32 empty)
diff --git a/perly.c b/perly.c
index 36b51c02e7..d03d3dee98 100644
--- a/perly.c
+++ b/perly.c
@@ -1386,6 +1386,9 @@ yyparse()
 #endif
 
     struct ysv *ysave;
+#ifdef USE_ITHREADS
+    ENTER;			/* force yydestruct() before we return */
+#endif
     New(73, ysave, 1, struct ysv);
     SAVEDESTRUCTOR_X(yydestruct, ysave);
     ysave->oldyydebug	= yydebug;
@@ -2477,6 +2480,9 @@ yyoverflow:
 yyabort:
     retval = 1;
 yyaccept:
+#ifdef USE_ITHREADS
+    LEAVE;			/* force yydestruct() before we return */
+#endif
     return retval;
 }
 
diff --git a/perly_c.diff b/perly_c.diff
index 0b73880c4e..0cfe10f8d7 100644
--- a/perly_c.diff
+++ b/perly_c.diff
@@ -12,7 +12,7 @@
       if (yys = getenv("YYDEBUG"))
       {
           yyn = *yys;
---- 1447,1473 ----
+--- 1447,1476 ----
   yyparse()
   {
       register int yym, yyn, yystate;
@@ -27,6 +27,9 @@
 ! #endif
   
 +     struct ysv *ysave;
++ #ifdef USE_ITHREADS
++     ENTER;			/* force yydestruct() before we return */
++ #endif
 +     New(73, ysave, 1, struct ysv);
 +     SAVEDESTRUCTOR_X(yydestruct, ysave);
 +     ysave->oldyydebug	= yydebug;
@@ -42,7 +45,7 @@
           yyn = *yys;
 ***************
 *** 1463,1468 ****
---- 1480,1495 ----
+--- 1483,1498 ----
       yyerrflag = 0;
       yychar = (-1);
   
@@ -68,7 +71,7 @@
           }
           *++yyssp = yystate = yytable[yyn];
           *++yyvsp = yylval;
---- 1520,1538 ----
+--- 1523,1541 ----
   #endif
           if (yyssp >= yyss + yystacksize - 1)
           {
@@ -97,7 +100,7 @@
                   }
                   *++yyssp = yystate = yytable[yyn];
                   *++yyvsp = yylval;
---- 1573,1591 ----
+--- 1576,1594 ----
   #endif
                   if (yyssp >= yyss + yystacksize - 1)
                   {
@@ -134,7 +137,7 @@
   yyaccept:
 !     return (0);
   }
---- 2524,2569 ----
+--- 2527,2575 ----
   #endif
       if (yyssp >= yyss + yystacksize - 1)
       {
@@ -160,6 +163,9 @@
   yyabort:
 !     retval = 1;
   yyaccept:
+! #ifdef USE_ITHREADS
+!     LEAVE;			/* force yydestruct() before we return */
+! #endif
 !     return retval;
 ! }
 ! 
diff --git a/pp_ctl.c b/pp_ctl.c
index 2060632d55..801f3f1ff1 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2634,11 +2634,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
     /* switch to eval mode */
 
     if (PL_curcop == &PL_compiling) {
-	SAVECOPSTASH(&PL_compiling);
+	SAVECOPSTASH_FREE(&PL_compiling);
 	CopSTASH_set(&PL_compiling, PL_curstash);
     }
-    SAVECOPFILE(&PL_compiling);
-    SAVECOPLINE(&PL_compiling);
     if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {
 	SV *sv = sv_newmortal();
 	Perl_sv_setpvf(aTHX_ sv, "_<(%.10seval %lu)[%s:%"IVdf"]",
@@ -2648,7 +2646,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
     }
     else
 	sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq);
+    SAVECOPFILE_FREE(&PL_compiling);
     CopFILE_set(&PL_compiling, tmpbuf+2);
+    SAVECOPLINE(&PL_compiling);
     CopLINE_set(&PL_compiling, 1);
     /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
        deleting the eval's FILEGV from the stash before gv_check() runs
@@ -3160,7 +3160,7 @@ trylocal: {
 	    }
 	}
     }
-    SAVECOPFILE(&PL_compiling);
+    SAVECOPFILE_FREE(&PL_compiling);
     CopFILE_set(&PL_compiling, tryrsfp ? tryname : name);
     SvREFCNT_dec(namesv);
     if (!tryrsfp) {
@@ -3270,7 +3270,6 @@ PP(pp_entereval)
  
     /* switch to eval mode */
 
-    SAVECOPFILE(&PL_compiling);
     if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {
 	SV *sv = sv_newmortal();
 	Perl_sv_setpvf(aTHX_ sv, "_<(eval %lu)[%s:%"IVdf"]",
@@ -3280,7 +3279,9 @@ PP(pp_entereval)
     }
     else
 	sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
+    SAVECOPFILE_FREE(&PL_compiling);
     CopFILE_set(&PL_compiling, tmpbuf+2);
+    SAVECOPLINE(&PL_compiling);
     CopLINE_set(&PL_compiling, 1);
     /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
        deleting the eval's FILEGV from the stash before gv_check() runs
diff --git a/proto.h b/proto.h
index eb861e1442..28c9581241 100644
--- a/proto.h
+++ b/proto.h
@@ -651,6 +651,7 @@ PERL_CALLCONV void	Perl_save_freesv(pTHX_ SV* sv);
 PERL_CALLCONV void	Perl_save_freeop(pTHX_ OP* o);
 PERL_CALLCONV void	Perl_save_freepv(pTHX_ char* pv);
 PERL_CALLCONV void	Perl_save_generic_svref(pTHX_ SV** sptr);
+PERL_CALLCONV void	Perl_save_generic_pvref(pTHX_ char** str);
 PERL_CALLCONV void	Perl_save_gp(pTHX_ GV* gv, I32 empty);
 PERL_CALLCONV HV*	Perl_save_hash(pTHX_ GV* gv);
 PERL_CALLCONV void	Perl_save_helem(pTHX_ HV* hv, SV *key, SV **sptr);
diff --git a/scope.c b/scope.c
index 3b9f0d108a..0544b893d5 100644
--- a/scope.c
+++ b/scope.c
@@ -249,7 +249,7 @@ Perl_save_svref(pTHX_ SV **sptr)
     return save_scalar_at(sptr);
 }
 
-/* Like save_svref(), but doesn't deal with magic.  Can be used to
+/* Like save_sptr(), but also SvREFCNT_dec()s the new value.  Can be used to
  * restore a global SV to its prior contents, freeing new value. */
 void
 Perl_save_generic_svref(pTHX_ SV **sptr)
@@ -261,6 +261,19 @@ Perl_save_generic_svref(pTHX_ SV **sptr)
     SSPUSHINT(SAVEt_GENERIC_SVREF);
 }
 
+/* Like save_pptr(), but also Safefree()s the new value if it is different
+ * from the old one.  Can be used to restore a global char* to its prior
+ * contents, freeing new value. */
+void
+Perl_save_generic_pvref(pTHX_ char **str)
+{
+    dTHR;
+    SSCHECK(3);
+    SSPUSHPTR(str);
+    SSPUSHPTR(*str);
+    SSPUSHINT(SAVEt_GENERIC_PVREF);
+}
+
 void
 Perl_save_gp(pTHX_ GV *gv, I32 empty)
 {
@@ -646,6 +659,7 @@ Perl_leave_scope(pTHX_ I32 base)
     register AV *av;
     register HV *hv;
     register void* ptr;
+    register char* str;
     I32 i;
 
     if (base < -1)
@@ -666,14 +680,20 @@ Perl_leave_scope(pTHX_ I32 base)
 	    ptr = &GvSV(gv);
 	    SvREFCNT_dec(gv);
 	    goto restore_sv;
+        case SAVEt_GENERIC_PVREF:		/* generic pv */
+	    str = (char*)SSPOPPTR;
+	    ptr = SSPOPPTR;
+	    if (*(char**)ptr != str) {
+		Safefree(*(char**)ptr);
+		*(char**)ptr = str;
+	    }
+	    break;
         case SAVEt_GENERIC_SVREF:		/* generic sv */
 	    value = (SV*)SSPOPPTR;
 	    ptr = SSPOPPTR;
-	    if (ptr) {
-		sv = *(SV**)ptr;
-		*(SV**)ptr = value;
-		SvREFCNT_dec(sv);
-	    }
+	    sv = *(SV**)ptr;
+	    *(SV**)ptr = value;
+	    SvREFCNT_dec(sv);
 	    SvREFCNT_dec(value);
 	    break;
         case SAVEt_SVREF:			/* scalar reference */
diff --git a/scope.h b/scope.h
index f33154abed..e6a4209bd7 100644
--- a/scope.h
+++ b/scope.h
@@ -32,6 +32,7 @@
 #define SAVEt_VPTR		31
 #define SAVEt_I8		32
 #define SAVEt_COMPPAD		33
+#define SAVEt_GENERIC_PVREF	34
 
 #define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow()
 #define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i))
@@ -105,6 +106,7 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 #define SAVEFREEPV(p)	save_freepv(SOFT_CAST(char*)(p))
 #define SAVECLEARSV(sv)	save_clearsv(SOFT_CAST(SV**)&(sv))
 #define SAVEGENERICSV(s)	save_generic_svref((SV**)&(s))
+#define SAVEGENERICPV(s)	save_generic_pvref((char**)&(s))
 #define SAVEDELETE(h,k,l) \
 	  save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l))
 #define SAVEDESTRUCTOR(f,p) \
@@ -147,14 +149,18 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
     } STMT_END
 
 #ifdef USE_ITHREADS
-#  define SAVECOPSTASH(cop)	SAVEPPTR(CopSTASHPV(cop))
-#  define SAVECOPFILE(cop)	SAVEPPTR(CopFILE(cop))
+#  define SAVECOPSTASH(c)	SAVEPPTR(CopSTASHPV(c))
+#  define SAVECOPSTASH_FREE(c)	SAVEGENERICPV(CopSTASHPV(c))
+#  define SAVECOPFILE(c)	SAVEPPTR(CopFILE(c))
+#  define SAVECOPFILE_FREE(c)	SAVEGENERICPV(CopFILE(c))
 #else
-#  define SAVECOPSTASH(cop)	SAVESPTR(CopSTASH(cop))
-#  define SAVECOPFILE(cop)	SAVESPTR(CopFILEGV(cop))
+#  define SAVECOPSTASH(c)	SAVESPTR(CopSTASH(c))
+#  define SAVECOPSTASH_FREE(c)	SAVECOPSTASH(c)	/* XXX not refcounted */
+#  define SAVECOPFILE(c)	SAVESPTR(CopFILEGV(c))
+#  define SAVECOPFILE_FREE(c)	SAVEGENERICSV(CopFILEGV(c))
 #endif
 
-#define SAVECOPLINE(cop)	SAVEI16(CopLINE(cop))
+#define SAVECOPLINE(c)		SAVEI16(CopLINE(c))
 
 /* SSNEW() temporarily allocates a specified number of bytes of data on the
  * savestack.  It returns an integer index into the savestack, because a
diff --git a/sv.c b/sv.c
index 5517355de0..3254cfba3e 100644
--- a/sv.c
+++ b/sv.c
@@ -7152,6 +7152,12 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
 	    gv = (GV*)POPPTR(ss,ix);
 	    TOPPTR(nss,ix) = gv_dup_inc(gv);
 	    break;
+	case SAVEt_GENERIC_PVREF:		/* generic char* */
+	    c = (char*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = pv_dup(c);
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+	    break;
         case SAVEt_GENERIC_SVREF:		/* generic sv */
         case SAVEt_SVREF:			/* scalar reference */
 	    sv = (SV*)POPPTR(ss,ix);
diff --git a/toke.c b/toke.c
index 99c993e8fa..70a7f537c0 100644
--- a/toke.c
+++ b/toke.c
@@ -502,8 +502,14 @@ S_incline(pTHX_ char *s)
 
     ch = *t;
     *t = '\0';
-    if (t - s > 0)
+    if (t - s > 0) {
+#ifdef USE_ITHREADS
+	Safefree(CopFILE(PL_curcop));
+#else
+	SvREFCNT_dec(CopFILEGV(PL_curcop));
+#endif
 	CopFILE_set(PL_curcop, s);
+    }
     *t = ch;
     CopLINE_set(PL_curcop, atoi(n)-1);
 }
@@ -2946,8 +2952,7 @@ Perl_yylex(pTHX)
 	    PL_expect = XTERM;
 	TOKEN('(');
     case ';':
-	if (CopLINE(PL_curcop) < PL_copline)
-	    PL_copline = CopLINE(PL_curcop);
+	CLINE;
 	tmp = *s++;
 	OPERATOR(tmp);
     case ')':
diff --git a/vms/perly_c.vms b/vms/perly_c.vms
index b17faeade1..0676ebd249 100644
--- a/vms/perly_c.vms
+++ b/vms/perly_c.vms
@@ -1387,6 +1387,9 @@ yyparse()
 #endif
 
     struct ysv *ysave;
+#ifdef USE_ITHREADS
+    ENTER;			/* force yydestruct() before we return */
+#endif
     New(73, ysave, 1, struct ysv);
     SAVEDESTRUCTOR_X(yydestruct, ysave);
     ysave->oldyydebug	= yydebug;
@@ -2479,6 +2482,9 @@ yyoverflow:
 yyabort:
     retval = 1;
 yyaccept:
+#ifdef USE_ITHREADS
+    LEAVE;			/* force yydestruct() before we return */
+#endif
     return retval;
 }