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

diff --git a/dosish.h b/dosish.h
index c41d9a7..94a15af 100644 (file)
--- 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 041d8fd..9691e53 100644 (file)
--- 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 bc64df4..29c9e43 100644 (file)
--- 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 dfb0d25..4ae5e1a 100644 (file)
--- 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 e69cc9c..bd667ee 100644 (file)
--- 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 cc6ce88..aac1e16 100644 (file)
--- 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 67ee5fd..b4f3e51 100644 (file)
--- 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 a3f795f..b2054bc 100644 (file)
--- 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 23b3cad..f464d83 100644 (file)
--- 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 1d08eb5..af70f06 100644 (file)
--- 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 b10d95f..7c0af0f 100644 (file)
--- 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 dbd960b..02b2781 100644 (file)
--- 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;
 }