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 (file)
--- 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 (file)
--- 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 (executable)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 */