Change 25385 by [EMAIL PROTECTED] on 2005/09/11 20:36:26
Integrate:
[ 24228]
Avoid taking a reference to SvIVX and putting that address on the
save stack
[ 24241]
Refactor the odd-one-out code before a Renew(SvPVX(...)...)
[ 24344]
Calling sv_backoff() on something that's about to be free()d will
memmov() memory that's about to be freed. Seems wasteful.
[ 24357]
Explode if anyone attempts to sv_upgrade PL_mess_sv.
Should this be a panic: ?
[ 24373]
PL_mess_sv is always >= SVt_PVMG, so no need for an if() test
[ 24418]
The idea is that when you find something, you stop looking.
( http://use.perl.org/comments.pl?sid=26369&cid=40183 )
[ 24419]
There's no need to set a reference count for the new SV heads, as it's
always set to 1 at uprooting time.
But set it to zero when DEBUGGING to make things clearer. Plus fix a
bug introduced by change 22945, where the last SV head had an
uninitialised reference count.
[ 24423]
Simplify S_hv_notallowed slightly by passing a prebuilt message
template. (Also slightly smaller object code)
[ 24438]
As we have the length of the string easily to hand, no reason not to
use it.
[ 24439]
s/sv_setpv(sv,"")/sv_setpvn(sv,"",0)/
plus a couple of 1 byte sv_setpv()s too.
[ 24626]
Subject: [PATCH] Teeny optimization in S_hv_magic_check
From: Andy Lester <[EMAIL PROTECTED]>
Date: Tue, 24 May 2005 11:41:15 -0500
Message-ID: <[EMAIL PROTECTED]>
[ 24638]
Change the logic to avoid needing to set a variable during the loop
[ 24646]
Avoid updating a variable in the loop
[ 24648]
Avoid updating a variable in a loop.
Only calculate the number of links in a hash bucket chain if we really
need it.
[ 24669]
Subject: [PATCH] use lengths in sv_setpv() calls
From: Andy Lester <[EMAIL PROTECTED]>
Date: Wed, 1 Jun 2005 23:16:56 -0500
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.8/perl/doio.c#32 integrate
... //depot/maint-5.8/perl/dump.c#33 integrate
... //depot/maint-5.8/perl/ext/B/B.xs#16 integrate
... //depot/maint-5.8/perl/ext/Storable/Storable.xs#24 integrate
... //depot/maint-5.8/perl/gv.c#27 integrate
... //depot/maint-5.8/perl/hv.c#46 integrate
... //depot/maint-5.8/perl/mg.c#55 integrate
... //depot/maint-5.8/perl/op.c#77 integrate
... //depot/maint-5.8/perl/perl.c#102 integrate
... //depot/maint-5.8/perl/pp_ctl.c#68 integrate
... //depot/maint-5.8/perl/pp_hot.c#57 integrate
... //depot/maint-5.8/perl/pp_sys.c#55 integrate
... //depot/maint-5.8/perl/sv.c#133 integrate
... //depot/maint-5.8/perl/toke.c#61 integrate
... //depot/maint-5.8/perl/util.c#57 integrate
Differences ...
==== //depot/maint-5.8/perl/doio.c#32 (text) ====
Index: perl/doio.c
--- perl/doio.c#31~24195~ Thu Apr 7 09:05:43 2005
+++ perl/doio.c Sun Sep 11 13:36:26 2005
@@ -1375,7 +1375,7 @@
io = GvIO(gv);
if (io && IoIFP(io)) {
PL_statgv = gv;
- sv_setpv(PL_statname,"");
+ sv_setpvn(PL_statname,"", 0);
PL_laststype = OP_STAT;
return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)),
&PL_statcache));
}
@@ -1385,7 +1385,7 @@
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
PL_statgv = Nullgv;
- sv_setpv(PL_statname,"");
+ sv_setpvn(PL_statname,"", 0);
return (PL_laststatval = -1);
}
}
==== //depot/maint-5.8/perl/dump.c#33 (text) ====
Index: perl/dump.c
--- perl/dump.c#32~24332~ Tue Apr 26 09:02:43 2005
+++ perl/dump.c Sun Sep 11 13:36:26 2005
@@ -1216,7 +1216,7 @@
Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
PTR2UV(AvARYLEN(sv)));
flags = AvFLAGS(sv);
- sv_setpv(d, "");
+ sv_setpvn(d, "", 0);
if (flags & AVf_REAL) sv_catpv(d, ",REAL");
if (flags & AVf_REIFY) sv_catpv(d, ",REIFY");
if (flags & AVf_REUSED) sv_catpv(d, ",REUSED");
==== //depot/maint-5.8/perl/ext/B/B.xs#16 (text) ====
Index: perl/ext/B/B.xs
--- perl/ext/B/B.xs#15~24302~ Fri Apr 22 14:25:13 2005
+++ perl/ext/B/B.xs Sun Sep 11 13:36:26 2005
@@ -257,7 +257,7 @@
SV *tmpsv = sv_newmortal(); /* Temporary SV to feed sv_uni_display */
len = SvCUR(sv);
s = sv_uni_display(tmpsv, sv, 8*len, UNI_DISPLAY_QQ);
- sv_setpv(sstr,"\"");
+ sv_setpvn(sstr,"\"",1);
while (*s)
{
if (*s == '"')
==== //depot/maint-5.8/perl/ext/Storable/Storable.xs#24 (text) ====
Index: perl/ext/Storable/Storable.xs
--- perl/ext/Storable/Storable.xs#23~23012~ Wed Jun 30 04:11:43 2004
+++ perl/ext/Storable/Storable.xs Sun Sep 11 13:36:26 2005
@@ -5204,7 +5204,7 @@
if (SvROK(cxt->eval) && SvTYPE(SvRV(cxt->eval)) == SVt_PVCV) {
SV* errsv = get_sv("@", TRUE);
- sv_setpv(errsv, ""); /*
clear $@ */
+ sv_setpvn(errsv, "", 0); /* clear $@ */
PUSHMARK(sp);
XPUSHs(sv_2mortal(newSVsv(sub)));
PUTBACK;
==== //depot/maint-5.8/perl/gv.c#27 (text) ====
Index: perl/gv.c
--- perl/gv.c#26~24153~ Mon Apr 4 14:13:55 2005
+++ perl/gv.c Sun Sep 11 13:36:26 2005
@@ -1080,11 +1080,11 @@
break;
case '\014': /* $^L */
- sv_setpv(GvSV(gv),"\f");
+ sv_setpvn(GvSV(gv),"\f",1);
PL_formfeed = GvSV(gv);
break;
case ';':
- sv_setpv(GvSV(gv),"\034");
+ sv_setpvn(GvSV(gv),"\034",1);
break;
case ']':
{
==== //depot/maint-5.8/perl/hv.c#46 (text) ====
Index: perl/hv.c
--- perl/hv.c#45~24415~ Sat May 7 22:45:28 2005
+++ perl/hv.c Sun Sep 11 13:36:26 2005
@@ -163,7 +163,7 @@
S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
const char *msg)
{
- SV *sv = sv_newmortal(), *esv = sv_newmortal();
+ SV *sv = sv_newmortal();
if (!(flags & HVhek_FREEKEY)) {
sv_setpvn(sv, key, klen);
}
@@ -175,8 +175,7 @@
if (flags & HVhek_UTF8) {
SvUTF8_on(sv);
}
- Perl_sv_setpvf(aTHX_ esv, "Attempt to %s a restricted hash", msg);
- Perl_croak(aTHX_ SvPVX(esv), sv);
+ Perl_croak(aTHX_ msg, sv);
}
/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
@@ -384,7 +383,6 @@
int flags, int action, SV *val, register U32 hash)
{
XPVHV* xhv;
- U32 n_links;
HE *entry;
HE **oentry;
SV *sv;
@@ -629,7 +627,6 @@
}
masked_flags = (flags & HVhek_MASK);
- n_links = 0;
#ifdef DYNAMIC_ENV_FETCH
if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*);
@@ -639,7 +636,7 @@
/* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
}
- for (; entry; ++n_links, entry = HeNEXT(entry)) {
+ for (; entry; entry = HeNEXT(entry)) {
if (!HeKEY_hek(entry))
continue;
if (HeHASH(entry) != hash) /* strings can't be equal */
@@ -724,8 +721,8 @@
if (!entry && SvREADONLY(hv) && !(action & HV_FETCH_ISEXISTS)) {
S_hv_notallowed(aTHX_ flags, key, klen,
- "access disallowed key '%"SVf"' in"
- );
+ "Attempt to access disallowed key '%"SVf"' in"
+ " a restricted hash");
}
if (!(action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE))) {
/* Not doing some form of store, so return failure. */
@@ -776,18 +773,30 @@
if (masked_flags & HVhek_ENABLEHVKFLAGS)
HvHASKFLAGS_on(hv);
- xhv->xhv_keys++; /* HvKEYS(hv)++ */
- if (!n_links) { /* initial entry? */
- xhv->xhv_fill++; /* HvFILL(hv)++ */
- } else if ((xhv->xhv_keys > (IV)xhv->xhv_max)
- || ((n_links > HV_MAX_LENGTH_BEFORE_SPLIT) && !HvREHASH(hv))) {
- /* Use only the old HvKEYS(hv) > HvMAX(hv) condition to limit bucket
- splits on a rehashed hash, as we're not going to split it again,
- and if someone is lucky (evil) enough to get all the keys in one
- list they could exhaust our memory as we repeatedly double the
- number of buckets on every entry. Linear search feels a less worse
- thing to do. */
- hsplit(hv);
+ {
+ const HE *counter = HeNEXT(entry);
+
+ xhv->xhv_keys++; /* HvKEYS(hv)++ */
+ if (!counter) { /* initial entry? */
+ xhv->xhv_fill++; /* HvFILL(hv)++ */
+ } else if (xhv->xhv_keys > (IV)xhv->xhv_max) {
+ hsplit(hv);
+ } else if(!HvREHASH(hv)) {
+ U32 n_links = 1;
+
+ while ((counter = HeNEXT(counter)))
+ n_links++;
+
+ if (n_links > HV_MAX_LENGTH_BEFORE_SPLIT) {
+ /* Use only the old HvKEYS(hv) > HvMAX(hv) condition to limit
+ bucket splits on a rehashed hash, as we're not going to
+ split it again, and if someone is lucky (evil) enough to
+ get all the keys in one list they could exhaust our memory
+ as we repeatedly double the number of buckets on every
+ entry. Linear search feels a less worse thing to do. */
+ hsplit(hv);
+ }
+ }
}
return entry;
@@ -806,6 +815,7 @@
case PERL_MAGIC_tied:
case PERL_MAGIC_sig:
*needs_store = FALSE;
+ return; /* We've set all there is to set. */
}
}
mg = mg->mg_moremagic;
@@ -889,9 +899,9 @@
int k_flags, I32 d_flags, U32 hash)
{
register XPVHV* xhv;
- register I32 i;
register HE *entry;
register HE **oentry;
+ HE *const *first_entry;
SV *sv;
bool is_utf8;
int masked_flags;
@@ -987,10 +997,9 @@
masked_flags = (k_flags & HVhek_MASK);
/* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
- oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
+ first_entry = oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
entry = *oentry;
- i = 1;
- for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
+ for (; entry; oentry = &HeNEXT(entry), entry = *oentry) {
if (HeHASH(entry) != hash) /* strings can't be equal */
continue;
if (HeKLEN(entry) != (I32)klen)
@@ -1009,8 +1018,8 @@
}
else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
S_hv_notallowed(aTHX_ k_flags, key, klen,
- "delete readonly key '%"SVf"' from"
- );
+ "Attempt to delete readonly key '%"SVf"' from"
+ " a restricted hash");
}
if (k_flags & HVhek_FREEKEY)
Safefree(key);
@@ -1036,8 +1045,9 @@
xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
} else {
*oentry = HeNEXT(entry);
- if (i && !*oentry)
+ if(!*first_entry) {
xhv->xhv_fill--; /* HvFILL(hv)-- */
+ }
if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
HvLAZYDEL_on(hv);
else
@@ -1050,8 +1060,8 @@
}
if (SvREADONLY(hv)) {
S_hv_notallowed(aTHX_ k_flags, key, klen,
- "delete disallowed key '%"SVf"' from"
- );
+ "Attempt to delete disallowed key '%"SVf"' from"
+ " a restricted hash");
}
if (k_flags & HVhek_FREEKEY)
@@ -1968,7 +1978,7 @@
register XPVHV* xhv;
register HE *entry;
register HE **oentry;
- register I32 i = 1;
+ HE **first;
I32 found = 0;
bool is_utf8 = FALSE;
int k_flags = 0;
@@ -1997,9 +2007,9 @@
/* assert(xhv_array != 0) */
LOCK_STRTAB_MUTEX;
/* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
- oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
+ first = oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
if (hek) {
- for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry =
*oentry) {
+ for (entry = *oentry; entry; oentry = &HeNEXT(entry), entry = *oentry)
{
if (HeKEY_hek(entry) != hek)
continue;
found = 1;
@@ -2007,7 +2017,7 @@
}
} else {
int flags_masked = k_flags & HVhek_MASK;
- for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry =
*oentry) {
+ for (entry = *oentry; entry; oentry = &HeNEXT(entry), entry = *oentry)
{
if (HeHASH(entry) != hash) /* strings can't be equal */
continue;
if (HeKLEN(entry) != len)
@@ -2024,8 +2034,10 @@
if (found) {
if (--HeVAL(entry) == Nullsv) {
*oentry = HeNEXT(entry);
- if (i && !*oentry)
+ if (!*first) {
+ /* There are now no entries in our slot. */
xhv->xhv_fill--; /* HvFILL(hv)-- */
+ }
Safefree(HeKEY_hek(entry));
del_HE(entry);
xhv->xhv_keys--; /* HvKEYS(hv)-- */
@@ -2080,7 +2092,6 @@
register XPVHV* xhv;
register HE *entry;
register HE **oentry;
- register I32 i = 1;
I32 found = 0;
int flags_masked = flags & HVhek_MASK;
@@ -2097,7 +2108,7 @@
LOCK_STRTAB_MUTEX;
/* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
- for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
+ for (entry = *oentry; entry; entry = HeNEXT(entry)) {
if (HeHASH(entry) != hash) /* strings can't be equal */
continue;
if (HeKLEN(entry) != len)
@@ -2110,13 +2121,17 @@
break;
}
if (!found) {
+ /* What used to be head of the list.
+ If this is NULL, then we're the first entry for this slot, which
+ means we need to increate fill. */
+ const HE *old_first = *oentry;
entry = new_HE();
HeKEY_hek(entry) = save_hek_flags(str, len, hash, flags_masked);
HeVAL(entry) = Nullsv;
HeNEXT(entry) = *oentry;
*oentry = entry;
xhv->xhv_keys++; /* HvKEYS(hv)++ */
- if (i) { /* initial entry? */
+ if (!old_first) { /* initial entry? */
xhv->xhv_fill++; /* HvFILL(hv)++ */
} else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv)
*/) {
hsplit(PL_strtab);
==== //depot/maint-5.8/perl/mg.c#55 (text) ====
Index: perl/mg.c
--- perl/mg.c#54~24291~ Fri Apr 22 07:02:56 2005
+++ perl/mg.c Sun Sep 11 13:36:26 2005
@@ -617,7 +617,7 @@
if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) &
1)
sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length);
else
- sv_setpv(sv,"");
+ sv_setpvn(sv,"",0);
}
#else
#ifdef OS2
@@ -643,7 +643,7 @@
PerlProc_GetOSError(sv, dwErr);
}
else
- sv_setpv(sv, "");
+ sv_setpvn(sv, "", 0);
SetLastError(dwErr);
}
#else
==== //depot/maint-5.8/perl/op.c#77 (text) ====
Index: perl/op.c
--- perl/op.c#76~24291~ Fri Apr 22 07:02:56 2005
+++ perl/op.c Sun Sep 11 13:36:26 2005
@@ -4178,6 +4178,7 @@
char *aname;
GV *gv;
char *ps;
+ STRLEN ps_len;
register CV *cv=0;
SV *const_sv;
@@ -4185,7 +4186,7 @@
if (proto) {
assert(proto->op_type == OP_CONST);
- ps = SvPVx(((SVOP*)proto)->op_sv, n_a);
+ ps = SvPVx(((SVOP*)proto)->op_sv, ps_len);
}
else
ps = Nullch;
@@ -4222,7 +4223,7 @@
cv_ckproto((CV*)gv, NULL, ps);
}
if (ps)
- sv_setpv((SV*)gv, ps);
+ sv_setpvn((SV*)gv, ps, ps_len);
else
sv_setiv((SV*)gv, -1);
SvREFCNT_dec(PL_compcv);
@@ -4295,7 +4296,7 @@
SvREFCNT_inc(const_sv);
if (cv) {
assert(!CvROOT(cv) && !CvCONST(cv));
- sv_setpv((SV*)cv, ""); /* prototype is "" */
+ sv_setpvn((SV*)cv, "", 0); /* prototype is "" */
CvXSUBANY(cv).any_ptr = const_sv;
CvXSUB(cv) = const_sv_xsub;
CvCONST_on(cv);
@@ -4381,7 +4382,7 @@
#endif /* USE_5005THREADS */
if (ps)
- sv_setpv((SV*)cv, ps);
+ sv_setpvn((SV*)cv, ps, ps_len);
if (PL_error_count) {
op_free(block);
@@ -4554,7 +4555,7 @@
cv = newXS(name, const_sv_xsub, savepv(CopFILE(PL_curcop)));
CvXSUBANY(cv).any_ptr = sv;
CvCONST_on(cv);
- sv_setpv((SV*)cv, ""); /* prototype is "" */
+ sv_setpvn((SV*)cv, "", 0); /* prototype is "" */
if (stash)
CopSTASH_free(PL_curcop);
==== //depot/maint-5.8/perl/perl.c#102 (text) ====
Index: perl/perl.c
--- perl/perl.c#101~24291~ Fri Apr 22 07:02:56 2005
+++ perl/perl.c Sun Sep 11 13:36:26 2005
@@ -1048,18 +1048,19 @@
/* As the absolutely last thing, free the non-arena SV for mess() */
if (PL_mess_sv) {
+ /* we know that type == SVt_PVMG */
+
/* it could have accumulated taint magic */
- if (SvTYPE(PL_mess_sv) >= SVt_PVMG) {
- MAGIC* mg;
- MAGIC* moremagic;
- for (mg = SvMAGIC(PL_mess_sv); mg; mg = moremagic) {
- moremagic = mg->mg_moremagic;
- if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global
- && mg->mg_len >= 0)
- Safefree(mg->mg_ptr);
- Safefree(mg);
- }
+ MAGIC* mg;
+ MAGIC* moremagic;
+ for (mg = SvMAGIC(PL_mess_sv); mg; mg = moremagic) {
+ moremagic = mg->mg_moremagic;
+ if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global
+ && mg->mg_len >= 0)
+ Safefree(mg->mg_ptr);
+ Safefree(mg);
}
+
/* we know that type >= SVt_PV */
SvOOK_off(PL_mess_sv);
Safefree(SvPVX(PL_mess_sv));
@@ -2264,7 +2265,7 @@
if (flags & G_KEEPERR)
PL_in_eval |= EVAL_KEEPERR;
else
- sv_setpv(ERRSV,"");
+ sv_setpvn(ERRSV,"",0);
}
PL_markstack_ptr++;
@@ -2283,7 +2284,7 @@
#endif
retval = PL_stack_sp - (PL_stack_base + oldmark);
if (!(flags & G_KEEPERR))
- sv_setpv(ERRSV,"");
+ sv_setpvn(ERRSV,"",0);
break;
case 1:
STATUS_ALL_FAILURE;
@@ -2429,7 +2430,7 @@
#endif
retval = PL_stack_sp - (PL_stack_base + oldmark);
if (!(flags & G_KEEPERR))
- sv_setpv(ERRSV,"");
+ sv_setpvn(ERRSV,"",0);
break;
case 1:
STATUS_ALL_FAILURE;
@@ -4054,7 +4055,6 @@
PL_DBgv = gv_fetchpv("DB::DB", GV_ADDMULTI, SVt_PVGV);
PL_DBline = gv_fetchpv("DB::dbline", GV_ADDMULTI, SVt_PVAV);
PL_DBsub = gv_HVadd(gv_fetchpv("DB::sub", GV_ADDMULTI, SVt_PVHV));
- sv_upgrade(GvSV(PL_DBsub), SVt_IV); /* IVX accessed if
PERLDB_SUB_NN */
PL_DBsingle = GvSV((gv_fetchpv("DB::single", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBsingle, 0);
PL_DBtrace = GvSV((gv_fetchpv("DB::trace", GV_ADDMULTI, SVt_PV)));
==== //depot/maint-5.8/perl/pp_ctl.c#68 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#67~25370~ Sat Sep 10 06:47:01 2005
+++ perl/pp_ctl.c Sun Sep 11 13:36:26 2005
@@ -1018,7 +1018,7 @@
RETURNOP(((LOGOP*)cUNOP->op_first)->op_other);
}
}
- sv_setpv(TARG, "");
+ sv_setpvn(TARG, "", 0);
SETs(targ);
RETURN;
}
@@ -1339,7 +1339,7 @@
SV *err = ERRSV;
char *e = Nullch;
if (!SvPOK(err))
- sv_setpv(err,"");
+ sv_setpvn(err,"",0);
else if (SvCUR(err) >= sizeof(prefix)+msglen-1) {
e = SvPV(err, n_a);
e += n_a - msglen;
@@ -1933,7 +1933,7 @@
LEAVESUB(sv);
if (clear_errsv)
- sv_setpv(ERRSV,"");
+ sv_setpvn(ERRSV,"",0);
return pop_return();
}
@@ -2354,13 +2354,14 @@
SV *sv = GvSV(PL_DBsub);
CV *gotocv;
+ save_item(sv);
if (PERLDB_SUB_NN) {
- (void)SvUPGRADE(sv, SVt_PVIV);
+ int type = SvTYPE(sv);
+ if (type < SVt_PVIV && type != SVt_IV)
+ sv_upgrade(sv, SVt_PVIV);
(void)SvIOK_on(sv);
- SAVEIV(SvIVX(sv));
SvIVX(sv) = PTR2IV(cv); /* Do it the quickest way */
} else {
- save_item(sv);
gv_efullname3(sv, CvGV(cv), Nullch);
}
if ( PERLDB_GOTO
@@ -2855,7 +2856,7 @@
if (saveop && saveop->op_flags & OPf_SPECIAL)
PL_in_eval |= EVAL_KEEPERR;
else
- sv_setpv(ERRSV,"");
+ sv_setpvn(ERRSV,"",0);
if (yyparse() || PL_error_count || !PL_eval_root) {
SV **newsp; /* Used by POPBLOCK. */
PERL_CONTEXT *cx;
@@ -3520,7 +3521,7 @@
else {
LEAVE;
if (!(save_flags & OPf_SPECIAL))
- sv_setpv(ERRSV,"");
+ sv_setpvn(ERRSV,"",0);
}
RETURNOP(retop);
@@ -3540,7 +3541,7 @@
PUSHEVAL(cx, 0, 0);
PL_in_eval = EVAL_INEVAL;
- sv_setpv(ERRSV,"");
+ sv_setpvn(ERRSV,"",0);
PUTBACK;
return DOCATCH(PL_op->op_next);
}
@@ -3589,7 +3590,7 @@
PL_curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
- sv_setpv(ERRSV,"");
+ sv_setpvn(ERRSV,"",0);
RETURNOP(retop);
}
==== //depot/maint-5.8/perl/pp_hot.c#57 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#56~24291~ Fri Apr 22 07:02:56 2005
+++ perl/pp_hot.c Sun Sep 11 13:36:26 2005
@@ -175,7 +175,7 @@
if (SvGMAGICAL(left))
mg_get(left); /* or mg_get(left) may happen here */
if (!SvOK(TARG))
- sv_setpv(left, "");
+ sv_setpvn(left, "", 0);
lpv = SvPV_nomg(left, llen);
lbyte = !DO_UTF8(left);
if (IN_BYTES)
@@ -1674,10 +1674,9 @@
}
else if (gimme == G_SCALAR && !tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
/* try to reclaim a bit of scalar space (only on 1st alloc) */
- if (SvCUR(sv) < 60)
- SvLEN_set(sv, 80);
- else
- SvLEN_set(sv, SvCUR(sv)+40); /* allow some slop */
+ const STRLEN new_len
+ = SvCUR(sv) < 60 ? 80 : SvCUR(sv)+40; /* allow some slop */
+ SvLEN_set(sv, new_len);
Renew(SvPVX(sv), SvLEN(sv), char);
}
RETURN;
@@ -2559,10 +2558,10 @@
{
SV *dbsv = GvSV(PL_DBsub);
+ save_item(dbsv);
if (!PERLDB_SUB_NN) {
GV *gv = CvGV(cv);
- save_item(dbsv);
if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
|| strEQ(GvNAME(gv), "END")
|| ((GvCV(gv) != cv) && /* Could be imported, and old sub
redefined. */
@@ -2579,9 +2578,10 @@
}
}
else {
- (void)SvUPGRADE(dbsv, SVt_PVIV);
+ int type = SvTYPE(dbsv);
+ if (type < SVt_PVIV && type != SVt_IV)
+ sv_upgrade(dbsv, SVt_PVIV);
(void)SvIOK_on(dbsv);
- SAVEIV(SvIVX(dbsv));
SvIVX(dbsv) = PTR2IV(cv); /* Do it the quickest way */
}
==== //depot/maint-5.8/perl/pp_sys.c#55 (text) ====
Index: perl/pp_sys.c
--- perl/pp_sys.c#54~24346~ Thu Apr 28 02:39:31 2005
+++ perl/pp_sys.c Sun Sep 11 13:36:26 2005
@@ -342,7 +342,7 @@
ENTER;
SAVESPTR(PL_rs);
PL_rs = &PL_sv_undef;
- sv_setpv(TARG, ""); /* note that this preserves previous buffer */
+ sv_setpvn(TARG, "", 0); /* note that this preserves previous
buffer */
while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
/*SUPPRESS 530*/
;
@@ -1221,7 +1221,7 @@
RETPUSHUNDEF;
}
TAINT;
- sv_setpv(TARG, " ");
+ sv_setpvn(TARG, " ", 1);
*SvPVX(TARG) = PerlIO_getc(IoIFP(GvIOp(gv))); /* should never be EOF */
if (PerlIO_isutf8(IoIFP(GvIOp(gv)))) {
/* Find out how many bytes the char needs */
@@ -2812,7 +2812,7 @@
if (gv != PL_defgv) {
PL_laststype = OP_STAT;
PL_statgv = gv;
- sv_setpv(PL_statname, "");
+ sv_setpvn(PL_statname, "", 0);
PL_laststatval = (GvIO(gv) && IoIFP(GvIOp(gv))
? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(gv))), &PL_statcache)
: -1);
}
@@ -3344,7 +3344,7 @@
else {
PL_statgv = gv;
PL_laststatval = -1;
- sv_setpv(PL_statname, "");
+ sv_setpvn(PL_statname, "", 0);
io = GvIO(PL_statgv);
}
if (io && IoIFP(io)) {
==== //depot/maint-5.8/perl/sv.c#133 (text) ====
Index: perl/sv.c
--- perl/sv.c#132~25367~ Sat Sep 10 04:42:11 2005
+++ perl/sv.c Sun Sep 11 13:36:26 2005
@@ -238,8 +238,10 @@
for (sva = PL_sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
sv = sva + 1;
svend = &sva[SvREFCNT(sva)];
- if (p >= sv && p < svend)
+ if (p >= sv && p < svend) {
ok = 1;
+ break;
+ }
}
if (!ok) {
if (ckWARN_d(WARN_INTERNAL))
@@ -289,11 +291,18 @@
sv = sva + 1;
while (sv < svend) {
SvANY(sv) = (void *)(SV*)(sv + 1);
+#ifdef DEBUGGING
SvREFCNT(sv) = 0;
+#endif
+ /* Must always set typemask because it's awlays checked in on cleanup
+ when the arenas are walked looking for objects. */
SvFLAGS(sv) = SVTYPEMASK;
sv++;
}
SvANY(sv) = 0;
+#ifdef DEBUGGING
+ SvREFCNT(sv) = 0;
+#endif
SvFLAGS(sv) = SVTYPEMASK;
}
@@ -1366,6 +1375,10 @@
del_XPVNV(SvANY(sv));
break;
case SVt_PVMG:
+ /* Because the XPVMG of PL_mess_sv isn't allocated from the arena,
+ there's no way that it can be safely upgraded, because perl.c
+ expects to Safefree(SvANY(PL_mess_sv)) */
+ assert(sv != PL_mess_sv);
pv = SvPVX(sv);
cur = SvCUR(sv);
len = SvLEN(sv);
@@ -3942,9 +3955,16 @@
return;
}
if (SvPVX(dstr)) {
- (void)SvOOK_off(dstr); /* backoff */
- if (SvLEN(dstr))
- Safefree(SvPVX(dstr));
+ if (SvLEN(dstr)) {
+ /* Unwrap the OOK offset by hand, to save a needless
+ memmove on memory that's about to be free()d. */
+ char *pv = SvPVX(dstr);
+ if (SvOOK(dstr)) {
+ pv -= SvIVX(dstr);
+ SvFLAGS(dstr) &= ~SVf_OOK;
+ }
+ Safefree(pv);
+ }
SvLEN(dstr)=SvCUR(dstr)=0;
}
}
@@ -5197,7 +5217,11 @@
case SVt_PVNV:
case SVt_PVIV:
freescalar:
- SvOOK_off(sv);
+ /* Don't bother with SvOOK_off(sv); as we're only going to free it. */
+ if (SvOOK(sv)) {
+ SvPV_set(sv, SvPVX(sv) - SvIVX(sv));
+ /* Don't even bother with turning off the OOK flag. */
+ }
/* FALL THROUGH */
case SVt_PV:
case SVt_RV:
@@ -6816,9 +6840,7 @@
register SV *sv;
new_SV(sv);
- if (!len)
- len = strlen(s);
- sv_setpvn(sv,s,len);
+ sv_setpvn(sv,s,len ? len : strlen(s));
return sv;
}
==== //depot/maint-5.8/perl/toke.c#61 (text) ====
Index: perl/toke.c
--- perl/toke.c#60~24635~ Mon May 30 06:51:00 2005
+++ perl/toke.c Sun Sep 11 13:36:26 2005
@@ -2534,7 +2534,7 @@
}
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart =
SvPVX(PL_linestr);
PL_last_lop = PL_last_uni = Nullch;
- sv_setpv(PL_linestr,"");
+ sv_setpvn(PL_linestr,"",0);
TOKEN(';'); /* not infinite loop because rsfp is NULL now */
}
/* If it looks like the start of a BOM or raw UTF-16,
@@ -2575,7 +2575,7 @@
if (PL_doextract) {
/* Incest with pod. */
if (*s == '=' && strnEQ(s, "=cut", 4)) {
- sv_setpv(PL_linestr, "");
+ sv_setpvn(PL_linestr, "", 0);
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart =
SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = Nullch;
@@ -2760,7 +2760,7 @@
/* if we have already added "LINE: while (<>) {",
we must not do it again */
{
- sv_setpv(PL_linestr, "");
+ sv_setpvn(PL_linestr, "", 0);
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart =
SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = Nullch;
@@ -5050,7 +5050,7 @@
Perl_croak(aTHX_ "Missing name in \"my sub\"");
PL_expect = XTERMBLOCK;
attrful = XATTRTERM;
- sv_setpv(PL_subname,"?");
+ sv_setpvn(PL_subname,"?",1);
have_name = FALSE;
}
==== //depot/maint-5.8/perl/util.c#57 (text) ====
Index: perl/util.c
--- perl/util.c#56~24634~ Mon May 30 06:01:42 2005
+++ perl/util.c Sun Sep 11 13:36:26 2005
@@ -2726,13 +2726,13 @@
if (strNE(a,b))
return FALSE;
if (fa == a)
- sv_setpv(tmpsv, ".");
+ sv_setpvn(tmpsv, ".", 1);
else
sv_setpvn(tmpsv, a, fa - a);
if (PerlLIO_stat(SvPVX(tmpsv), &tmpstatbuf1) < 0)
return FALSE;
if (fb == b)
- sv_setpv(tmpsv, ".");
+ sv_setpvn(tmpsv, ".", 1);
else
sv_setpvn(tmpsv, b, fb - b);
if (PerlLIO_stat(SvPVX(tmpsv), &tmpstatbuf2) < 0)
End of Patch.
