This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Store FBMs in PVMGs, instead of GVs.
authorNicholas Clark <nick@ccl4.org>
Tue, 24 May 2011 14:11:53 +0000 (15:11 +0100)
committerNicholas Clark <nick@ccl4.org>
Sat, 11 Jun 2011 07:52:56 +0000 (09:52 +0200)
This should reduce the complexity of code dealing with GVs, as they no longer
try to play several different incompatible roles.

(As suggested by Ben Morrow. However, it didn't turn out to be as
straightforward as one might have hoped).

dump.c
ext/B/t/optree_misc.t
ext/Devel-Peek/t/Peek.t
pod/perldelta.pod
sv.c
sv.h
util.c

diff --git a/dump.c b/dump.c
index b541aa1..c3c07b2 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1647,8 +1647,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                sv_catpv(d, " ),");
            }
        }
-       if (SvTAIL(sv))         sv_catpv(d, "TAIL,");
-       if (SvVALID(sv))        sv_catpv(d, "VALID,");
        /* FALL THROUGH */
     default:
     evaled_or_uv:
@@ -1656,6 +1654,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (SvIsUV(sv) && !(flags & SVf_ROK))   sv_catpv(d, "IsUV,");
        break;
     case SVt_PVMG:
+       if (SvTAIL(sv))         sv_catpv(d, "TAIL,");
+       if (SvVALID(sv))        sv_catpv(d, "VALID,");
        if (SvPAD_TYPED(sv))    sv_catpv(d, "TYPED,");
        if (SvPAD_OUR(sv))      sv_catpv(d, "OUR,");
        /* FALL THROUGH */
@@ -1798,6 +1798,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        }
        if (SvSTASH(sv))
            do_hv_dump(level, file, "  STASH", SvSTASH(sv));
+
+       if ((type == SVt_PVMG || type == SVt_PVLV) && SvVALID(sv)) {
+           Perl_dump_indent(aTHX_ level, file, "  RARE = %u\n", (U8)BmRARE(sv));
+           Perl_dump_indent(aTHX_ level, file, "  PREVIOUS = %"UVuf"\n", (UV)BmPREVIOUS(sv));
+           Perl_dump_indent(aTHX_ level, file, "  USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
+       }
     }
 
     /* Dump type-specific SV fields */
@@ -2089,11 +2095,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
                    dumpops, pvlim);
        }
