GvFILE() cannot be a pointer to the memory owned by the COP, because

COPs created by use can be freed along this memory, but the GP
remains. Given that several GVs may refer to the same file, use a
shared string rather than an individual allocation per GP.

p4raw-id: //depot/perl@28060

6 files changed, 35 insertions, 6 deletions

diff --git a/bytecode.pl b/bytecode.pl
index 4da765a86f..06269e4edb 100644
--- a/bytecode.pl
+++ b/bytecode.pl
@@ -448,7 +448,7 @@ gp_refcnt_add	GvREFCNT(bstate->bs_sv)			I32		x
 gp_av		*(SV**)&GvAV(bstate->bs_sv)		svindex
 gp_hv		*(SV**)&GvHV(bstate->bs_sv)		svindex
 gp_cv		*(SV**)&GvCV(bstate->bs_sv)		svindex
-gp_file		GvFILE(bstate->bs_sv)			pvindex
+gp_file		bstate->bs_sv				pvindex		x
 gp_io		*(SV**)&GvIOp(bstate->bs_sv)		svindex
 gp_form		*(SV**)&GvFORM(bstate->bs_sv)		svindex
 gp_cvgen	GvCVGEN(bstate->bs_sv)			U32
diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h
index 50198ece82..9df93ffd76 100644
--- a/ext/ByteLoader/bytecode.h
+++ b/ext/ByteLoader/bytecode.h
@@ -376,6 +376,17 @@ typedef char *pvindex;
 		SvREFCNT_dec(w);					\
 	    }								\
 	} STMT_END
+#define BSET_gp_file(gv, file) \
+	STMT_START {							\
+	    STRLEN len = strlen(file);					\
+	    U32 hash;							\
+	    PERL_HASH(hash, file, len);					\
+	    if(GvFILE_HEK(gv)) {					\
+		Perl_unshare_hek(aTHX_ GvFILE_HEK(gv));			\
+	    }								\
+	    GvGP(gv)->gp_file_hek = share_hek(file, len, hash);		\
+	    Safefree(file);						\
+	} STMT_END
 
 /* NOTE: the bytecode header only sanity-checks the bytecode. If a script cares about
  * what version of Perl it's being called under, it should do a 'use 5.006_001' or
diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c
index 77568ba2c6..3738ad5bdd 100644
--- a/ext/ByteLoader/byterun.c
+++ b/ext/ByteLoader/byterun.c
@@ -658,7 +658,7 @@ byterun(pTHX_ register struct byteloader_state *bstate)
 	    {
 		pvindex arg;
 		BGET_pvindex(arg);
-		GvFILE(bstate->bs_sv) = arg;
+		BSET_gp_file(bstate->bs_sv, arg);
 		break;
 	    }
 	  case INSN_GP_IO:		/* 86 */
diff --git a/gv.c b/gv.c
index b57060ca5c..f01212989b 100644
--- a/gv.c
+++ b/gv.c
@@ -161,6 +161,12 @@ GP *
 Perl_newGP(pTHX_ GV *const gv)
 {
     GP *gp;
+    const char *const file = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : "";
+    STRLEN len = strlen(file);
+    U32 hash;
+
+    PERL_HASH(hash, file, len);
+
     Newxz(gp, 1, GP);
 
 #ifndef PERL_DONT_CREATE_GVSV
@@ -170,7 +176,7 @@ Perl_newGP(pTHX_ GV *const gv)
     gp->gp_line = CopLINE(PL_curcop);
     /* XXX Ideally this cast would be replaced with a change to const char*
        in the struct.  */
-    gp->gp_file = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : (char *) "";
+    gp->gp_file_hek = share_hek(file, len, hash);
     gp->gp_egv = gv;
     gp->gp_refcnt = 1;
 
@@ -1416,6 +1422,7 @@ Perl_gp_free(pTHX_ GV *gv)
         return;
     }
 
+    unshare_hek(gp->gp_file_hek);
     SvREFCNT_dec(gp->gp_sv);
     SvREFCNT_dec(gp->gp_av);
     /* FIXME - another reference loop GV -> symtab -> GV ?
diff --git a/gv.h b/gv.h
index 269843fe65..25961efd87 100644
--- a/gv.h
+++ b/gv.h
@@ -19,7 +19,7 @@ struct gp {
     CV *	gp_cv;		/* subroutine value */
     U32		gp_cvgen;	/* generational validity of cached gv_cv */
     line_t	gp_line;	/* line first declared at (for -w) */
-    char *	gp_file;	/* file first declared in (for -w) */
+    HEK *	gp_file_hek;	/* file first declared in (for -w) */
 };
 
 #define GvXPVGV(gv)	((XPVGV*)SvANY(gv))
@@ -111,7 +111,8 @@ Return the SV from the GV.
 #define GvCVu(gv)	(GvGP(gv)->gp_cvgen ? NULL : GvGP(gv)->gp_cv)
 
 #define GvLINE(gv)	(GvGP(gv)->gp_line)
-#define GvFILE(gv)	(GvGP(gv)->gp_file)
+#define GvFILE_HEK(gv)	(GvGP(gv)->gp_file_hek)
+#define GvFILE(gv)	HEK_KEY(GvFILE_HEK(gv))
 #define GvFILEGV(gv)	(gv_fetchfile(GvFILE(gv)))
 
 #define GvEGV(gv)	(GvGP(gv)->gp_egv)
@@ -208,3 +209,13 @@ Return the SV from the GV.
 #define gv_fullname3(sv,gv,prefix) gv_fullname4(sv,gv,prefix,TRUE)
 #define gv_efullname3(sv,gv,prefix) gv_efullname4(sv,gv,prefix,TRUE)
 #define gv_fetchmethod(stash, name) gv_fetchmethod_autoload(stash, name, TRUE)
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
diff --git a/sv.c b/sv.c
index e350adebe0..70a5110fbf 100644
--- a/sv.c
+++ b/sv.c
@@ -9645,7 +9645,7 @@ Perl_gp_dup(pTHX_ GP *gp, CLONE_PARAMS* param)
     ret->gp_cv		= cv_dup_inc(gp->gp_cv, param);
     ret->gp_cvgen	= gp->gp_cvgen;
     ret->gp_line	= gp->gp_line;
-    ret->gp_file	= gp->gp_file;		/* points to COP.cop_file */
+    ret->gp_file_hek	= hek_dup(gp->gp_file_hek, param);
     return ret;
 }