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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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;
 }