This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
GvFILE() cannot be a pointer to the memory owned by the COP, because
authorNicholas Clark <nick@ccl4.org>
Tue, 2 May 2006 12:41:43 +0000 (12:41 +0000)
committerNicholas Clark <nick@ccl4.org>
Tue, 2 May 2006 12:41:43 +0000 (12:41 +0000)
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

bytecode.pl
ext/ByteLoader/bytecode.h
ext/ByteLoader/byterun.c
gv.c
gv.h
sv.c

index 4da765a..06269e4 100644 (file)
@@ -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
index 50198ec..9df93ff 100644 (file)
@@ -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
index 77568ba..3738ad5 100644 (file)
@@ -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;
 }