Need to migrate the refcounted_he structure to be properly shared.

Add a mutex for manipulated their reference counts.
Unwrap the structure, so that for ithreads it can store SVs in pads.

p4raw-id: //depot/perl@27764

12 files changed, 68 insertions, 36 deletions

diff --git a/dosish.h b/dosish.h
index c41d9a721d..94a15afe90 100644
--- a/dosish.h
+++ b/dosish.h
@@ -43,7 +43,7 @@
 #endif	/* DJGPP */
 
 #ifndef PERL_SYS_TERM
-#  define PERL_SYS_TERM() OP_REFCNT_TERM; MALLOC_TERM
+#  define PERL_SYS_TERM() HINTS_REFCNT_TERM; OP_REFCNT_TERM; MALLOC_TERM
 #endif
 #define dXSUB_SYS
 
diff --git a/embedvar.h b/embedvar.h
index 041d8fd61f..9691e539ca 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -820,6 +820,8 @@
 #define PL_Gfold_locale		(my_vars->Gfold_locale)
 #define PL_hexdigit		(my_vars->Ghexdigit)
 #define PL_Ghexdigit		(my_vars->Ghexdigit)
+#define PL_hints_mutex		(my_vars->Ghints_mutex)
+#define PL_Ghints_mutex		(my_vars->Ghints_mutex)
 #define PL_malloc_mutex		(my_vars->Gmalloc_mutex)
 #define PL_Gmalloc_mutex	(my_vars->Gmalloc_mutex)
 #define PL_mmap_page_size	(my_vars->Gmmap_page_size)
@@ -881,6 +883,7 @@
 #define PL_Gdollarzero_mutex	PL_dollarzero_mutex
 #define PL_Gfold_locale		PL_fold_locale
 #define PL_Ghexdigit		PL_hexdigit
+#define PL_Ghints_mutex		PL_hints_mutex
 #define PL_Gmalloc_mutex	PL_malloc_mutex
 #define PL_Gmmap_page_size	PL_mmap_page_size
 #define PL_Gmy_ctx_mutex	PL_my_ctx_mutex
diff --git a/hv.c b/hv.c
index bc64df4c68..29c9e43e30 100644
--- a/hv.c
+++ b/hv.c
@@ -2577,7 +2577,7 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain)
     }
 
     while (chain) {
-	const U32 hash = HEK_HASH(chain->refcounted_he_he.hent_hek);
+	const U32 hash = HEK_HASH(chain->refcounted_he_hek);
 	HE **oentry = &((HvARRAY(hv))[hash & max]);
 	HE *entry = *oentry;
 
@@ -2589,9 +2589,9 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain)
 	assert (!entry);
 	entry = new_HE();
 
-	HeKEY_hek(entry) = share_hek_hek(chain->refcounted_he_he.hent_hek);
+	HeKEY_hek(entry) = share_hek_hek(chain->refcounted_he_hek);
 
-	HeVAL(entry) = chain->refcounted_he_he.he_valu.hent_val;
+	HeVAL(entry) = chain->refcounted_he_val;
 	if (HeVAL(entry) == &PL_sv_placeholder)
 	    placeholders++;
 	SvREFCNT_inc_void_NN(HeVAL(entry));
@@ -2607,7 +2607,7 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain)
 	HvTOTALKEYS(hv)++;
 
     next_please:
-	chain = (struct refcounted_he *) chain->refcounted_he_he.hent_next;
+	chain = chain->refcounted_he_next;
     }
 
     if (placeholders) {
@@ -2647,9 +2647,9 @@ Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent,
 
     Newx(he, 1, struct refcounted_he);
 
-    he->refcounted_he_he.hent_next = (HE *)parent;
-    he->refcounted_he_he.he_valu.hent_val = value;
-    he->refcounted_he_he.hent_hek
+    he->refcounted_he_next = parent;
+    he->refcounted_he_val = value;
+    he->refcounted_he_hek
 	= share_hek(p, SvUTF8(key) ? -(I32)len : len, hash);
     he->refcounted_he_refcnt = 1;
 
@@ -2674,10 +2674,10 @@ Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
 	if (--he->refcounted_he_refcnt)
 	    return;
 
-	unshare_hek_or_pvn (he->refcounted_he_he.hent_hek, 0, 0, 0);
-	SvREFCNT_dec(he->refcounted_he_he.he_valu.hent_val);
+	unshare_hek_or_pvn (he->refcounted_he_hek, 0, 0, 0);
+	SvREFCNT_dec(he->refcounted_he_val);
 	copy = he;
-	he = (struct refcounted_he *) he->refcounted_he_he.hent_next;
+	he = he->refcounted_he_next;
 	Safefree(copy);
     }
 }