-       if (SvVALID(sv)) {
-           Perl_dump_indent(aTHX_ level, file, "  RARE = %u\n", (U8)BmRARE(sv));
-           Perl_dump_indent(aTHX_ level, file, "  PREVIOUS = %"UVuf"\n", (UV)BmPREVIOUS(sv));
-           Perl_dump_indent(aTHX_ level, file, "  USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
-       }
        if (!isGV_with_GP(sv))
            break;
        Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", GvNAME(sv));
index 4c3ea14..5e16b92 100644 (file)
@@ -95,7 +95,7 @@ my $t = <<'EOT_EOT';
 # 5        <@> index[t2] sK/2 ->6
 # -           <0> ex-pushmark s ->3
 # 3           <$> const[PV "foo"] s ->4
-# 4           <$> const[GV "foo"] s ->5
+# 4           <$> const[PVMG "foo"] s ->5
 # -        <1> ex-rv2sv sKRM*/1 ->7
 # 6           <#> gvsv[*_] s ->7
 EOT_EOT
@@ -107,7 +107,7 @@ my $nt = <<'EONT_EONT';
 # 5        <@> index[t1] sK/2 ->6
 # -           <0> ex-pushmark s ->3
 # 3           <$> const(PV "foo") s ->4
-# 4           <$> const(GV "foo") s ->5
+# 4           <$> const(PVMG "foo") s ->5
 # -        <1> ex-rv2sv sKRM*/1 ->7
 # 6           <$> gvsv(*_) s ->7
 EONT_EONT
index c0cfa93..7c6e985 100644 (file)
@@ -807,7 +807,7 @@ unless ($Config{useithreads}) {
     # eval"
 
     do_test('string constant now an FBM', perl,
-'SV = PVGV\\($ADDR\\) at $ADDR
+'SV = PVMG\\($ADDR\\) at $ADDR
   REFCNT = 5
   FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)
   PV = $ADDR "rules"\\\0
@@ -826,7 +826,7 @@ unless ($Config{useithreads}) {
     is(study perl, '', "Not allowed to study an FBM");
 
     do_test('string constant still an FBM', perl,
-'SV = PVGV\\($ADDR\\) at $ADDR
+'SV = PVMG\\($ADDR\\) at $ADDR
   REFCNT = 5
   FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)
   PV = $ADDR "rules"\\\0
index bea7ea4..7536cae 100644 (file)
@@ -611,6 +611,13 @@ be noted as well.
 
 =item *
 
+When empting a hash of its elements (e.g. via undef(%h), or %h=()), HvARRAY
+field is no longer temporarily zeroed.  Any destructors called on the freed
+elements see the remaining elements. Thus, %h=() becomes more like C<delete
+$h{$_} for keys %h>.
+
+=item *
+
 The compiled representation of formats is now stored via the mg_ptr of
 their PERL_MAGIC_fm. Previously it was stored in the string buffer,
 beyond SvLEN(), the regular end of the string. SvCOMPILED() and
@@ -619,10 +626,10 @@ The first is always 0, the other two now no-ops.
 
 =item *
 
-When empting a hash of its elements (e.g. via undef(%h), or %h=()), HvARRAY
-field is no longer temporarily zeroed.  Any destructors called on the freed
-elements see the remaining elements. Thus, %h=() becomes more like C<delete
-$h{$_} for keys %h>.
+Boyer-Moore compiled scalars are now PVMGs, and the Boyer-Moore tables are now
+stored via the mg_ptr of their PERL_MAGIC_bm. Previously they were PVGVs, with
+the tables stored in the string buffer, beyond SvLEN(). This eliminates the
+last place where the core stores data beyond SvLEN().
 
 =back
 
diff --git a/sv.c b/sv.c
index 530e3bb..e0899ba 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4088,8 +4088,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
        /* case SVt_BIND: */
     case SVt_PVLV:
     case SVt_PVGV:
-       /* SvVALID means that this PVGV is playing at being an FBM.  */
-
     case SVt_PVMG:
        if (SvGMAGICAL(sstr) && (flags & SV_GMAGIC)) {
            mg_get(sstr);
diff --git a/sv.h b/sv.h
index fe8a70a..5f58935 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -1298,27 +1298,27 @@ the scalar's value cannot change unless written to.
 #if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
 #  define BmRARE(sv)                                                   \
        (*({ SV *const _bmrare = MUTABLE_SV(sv);                        \
-               assert(SvTYPE(_bmrare) == SVt_PVGV);                    \
+               assert(SvTYPE(_bmrare) == SVt_PVMG);                    \
                assert(SvVALID(_bmrare));                               \
-           &(((XPVGV*) SvANY(_bmrare))->xnv_u.xbm_s.xbm_rare);         \
+           &(((XPVMG*) SvANY(_bmrare))->xnv_u.xbm_s.xbm_rare);         \
         }))
 #  define BmUSEFUL(sv)                                                 \
        (*({ SV *const _bmuseful = MUTABLE_SV(sv);                      \
-           assert(SvTYPE(_bmuseful) == SVt_PVGV);                      \
+           assert(SvTYPE(_bmuseful) == SVt_PVMG);                      \
            assert(SvVALID(_bmuseful));                                 \
            assert(!SvIOK(_bmuseful));                                  \
-           &(((XPVGV*) SvANY(_bmuseful))->xnv_u.xbm_s.xbm_useful);     \
+           &(((XPVMG*) SvANY(_bmuseful))->xnv_u.xbm_s.xbm_useful);     \
         }))
 #  define BmPREVIOUS(sv)                                               \
     (*({ SV *const _bmprevious = MUTABLE_SV(sv);                       \
-               assert(SvTYPE(_bmprevious) == SVt_PVGV);                \
+               assert(SvTYPE(_bmprevious) == SVt_PVMG);                \
                assert(SvVALID(_bmprevious));                           \
-           &(((XPVGV*) SvANY(_bmprevious))->xiv_u.xivu_uv);            \
+           &(((XPVMG*) SvANY(_bmprevious))->xiv_u.xivu_uv);            \
         }))
 #else
-#  define BmRARE(sv)           ((XPVGV*) SvANY(sv))->xnv_u.xbm_s.xbm_rare
-#  define BmUSEFUL(sv)         ((XPVGV*) SvANY(sv))->xnv_u.xbm_s.xbm_useful
-#  define BmPREVIOUS(sv)       ((XPVGV*) SvANY(sv))->xiv_u.xivu_uv
+#  define BmRARE(sv)           ((XPVMG*) SvANY(sv))->xnv_u.xbm_s.xbm_rare
+#  define BmUSEFUL(sv)         ((XPVMG*) SvANY(sv))->xnv_u.xbm_s.xbm_useful
+#  define BmPREVIOUS(sv)       ((XPVMG*) SvANY(sv))->xiv_u.xivu_uv
 
 #endif
 
diff --git a/util.c b/util.c
index 8c836c2..3428a25 100644 (file)
--- a/util.c
+++ b/util.c
@@ -572,7 +572,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
     s = (U8*)SvPV_force_mutable(sv, len);
     if (len == 0)              /* TAIL might be on a zero-length string. */
        return;
-    SvUPGRADE(sv, SVt_PVGV);
+    SvUPGRADE(sv, SVt_PVMG);
     SvIOK_off(sv);
     SvNOK_off(sv);
     SvVALID_on(sv);
@@ -864,7 +864,7 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
 
     PERL_ARGS_ASSERT_SCREAMINSTR;
 
-    assert(SvTYPE(littlestr) == SVt_PVGV);
+    assert(SvTYPE(littlestr) == SVt_PVMG);
     assert(SvVALID(littlestr));
 
     if (*old_posp == -1