This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In S_mro_get_linear_isa_dfs(), save copying by making a shared hash
authorNicholas Clark <nick@ccl4.org>
Fri, 22 Aug 2008 07:00:17 +0000 (07:00 +0000)
committerNicholas Clark <nick@ccl4.org>
Fri, 22 Aug 2008 07:00:17 +0000 (07:00 +0000)
key scalar from the key of the hash entry we've just creating.
(Currently the hash is disposed of afterwards, but soon it won't, so
having both point to the same string buffer will also save memory.)

p4raw-id: //depot/perl@34215

mro.c
sv.c

diff --git a/mro.c b/mro.c
index a7ea282..ffb72ab 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -193,9 +193,23 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, I32 level)
                    /* It was newly created.  Steal it for our new SV, and
                       replace it in the hash with the "real" thing.  */
                    SV *const val = HeVAL(he);
                    /* It was newly created.  Steal it for our new SV, and
                       replace it in the hash with the "real" thing.  */
                    SV *const val = HeVAL(he);
+                   HEK *const key = HeKEY_hek(he);
 
                    HeVAL(he) = &PL_sv_undef;
 
                    HeVAL(he) = &PL_sv_undef;
-                   sv_setsv(val, subsv);
+                   /* Save copying by making a shared hash key scalar. We
+                      inline this here rather than calling Perl_newSVpvn_share
+                      because we already have the scalar, and we already have
+                      the hash key.  */
+                   assert(SvTYPE(val) == SVt_NULL);
+                   sv_upgrade(val, SVt_PV);
+                   SvPV_set(val, HEK_KEY(share_hek_hek(key)));
+                   SvCUR_set(val, HEK_LEN(key));
+                   SvREADONLY_on(val);
+                   SvFAKE_on(val);
+                   SvPOK_on(val);
+                   if (HEK_UTF8(key))
+                       SvUTF8_on(val);
+
                    av_push(retval, val);
                }
             }
                    av_push(retval, val);
                }
             }
diff --git a/sv.c b/sv.c
index 5fcf018..f56d70c 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -7502,6 +7502,8 @@ Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
     if (!hash)
        PERL_HASH(hash, src, len);
     new_SV(sv);
     if (!hash)
        PERL_HASH(hash, src, len);
     new_SV(sv);
+    /* The logic for this is inlined in S_mro_get_linear_isa_dfs(), so if it
+       changes here, update it there too.  */
     sv_upgrade(sv, SVt_PV);
     SvPV_set(sv, sharepvn(src, is_utf8?-len:len, hash));
     SvCUR_set(sv, len);
     sv_upgrade(sv, SVt_PV);
     SvPV_set(sv, sharepvn(src, is_utf8?-len:len, hash));
     SvCUR_set(sv, len);