@@ -2710,15 +2710,11 @@ Perl_refcounted_he_dup(pTHX_ const struct refcounted_he *const he,
     Newx(copy, 1, struct refcounted_he);
     ptr_table_store(PL_ptr_table, he, copy);
 
-    copy->refcounted_he_he.hent_next
-	= (HE *)Perl_refcounted_he_dup(aTHX_
-				       (struct refcounted_he *)
-				       he->refcounted_he_he.hent_next,
-				       param);
-    copy->refcounted_he_he.he_valu.hent_val
-	= SvREFCNT_inc(sv_dup(he->refcounted_he_he.he_valu.hent_val, param));
-    copy->refcounted_he_he.hent_hek
-	= hek_dup(he->refcounted_he_he.hent_hek, param);
+    copy->refcounted_he_next
+	= Perl_refcounted_he_dup(aTHX_ he->refcounted_he_next, param);
+    copy->refcounted_he_val
+	= SvREFCNT_inc(sv_dup(he->refcounted_he_val, param));
+    copy->refcounted_he_hek = hek_dup(he->refcounted_he_hek, param);
     copy->refcounted_he_refcnt = he->refcounted_he_refcnt;
     return copy;
 }
@@ -2741,14 +2737,11 @@ Perl_refcounted_he_copy(pTHX_ const struct refcounted_he * he)
 	return NULL;
 
     Newx(copy, 1, struct refcounted_he);
-    copy->refcounted_he_he.hent_next
-	= (HE *)Perl_refcounted_he_copy(aTHX_
-				       (struct refcounted_he *)
-				       he->refcounted_he_he.hent_next);
-    copy->refcounted_he_he.he_valu.hent_val
-	= newSVsv(he->refcounted_he_he.he_valu.hent_val);
-    hek = he->refcounted_he_he.hent_hek;
-    copy->refcounted_he_he.hent_hek
+    copy->refcounted_he_next
+	= Perl_refcounted_he_copy(aTHX_ he->refcounted_he_next);
+    copy->refcounted_he_val = newSVsv(he->refcounted_he_val);
+    hek = he->refcounted_he_hek;
+    copy->refcounted_he_hek
 	= share_hek(HEK_KEY(hek),
 		    HEK_UTF8(hek) ? -(I32)HEK_LEN(hek) : HEK_LEN(hek),
 		    HEK_HASH(hek));
diff --git a/hv.h b/hv.h
index dfb0d25162..4ae5e1af71 100644
--- a/hv.h
+++ b/hv.h
@@ -36,11 +36,6 @@ struct shared_he {
     struct hek shared_he_hek;
 };
 
-struct refcounted_he {
-    struct he refcounted_he_he;
-    U32 refcounted_he_refcnt;
-};
-
 /* Subject to change.
    Don't access this directly.
 */
@@ -383,6 +378,38 @@ C<SV*>.
 	->shared_he_he.he_valu.hent_refcount),				\
      hek)
 
