[perl #117855] Store CopFILEGV in a pad under ithreads

This saves having to allocate a separate string buffer for every cop
(control op; every statement has one).

Under non-threaded builds, every cop has a pointer to the GV for that
source file, namely *{"_<filename"}.

Under threaded builds, the name of the GV used to be stored instead.

Now we store an offset into the per-interpreter PL_filegvpad, which
points to the GV.

This makes no significant speed difference, but it reduces mem-
ory usage.

diff --git a/MANIFEST b/MANIFEST
index 1b6f056..69683f4 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3868,7 +3868,7 @@ ext/XS-APItest/t/cleanup.t        test stack behaviour on unwinding
 ext/XS-APItest/t/clone-with-stack.t    test clone with CLONEf_COPY_STACKS works
 ext/XS-APItest/t/cophh.t       test COPHH API
 ext/XS-APItest/t/coplabel.t    test cop_*_label
-ext/XS-APItest/t/copstash.t    test alloccopstash
+ext/XS-APItest/t/cop.t         test other cop stuff
 ext/XS-APItest/t/copyhints.t   test hv_copy_hints_hv() API
 ext/XS-APItest/t/customop.t    XS::APItest: tests for custom ops
 ext/XS-APItest/t/eval-filter.t Simple source filter/eval test

diff --git a/cop.h b/cop.h
index e33dc15..cfa976f 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -389,7 +389,8 @@ struct cop {
 #ifdef USE_ITHREADS
     PADOFFSET  cop_stashoff;   /* offset into PL_stashpad, for the
                                   package the line was compiled in */
-    char *     cop_file;       /* file name the following line # is from */
+    PADOFFSET  cop_filegvoff;  /* PL_filegv offset, for the file name the
+                                  following line # is from */
 #else
     HV *       cop_stash;      /* package line was compiled in */
     GV *       cop_filegv;     /* file the following line # is from */
@@ -404,54 +405,32 @@ struct cop {
 };
 
 #ifdef USE_ITHREADS
-#  define CopFILE(c)           ((c)->cop_file)
-#  define CopFILEGV(c)         (CopFILE(c) \
-                                ? gv_fetchfile(CopFILE(c)) : NULL)
-                                
-#  ifdef NETWARE
-#    define CopFILE_set(c,pv)  ((c)->cop_file = savepv(pv))
-#    define CopFILE_setn(c,pv,l)  ((c)->cop_file = savepv((pv),(l)))
-#  else
-#    define CopFILE_set(c,pv)  ((c)->cop_file = savesharedpv(pv))
-#    define CopFILE_setn(c,pv,l)  ((c)->cop_file = savesharedpvn((pv),(l)))
-#  endif
-
-#  define CopFILESV(c)         (CopFILE(c) \
-                                ? GvSV(gv_fetchfile(CopFILE(c))) : NULL)
-#  define CopFILEAV(c)         (CopFILE(c) \
-                                ? GvAV(gv_fetchfile(CopFILE(c))) : NULL)
-#  define CopFILEAVx(c)                (assert_(CopFILE(c)) \
-                                  GvAV(gv_fetchfile(CopFILE(c))))
+#  define CopFILEGV(c)         PL_filegvpad[(c)->cop_filegvoff]
+#  define CopFILEGV_set(c,gv)  ((c)->cop_filegvoff = (gv) \
+                                ? allocfilegv((GV *)SvREFCNT_inc_NN(gv)) \
+                                : 0)
 
 #  define CopSTASH(c)           PL_stashpad[(c)->cop_stashoff]
 #  define CopSTASH_set(c,hv)   ((c)->cop_stashoff = (hv)               \
                                    ? alloccopstash(hv)                 \
                                    : 0)
-#  ifdef NETWARE
-#    define CopFILE_free(c) SAVECOPFILE_FREE(c)
-#  else
-#    define CopFILE_free(c)    (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = NULL))
-#  endif
+#  define CopFILE_free(c)      S_CopFILE_free(aTHX_ c)
 #else
 #  define CopFILEGV(c)         ((c)->cop_filegv)
 #  define CopFILEGV_set(c,gv)  ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
