First stab at using the pad to store the serialised hints data.

This approach is almost certainly not only wrong, but also doomed.
But it's needed to build a correct solution.

p4raw-id: //depot/perl@27768

6 files changed, 68 insertions, 26 deletions

diff --git a/hv.c b/hv.c
index 29c9e43e30..af8fe67821 100644
--- a/hv.c
+++ b/hv.c
@@ -2577,10 +2577,20 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain)
     }
 
     while (chain) {
-	const U32 hash = HEK_HASH(chain->refcounted_he_hek);
+#ifdef USE_ITHREADS
+	SV *const sv = *(av_fetch(chain->refcounted_he_pad,
+				  chain->refcounted_he_hek, FALSE));
+	U32 hash = SvSHARED_HASH(sv);
+#else
+	U32 hash = HEK_HASH(chain->refcounted_he_hek);
+#endif
 	HE **oentry = &((HvARRAY(hv))[hash & max]);
 	HE *entry = *oentry;
 
+#ifdef USE_ITHREADS
+	assert(SvIsCOW_shared_hash(sv));
+#endif
+
 	for (; entry; entry = HeNEXT(entry)) {
 	    if (HeHASH(entry) == hash) {
 		goto next_please;
@@ -2589,9 +2599,16 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain)
 	assert (!entry);
 	entry = new_HE();
 
+#ifdef USE_ITHREADS
+	HeKEY_hek(entry)
+	    = share_hek_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv)));
+	HeVAL(entry) = *(av_fetch(chain->refcounted_he_pad,
+				  chain->refcounted_he_val, FALSE));
+#else
 	HeKEY_hek(entry) = share_hek_hek(chain->refcounted_he_hek);
-
 	HeVAL(entry) = chain->refcounted_he_val;
+#endif
+
 	if (HeVAL(entry) == &PL_sv_placeholder)
 	    placeholders++;
 	SvREFCNT_inc_void_NN(HeVAL(entry));
@@ -2648,9 +2665,21 @@ Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent,
     Newx(he, 1, struct refcounted_he);
 
     he->refcounted_he_next = parent;
+#ifdef USE_ITHREADS
+    he->refcounted_he_hek = pad_alloc(OP_CUSTOM, SVs_PADTMP);
+    SvREFCNT_dec(PAD_SVl(he->refcounted_he_hek));
+    PAD_SETSV(he->refcounted_he_hek,
+	      newSVpvn_share(p, SvUTF8(key) ? -(I32)len : len, hash));
+    he->refcounted_he_val = pad_alloc(OP_CUSTOM, SVs_PADTMP);
+    SvREFCNT_dec(PAD_SVl(he->refcounted_he_val));
+    PAD_SETSV(he->refcounted_he_val, value);
+    he->refcounted_he_pad = PL_comppad;
+    /* FIXME. This is wrong, but without it t/op/caller.t fails.  */
+    SvREFCNT_inc_simple_void_NN(he->refcounted_he_pad);
+#else
     he->refcounted_he_val = value;
-    he->refcounted_he_hek
-	= share_hek(p, SvUTF8(key) ? -(I32)len : len, hash);
+    he->refcounted_he_hek = share_hek(p, SvUTF8(key) ? -(I32)len : len, hash);
+#endif
     he->refcounted_he_refcnt = 1;
 
     return he;
