Export Perl_hek_dup, which duplicates shared hash keys.

p4raw-id: //depot/perl@24575

diff --git a/embed.fnc b/embed.fnc
index a1ce117..8a7a248 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -937,6 +937,7 @@ Ap  |PERL_SI*|si_dup        |PERL_SI* si|CLONE_PARAMS* param
 Ap     |ANY*   |ss_dup         |PerlInterpreter* proto_perl|CLONE_PARAMS* param
 Ap     |void*  |any_dup        |void* v|PerlInterpreter* proto_perl
 Ap     |HE*    |he_dup         |HE* e|bool shared|CLONE_PARAMS* param
+Ap     |HEK*   |hek_dup        |HEK* e|CLONE_PARAMS* param
 Ap     |REGEXP*|re_dup         |REGEXP* r|CLONE_PARAMS* param
 Ap     |PerlIO*|fp_dup         |PerlIO* fp|char type|CLONE_PARAMS* param
 Ap     |DIR*   |dirp_dup       |DIR* dp

diff --git a/embed.h b/embed.h
index 19b5f69..648f821 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -976,6 +976,7 @@
 #define ss_dup                 Perl_ss_dup
 #define any_dup                        Perl_any_dup
 #define he_dup                 Perl_he_dup
+#define hek_dup                        Perl_hek_dup
 #define re_dup                 Perl_re_dup
 #define fp_dup                 Perl_fp_dup
 #define dirp_dup               Perl_dirp_dup
@@ -2954,6 +2955,7 @@
 #define ss_dup(a,b)            Perl_ss_dup(aTHX_ a,b)
 #define any_dup(a,b)           Perl_any_dup(aTHX_ a,b)
 #define he_dup(a,b,c)          Perl_he_dup(aTHX_ a,b,c)
+#define hek_dup(a,b)           Perl_hek_dup(aTHX_ a,b)
 #define re_dup(a,b)            Perl_re_dup(aTHX_ a,b)
 #define fp_dup(a,b,c)          Perl_fp_dup(aTHX_ a,b,c)
 #define dirp_dup(a)            Perl_dirp_dup(aTHX_ a)

diff --git a/hv.c b/hv.c
index 919f3f6..5086b83 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -123,6 +123,23 @@ Perl_free_tied_hv_pool(pTHX)
 }
 
 #if defined(USE_ITHREADS)
+HEK *
+Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param)
+{
+    HE *shared = (HE*)ptr_table_fetch(PL_shared_hek_table, source);
+
+    if (shared) {
+       /* We already shared this hash key.  */
+       ++HeVAL(shared);
+    }
+    else {
+       shared = share_hek_flags(HEK_KEY(source), HEK_LEN(source),
+                                HEK_HASH(source), HEK_FLAGS(source));
+       ptr_table_store(PL_shared_hek_table, source, shared);
+    }
+    return HeKEY_hek(shared);
+}
+
 HE *
 Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
 {
@@ -147,6 +164,8 @@ Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
        HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param));
     }
     else if (shared) {
+       /* This is hek_dup inlined, which seems to be important for speed
+          reasons.  */
        HEK *source = HeKEY_hek(e);
        HE *shared = (HE*)ptr_table_fetch(PL_shared_hek_table, source);
 

diff --git a/proto.h b/proto.h
index d816332..839cdbf 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1732,6 +1732,7 @@ PERL_CALLCONV PERL_SI*    Perl_si_dup(pTHX_ PERL_SI* si, CLONE_PARAMS* param);
 PERL_CALLCONV ANY*     Perl_ss_dup(pTHX_ PerlInterpreter* proto_perl, CLONE_PARAMS* param);
 PERL_CALLCONV void*    Perl_any_dup(pTHX_ void* v, PerlInterpreter* proto_perl);
 PERL_CALLCONV HE*      Perl_he_dup(pTHX_ HE* e, bool shared, CLONE_PARAMS* param);
+PERL_CALLCONV HEK*     Perl_hek_dup(pTHX_ HEK* e, CLONE_PARAMS* param);
 PERL_CALLCONV REGEXP*  Perl_re_dup(pTHX_ REGEXP* r, CLONE_PARAMS* param);
 PERL_CALLCONV PerlIO*  Perl_fp_dup(pTHX_ PerlIO* fp, char type, CLONE_PARAMS* param);
 PERL_CALLCONV DIR*     Perl_dirp_dup(pTHX_ DIR* dp);