diff options
author | Nicholas Clark <nick@ccl4.org> | 2011-05-24 15:11:53 +0100 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2011-06-11 09:52:56 +0200 |
commit | c13a5c80de2334e935eada0927b9f5f7c862a45e (patch) | |
tree | 0c3f447e07e19ac968e711ec579a327c9090125f | |
parent | 2bda37bab5fb768caff2b228fda376b75df4815c (diff) | |
download | perl-c13a5c80de2334e935eada0927b9f5f7c862a45e.tar.gz |
Store FBMs in PVMGs, instead of GVs.
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).
-rw-r--r-- | dump.c | 15 | ||||
-rw-r--r-- | ext/B/t/optree_misc.t | 4 | ||||
-rw-r--r-- | ext/Devel-Peek/t/Peek.t | 4 | ||||
-rw-r--r-- | pod/perldelta.pod | 15 | ||||
-rw-r--r-- | sv.c | 2 | ||||
-rw-r--r-- | sv.h | 18 | ||||
-rw-r--r-- | util.c | 4 |
7 files changed, 34 insertions, 28 deletions
@@ -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)); diff --git a/ext/B/t/optree_misc.t b/ext/B/t/optree_misc.t index 4c3ea1457f..5e16b9262f 100644 --- a/ext/B/t/optree_misc.t +++ b/ext/B/t/optree_misc.t @@ -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 diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index c0cfa93bce..7c6e985c2d 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -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 diff --git a/pod/perldelta.pod b/pod/perldelta.pod index bea7ea43ff..7536caef15 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -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 @@ -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); @@ -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 @@ -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 |