From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sat, 3 Apr 1999 17:43:23 +0000 (+0000)
Subject: remove duplicate code and an extra branch in sv_setsv() and
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6fc9266916f08dacf1850556174b6312eefb14e6;p=p5sagit%2Fp5-mst-13.2.git
remove duplicate code and an extra branch in sv_setsv() and
other hot code by making SvTHINKFIRST() think about FAKE SVs
p4raw-id: //depot/perl@3213
---
diff --git a/doio.c b/doio.c
index 695a209..0fd0288 100644
--- a/doio.c
+++ b/doio.c
@@ -1615,12 +1615,6 @@ do_msgrcv(SV **mark, SV **sp)
msize = SvIVx(*++mark);
mtype = (long)SvIVx(*++mark);
flags = SvIVx(*++mark);
- if (SvTHINKFIRST(mstr)) {
- if (SvREADONLY(mstr))
- croak("Can't msgrcv to readonly var");
- if (SvROK(mstr))
- sv_unref(mstr);
- }
SvPV_force(mstr, len);
mbuf = SvGROW(mstr, sizeof(long)+msize+1);
diff --git a/embed.h b/embed.h
index d21cc3b..e95c95c 100644
--- a/embed.h
+++ b/embed.h
@@ -868,6 +868,7 @@
#define sv_derived_from Perl_sv_derived_from
#define sv_dump Perl_sv_dump
#define sv_eq Perl_sv_eq
+#define sv_force_normal Perl_sv_force_normal
#define sv_free Perl_sv_free
#define sv_free_arenas Perl_sv_free_arenas
#define sv_gets Perl_sv_gets
@@ -2013,7 +2014,6 @@
#define sv_catpvn_mg CPerlObj::Perl_sv_catpvn_mg
#define sv_catsv CPerlObj::Perl_sv_catsv
#define sv_catsv_mg CPerlObj::Perl_sv_catsv_mg
-#define sv_check_thinkfirst CPerlObj::Perl_sv_check_thinkfirst
#define sv_chop CPerlObj::Perl_sv_chop
#define sv_clean_all CPerlObj::Perl_sv_clean_all
#define sv_clean_objs CPerlObj::Perl_sv_clean_objs
@@ -2026,6 +2026,7 @@
#define sv_derived_from CPerlObj::Perl_sv_derived_from
#define sv_dump CPerlObj::Perl_sv_dump
#define sv_eq CPerlObj::Perl_sv_eq
+#define sv_force_normal CPerlObj::Perl_sv_force_normal
#define sv_free CPerlObj::Perl_sv_free
#define sv_free_arenas CPerlObj::Perl_sv_free_arenas
#define sv_gets CPerlObj::Perl_sv_gets
diff --git a/embed.pl b/embed.pl
index 89e1506..d089160 100755
--- a/embed.pl
+++ b/embed.pl
@@ -227,7 +227,6 @@ my @staticfuncs = qw(
del_xrv
sv_mortalgrow
sv_unglob
- sv_check_thinkfirst
avhv_index_sv
do_report_used
do_clean_objs
diff --git a/global.sym b/global.sym
index 8919957..881ee76 100644
--- a/global.sym
+++ b/global.sym
@@ -515,6 +515,7 @@ sv_dec
sv_derived_from
sv_dump
sv_eq
+sv_force_normal
sv_free
sv_free_arenas
sv_gets
diff --git a/objXSUB.h b/objXSUB.h
index 033430e..2c24b59 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -2893,8 +2893,6 @@
#define sv_catsv pPerl->Perl_sv_catsv
#undef sv_catsv_mg
#define sv_catsv_mg pPerl->Perl_sv_catsv_mg
-#undef sv_check_thinkfirst
-#define sv_check_thinkfirst pPerl->Perl_sv_check_thinkfirst
#undef sv_chop
#define sv_chop pPerl->Perl_sv_chop
#undef sv_clean_all
@@ -2919,6 +2917,8 @@
#define sv_dump pPerl->Perl_sv_dump
#undef sv_eq
#define sv_eq pPerl->Perl_sv_eq
+#undef sv_force_normal
+#define sv_force_normal pPerl->Perl_sv_force_normal
#undef sv_free
#define sv_free pPerl->Perl_sv_free
#undef sv_free_arenas
diff --git a/pp.c b/pp.c
index b03acf3..207a72d 100644
--- a/pp.c
+++ b/pp.c
@@ -792,15 +792,8 @@ PP(pp_undef)
if (!sv)
RETPUSHUNDEF;
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv)) {
- dTHR;
- if (PL_curcop != &PL_compiling)
- croak(PL_no_modify);
- }
- if (SvROK(sv))
- sv_unref(sv);
- }
+ if (SvTHINKFIRST(sv))
+ sv_force_normal(sv);
switch (SvTYPE(sv)) {
case SVt_NULL:
@@ -817,9 +810,12 @@ PP(pp_undef)
CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
/* FALL THROUGH */
case SVt_PVFM:
- { GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv));
- cv_undef((CV*)sv);
- CvGV((CV*)sv) = gv; } /* let user-undef'd sub keep its identity */
+ {
+ /* let user-undef'd sub keep its identity */
+ GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv));
+ cv_undef((CV*)sv);
+ CvGV((CV*)sv) = gv;
+ }
break;
case SVt_PVGV:
if (SvFAKE(sv))
@@ -1037,12 +1033,6 @@ PP(pp_repeat)
STRLEN len;
tmpstr = POPs;
- if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
- if (SvREADONLY(tmpstr) && PL_curcop != &PL_compiling)
- DIE("Can't x= to readonly value");
- if (SvROK(tmpstr))
- sv_unref(tmpstr);
- }
SvSetSV(TARG, tmpstr);
SvPV_force(TARG, len);
if (count != 1) {
diff --git a/pp_hot.c b/pp_hot.c
index 0785f5f..cdfe8c4 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -733,16 +733,10 @@ PP(pp_aassign)
}
break;
default:
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && PL_curcop != &PL_compiling) {
- if (!SvIMMORTAL(sv))
- DIE(PL_no_modify);
- if (relem <= lastrelem)
- relem++;
- break;
- }
- if (SvROK(sv))
- sv_unref(sv);
+ if (SvIMMORTAL(sv)) {
+ if (relem <= lastrelem)
+ relem++;
+ break;
}
if (relem <= lastrelem) {
sv_setsv(sv, *relem);
diff --git a/proto.h b/proto.h
index b809ea0..0b1c962 100644
--- a/proto.h
+++ b/proto.h
@@ -717,7 +717,6 @@ void del_xpv _((XPV* p));
void del_xrv _((XRV* p));
void sv_mortalgrow _((void));
void sv_unglob _((SV* sv));
-void sv_check_thinkfirst _((SV *sv));
I32 avhv_index_sv _((SV* sv));
void do_report_used _((SV *sv));
@@ -967,3 +966,4 @@ VIRTUAL void magic_dump _((MAGIC *mg));
VIRTUAL void reginitcolors _((void));
VIRTUAL char* sv_2pv_nolen _((SV* sv));
VIRTUAL char* sv_pv _((SV *sv));
+VIRTUAL void sv_force_normal _((SV *sv));
diff --git a/scope.c b/scope.c
index 4a2a778..4d62ae8 100644
--- a/scope.c
+++ b/scope.c
@@ -742,12 +742,8 @@ leave_scope(I32 base)
sv = *(SV**)ptr;
/* Can clear pad variable in place? */
if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv))
- croak("panic: leave_scope clearsv");
- if (SvROK(sv))
- sv_unref(sv);
- }
+ if (SvTHINKFIRST(sv))
+ sv_force_normal(sv);
if (SvMAGICAL(sv))
mg_free(sv);
diff --git a/sv.c b/sv.c
index 6310937..95f69ea 100644
--- a/sv.c
+++ b/sv.c
@@ -59,7 +59,6 @@ static void del_xpv _((XPV* p));
static void del_xrv _((XRV* p));
static void sv_mortalgrow _((void));
static void sv_unglob _((SV* sv));
-static void sv_check_thinkfirst _((SV *sv));
#ifndef PURIFY
static void *my_safemalloc(MEM_SIZE size);
@@ -71,7 +70,7 @@ typedef void (*SVFUNC) _((SV*));
#endif /* PERL_OBJECT */
-#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_check_thinkfirst(sv)
+#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_force_normal(sv)
#ifdef PURIFY
@@ -1002,11 +1001,6 @@ sv_setiv(register SV *sv, IV i)
break;
case SVt_PVGV:
- if (SvFAKE(sv)) {
- sv_unglob(sv);
- break;
- }
- /* FALL THROUGH */
case SVt_PVAV:
case SVt_PVHV:
case SVt_PVCV:
@@ -1062,11 +1056,6 @@ sv_setnv(register SV *sv, double num)
break;
case SVt_PVGV:
- if (SvFAKE(sv)) {
- sv_unglob(sv);
- break;
- }
- /* FALL THROUGH */
case SVt_PVAV:
case SVt_PVHV:
case SVt_PVCV:
@@ -1810,13 +1799,6 @@ sv_setsv(SV *dstr, register SV *sstr)
stype = SvTYPE(sstr);
dtype = SvTYPE(dstr);
- if (dtype == SVt_PVGV && (SvFLAGS(dstr) & SVf_FAKE)) {
- sv_unglob(dstr); /* so fake GLOB won't perpetuate */
- sv_setpvn(dstr, "", 0);
- (void)SvPOK_only(dstr);
- dtype = SvTYPE(dstr);
- }
-
SvAMAGIC_off(dstr);
/* There's a lot of redundancy below but we're going for speed here */
@@ -1949,9 +1931,9 @@ sv_setsv(SV *dstr, register SV *sstr)
}
}
if (stype == SVt_PVLV)
- SvUPGRADE(dstr, SVt_PVNV);
+ (void)SvUPGRADE(dstr, SVt_PVNV);
else
- SvUPGRADE(dstr, stype);
+ (void)SvUPGRADE(dstr, stype);
}
sflags = SvFLAGS(sstr);
@@ -2183,12 +2165,7 @@ sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len)
(void)SvOK_off(sv);
return;
}
- if (SvTYPE(sv) >= SVt_PV) {
- if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
- sv_unglob(sv);
- }
- else
- sv_upgrade(sv, SVt_PV);
+ (void)SvUPGRADE(sv, SVt_PV);
SvGROW(sv, len + 1);
dptr = SvPVX(sv);
@@ -2217,12 +2194,7 @@ sv_setpv(register SV *sv, register const char *ptr)
return;
}
len = strlen(ptr);
- if (SvTYPE(sv) >= SVt_PV) {
- if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
- sv_unglob(sv);
- }
- else
- sv_upgrade(sv, SVt_PV);
+ (void)SvUPGRADE(sv, SVt_PV);
SvGROW(sv, len + 1);
Move(ptr,SvPVX(sv),len+1,char);
@@ -2266,8 +2238,8 @@ sv_usepvn_mg(register SV *sv, register char *ptr, register STRLEN len)
SvSETMAGIC(sv);
}
-STATIC void
-sv_check_thinkfirst(register SV *sv)
+void
+sv_force_normal(register SV *sv)
{
if (SvREADONLY(sv)) {
dTHR;
@@ -2276,6 +2248,8 @@ sv_check_thinkfirst(register SV *sv)
}
if (SvROK(sv))
sv_unref(sv);
+ else if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
+ sv_unglob(sv);
}
void
@@ -3176,12 +3150,7 @@ sv_gets(register SV *sv, register PerlIO *fp, I32 append)
I32 i;
SV_CHECK_THINKFIRST(sv);
- if (SvTYPE(sv) >= SVt_PV) {
- if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
- sv_unglob(sv);
- }
- else
- sv_upgrade(sv, SVt_PV);
+ (void)SvUPGRADE(sv, SVt_PV);
SvSCREAM_off(sv);
@@ -4016,27 +3985,17 @@ sv_pvn_force(SV *sv, STRLEN *lp)
{
char *s;
- if (SvREADONLY(sv)) {
- dTHR;
- if (PL_curcop != &PL_compiling)
- croak(PL_no_modify);
- }
+ if (SvTHINKFIRST(sv) && !SvROK(sv))
+ sv_force_normal(sv);
if (SvPOK(sv)) {
*lp = SvCUR(sv);
}
else {
if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) {
- if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) {
- sv_unglob(sv);
- s = SvPVX(sv);
- *lp = SvCUR(sv);
- }
- else {
- dTHR;
- croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
- PL_op_name[PL_op->op_type]);
- }
+ dTHR;
+ croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
+ PL_op_name[PL_op->op_type]);
}
else
s = sv_2pv(sv, lp);
diff --git a/sv.h b/sv.h
index fb89907..92e9207 100644
--- a/sv.h
+++ b/sv.h
@@ -137,7 +137,7 @@ struct io {
#define SVf_BREAK 0x00400000 /* refcnt is artificially low */
#define SVf_READONLY 0x00800000 /* may not be modified */
-#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK)
+#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE)
#define SVp_IOK 0x01000000 /* has valid non-public integer value */
#define SVp_NOK 0x02000000 /* has valid non-public numeric value */