From f4890806d306bfeee79f1864c882eb307b4f54fd Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Tue, 2 May 2006 12:41:43 +0000 Subject: [PATCH] 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 --- bytecode.pl | 2 +- ext/ByteLoader/bytecode.h | 11 +++++++++++ ext/ByteLoader/byterun.c | 2 +- gv.c | 9 ++++++++- gv.h | 15 +++++++++++++-- sv.c | 2 +- 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; } -- 2.34.1