From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 2 May 2006 12:41:43 +0000 (+0000)
Subject: GvFILE() cannot be a pointer to the memory owned by the COP, because
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f4890806d306bfeee79f1864c882eb307b4f54fd;p=p5sagit%2Fp5-mst-13.2.git

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
---

diff --git a/bytecode.pl b/bytecode.pl
index 4da765a..06269e4 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 50198ec..9df93ff 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 77568ba..3738ad5 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 b57060c..f012129 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 269843f..25961ef 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 e350ade..70a5110 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;
 }