We no longer need PL_shared_hek_table

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 81f407c..d101c1d 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3441,8 +3441,22 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
             register const char *typestr;
             if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) &&
                 (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
-               /* FIXME - figure out best way to pass context inwards.  */
-                char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr);
+               /* Unwrap this:  */
+               /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr); */
+
+                char *pv;
+               if ((SvFLAGS(tmpstr) & (SVf_POK)) == SVf_POK) {
+                   if (flags & SV_CONST_RETURN) {
+                       pv = (char *) SvPVX_const(tmpstr);
+                   } else {
+                       pv = (flags & SV_MUTABLE_RETURN)
+                           ? SvPVX_mutable(tmpstr) : SvPVX(tmpstr);
+                   }
+                   if (lp)
+                       *lp = SvCUR(tmpstr);
+               } else {
+                   pv = sv_2pv_flags(tmpstr, lp, flags);
+               }
                 if (SvUTF8(tmpstr))
                     SvUTF8_on(sv);
                 else
@@ -4548,16 +4562,13 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
 #endif
                {
                     /* SvIsCOW_shared_hash */
-                    UV hash = SvSHARED_HASH(sstr);
                     DEBUG_C(PerlIO_printf(Perl_debug_log,
                                           "Copy on write: Sharing hash\n"));
 
-                   assert (SvTYPE(dstr) >= SVt_PVIV);
+                   assert (SvTYPE(dstr) >= SVt_PV);
                     SvPV_set(dstr,
-                             sharepvn(SvPVX_const(sstr),
-                                      (sflags & SVf_UTF8?-cur:cur), hash));
-                    SvUV_set(dstr, hash);
-                }
+                            HEK_KEY(share_hek_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr)))));
+               }
                 SvLEN_set(dstr, len);
                 SvCUR_set(dstr, cur);
                 SvREADONLY_on(dstr);
@@ -4694,11 +4705,9 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
 
        if (SvLEN(sstr) == 0) {
            /* source is a COW shared hash key.  */
-           UV hash = SvSHARED_HASH(sstr);
            DEBUG_C(PerlIO_printf(Perl_debug_log,
                                  "Fast copy on write: Sharing hash\n"));
-           SvUV_set(dstr, hash);
-           new_pv = sharepvn(SvPVX_const(sstr), (SvUTF8(sstr)?-cur:cur), hash);
+           new_pv = HEK_KEY(share_hek_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr))));
            goto common_exit;
        }
        SV_COW_NEXT_SV_SET(dstr, SV_COW_NEXT_SV(sstr));
@@ -4882,8 +4891,7 @@ Perl_sv_usepvn_mg(pTHX_ register SV *sv, register char *ptr, register STRLEN len
    (which it can do by means other than releasing copy-on-write Svs)
    or by changing the other copy-on-write SVs in the loop.  */
 STATIC void
-S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN cur, STRLEN len,
-                 U32 hash, SV *after)
+S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN len, SV *after)
 {
     if (len) { /* this SV was SvIsCOW_normal(sv) */
          /* we need to find the SV pointing to us.  */
@@ -4910,7 +4918,7 @@ S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN cur, STRLEN len,
             SV_COW_NEXT_SV_SET(current, after);
         }
     } else {
-        unsharepvn(pvx, SvUTF8(sv) ? -(I32)cur : cur, hash);
+        unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
     }
 }
 
@@ -4949,7 +4957,6 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
            const char *pvx = SvPVX_const(sv);
            const STRLEN len = SvLEN(sv);
            const STRLEN cur = SvCUR(sv);
