From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 25 May 2005 16:26:12 +0000 (+0000)
Subject: Export Perl_hek_dup, which duplicates shared hash keys.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0bff533ca2a343dc64973f34f3c611670d92fff1;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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);