Change 29544 by [EMAIL PROTECTED] on 2006/12/13 08:35:43
Eliminate PVBM. Store fast Boyer-Moore tables in PVGV.
Add the placeholder for new type, temporarily named BIND, for binding
and aliasing in 6 on 5.
Affected files ...
... //depot/perl/dump.c#240 edit
... //depot/perl/ext/B/B.xs#123 edit
... //depot/perl/ext/Storable/Storable.xs#125 edit
... //depot/perl/op.h#160 edit
... //depot/perl/pod/perltodo.pod#167 edit
... //depot/perl/pp_hot.c#491 edit
... //depot/perl/sv.c#1335 edit
... //depot/perl/sv.h#300 edit
... //depot/perl/util.c#600 edit
Differences ...
==== //depot/perl/dump.c#240 (text) ====
Index: perl/dump.c
--- perl/dump.c#239~29540~ 2006-12-12 14:30:29.000000000 -0800
+++ perl/dump.c 2006-12-13 00:35:43.000000000 -0800
@@ -32,11 +32,11 @@
"IV",
"NV",
"RV",
+ "BIND",
"PV",
"PVIV",
"PVNV",
"PVMG",
- "PVBM",
"PVGV",
"PVLV",
"PVAV",
@@ -52,11 +52,11 @@
"IV",
"NV",
"RV",
+ "BIND",
"PV",
"PVIV",
"PVNV",
"PVMG",
- "BM",
"GV",
"PVLV",
"AV",
@@ -1429,16 +1429,14 @@
sv_catpv(d, " ),");
}
}
+ if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
+ if (SvVALID(sv)) sv_catpv(d, "VALID,");
/* FALL THROUGH */
default:
evaled_or_uv:
if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
break;
- case SVt_PVBM:
- if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
- if (SvVALID(sv)) sv_catpv(d, "VALID,");
- break;
case SVt_PVMG:
if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
@@ -2341,8 +2339,8 @@
case SVt_PVGV:
sv_catpv(t, " GV=\"");
break;
- case SVt_PVBM:
- sv_catpv(t, " BM=\"");
+ case SVt_BIND:
+ sv_catpv(t, " BIND=\"");
break;
case SVt_PVFM:
sv_catpv(t, " FM=\"");
==== //depot/perl/ext/B/B.xs#123 (text) ====
Index: perl/ext/B/B.xs
--- perl/ext/B/B.xs#122~29538~ 2006-12-12 13:54:22.000000000 -0800
+++ perl/ext/B/B.xs 2006-12-13 00:35:43.000000000 -0800
@@ -24,11 +24,16 @@
"B::IV",
"B::NV",
"B::RV",
+#if PERL_VERSION >= 9
+ "B::BIND",
+#endif
"B::PV",
"B::PVIV",
"B::PVNV",
"B::PVMG",
+#if PERL_VERSION <= 8
"B::BM",
+#endif
#if PERL_VERSION >= 9
"B::GV",
#endif
==== //depot/perl/ext/Storable/Storable.xs#125 (text) ====
Index: perl/ext/Storable/Storable.xs
--- perl/ext/Storable/Storable.xs#124~29511~ 2006-12-11 05:23:55.000000000
-0800
+++ perl/ext/Storable/Storable.xs 2006-12-13 00:35:43.000000000 -0800
@@ -3457,7 +3457,9 @@
if (SvRMAGICAL(sv) && (mg_find(sv, 'p')))
return svis_TIED_ITEM;
/* FALL THROUGH */
+#if PERL_VERSION < 9
case SVt_PVBM:
+#endif
if (SvRMAGICAL(sv) && (mg_find(sv, 'q')))
return svis_TIED;
return SvROK(sv) ? svis_REF : svis_SCALAR;
@@ -3471,6 +3473,9 @@
return svis_HASH;
case SVt_PVCV:
return svis_CODE;
+#if PERL_VERSION > 8
+ /* case SVt_BIND: */
+#endif
default:
break;
}
==== //depot/perl/op.h#160 (text) ====
Index: perl/op.h
--- perl/op.h#159~29543~ 2006-12-12 17:47:34.000000000 -0800
+++ perl/op.h 2006-12-13 00:35:43.000000000 -0800
@@ -460,7 +460,8 @@
#ifdef USE_ITHREADS
# define cGVOPx_gv(o) ((GV*)PAD_SVl(cPADOPx(o)->op_padix))
-# define IS_PADGV(v) (v && SvTYPE(v) == SVt_PVGV && GvIN_PAD(v))
+# define IS_PADGV(v) (v && SvTYPE(v) == SVt_PVGV && isGV_with_GP(v) \
+ && GvIN_PAD(v))
# define IS_PADCONST(v) (v && SvREADONLY(v))
# define cSVOPx_sv(v) (cSVOPx(v)->op_sv \
? cSVOPx(v)->op_sv : PAD_SVl((v)->op_targ))
==== //depot/perl/pod/perltodo.pod#167 (text) ====
Index: perl/pod/perltodo.pod
--- perl/pod/perltodo.pod#166~29435~ 2006-12-02 01:10:01.000000000 -0800
+++ perl/pod/perltodo.pod 2006-12-13 00:35:43.000000000 -0800
@@ -405,15 +405,6 @@
the perl API that comes from writing modules that use XS to interface to
C.
-=head2 shrink C<PVBM>s
-
-By removing unused elements and careful re-ordering, the structures for C<AV>s,
-C<HV>s, C<CV>s and C<GV>s have recently been shrunk considerably. C<PVIO>s
-probably aren't worth it, as typical programs don't use more than 8, and
-(at least) C<Filter::Util::Call> uses C<SvPVX>/C<SvCUR>/C<SvLEN> on a C<PVIO>,
-so it would mean code changes to modules on CPAN. C<PVBM>s might have some
-savings to win.
-
=head2 autovivification
Make all autovivification consistent w.r.t LVALUE/RVALUE and strict/no strict;
==== //depot/perl/pp_hot.c#491 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#490~29463~ 2006-12-04 14:50:09.000000000 -0800
+++ perl/pp_hot.c 2006-12-13 00:35:43.000000000 -0800
@@ -2120,7 +2120,8 @@
!is_cow &&
#endif
(SvREADONLY(TARG)
- || ( (SvTYPE(TARG) == SVt_PVGV || SvTYPE(TARG) > SVt_PVLV)
+ || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
+ || SvTYPE(TARG) > SVt_PVLV)
&& !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
DIE(aTHX_ PL_no_modify);
PUTBACK;
==== //depot/perl/sv.c#1335 (text) ====
Index: perl/sv.c
--- perl/sv.c#1334~29539~ 2006-12-12 14:03:21.000000000 -0800
+++ perl/sv.c 2006-12-13 00:35:43.000000000 -0800
@@ -904,6 +904,9 @@
/* RVs are in the head now. */
{ 0, 0, 0, SVt_RV, FALSE, NONV, NOARENA, 0 },
+ /* The bind placeholder pretends to be an RV for now. */
+ { 0, 0, 0, SVt_BIND, FALSE, NONV, NOARENA, 0 },
+
/* 8 bytes on most ILP32 with IEEE doubles */
{ sizeof(xpv_allocated),
copy_length(XPV, xpv_len)
@@ -926,10 +929,6 @@
{ sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_PVMG, FALSE, HADNV,
HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
- /* 36 */
- { sizeof(XPVBM), sizeof(XPVBM), 0, SVt_PVBM, TRUE, HADNV,
- HASARENA, FIT_ARENA(0, sizeof(XPVBM)) },
-
/* 48 */
{ sizeof(XPVGV), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
HASARENA, FIT_ARENA(0, sizeof(XPVGV)) },
@@ -1293,7 +1292,6 @@
assert(!SvNOK(sv));
case SVt_PVIO:
case SVt_PVFM:
- case SVt_PVBM:
case SVt_PVGV:
case SVt_PVCV:
case SVt_PVLV:
@@ -2159,8 +2157,8 @@
dVAR;
if (!sv)
return 0;
- if (SvGMAGICAL(sv) || SvTYPE(sv) == SVt_PVBM) {
- /* PVBMs use the same flag bit as SVf_IVisUV, so must let them
+ if (SvGMAGICAL(sv) || (SvTYPE(sv) == SVt_PVGV && SvVALID(sv))) {
+ /* FBMs use the same flag bit as SVf_IVisUV, so must let them
cache IVs just in case. In practice it seems that they never
actually anywhere accessible by user Perl code, let alone get used
in anything other than a string context. */
@@ -2243,8 +2241,8 @@
dVAR;
if (!sv)
return 0;
- if (SvGMAGICAL(sv) || SvTYPE(sv) == SVt_PVBM) {
- /* PVBMs use the same flag bit as SVf_IVisUV, so must let them
+ if (SvGMAGICAL(sv) || (SvTYPE(sv) == SVt_PVGV && SvVALID(sv))) {
+ /* FBMs use the same flag bit as SVf_IVisUV, so must let them
cache IVs just in case. */
if (flags & SV_GMAGIC)
mg_get(sv);
@@ -2320,8 +2318,8 @@
dVAR;
if (!sv)
return 0.0;
- if (SvGMAGICAL(sv) || SvTYPE(sv) == SVt_PVBM) {
- /* PVBMs use the same flag bit as SVf_IVisUV, so must let them
+ if (SvGMAGICAL(sv) || (SvTYPE(sv) == SVt_PVGV && SvVALID(sv))) {
+ /* FBMs use the same flag bit as SVf_IVisUV, so must let them
cache IVs just in case. */
mg_get(sv);
if (SvNOKp(sv))
@@ -3453,21 +3451,22 @@
}
break;
+ /* case SVt_BIND: */
case SVt_PVGV:
- if (dtype <= SVt_PVGV) {
+ if (isGV_with_GP(sstr) && dtype <= SVt_PVGV) {
glob_assign_glob(dstr, sstr, dtype);
return;
}
+ /* SvVALID means that this PVGV is playing at being an FBM. */
/*FALLTHROUGH*/
case SVt_PVMG:
case SVt_PVLV:
- case SVt_PVBM:
if (SvGMAGICAL(sstr) && (flags & SV_GMAGIC)) {
mg_get(sstr);
if (SvTYPE(sstr) != stype) {
stype = SvTYPE(sstr);
- if (stype == SVt_PVGV && dtype <= SVt_PVGV) {
+ if (isGV_with_GP(sstr) && stype == SVt_PVGV && dtype <=
SVt_PVGV) {
glob_assign_glob(dstr, sstr, dtype);
return;
}
@@ -3498,7 +3497,8 @@
SvOK_off(dstr);
}
} else if (sflags & SVf_ROK) {
- if (dtype == SVt_PVGV && SvTYPE(SvRV(sstr)) == SVt_PVGV) {
+ if (isGV_with_GP(dstr) && dtype == SVt_PVGV
+ && SvTYPE(SvRV(sstr)) == SVt_PVGV) {
sstr = SvRV(sstr);
if (sstr == dstr) {
if (GvIMPORTED(dstr) != GVf_IMPORTED
@@ -3532,7 +3532,7 @@
assert(!(sflags & SVf_NOK));
assert(!(sflags & SVf_IOK));
}
- else if (dtype == SVt_PVGV) {
+ else if (dtype == SVt_PVGV && isGV_with_GP(dstr)) {
if (!(sflags & SVf_OK)) {
if (ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_MISC),
@@ -5106,8 +5106,7 @@
}
}
if (type >= SVt_PVMG) {
- if ((type == SVt_PVMG || type == SVt_PVGV) && SvPAD_OUR(sv)) {
- assert(type != SVt_PVGV);
+ if (type == SVt_PVMG && SvPAD_OUR(sv)) {
SvREFCNT_dec(OURSTASH(sv));
} else if (SvMAGIC(sv))
mg_free(sv);
@@ -5115,6 +5114,7 @@
SvREFCNT_dec(SvSTASH(sv));
}
switch (type) {
+ /* case SVt_BIND: */
case SVt_PVIO:
if (IoIFP(sv) &&
IoIFP(sv) != PerlIO_stdin() &&
@@ -5130,8 +5130,6 @@
Safefree(IoFMT_NAME(sv));
Safefree(IoBOTTOM_NAME(sv));
goto freescalar;
- case SVt_PVBM:
- goto freescalar;
case SVt_PVCV:
case SVt_PVFM:
cv_undef((CV*)sv);
@@ -5153,14 +5151,15 @@
SvREFCNT_dec(LvTARG(sv));
goto freescalar;
case SVt_PVGV:
- gp_free((GV*)sv);
- if (GvNAME_HEK(sv)) {
- unshare_hek(GvNAME_HEK(sv));
- }
+ if (isGV_with_GP(sv)) {
+ gp_free((GV*)sv);
+ if (GvNAME_HEK(sv))
+ unshare_hek(GvNAME_HEK(sv));
/* If we're in a stash, we don't own a reference to it. However it does
have a back reference to us, which needs to be cleared. */
- if (GvSTASH(sv))
- sv_del_backref((SV*)GvSTASH(sv), sv);
+ if (!SvVALID(sv) && GvSTASH(sv))
+ sv_del_backref((SV*)GvSTASH(sv), sv);
+ }
case SVt_PVMG:
case SVt_PVNV:
case SVt_PVIV:
@@ -7637,7 +7636,6 @@
case SVt_PVIV:
case SVt_PVNV:
case SVt_PVMG:
- case SVt_PVBM:
if (SvVOK(sv))
return "VSTRING";
if (SvROK(sv))
@@ -7656,6 +7654,7 @@
case SVt_PVGV: return "GLOB";
case SVt_PVFM: return "FORMAT";
case SVt_PVIO: return "IO";
+ case SVt_BIND: return "BIND";
default: return "UNKNOWN";
}
}
@@ -9877,6 +9876,7 @@
SvANY(dstr) = &(dstr->sv_u.svu_rv);
Perl_rvpv_dup(aTHX_ dstr, sstr, param);
break;
+ /* case SVt_BIND: */
default:
{
/* These are all the types that need complex bodies allocating. */
@@ -9898,7 +9898,6 @@
case SVt_PVFM:
case SVt_PVHV:
case SVt_PVAV:
- case SVt_PVBM:
case SVt_PVCV:
case SVt_PVLV:
case SVt_PVMG:
@@ -9955,8 +9954,6 @@
break;
case SVt_PVMG:
break;
- case SVt_PVBM:
- break;
case SVt_PVLV:
/* XXX LvTARGOFF sometimes holds PMOP* when DEBUGGING */
if (LvTYPE(dstr) == 't') /* for tie: unrefcnted fake (SV**) */
@@ -9967,12 +9964,15 @@
LvTARG(dstr) = sv_dup_inc(LvTARG(dstr), param);
break;
case SVt_PVGV:
- if (GvNAME_HEK(dstr))
- GvNAME_HEK(dstr) = hek_dup(GvNAME_HEK(dstr), param);
+ if(isGV_with_GP(sstr)) {
+ if (GvNAME_HEK(dstr))
+ GvNAME_HEK(dstr) = hek_dup(GvNAME_HEK(dstr), param);
+ }
/* Don't call sv_add_backref here as it's going to be created
as part of the magic cloning of the symbol table. */
- GvSTASH(dstr) = hv_dup(GvSTASH(dstr), param);
+ if(!SvVALID(dstr))
+ GvSTASH(dstr) = hv_dup(GvSTASH(dstr), param);
if(isGV_with_GP(sstr)) {
/* Danger Will Robinson - GvGP(dstr) isn't initialised
at the point of this comment. */
==== //depot/perl/sv.h#300 (text) ====
Index: perl/sv.h
--- perl/sv.h#299~29537~ 2006-12-12 13:31:10.000000000 -0800
+++ perl/sv.h 2006-12-13 00:35:43.000000000 -0800
@@ -48,11 +48,12 @@
SVt_IV, /* 1 */
SVt_NV, /* 2 */
SVt_RV, /* 3 */
- SVt_PV, /* 4 */
- SVt_PVIV, /* 5 */
- SVt_PVNV, /* 6 */
- SVt_PVMG, /* 7 */
- SVt_PVBM, /* 8 */
+ SVt_BIND, /* 4 */
+ SVt_PV, /* 5 */
+ SVt_PVIV, /* 6 */
+ SVt_PVNV, /* 7 */
+ SVt_PVMG, /* 8 */
+ /* PVBM was here, before BIND replaced it. */
SVt_PVGV, /* 9 */
SVt_PVLV, /* 10 */
SVt_PVAV, /* 11 */
@@ -63,6 +64,13 @@
SVt_LAST /* keep last in enum. used to size arrays */
} svtype;
+#ifndef PERL_CORE
+/* Although Fast Boyer Moore tables are now being stored in PVGVs, for most
+ purposes eternal code wanting to consider PVBM probably needs to think of
+ PVMG instead. */
+# define SVt_PVBM SVt_PVMG
+#endif
+
/* There is collusion here with sv_clear - sv_clear exits early for SVt_NULL
and SVt_IV, so never reaches the clause at the end that uses
sv_type_details->body_size to determine whether to call safefree(). Hence
@@ -349,7 +357,7 @@
#define SVpav_REAL 0x40000000 /* free old entries */
/* PVHV */
#define SVphv_LAZYDEL 0x40000000 /* entry in xhv_eiter must be deleted */
-/* Not just PVBM - basically anything that can be a regular scalar */
+/* Not just "PVBM" (PVGV) - basically anything that can be a regular scalar */
#define SVpbm_VALID 0x40000000
/* ??? */
#define SVrepl_EVAL 0x40000000 /* Replacement part of s///e */
@@ -363,7 +371,7 @@
#define SVphv_HASKFLAGS 0x80000000 /* keys have flag byte after
hash */
/* PVFM */
#define SVpfm_COMPILED 0x80000000 /* FORMLINE is compiled */
-/* PVBM */
+/* PVGV when SVpbm_VALID is true */
#define SVpbm_TAIL 0x80000000
/* RV upwards. However, SVf_ROK and SVp_IOK are exclusive */
#define SVprv_WEAKREF 0x80000000 /* Weak reference */
@@ -503,6 +511,8 @@
* y=alem/helem/iter t=tie T=tied HE */
};
+/* This structure works in 3 ways - regular scalar, GV with GP, or fast
+ Boyer-Moore. */
struct xpvgv {
union {
NV xnv_nv;
@@ -514,7 +524,7 @@
IV xivu_iv;
UV xivu_uv;
void * xivu_p1;
- I32 xivu_i32;
+ I32 xivu_i32; /* is this constant pattern being useful? */
HEK * xivu_namehek; /* GvNAME */
} xiv_u;
union {
@@ -525,27 +535,6 @@
};
-struct xpvbm {
- union {
- NV xnv_nv; /* numeric value, if any */
- HV * xgv_stash;
- } xnv_u;
- STRLEN xpv_cur; /* length of svu_pv as a C string */
- STRLEN xpv_len; /* allocated size */
- union {
- IV xivu_iv; /* integer value or pv offset */
- UV xivu_uv;
- void * xivu_p1;
- I32 xivu_i32; /* is this constant pattern being useful? */
- HEK * xivu_namehek;
- } xiv_u;
- union {
- MAGIC* xmg_magic; /* linked list of magicalness */
- HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */
- } xmg_u;
- HV* xmg_stash; /* class package */
-};
-
/* This structure must match XPVCV in cv.h */
typedef U16 cv_flags_t;
@@ -1353,7 +1342,7 @@
#if defined (DEBUGGING) && defined(__GNUC__) &&
!defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
# define BmRARE(sv) \
(*({ SV *const uggh = (SV *) (sv); \
- assert(SvTYPE(uggh) == SVt_PVBM); \
+ assert(SvTYPE(uggh) == SVt_PVGV); \
assert(SvVALID(uggh)); \
assert(SvCUR(uggh) + PERL_FBM_TABLE_OFFSET \
+ PERL_FBM_RARE_OFFSET_FROM_TABLE <= SvLEN(uggh)); \
@@ -1363,14 +1352,14 @@
}))
# define BmUSEFUL(sv) \
(*({ SV *const uggh = (SV *) (sv); \
- assert(SvTYPE(uggh) == SVt_PVBM); \
+ assert(SvTYPE(uggh) == SVt_PVGV); \
assert(SvVALID(uggh)); \
assert(!SvIOK(uggh)); \
- &(((XPVBM*) SvANY(uggh))->xiv_u.xivu_i32); \
+ &(((XPVGV*) SvANY(uggh))->xiv_u.xivu_i32); \
}))
# define BmPREVIOUS(sv) \
({ SV *const uggh = (SV *) (sv); \
- assert(SvTYPE(uggh) == SVt_PVBM); \
+ assert(SvTYPE(uggh) == SVt_PVGV); \
assert(SvVALID(uggh)); \
assert(SvPOKp(uggh)); \
assert(SvCUR(uggh) + PERL_FBM_TABLE_OFFSET <= SvLEN(uggh)); \
@@ -1384,7 +1373,7 @@
(*(U8*)(SvEND(sv) \
+ PERL_FBM_TABLE_OFFSET + PERL_FBM_RARE_OFFSET_FROM_TABLE))
-# define BmUSEFUL(sv) ((XPVBM*) SvANY(sv))->xiv_u.xivu_i32
+# define BmUSEFUL(sv) ((XPVGV*) SvANY(sv))->xiv_u.xivu_i32
# define BmPREVIOUS(sv) \
((*(U8*)(SvEND(sv) + PERL_FBM_TABLE_OFFSET \
+ PERL_FBM_PREVIOUS_H_OFFSET_FROM_TABLE) << 8) \
@@ -1393,7 +1382,7 @@
#endif
#define BmPREVIOUS_set(sv, val)
\
- STMT_START { assert(SvTYPE(sv) == SVt_PVBM); \
+ STMT_START { assert(SvTYPE(sv) == SVt_PVGV); \
assert(SvVALID(sv)); \
assert(SvPOKp(sv)); \
assert(SvCUR(sv) + PERL_FBM_TABLE_OFFSET <= SvLEN(sv)); \
==== //depot/perl/util.c#600 (text) ====
Index: perl/util.c
--- perl/util.c#599~29532~ 2006-12-12 09:49:51.000000000 -0800
+++ perl/util.c 2006-12-13 00:35:43.000000000 -0800
@@ -490,7 +490,7 @@
s = (U8*)SvPV_force_mutable(sv, len);
if (len == 0) /* TAIL might be on a zero-length string. */
return;
- SvUPGRADE(sv, SVt_PVBM);
+ SvUPGRADE(sv, SVt_PVGV);
SvIOK_off(sv);
if (len > 2) {
const unsigned char *sb;
@@ -665,7 +665,7 @@
}
return NULL;
}
- if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
+ if (!SvVALID(littlestr)) {
char * const b = ninstr((char*)big,(char*)bigend,
(char*)little, (char*)little + littlelen);
@@ -760,7 +760,8 @@
register const unsigned char *littleend;
I32 found = 0;
- assert(SvTYPE(littlestr) == SVt_PVBM);
+ assert(SvTYPE(littlestr) == SVt_PVGV);
+ assert(SvVALID(littlestr));
if (*old_posp == -1
? (pos = PL_screamfirst[BmRARE(littlestr)]) < 0
End of Patch.
