author Nicholas Clark Sat, 27 Dec 2008 09:20:21 +0000 (09:20 +0000) committer David Mitchell Mon, 30 Mar 2009 15:42:24 +0000 (16:42 +0100)
are dealing with is data for the current MRO. Instead the direct pointer "owns"
the (reference to the) data, with the hash pointer left as NULL to signal this.

(cherry picked from commit 553e831a35acc518a30a7514866e0d1440e894ef)

 hv.c patch | blob | blame | history mro.c patch | blob | blame | history

diff --git a/hv.c b/hv.c
index e9bd1bd..c150893 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1703,7 +1703,17 @@ S_hfreeentries(pTHX_ HV *hv)
iter->xhv_eiter = NULL;     /* HvEITER(hv) = NULL */

if((meta = iter->xhv_mro_meta)) {
-                if(meta->mro_linear_dfs) SvREFCNT_dec(meta->mro_linear_dfs);
+               if (meta->mro_linear_dfs) {
+                   SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_dfs));
+                   meta->mro_linear_dfs = NULL;
+                   /* This is just acting as a shortcut pointer.  */
+                   meta->mro_linear_c3 = NULL;
+               } else if (meta->mro_linear_c3) {
+                   /* Only the current MRO is stored, so this owns the data.
+                    */
+                   SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_c3));
+                   meta->mro_linear_c3 = NULL;
+               }
if(meta->mro_nextmethod) SvREFCNT_dec(meta->mro_nextmethod);
SvREFCNT_dec(meta->isa);
Safefree(meta);
diff --git a/mro.c b/mro.c
index 150c03c..d40d141 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -57,16 +57,35 @@ Perl_mro_set_private_data(pTHX_ struct mro_meta *const smeta,
{
PERL_ARGS_ASSERT_MRO_SET_PRIVATE_DATA;

-    /* If we've been asked to look up the private data for the current MRO, then
-       cache it.  */
-    if (smeta->mro_which == which)
-       smeta->mro_linear_c3 = MUTABLE_AV(data);
-
if (!smeta->mro_linear_dfs) {
-       HV *const hv = newHV();
-       HvMAX(hv) = 0;  /* Start with 1 bucket. It's unlikely we'll need more.
-                        */
-       smeta->mro_linear_dfs = MUTABLE_AV(hv);
+       if (smeta->mro_which == which) {
+           /* If all we need to store is the current MRO's data, then don't use
+              memory on a hash with 1 element - store it direct, and signal
+              this by leaving the would-be-hash NULL.  */
+           smeta->mro_linear_c3 = MUTABLE_AV(data);
+           return data;
+       } else {
+           HV *const hv = newHV();
+           /* Start with 2 buckets. It's unlikely we'll need more. */
+           HvMAX(hv) = 1;
+           smeta->mro_linear_dfs = MUTABLE_AV(hv);
+
+           if (smeta->mro_linear_c3) {
+               /* If we were storing something directly, put it in the hash
+                  before we lose it. */
+               Perl_mro_set_private_data(aTHX_ smeta, smeta->mro_which,
+                                         MUTABLE_SV(smeta->mro_linear_c3));
+           }
+       }
+    }
+
+    /* We get here if we're storing more than one linearisation for this stash,
+       or the linearisation we are storing is not that if its current MRO.  */
+
+    if (smeta->mro_which == which) {
+       /* If we've been asked to store the private data for the current MRO,
+          then cache it.  */
+       smeta->mro_linear_c3 = MUTABLE_AV(data);
}

if (!Perl_hv_common(aTHX_ MUTABLE_HV(smeta->mro_linear_dfs), NULL,
@@ -141,10 +160,18 @@ Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param)
Newx(newmeta, 1, struct mro_meta);
Copy(smeta, newmeta, 1, struct mro_meta);

-    if (newmeta->mro_linear_dfs)
+    if (newmeta->mro_linear_dfs) {
newmeta->mro_linear_dfs
= MUTABLE_AV(SvREFCNT_inc(sv_dup((const SV *)newmeta->mro_linear_dfs, param)));
-    newmeta->mro_linear_c3 = NULL;
+       /* This is just acting as a shortcut pointer, and will be automatically
+          updated on the first get.  */
+       newmeta->mro_linear_c3 = NULL;
+    } else if (newmeta->mro_linear_c3) {
+       /* Only the current MRO is stored, so this owns the data.  */
+       newmeta->mro_linear_c3
+           = MUTABLE_AV(SvREFCNT_inc(sv_dup((const SV *)newmeta->mro_linear_c3, param)));
+    }
+
if (newmeta->mro_nextmethod)
newmeta->mro_nextmethod
= MUTABLE_HV(SvREFCNT_inc(sv_dup((const SV *)newmeta->mro_nextmethod, param)));
@@ -407,9 +434,16 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)

/* wipe out the cached linearizations for this stash */
meta = HvMROMETA(stash);
-    SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_dfs));
-    meta->mro_linear_dfs = NULL;
-    meta->mro_linear_c3 = NULL;
+    if (meta->mro_linear_dfs) {
+       SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_dfs));
+       meta->mro_linear_dfs = NULL;
+       /* This is just acting as a shortcut pointer.  */
+       meta->mro_linear_c3 = NULL;
+    } else if (meta->mro_linear_c3) {
+       /* Only the current MRO is stored, so this owns the data.  */
+       SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_c3));
+       meta->mro_linear_c3 = NULL;
+    }
if (meta->isa) {
SvREFCNT_dec(meta->isa);
meta->isa = NULL;
@@ -449,9 +483,16 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)