@@ -2670,12 +2699,23 @@ void
 Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
     while (he) {
 	struct refcounted_he *copy;
+	U32 new_count;
 
-	if (--he->refcounted_he_refcnt)
+	HINTS_REFCNT_LOCK;
+	new_count = --he->refcounted_he_refcnt;
+	HINTS_REFCNT_UNLOCK;
+	
+	if (new_count) {
 	    return;
+	}
 
+#ifdef USE_ITHREADS
+	/* FIXME as above */
+	SvREFCNT_dec(he->refcounted_he_pad);
+#else
 	unshare_hek_or_pvn (he->refcounted_he_hek, 0, 0, 0);
 	SvREFCNT_dec(he->refcounted_he_val);
+#endif
 	copy = he;
 	he = he->refcounted_he_next;
 	Safefree(copy);
@@ -2691,7 +2731,7 @@ Duplicates the C<struct refcounted_he *> for a new thread.
 =cut
 */
 
-#if defined(USE_ITHREADS)
+#if 0
 struct refcounted_he *
 Perl_refcounted_he_dup(pTHX_ const struct refcounted_he *const he,
 			CLONE_PARAMS* param)
diff --git a/hv.h b/hv.h
index 4ae5e1af71..223acdb51c 100644
--- a/hv.h
+++ b/hv.h
@@ -388,8 +388,14 @@ C<SV*>.
 
 struct refcounted_he {
     struct refcounted_he *refcounted_he_next;	/* next entry in chain */
+#ifdef USE_ITHREADS
+    PAD                  *refcounted_he_pad;
+    PADOFFSET             refcounted_he_hek;
+    PADOFFSET             refcounted_he_val;
+#else
     HEK                  *refcounted_he_hek;	/* hint key */
     SV                   *refcounted_he_val;	/* hint value */
+#endif
     U32	                  refcounted_he_refcnt;	/* reference count */
 };
 
diff --git a/op.c b/op.c
index 851d35e2bf..64dc9f2e7c 100644
--- a/op.c
+++ b/op.c
@@ -3956,7 +3956,9 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
         cop->cop_io = newSVsv(PL_curcop->cop_io) ;
     cop->cop_hints = PL_curcop->cop_hints;
     if (cop->cop_hints) {
+	HINTS_REFCNT_LOCK;
 	cop->cop_hints->refcounted_he_refcnt++;
+	HINTS_REFCNT_UNLOCK;
     }
 
     if (PL_copline == NOLINE)
diff --git a/pp_ctl.c b/pp_ctl.c
index cb35b5923d..0cb37874c2 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3476,27 +3476,13 @@ PP(pp_entereval)
         SAVEFREESV(PL_compiling.cop_io);
     }
     if (PL_compiling.cop_hints) {
-	PL_compiling.cop_hints->refcounted_he_refcnt--;
+	Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints);
     }
     PL_compiling.cop_hints = PL_curcop->cop_hints;
     if (PL_compiling.cop_hints) {
-#ifdef USE_ITHREADS
-	/* PL_curcop could be pointing to an optree owned by another /.*parent/
-	   thread. We can't manipulate the reference count of the refcounted he
-	   there (race condition) so we have to do something less than
-	   pleasant to keep it read only. The simplest solution seems to be to
-	   copy their chain. We might want to cache this.
-	   Alternatively we could add a flag to the refcounted he *we* point to
-	   here saying "I don't own a reference count on the thing I point to",
-	   and arrange for Perl_refcounted_he_free() to spot that. If so, we'd
-	   still need to copy the topmost refcounted he so that we could change
-	   its flag. So still not trivial. (Flag bits could be hung from the
-	   shared HEK) */
-	PL_compiling.cop_hints
-	    = Perl_refcounted_he_copy(aTHX_ PL_compiling.cop_hints);
-#else
+	HINTS_REFCNT_LOCK;
 	PL_compiling.cop_hints->refcounted_he_refcnt++;
-#endif
+	HINTS_REFCNT_UNLOCK;
     }
     /* special case: an eval '' executed within the DB package gets lexically
      * placed in the first non-DB CV rather than the current CV - this
diff --git a/scope.h b/scope.h
index 772eb41bd6..e5160e1b36 100644
--- a/scope.h
+++ b/scope.h
@@ -158,7 +158,9 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 	    GvHV(PL_hintgv) = Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv)); \
 	}						\
 	if (PL_compiling.cop_hints) {			\
+	    HINTS_REFCNT_LOCK;				\
 	    PL_compiling.cop_hints->refcounted_he_refcnt++;	\
+	    HINTS_REFCNT_UNLOCK;			\
 	}						\
 	SSPUSHPTR(PL_compiling.cop_hints);		\
 	SSPUSHINT(PL_hints);				\
diff --git a/sv.c b/sv.c
index e84b0e594d..cf42029ef4 100644
--- a/sv.c
+++ b/sv.c
@@ -10578,7 +10578,10 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 	    i = POPINT(ss,ix);
 	    TOPINT(nss,ix) = i;
 	    ptr = POPPTR(ss,ix);
-	    TOPPTR(nss,ix) = Perl_refcounted_he_dup(aTHX_ ptr, param);
+	    HINTS_REFCNT_LOCK;
+	    ((COP *)ptr)->cop_hints->refcounted_he_refcnt++;
+	    HINTS_REFCNT_UNLOCK;
+	    TOPPTR(nss,ix) = ptr;
 	    if (i & HINT_LOCALIZE_HH) {
 		hv = (HV*)POPPTR(ss,ix);
 		TOPPTR(nss,ix) = hv_dup_inc(hv, param);
@@ -10939,8 +10942,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 	PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings, param);
     if (!specialCopIO(PL_compiling.cop_io))
 	PL_compiling.cop_io = sv_dup_inc(PL_compiling.cop_io, param);
-    PL_compiling.cop_hints
-	= Perl_refcounted_he_dup(aTHX_ PL_compiling.cop_hints, param);
+    if (PL_compiling.cop_hints) {
+	HINTS_REFCNT_LOCK;
+	PL_compiling.cop_hints->refcounted_he_refcnt++;
+	HINTS_REFCNT_UNLOCK;
+    }
     PL_curcop		= (COP*)any_dup(proto_perl->Tcurcop, proto_perl);
 
     /* pseudo environmental stuff */