-#  define CopFILE_set(c,pv)    CopFILEGV_set((c), gv_fetchfile(pv))
-#  define CopFILE_setn(c,pv,l) CopFILEGV_set((c), gv_fetchfile_flags((pv),(l),0))
-#  define CopFILESV(c)         (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : NULL)
-#  define CopFILEAV(c)         (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : NULL)
-#  ifdef DEBUGGING
-#    define CopFILEAVx(c)      (assert(CopFILEGV(c)), GvAV(CopFILEGV(c)))
-#  else
-#    define CopFILEAVx(c)      (GvAV(CopFILEGV(c)))
-# endif
-#  define CopFILE(c)           (CopFILEGV(c) && GvSV(CopFILEGV(c)) \
-                                   ? SvPVX(GvSV(CopFILEGV(c))) : NULL)
 #  define CopSTASH(c)          ((c)->cop_stash)
 #  define CopSTASH_set(c,hv)   ((c)->cop_stash = (hv))
 #  define CopFILE_free(c)      (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL))
 
 #endif /* USE_ITHREADS */
 
+#define CopFILE_set(c,pv)      CopFILEGV_set((c), gv_fetchfile(pv))
+#define CopFILE_setn(c,pv,l)   CopFILEGV_set((c), gv_fetchfile_flags((pv),(l),0))
+#define CopFILESV(c)           (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : NULL)
+#define CopFILEAV(c)           (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : NULL)
+#define CopFILEAVx(c)          (assert_(CopFILEGV(c)) GvAV(CopFILEGV(c)))
+#define CopFILE(c)             (CopFILEGV(c) && GvSV(CopFILEGV(c)) \
+                                   ? SvPVX(GvSV(CopFILEGV(c))) : NULL)
 #define CopSTASHPV(c)          (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : NULL)
    /* cop_stash is not refcounted */
 #define CopSTASHPV_set(c,pv)   CopSTASH_set((c), gv_stashpv(pv,GV_ADD))

diff --git a/embed.fnc b/embed.fnc
index f3e351e..15f21ec 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1024,6 +1024,7 @@ p |PADOFFSET|allocmy      |NN const char *const name|const STRLEN len\
                                |const U32 flags
 #ifdef USE_ITHREADS
 AMp    |PADOFFSET|alloccopstash|NN HV *hv
+AMp    |PADOFFSET|allocfilegv  |NN GV *gv
 #endif
 : Used in perly.y
 pR     |OP*    |oopsAV         |NN OP* o
@@ -2659,4 +2660,8 @@ op        |void   |populate_isa   |NN const char *name|STRLEN len|...
 Xop    |bool   |feature_is_enabled|NN const char *const name \
                |STRLEN namelen
 
+: Some static inline functions that implement macros need predeclaration
+: because they are used inside other static inline functions.
+Aoi    |void   |SvREFCNT_dec_NN|NN SV *sv
+
 : ex: set ts=8 sts=4 sw=4 noet:

diff --git a/embed.h b/embed.h
index 9b5125a..5d9bc1e 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -806,6 +806,7 @@
 #endif
 #if defined(USE_ITHREADS)
 #define alloccopstash(a)       Perl_alloccopstash(aTHX_ a)
+#define allocfilegv(a)         Perl_allocfilegv(aTHX_ a)
 #define any_dup(a,b)           Perl_any_dup(aTHX_ a,b)
 #define cx_dup(a,b,c,d)                Perl_cx_dup(aTHX_ a,b,c,d)
 #define dirp_dup(a,b)          Perl_dirp_dup(aTHX_ a,b)

diff --git a/embedvar.h b/embedvar.h
index ef2fa68..240d205 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -146,6 +146,9 @@
 #define PL_exitlist            (vTHX->Iexitlist)
 #define PL_exitlistlen         (vTHX->Iexitlistlen)
 #define PL_fdpid               (vTHX->Ifdpid)
+#define PL_filegvpad           (vTHX->Ifilegvpad)
+#define PL_filegvpadix         (vTHX->Ifilegvpadix)
+#define PL_filegvpadmax                (vTHX->Ifilegvpadmax)
 #define PL_filemode            (vTHX->Ifilemode)
 #define PL_firstgv             (vTHX->Ifirstgv)
 #define PL_forkprocess         (vTHX->Iforkprocess)

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 35b81cf..aa8dfef 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -1228,6 +1228,8 @@ Since perl 5.17.1
 
 =item file
 