if(!revstash) continue;
revmeta = HvMROMETA(revstash);
-            SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_dfs));
-            revmeta->mro_linear_dfs = NULL;
-            revmeta->mro_linear_c3 = NULL;
+           if (revmeta->mro_linear_dfs) {
+               SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_dfs));
+               revmeta->mro_linear_dfs = NULL;
+               /* This is just acting as a shortcut pointer.  */
+               revmeta->mro_linear_c3 = NULL;
+           } else if (revmeta->mro_linear_c3) {
+               /* Only the current MRO is stored, so this owns the data.  */
+               SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_c3));
+               revmeta->mro_linear_c3 = NULL;
+           }
if(!is_universal)
revmeta->cache_gen++;
if(revmeta->mro_nextmethod)
@@ -671,7 +712,13 @@ XS(XS_mro_set_mro)
Perl_croak(aTHX_ "Invalid mro name: '%"SVf"'", ST(1));

if(meta->mro_which != which) {
-        meta->mro_which = which;
+       if (meta->mro_linear_c3 && !meta->mro_linear_dfs) {
+           /* If we were storing something directly, put it in the hash before
+              we lose it. */
+           Perl_mro_set_private_data(aTHX_ meta, meta->mro_which,
+                                     MUTABLE_SV(meta->mro_linear_c3));
+       }
+       meta->mro_which = which;
/* Scrub our cached pointer to the private data.  */
meta->mro_linear_c3 = NULL;
/* Only affects local method cache, not
{"ft_lang_label":"__label__en","ft_lang_prob":0.54896766,"math_prob":0.8866184,"size":3963,"snap":"2019-43-2019-47","text_gpt3_token_len":1304,"char_repetition_ratio":0.2601667,"word_repetition_ratio":0.23159784,"special_character_ratio":0.334595,"punctuation_ratio":0.16552901,"nsfw_num_words":0,"has_unicode_error":false,"math_prob_llama3":0.96892005,"pos_list":[0,1,2,3,4,5,6],"im_url_duplicate_count":[null,null,null,null,null,null,null],"WARC_HEADER":"{\"WARC-Type\":\"response\",\"WARC-Date\":\"2019-10-18T16:59:47Z\",\"WARC-Record-ID\":\"<urn:uuid:dc49504d-011d-471a-b76a-96f9bd776517>\",\"Content-Length\":\"29678\",\"Content-Type\":\"application/http; msgtype=response\",\"WARC-Warcinfo-ID\":\"<urn:uuid:fb076b9e-bf21-4635-af2f-dc5114dcab6a>\",\"WARC-Concurrent-To\":\"<urn:uuid:ef468387-e117-469a-a674-2219d94b623a>\",\"WARC-IP-Address\":\"37.10.29.195\",\"WARC-Target-URI\":\"https://perl5.git.perl.org/perl.git/commitdiff/4dead2c6d297fc7f6576fa319c8556574fd3aa27\",\"WARC-Payload-Digest\":\"sha1:OYJN3UCCMUZVJXXMWGW5LDFYECGWPEHT\",\"WARC-Block-Digest\":\"sha1:5ZKWCD3BIHCDKATPCVNOGTEZINWLXSIX\",\"WARC-Identified-Payload-Type\":\"application/xhtml+xml\",\"warc_filename\":\"/cc_download/warc_2019/CC-MAIN-2019-43/CC-MAIN-2019-43_segments_1570986684226.55_warc_CC-MAIN-20191018154409-20191018181909-00137.warc.gz\"}"}