-           const U32 hash = SvSHARED_HASH(sv);
            SV * const next = SV_COW_NEXT_SV(sv);   /* next COW sv in the loop. */
             if (DEBUG_C_TEST) {
                 PerlIO_printf(Perl_debug_log,
@@ -4971,7 +4978,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
                 SvCUR_set(sv, cur);
                 *SvEND(sv) = '\0';
             }
-            sv_release_COW(sv, pvx, cur, len, hash, next);
+            sv_release_COW(sv, pvx, len, next);
             if (DEBUG_C_TEST) {
                 sv_dump(sv);
             }
@@ -4984,9 +4991,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
     if (SvREADONLY(sv)) {
        if (SvFAKE(sv)) {
            const char *pvx = SvPVX_const(sv);
-           const int is_utf8 = SvUTF8(sv);
            const STRLEN len = SvCUR(sv);
-           const U32 hash = SvSHARED_HASH(sv);
            SvFAKE_off(sv);
            SvREADONLY_off(sv);
            SvPV_set(sv, Nullch);
@@ -4994,7 +4999,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
            SvGROW(sv, len + 1);
            Move(pvx,SvPVX_const(sv),len,char);
            *SvEND(sv) = '\0';
-           unsharepvn(pvx, is_utf8 ? -(I32)len : len, hash);
+           unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
        }
        else if (IN_PERL_RUNTIME)
            Perl_croak(aTHX_ PL_no_modify);
@@ -5990,8 +5995,8 @@ Perl_sv_clear(pTHX_ register SV *sv)
                     PerlIO_printf(Perl_debug_log, "Copy on write: clear\n");
                     sv_dump(sv);
                 }
-                sv_release_COW(sv, SvPVX_const(sv), SvCUR(sv), SvLEN(sv),
-                                 SvUVX(sv), SV_COW_NEXT_SV(sv));
+                sv_release_COW(sv, SvPVX_const(sv), SvLEN(sv),
+                              SV_COW_NEXT_SV(sv));
                 /* And drop it here.  */
                 SvFAKE_off(sv);
             } else if (SvLEN(sv)) {
@@ -6002,9 +6007,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
        else if (SvPVX_const(sv) && SvLEN(sv))
            Safefree(SvPVX_const(sv));
        else if (SvPVX_const(sv) && SvREADONLY(sv) && SvFAKE(sv)) {
-           unsharepvn(SvPVX_const(sv),
-                      SvUTF8(sv) ? -(I32)SvCUR(sv) : SvCUR(sv),
-                      SvUVX(sv));
+           unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv)));
            SvFAKE_off(sv);
        }
 #endif
@@ -7715,10 +7718,9 @@ Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
     if (!hash)
        PERL_HASH(hash, src, len);
     new_SV(sv);
-    sv_upgrade(sv, SVt_PVIV);
+    sv_upgrade(sv, SVt_PV);
     SvPV_set(sv, sharepvn(src, is_utf8?-len:len, hash));
     SvCUR_set(sv, len);
-    SvUV_set(sv, hash);
     SvLEN_set(sv, 0);
     SvREADONLY_on(sv);
     SvFAKE_on(sv);
@@ -10738,22 +10740,11 @@ Perl_rvpv_dup(pTHX_ SV *dstr, SV *sstr, CLONE_PARAMS* param)
        }
        else {
            /* Special case - not normally malloced for some reason */
-           if (SvREADONLY(sstr) && SvFAKE(sstr)) {
-               /* A "shared" PV - clone it as unshared string */
-                if(SvPADTMP(sstr)) {
-                    /* However, some of them live in the pad
-                       and they should not have these flags
-                       turned off */
-
-                    SvPV_set(dstr, sharepvn(SvPVX_const(sstr), SvCUR(sstr),
-                                           SvUVX(sstr)));
-                    SvUV_set(dstr, SvUVX(sstr));
-                } else {
-
-                    SvPV_set(dstr, SAVEPVN(SvPVX_const(sstr), SvCUR(sstr)));
-                    SvFAKE_off(dstr);
-                    SvREADONLY_off(dstr);
-                }
+           if ((SvREADONLY(sstr) && SvFAKE(sstr))) {
+               /* A "shared" PV - clone it as "shared" PV */
+               SvPV_set(dstr,
+                        HEK_KEY(hek_dup(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr)),
+                                        param)));
            }
            else {
                /* Some other special case - random pointer */
@@ -11785,8 +11776,6 @@ 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;
@@ -12416,8 +12405,6 @@ 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