+/* This refcounted he structure is used for storing the hints used for lexical
+   pragmas. Without threads, it's basically struct he + refcount.
+   With threads, life gets more complex as the structure needs to be shared
+   between threads (because it hangs from OPs, which are shared), hence the
+   alternate definition and mutex.  */
+
+#ifdef PERL_CORE
+
+struct refcounted_he {
+    struct refcounted_he *refcounted_he_next;	/* next entry in chain */
+    HEK                  *refcounted_he_hek;	/* hint key */
+    SV                   *refcounted_he_val;	/* hint value */
+    U32	                  refcounted_he_refcnt;	/* reference count */
+};
+
+#  ifdef USE_ITHREADS
+#    define HINTS_REFCNT_LOCK		MUTEX_LOCK(&PL_hints_mutex)
+#    define HINTS_REFCNT_UNLOCK		MUTEX_UNLOCK(&PL_hints_mutex)
+#  else
+#    define HINTS_REFCNT_LOCK		NOOP
+#    define HINTS_REFCNT_UNLOCK		NOOP
+#  endif
+#endif
+
+#ifdef USE_ITHREADS
+#  define HINTS_REFCNT_INIT		MUTEX_INIT(&PL_hints_mutex)
+#  define HINTS_REFCNT_TERM		MUTEX_DESTROY(&PL_hints_mutex)
+#else
+#  define HINTS_REFCNT_INIT		NOOP
+#  define HINTS_REFCNT_TERM		NOOP
+#endif
+
 /*
  * Local variables:
  * c-indentation-style: bsd
diff --git a/perl.c b/perl.c
index e69cc9ca1f..bd667eee7b 100644
--- a/perl.c
+++ b/perl.c
@@ -148,6 +148,7 @@ S_init_tls_and_interp(PerlInterpreter *my_perl)
 	ALLOC_THREAD_KEY;
 	PERL_SET_THX(my_perl);
 	OP_REFCNT_INIT;
+	HINTS_REFCNT_INIT;
 	MUTEX_INIT(&PL_dollarzero_mutex);
 #  endif
 #ifdef PERL_IMPLICIT_CONTEXT
diff --git a/perlapi.h b/perlapi.h
index cc6ce88d77..aac1e1625c 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -884,6 +884,8 @@ END_EXTERN_C
 #define PL_fold_locale		(*Perl_Gfold_locale_ptr(NULL))
 #undef  PL_hexdigit
 #define PL_hexdigit		(*Perl_Ghexdigit_ptr(NULL))
+#undef  PL_hints_mutex
+#define PL_hints_mutex		(*Perl_Ghints_mutex_ptr(NULL))
 #undef  PL_malloc_mutex
 #define PL_malloc_mutex		(*Perl_Gmalloc_mutex_ptr(NULL))
 #undef  PL_mmap_page_size
diff --git a/perlvars.h b/perlvars.h
index 67ee5fd511..b4f3e51319 100644
--- a/perlvars.h
+++ b/perlvars.h
@@ -134,3 +134,7 @@ PERLVAR(Gmy_ctx_mutex, perl_mutex)
 # endif
 PERLVARI(Gmy_cxt_index, int, 0)
 #endif
+
+#if defined(USE_ITHREADS)
+PERLVAR(Ghints_mutex, perl_mutex)    /* Mutex for refcounted he refcounting */
+#endif
diff --git a/symbian/symbianish.h b/symbian/symbianish.h
index a3f795f380..b2054bcea2 100644
--- a/symbian/symbianish.h
+++ b/symbian/symbianish.h
@@ -120,7 +120,7 @@
 #define Mkdir(path,mode)   mkdir((path),(mode))
 
 #ifndef PERL_SYS_TERM
-#define PERL_SYS_TERM()		OP_REFCNT_TERM; MALLOC_TERM; CloseSTDLIB();
+#define PERL_SYS_TERM()		HINTS_REFCNT_TERM; OP_REFCNT_TERM; MALLOC_TERM; CloseSTDLIB();
 #endif
 
 #define BIT_BUCKET "NUL:"
diff --git a/unixish.h b/unixish.h
index 23b3cadf12..f464d8302b 100644
--- a/unixish.h
+++ b/unixish.h
@@ -131,7 +131,7 @@
 #endif
 
 #ifndef PERL_SYS_TERM
-#define PERL_SYS_TERM()		OP_REFCNT_TERM; MALLOC_TERM
+#define PERL_SYS_TERM()		HINTS_REFCNT_TERM; OP_REFCNT_TERM; MALLOC_TERM
 #endif
 
 #define BIT_BUCKET "/dev/null"
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 1d08eb552d..af70f06e28 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -370,7 +370,7 @@ struct interp_intern {
 #define BIT_BUCKET "/dev/null"
 #endif
 #define PERL_SYS_INIT(c,v)	MALLOC_CHECK_TAINT2(*c,*v) vms_image_init((c),(v)); MALLOC_INIT
-#define PERL_SYS_TERM()		OP_REFCNT_TERM; MALLOC_TERM
+#define PERL_SYS_TERM()		HINTS_REFCNT_TERM; OP_REFCNT_TERM; MALLOC_TERM
 #define dXSUB_SYS
 #define HAS_KILL
 #define HAS_WAIT
diff --git a/win32/win32.c b/win32/win32.c
index b10d95f798..7c0af0f11d 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -4874,6 +4874,7 @@ Perl_win32_init(int *argcp, char ***argvp)
 void
 Perl_win32_term(void)
 {
+    HINTS_REFCNT_TERM;
     OP_REFCNT_TERM;
     MALLOC_TERM;
 }
diff --git a/wince/wince.c b/wince/wince.c
index dbd960b105..02b278184c 100644
--- a/wince/wince.c
+++ b/wince/wince.c
@@ -2660,6 +2660,7 @@ Perl_win32_init(int *argcp, char ***argvp)
 DllExport void
 Perl_win32_term(void)
 {
+    HINTS_REFCNT_TERM;
     OP_REFCNT_TERM;
     MALLOC_TERM;
 }