summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2011-05-24 15:11:53 +0100
committerNicholas Clark <nick@ccl4.org>2011-06-11 09:52:56 +0200
commitc13a5c80de2334e935eada0927b9f5f7c862a45e (patch)
tree0c3f447e07e19ac968e711ec579a327c9090125f
parent2bda37bab5fb768caff2b228fda376b75df4815c (diff)
downloadperl-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.c15
-rw-r--r--ext/B/t/optree_misc.t4
-rw-r--r--ext/Devel-Peek/t/Peek.t4
-rw-r--r--pod/perldelta.pod15
-rw-r--r--sv.c2
-rw-r--r--sv.h18
-rw-r--r--util.c4
7 files changed, 34 insertions, 28 deletions
diff --git a/dump.c b/dump.c
index b541aa15be..c3c07b2bdf 100644
--- 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));
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
diff --git a/sv.c b/sv.c
index 530e3bb87e..e0899ba0ce 100644
--- 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 fe8a70af1a..5f58935ddc 100644
--- 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 8c836c2faf..3428a25e39 100644
--- 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