+=item filegvoff (threaded only)
+
 =item cop_seq
 
 =item arybase

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 9bafb38..2338be7 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -680,7 +680,11 @@ struct OP_methods {
 #ifdef USE_ITHREADS
     STR_WITH_LEN("pmoffset"),IVp,     offsetof(struct pmop, op_pmoffset),/*20*/
     STR_WITH_LEN("filegv"),  0,       -1,                                /*21*/
+#  if PERL_VERSION < 19
     STR_WITH_LEN("file"),    char_pp, offsetof(struct cop, cop_file),    /*22*/
+#  else
+    STR_WITH_LEN("file"),    0,       -1,                                /*22*/
+#  endif
     STR_WITH_LEN("stash"),   0,       -1,                                /*23*/
 #  if PERL_VERSION < 17
     STR_WITH_LEN("stashpv"), char_pp, offsetof(struct cop, cop_stashpv), /*24*/
@@ -726,6 +730,11 @@ struct OP_methods {
     STR_WITH_LEN("folded"),  0,       -1,                                /*50*/
 #endif
 #endif
+#if PERL_VERSION < 19 || !defined(USE_ITHREADS)
+    STR_WITH_LEN("filegvoff"),0,      -1,                                /*51*/
+#else
+    STR_WITH_LEN("filegvoff"),PADOFFSETp,offsetof(struct cop, cop_filegvoff),/*51*/
+#endif
 };
 
 #include "const-c.inc"
@@ -1034,7 +1043,7 @@ next(o)
                ret = make_sv_object(aTHX_ (SV *)CopFILEGV((COP*)o));
                break;
 #endif
-#ifndef USE_ITHREADS
+#if !defined(USE_ITHREADS) || PERL_VERSION >= 19
            case 22: /* file */
                ret = sv_2mortal(newSVpv(CopFILE((COP*)o), 0));
                break;

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 8eaabdb..c0e18e5 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -3387,6 +3387,13 @@ CODE:
 OUTPUT:
     RETVAL
 
+bool
+test_allocfilegv()
+CODE:
+    RETVAL = PL_filegvpad[allocfilegv(PL_defgv)] == PL_defgv;
+OUTPUT:
+    RETVAL
+
 #endif
 
 bool

diff --git a/ext/XS-APItest/t/copstash.t b/ext/XS-APItest/t/cop.t
similarity index 78%
rename from ext/XS-APItest/t/copstash.t
rename to ext/XS-APItest/t/cop.t
index 8ed98a2..b5571e6 100644 (file)
--- a/ext/XS-APItest/t/copstash.t
+++ b/ext/XS-APItest/t/cop.t
@@ -2,8 +2,9 @@ use Config;
 use Test::More;
 BEGIN { plan skip_all => 'no threads' unless $Config{useithreads} }
 
-plan tests => 1;
+plan tests => 2;
 
 use XS::APItest;
 
 ok test_alloccopstash;
+ok test_allocfilegv;

diff --git a/gv.c b/gv.c
index 067847c..b66eced 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -2102,12 +2102,9 @@ Perl_gv_check(pTHX_ const HV *stash)
                    continue;
                file = GvFILE(gv);
                CopLINE_set(PL_curcop, GvLINE(gv));
-#ifdef USE_ITHREADS
-               CopFILE(PL_curcop) = (char *)file;      /* set for warning */
-#else
-               CopFILEGV(PL_curcop)
-                   = gv_fetchfile_flags(file, HEK_LEN(GvFILE_HEK(gv)), 0);
-#endif
+               /* set file name for warning */
+               CopFILE_setn(PL_curcop, file, HEK_LEN(GvFILE_HEK(gv)));
+               SvREFCNT_dec(CopFILEGV(PL_curcop));
                Perl_warner(aTHX_ packWARN(WARN_ONCE),
                        "Name \"%"HEKf"::%"HEKf
                        "\" used only once: possible typo",

diff --git a/inline.h b/inline.h
index 2d09dcb..6b24ae5 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -23,6 +23,20 @@ S_av_top_index(pTHX_ AV *av)
     return AvFILL(av);
 }
 
+/* ------------------------------- cop.h ------------------------------ */
+
+#ifdef USE_ITHREADS
+PERL_STATIC_INLINE void
+S_CopFILE_free(pTHX_ COP * const c)
+{
+    GV * const gv = CopFILEGV(c);
+    if (!gv) return;
+    if (SvREFCNT(gv) == 1) PL_filegvpad[c->cop_filegvoff] = NULL;
+    SvREFCNT_dec_NN(gv);
+    c->cop_filegvoff = 0;
+}
+#endif
+
 /* ------------------------------- cv.h ------------------------------- */
 
 PERL_STATIC_INLINE I32 *
@@ -108,6 +122,7 @@ PERL_STATIC_INLINE void
 S_SvREFCNT_dec_NN(pTHX_ SV *sv)
 {
     U32 rc = SvREFCNT(sv);
+    PERL_ARGS_ASSERT_SVREFCNT_DEC_NN;
     if (LIKELY(rc > 1))
        SvREFCNT(sv) = rc - 1;
     else

diff --git a/intrpvar.h b/intrpvar.h
index 299ac0f..ea37d41 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -657,6 +657,9 @@ PERLVAR(I, regex_padav,   AV *)             /* All regex objects, indexed via the
 PERLVAR(I, stashpad,    HV **)         /* for CopSTASH */
 PERLVARI(I, stashpadmax, PADOFFSET, 64)
 PERLVARI(I, stashpadix, PADOFFSET, 0)
+PERLVAR(I, filegvpad,    GV **)                /* for CopFILEGV */
+PERLVARI(I, filegvpadmax, PADOFFSET, 64)
+PERLVARI(I, filegvpadix, PADOFFSET, 0)
 #endif
 
 #ifdef USE_REENTRANT_API

diff --git a/makedef.pl b/makedef.pl
index 8523455..0f4790e 100644 (file)
--- a/makedef.pl
+++ b/makedef.pl
@@ -363,6 +363,9 @@ unless ($define{'USE_ITHREADS'}) {
                    PL_stashpad
                    PL_stashpadix
                    PL_stashpadmax
+                   PL_filegvpad
+                   PL_filegvpadix
+                   PL_filegvpadmax
                    Perl_alloccopstash
                    Perl_clone_params_del
                    Perl_clone_params_new

diff --git a/op.c b/op.c
index 622236c..b69585b 100644 (file)
--- a/op.c
+++ b/op.c
@@ -634,31 +634,64 @@ C<PL_stashpad> for the stash passed to it.
 */
 
 #ifdef USE_ITHREADS
+
 PADOFFSET
-Perl_alloccopstash(pTHX_ HV *hv)
+S_alloc_global_pad_slot(pTHX_ SV *sv, svtype type, SV ***padp,
+                             PADOFFSET *ixp, PADOFFSET *maxp)
 {
     PADOFFSET off = 0, o = 1;
     bool found_slot = FALSE;
+    SV **pad = *padp;
 
-    PERL_ARGS_ASSERT_ALLOCCOPSTASH;
-
-    if (PL_stashpad[PL_stashpadix] == hv) return PL_stashpadix;
+    if (pad[*ixp] == sv) return *ixp;
 
-    for (; o < PL_stashpadmax; ++o) {
-       if (PL_stashpad[o] == hv) return PL_stashpadix = o;
-       if (!PL_stashpad[o] || SvTYPE(PL_stashpad[o]) != SVt_PVHV)
+    for (; o < *maxp; ++o) {
+       if (pad[o] == sv) return *ixp = o;
+       if (!pad[o] || SvTYPE(pad[o]) != type)
            found_slot = TRUE, off = o;
     }
     if (!found_slot) {
-       Renew(PL_stashpad, PL_stashpadmax + 10, HV *);
-       Zero(PL_stashpad + PL_stashpadmax, 10, HV *);
-       off = PL_stashpadmax;
-       PL_stashpadmax += 10;
+       Renew(*padp, *maxp + 10, SV *);
+       pad = *padp;
+       Zero(pad + *maxp, 10, SV *);
+       off = *maxp;
+       *maxp += 10;
     }
 
-    PL_stashpad[PL_stashpadix = off] = hv;
+    pad[*ixp = off] = sv;
     return off;
 }
+
+PADOFFSET
+Perl_alloccopstash(pTHX_ HV *hv)
+{
+    PERL_ARGS_ASSERT_ALLOCCOPSTASH;
+    return S_alloc_global_pad_slot(aTHX_
+               (SV *)hv, SVt_PVHV, (SV ***)&PL_stashpad, &PL_stashpadix,
+               &PL_stashpadmax
+          );
+}
+#endif
+
+/*
+=for apidoc allocfilegv
+
+Available only under threaded builds, this function allocates an entry in
+C<PL_filegvpad> for the GV passed to it.
+
+=cut
+*/
+
+#ifdef USE_ITHREADS
+PADOFFSET
+Perl_allocfilegv(pTHX_ GV *gv)
+{
+    PERL_ARGS_ASSERT_ALLOCFILEGV;
+    return S_alloc_global_pad_slot(aTHX_
+               (SV *)gv, SVt_PVGV, (SV ***)&PL_filegvpad, &PL_filegvpadix,
+               &PL_filegvpadmax
+          );
+}
 #endif
 
 /* free the body of an op without examining its contents.
@@ -5723,7 +5756,10 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
        PL_parser->copline = NOLINE;
     }
 #ifdef USE_ITHREADS
-    CopFILE_set(cop, CopFILE(PL_curcop));      /* XXX share in a pvtable? */
+    /* While CopFILEGV_set does work under ithreads, this is faster, as it
+       avoids a linear scan of the filegv pad: */
+    if((cop->cop_filegvoff = PL_curcop->cop_filegvoff))
+       SvREFCNT_inc_void_NN(PL_filegvpad[cop->cop_filegvoff]);
 #else
     CopFILEGV_set(cop, CopFILEGV(PL_curcop));
 #endif
@@ -10874,7 +10910,7 @@ Perl_rpeep(pTHX_ OP *o)
                    firstcop->cop_line = secondcop->cop_line;
 #ifdef USE_ITHREADS
                    firstcop->cop_stashoff = secondcop->cop_stashoff;
-                   firstcop->cop_file = secondcop->cop_file;
+                   firstcop->cop_filegvoff = secondcop->cop_filegvoff;
 #else
                    firstcop->cop_stash = secondcop->cop_stash;
                    firstcop->cop_filegv = secondcop->cop_filegv;
@@ -10886,7 +10922,7 @@ Perl_rpeep(pTHX_ OP *o)
 
 #ifdef USE_ITHREADS
                    secondcop->cop_stashoff = 0;
-                   secondcop->cop_file = NULL;
+                   secondcop->cop_filegvoff = 0;
 #else
                    secondcop->cop_stash = NULL;
                    secondcop->cop_filegv = NULL;

diff --git a/perl.c b/perl.c
index f31c1ed..5663549 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -286,6 +286,7 @@ perl_construct(pTHXx)
     Perl_av_create_and_push(aTHX_ &PL_regex_padav, newSVpvs(""));
     PL_regex_pad = AvARRAY(PL_regex_padav);
     Newxz(PL_stashpad, PL_stashpadmax, HV *);
+    Newxz(PL_filegvpad, PL_filegvpadmax, GV *);
 #endif
 #ifdef USE_REENTRANT_API
     Perl_reentrant_init(aTHX);
@@ -1092,6 +1093,7 @@ perl_destruct(pTHXx)
 
 #ifdef USE_ITHREADS
     Safefree(PL_stashpad); /* must come after sv_clean_all */
+    Safefree(PL_filegvpad);
 #endif
 
     AvREAL_off(PL_fdpid);              /* no surviving entries */

diff --git a/proto.h b/proto.h
index e57f3ea..d1186ba 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -32,6 +32,11 @@ PERL_CALLCONV void   Perl_Slab_Free(pTHX_ void *op)
 #define PERL_ARGS_ASSERT_SLAB_FREE     \
        assert(op)
 
+PERL_STATIC_INLINE void        S_SvREFCNT_dec_NN(pTHX_ SV *sv)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_SVREFCNT_DEC_NN       \
+       assert(sv)
+
 PERL_CALLCONV bool     Perl__is_uni_FOO(pTHX_ const U8 classnum, const UV c)
                        __attribute__warn_unused_result__;
 
@@ -7646,6 +7651,11 @@ PERL_CALLCONV PADOFFSET  Perl_alloccopstash(pTHX_ HV *hv)
 #define PERL_ARGS_ASSERT_ALLOCCOPSTASH \
        assert(hv)
 
+PERL_CALLCONV PADOFFSET        Perl_allocfilegv(pTHX_ GV *gv)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_ALLOCFILEGV   \
+       assert(gv)
+
 PERL_CALLCONV void*    Perl_any_dup(pTHX_ void* v, const PerlInterpreter* proto_perl)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_2);

diff --git a/scope.c b/scope.c
index 3ac3990..2464590 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -1231,6 +1231,11 @@ Perl_leave_scope(pTHX_ I32 base)
        case SAVEt_READONLY_OFF:
            SvREADONLY_off(ARG0_SV);
            break;
+#ifdef USE_ITHREADS
+       case SAVEt_COPFILEFREE:
+           CopFILE_free((COP *)ARG0_PTR);
+           break;
+#endif
        default:
            Perl_croak(aTHX_ "panic: leave_scope inconsistency %u", type);
        }

diff --git a/scope.h b/scope.h
index 235212f..97aa1b6 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -39,12 +39,14 @@
 #define SAVEt_PARSER           19
 #define SAVEt_STACK_POS                20
 #define SAVEt_READONLY_OFF     21
+#ifdef USE_ITHREADS
+# define SAVEt_COPFILEFREE     22
+#endif
 
-#define SAVEt_ARG1_MAX         21
+#define SAVEt_ARG1_MAX         22
 
 /* two args */
 
-#define SAVEt_APTR             22
 #define SAVEt_AV               23
 #define SAVEt_DESTRUCTOR       24
 #define SAVEt_DESTRUCTOR_X     25
@@ -69,17 +71,18 @@
 #define SAVEt_SVREF            44
 #define SAVEt_VPTR             45
 #define SAVEt_ADELETE          46
+#define SAVEt_APTR             47
 
-#define SAVEt_ARG2_MAX         46
+#define SAVEt_ARG2_MAX         47
 
 /* three args */
 
-#define SAVEt_DELETE           47
 #define SAVEt_HELEM            48
 #define SAVEt_PADSV_AND_MORTALIZE 49
 #define SAVEt_SET_SVFLAGS      50
 #define SAVEt_GVSLOT           51
 #define SAVEt_AELEM            52
+#define SAVEt_DELETE           53
 
 #define SAVEf_SETMAGIC         1
 #define SAVEf_KEEPOLDELEM      2
@@ -301,8 +304,11 @@ scope has the given name. Name must be a literal string.
 
 #ifdef USE_ITHREADS
 #  define SAVECOPSTASH_FREE(c) SAVEIV((c)->cop_stashoff)
-#  define SAVECOPFILE(c)       SAVEPPTR(CopFILE(c))
-#  define SAVECOPFILE_FREE(c)  SAVESHAREDPV(CopFILE(c))
+#  define SAVECOPFILE(c)       SAVEIV((c)->cop_filegvoff)
+#  define SAVECOPFILE_FREE(c) ( \
+       SAVEIV((c)->cop_filegvoff),                     \
+       save_pushptr((void *)(c), SAVEt_COPFILEFREE)    \
+    )
 #else
 #  /* XXX not refcounted */
 #  define SAVECOPSTASH_FREE(c) SAVESPTR(CopSTASH(c))

diff --git a/sv.c b/sv.c
index fcc0761..e3a98cc 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -13025,6 +13025,10 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = parser_dup((const yy_parser*)ptr, param);
            break;
+       case SAVEt_COPFILEFREE:
+           ptr = POPPTR(ss,ix);
+           TOPPTR(nss,ix) = any_dup(ptr, param->proto_perl);
+           break;
        default:
            Perl_croak(aTHX_
                       "panic: ss_dup inconsistency (%"IVdf")", (IV) type);
@@ -13474,10 +13478,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     Zero(PL_sv_consts, SV_CONSTS_COUNT, SV*);
 
-    /* This PV will be free'd special way so must set it same way op.c does */
-    PL_compiling.cop_file    = savesharedpv(PL_compiling.cop_file);
-    ptr_table_store(PL_ptr_table, proto_perl->Icompiling.cop_file, PL_compiling.cop_file);
-
     ptr_table_store(PL_ptr_table, &proto_perl->Icompiling, &PL_compiling);
     PL_compiling.cop_warnings = DUP_WARNINGS(PL_compiling.cop_warnings);
     CopHINTHASH_set(&PL_compiling, cophh_copy(CopHINTHASH_get(&PL_compiling)));
@@ -13539,6 +13539,14 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        for (; o < PL_stashpadmax; ++o)
            PL_stashpad[o] = hv_dup(proto_perl->Istashpad[o], param);
     }
+    PL_filegvpadmax    = proto_perl->Ifilegvpadmax;
+    PL_filegvpadix     = proto_perl->Ifilegvpadix ;
+    Newx(PL_filegvpad, PL_filegvpadmax, GV *);
+    {
+       PADOFFSET o = 0;
+       for (; o < PL_filegvpadmax; ++o)
+           PL_filegvpad[o] = gv_dup(proto_perl->Ifilegvpad[o], param);
+    }
 
     /* shortcuts to various I/O objects */
     PL_ofsgv            = gv_dup_inc(proto_perl->Iofsgv, param);