From: Nicholas Clark Date: Wed, 25 May 2005 15:52:33 +0000 (+0000) Subject: Track the mapping between source shared hash keys and target shared X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c21d1a0f049833fd2ca59ef598337f86f2cd08f4;p=p5sagit%2Fp5-mst-13.2.git Track the mapping between source shared hash keys and target shared hash keys to save repeated lookups during cloning. p4raw-id: //depot/perl@24574 --- diff --git a/embed.fnc b/embed.fnc index 2ae37bb..a1ce117 100644 --- a/embed.fnc +++ b/embed.fnc @@ -993,7 +993,7 @@ s |void |del_he |HE *p s |HEK* |save_hek_flags |const char *str|I32 len|U32 hash|int flags s |void |hv_magic_check |HV *hv|bool *needs_copy|bool *needs_store s |void |unshare_hek_or_pvn|HEK* hek|const char* sv|I32 len|U32 hash -s |HEK* |share_hek_flags|const char* sv|I32 len|U32 hash|int flags +s |HE* |share_hek_flags|const char* sv|I32 len|U32 hash|int flags rs |void |hv_notallowed |int flags|const char *key|I32 klen|const char *msg #endif diff --git a/embedvar.h b/embedvar.h index d0c3a46..ea68e16 100644 --- a/embedvar.h +++ b/embedvar.h @@ -377,6 +377,7 @@ #define PL_savebegin (vTHX->Isavebegin) #define PL_sawampersand (vTHX->Isawampersand) #define PL_sh_path_compat (vTHX->Ish_path_compat) +#define PL_shared_hek_table (vTHX->Ishared_hek_table) #define PL_sharehook (vTHX->Isharehook) #define PL_sig_pending (vTHX->Isig_pending) #define PL_sighandlerp (vTHX->Isighandlerp) @@ -681,6 +682,7 @@ #define PL_Isavebegin PL_savebegin #define PL_Isawampersand PL_sawampersand #define PL_Ish_path_compat PL_sh_path_compat +#define PL_Ishared_hek_table PL_shared_hek_table #define PL_Isharehook PL_sharehook #define PL_Isig_pending PL_sig_pending #define PL_Isighandlerp PL_sighandlerp diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs index 03cb590..f6b57d6 100755 --- a/ext/threads/threads.xs +++ b/ext/threads/threads.xs @@ -615,6 +615,7 @@ Perl_ithread_join(pTHX_ SV *obj) clone_params.stashes = newAV(); clone_params.flags |= CLONEf_JOIN_IN; PL_ptr_table = ptr_table_new(); + PL_shared_hek_table = ptr_table_new(); current_thread = Perl_ithread_get(aTHX); Perl_ithread_set(aTHX_ thread); /* ensure 'meaningful' addresses retain their meaning */ @@ -646,6 +647,8 @@ Perl_ithread_join(pTHX_ SV *obj) SvREFCNT_inc(retparam); ptr_table_free(PL_ptr_table); PL_ptr_table = NULL; + ptr_table_free(PL_shared_hek_table); + PL_shared_hek_table = NULL; } /* We are finished with it */ diff --git a/hv.c b/hv.c index 5443771..919f3f6 100644 --- a/hv.c +++ b/hv.c @@ -146,9 +146,21 @@ Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param) HeKEY_hek(ret) = (HEK*)k; HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param)); } - else if (shared) - HeKEY_hek(ret) = share_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e), - HeKFLAGS(e)); + else if (shared) { + HEK *source = HeKEY_hek(e); + 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); + } + HeKEY_hek(ret) = HeKEY_hek(shared); + } else HeKEY_hek(ret) = save_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e), HeKFLAGS(e)); @@ -652,8 +664,8 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, /* Need to swap the key we have for a key with the flags we need. As keys are shared we can't just write to the flag, so we share the new one, unshare the old one. */ - HEK *new_hek = share_hek_flags(key, klen, hash, - masked_flags); + HEK *new_hek = HeKEY_hek(share_hek_flags(key, klen, hash, + masked_flags)); unshare_hek (HeKEY_hek(entry)); HeKEY_hek(entry) = new_hek; } @@ -755,7 +767,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, /* share_hek_flags will do the free for us. This might be considered bad API design. */ if (HvSHAREKEYS(hv)) - HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags); + HeKEY_hek(entry) = HeKEY_hek(share_hek_flags(key, klen, hash, flags)); else /* gotta do the real thing */ HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags); HeVAL(entry) = val; @@ -1348,7 +1360,7 @@ Perl_newHVhv(pTHX_ HV *ohv) ent = new_HE(); HeVAL(ent) = newSVsv(HeVAL(oent)); HeKEY_hek(ent) - = shared ? share_hek_flags(key, len, hash, flags) + = shared ? HeKEY_hek(share_hek_flags(key, len, hash, flags)) : save_hek_flags(key, len, hash, flags); if (prev) HeNEXT(prev) = ent; @@ -2206,10 +2218,10 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash) flags |= HVhek_WASUTF8 | HVhek_FREEKEY; } - return share_hek_flags (str, len, hash, flags); + return HeKEY_hek(share_hek_flags (str, len, hash, flags)); } -STATIC HEK * +STATIC HE * S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) { register XPVHV* xhv; @@ -2263,7 +2275,7 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) if (flags & HVhek_FREEKEY) Safefree(str); - return HeKEY_hek(entry); + return entry; } I32 * diff --git a/intrpvar.h b/intrpvar.h index 3fd201d..ae4850c 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -425,6 +425,7 @@ PERLVAR(IProc, struct IPerlProc*) #if defined(USE_ITHREADS) PERLVAR(Iptr_table, PTR_TBL_t*) +PERLVAR(Ishared_hek_table, PTR_TBL_t*) #endif PERLVARI(Ibeginav_save, AV*, Nullav) /* save BEGIN{}s when compiling */ diff --git a/perl.c b/perl.c index babaaed..a7ed27e 100644 --- a/perl.c +++ b/perl.c @@ -834,9 +834,11 @@ perl_destruct(pTHXx) SvREFCNT_dec(PL_strtab); #ifdef USE_ITHREADS - /* free the pointer table used for cloning */ + /* free the pointer tables used for cloning */ ptr_table_free(PL_ptr_table); PL_ptr_table = (PTR_TBL_t*)NULL; + ptr_table_free(PL_shared_hek_table); + PL_shared_hek_table = (PTR_TBL_t*)NULL; #endif /* free special SVs */ diff --git a/perlapi.h b/perlapi.h index 1702029..39d516e 100644 --- a/perlapi.h +++ b/perlapi.h @@ -533,6 +533,8 @@ END_EXTERN_C #define PL_sawampersand (*Perl_Isawampersand_ptr(aTHX)) #undef PL_sh_path_compat #define PL_sh_path_compat (*Perl_Ish_path_compat_ptr(aTHX)) +#undef PL_shared_hek_table +#define PL_shared_hek_table (*Perl_Ishared_hek_table_ptr(aTHX)) #undef PL_sharehook #define PL_sharehook (*Perl_Isharehook_ptr(aTHX)) #undef PL_sig_pending diff --git a/proto.h b/proto.h index 3408671..d816332 100644 --- a/proto.h +++ b/proto.h @@ -1816,7 +1816,7 @@ STATIC void S_del_he(pTHX_ HE *p); STATIC HEK* S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags); STATIC void S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store); STATIC void S_unshare_hek_or_pvn(pTHX_ HEK* hek, const char* sv, I32 len, U32 hash); -STATIC HEK* S_share_hek_flags(pTHX_ const char* sv, I32 len, U32 hash, int flags); +STATIC HE* S_share_hek_flags(pTHX_ const char* sv, I32 len, U32 hash, int flags); STATIC void S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen, const char *msg) __attribute__noreturn__; diff --git a/sv.c b/sv.c index 3e87962..b0571d8 100644 --- a/sv.c +++ b/sv.c @@ -11668,6 +11668,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, /* create SV map for pointer relocation */ PL_ptr_table = ptr_table_new(); + /* and one for finding shared hash keys quickly */ + PL_shared_hek_table = ptr_table_new(); /* initialize these special pointers as early as possible */ SvANY(&PL_sv_undef) = NULL; @@ -12296,6 +12298,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, if (!(flags & CLONEf_KEEP_PTR_TABLE)) { ptr_table_free(PL_ptr_table); PL_ptr_table = NULL; + ptr_table_free(PL_shared_hek_table); + PL_shared_hek_table = NULL; } /* Call the ->CLONE method, if it exists, for each of the stashes