Change 30077 by [EMAIL PROTECTED] on 2007/01/29 23:50:30
Integrate:
[ 29492]
In Perl_fbm_instr(), no need to calculate the address of the table if
we're going to return anyway.
[ 29493]
Exterminate! 2 pieces of superfluous code related to UV setting.
[ 29494]
PVBMs mustn't enter anything that turns SVIVisUV_on().
[ 29518]
Change SvTAIL() to check that both SVpbm_TAIL|SVpbm_VALID are true.
SVpbm_VALID is the same bit value is SVf_IVisUV, which means that
PVBMs can't actually ever be IOK. Therefore move BmUSEFUL() into the
IV union, and save one I32 per PVBM.
[ 29534]
Shrink Perl_sv_peek() and Perl_do_sv_dump() by using type to name
lookup tables.
Affected files ...
... //depot/maint-5.8/perl/dump.c#75 edit
... //depot/maint-5.8/perl/sv.c#336 integrate
... //depot/maint-5.8/perl/util.c#141 integrate
Differences ...
==== //depot/maint-5.8/perl/dump.c#75 (text) ====
Index: perl/dump.c
--- perl/dump.c#74~30061~ 2007-01-29 09:39:20.000000000 -0800
+++ perl/dump.c 2007-01-29 15:50:30.000000000 -0800
@@ -27,6 +27,45 @@
#include "proto.h"
+static const char* const svtypenames[SVt_LAST] = {
+ "NULL",
+ "IV",
+ "NV",
+ "RV",
+ "PV",
+ "PVIV",
+ "PVNV",
+ "PVMG",
+ "PVBM",
+ "PVLV",
+ "PVAV",
+ "PVHV",
+ "PVCV",
+ "PVGV",
+ "PVFM",
+ "PVIO"
+};
+
+
+static const char* const svshorttypenames[SVt_LAST] = {
+ "UNDEF",
+ "IV",
+ "NV",
+ "RV",
+ "PV",
+ "PVIV",
+ "PVNV",
+ "PVMG",
+ "BM",
+ "PVLV",
+ "AV",
+ "HV",
+ "CV",
+ "GV",
+ "FM",
+ "IO"
+};
+
void
Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
{
@@ -324,6 +363,7 @@
{
SV * const t = sv_newmortal();
int unref = 0;
+ U32 type;
sv_setpvn(t, "", 0);
retry:
@@ -405,62 +445,18 @@
sv = (SV*)SvRV(sv);
goto retry;
}
- switch (SvTYPE(sv)) {
- default:
- sv_catpv(t, "FREED");
+ type = SvTYPE(sv);
+ if (type == SVt_PVCV) {
+ Perl_sv_catpvf(aTHX_ t, "CV(%s)", CvGV(sv) ? GvNAME(CvGV(sv)) : "");
goto finish;
+ } else if (type < SVt_LAST) {
+ sv_catpv(t, svshorttypenames[type]);
- case SVt_NULL:
- sv_catpv(t, "UNDEF");
- goto finish;
- case SVt_IV:
- sv_catpv(t, "IV");
- break;
- case SVt_NV:
- sv_catpv(t, "NV");
- break;
- case SVt_RV:
- sv_catpv(t, "RV");
- break;
- case SVt_PV:
- sv_catpv(t, "PV");
- break;
- case SVt_PVIV:
- sv_catpv(t, "PVIV");
- break;
- case SVt_PVNV:
- sv_catpv(t, "PVNV");
- break;
- case SVt_PVMG:
- sv_catpv(t, "PVMG");
- break;
- case SVt_PVLV:
- sv_catpv(t, "PVLV");
- break;
- case SVt_PVAV:
- sv_catpv(t, "AV");
- break;
- case SVt_PVHV:
- sv_catpv(t, "HV");
- break;
- case SVt_PVCV:
- if (CvGV(sv))
- Perl_sv_catpvf(aTHX_ t, "CV(%s)", GvNAME(CvGV(sv)));
- else
- sv_catpv(t, "CV()");
+ if (type == SVt_NULL)
+ goto finish;
+ } else {
+ sv_catpv(t, "FREED");
goto finish;
- case SVt_PVGV:
- sv_catpv(t, "GV");
- break;
- case SVt_PVBM:
- sv_catpv(t, "BM");
- break;
- case SVt_PVFM:
- sv_catpv(t, "FM");
- break;
- case SVt_PVIO:
- sv_catpv(t, "IO");
- break;
}
if (SvPOKp(sv)) {
@@ -1276,57 +1272,14 @@
s = SvPVX_const(d);
Perl_dump_indent(aTHX_ level, file, "SV = ");
- switch (type) {
- case SVt_NULL:
- PerlIO_printf(file, "NULL%s\n", s);
- SvREFCNT_dec(d);
- return;
- case SVt_IV:
- PerlIO_printf(file, "IV%s\n", s);
- break;
- case SVt_NV:
- PerlIO_printf(file, "NV%s\n", s);
- break;
- case SVt_RV:
- PerlIO_printf(file, "RV%s\n", s);
- break;
- case SVt_PV:
- PerlIO_printf(file, "PV%s\n", s);
- break;
- case SVt_PVIV:
- PerlIO_printf(file, "PVIV%s\n", s);
- break;
- case SVt_PVNV:
- PerlIO_printf(file, "PVNV%s\n", s);
- break;
- case SVt_PVBM:
- PerlIO_printf(file, "PVBM%s\n", s);
- break;
- case SVt_PVMG:
- PerlIO_printf(file, "PVMG%s\n", s);
- break;
- case SVt_PVLV:
- PerlIO_printf(file, "PVLV%s\n", s);
- break;
- case SVt_PVAV:
- PerlIO_printf(file, "PVAV%s\n", s);
- break;
- case SVt_PVHV:
- PerlIO_printf(file, "PVHV%s\n", s);
- break;
- case SVt_PVCV:
- PerlIO_printf(file, "PVCV%s\n", s);
- break;
- case SVt_PVGV:
- PerlIO_printf(file, "PVGV%s\n", s);
- break;
- case SVt_PVFM:
- PerlIO_printf(file, "PVFM%s\n", s);
- break;
- case SVt_PVIO:
- PerlIO_printf(file, "PVIO%s\n", s);
- break;
- default:
+ if (type < SVt_LAST) {
+ PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
+
+ if (type == SVt_NULL) {
+ SvREFCNT_dec(d);
+ return;
+ }
+ } else {
PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
SvREFCNT_dec(d);
return;
==== //depot/maint-5.8/perl/sv.c#336 (text) ====
Index: perl/sv.c
--- perl/sv.c#335~30071~ 2007-01-29 14:30:00.000000000 -0800
+++ perl/sv.c 2007-01-29 15:50:30.000000000 -0800
@@ -1534,8 +1534,6 @@
void
Perl_sv_setuv_mg(pTHX_ register SV *sv, UV u)
{
- sv_setiv(sv, 0);
- SvIsUV_on(sv);
sv_setuv(sv,u);
SvSETMAGIC(sv);
}
@@ -2089,7 +2087,11 @@
{
if (!sv)
return 0;
- if (SvGMAGICAL(sv)) {
+ if (SvGMAGICAL(sv) || SvTYPE(sv) == SVt_PVBM) {
+ /* PVBMs 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. */
if (flags & SV_GMAGIC)
mg_get(sv);
if (SvIOKp(sv))
@@ -2168,7 +2170,9 @@
{
if (!sv)
return 0;
- if (SvGMAGICAL(sv)) {
+ if (SvGMAGICAL(sv) || SvTYPE(sv) == SVt_PVBM) {
+ /* PVBMs use the same flag bit as SVf_IVisUV, so must let them
+ cache IVs just in case. */
if (flags & SV_GMAGIC)
mg_get(sv);
if (SvIOKp(sv))
@@ -2242,7 +2246,9 @@
{
if (!sv)
return 0.0;
- if (SvGMAGICAL(sv)) {
+ if (SvGMAGICAL(sv) || SvTYPE(sv) == SVt_PVBM) {
+ /* PVBMs use the same flag bit as SVf_IVisUV, so must let them
+ cache IVs just in case. */
mg_get(sv);
if (SvNOKp(sv))
return SvNVX(sv);
@@ -2729,7 +2735,6 @@
if (SvIOK(sv) || ((SvIOKp(sv) && !SvNOKp(sv)))) {
/* I'm assuming that if both IV and NV are equally valid then
converting the IV is going to be more efficient */
- const U32 isIOK = SvIOK(sv);
const U32 isUIOK = SvIsUV(sv);
char buf[TYPE_CHARS(UV)];
char *ebuf, *ptr;
@@ -2743,12 +2748,6 @@
SvCUR_set(sv, ebuf - ptr);
s = SvEND(sv);
*s = '\0';
- if (isIOK)
- SvIOK_on(sv);
- else
- SvIOKp_on(sv);
- if (isUIOK)
- SvIsUV_on(sv);
}
else if (SvNOKp(sv)) {
const int olderrno = errno;
==== //depot/maint-5.8/perl/util.c#141 (text) ====
Index: perl/util.c
--- perl/util.c#140~30075~ 2007-01-29 15:16:13.000000000 -0800
+++ perl/util.c 2007-01-29 15:50:30.000000000 -0800
@@ -489,6 +489,7 @@
if (len == 0) /* TAIL might be on a zero-length string. */
return;
(void)SvUPGRADE(sv, SVt_PVBM);
+ SvIOK_off(sv);
if (len > 2) {
const unsigned char *sb;
const U8 mlen = (len>255) ? 255 : (U8)len;
@@ -676,12 +677,14 @@
return b;
}
- { /* Do actual FBM. */
+ /* Do actual FBM. */
+ if (littlelen > (STRLEN)(bigend - big))
+ return NULL;
+
+ {
register const unsigned char * const table = little + littlelen +
FBM_TABLE_OFFSET;
register const unsigned char *oldlittle;
- if (littlelen > (STRLEN)(bigend - big))
- return NULL;
--littlelen; /* Last char found by table lookup */
s = big + littlelen;
End of Patch.
