fixes for mortalization bug in xsubpp, other efficiency tweaks

	Message-Id: <H00000e500086fb3@MHS>
	Subject: [PATCH _69] sv_2mortal fix

p4raw-id: //depot/perl@1306

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 7194ad2..774ba79 100755 (executable)
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -1450,13 +1450,9 @@ sub generate_output {
                }
                elsif ($expr =~ /^\s*\$arg\s*=/) {
                    # We expect that $arg has refcnt >=1, so we need
-                   # to mortalize it. However, the extension may have
-                   # returned the built-in perl value, which is
-                   # read-only, thus not mortalizable. However, it is
-                   # safe to leave it as it is, since it would be
-                   # ignored by REFCNT_dec. Builtin values have REFCNT==0.
+                   # to mortalize it!
                    eval "print qq\a$expr\a";
-                   print "\tif (SvREFCNT(ST(0))) sv_2mortal(ST(0));\n";
+                   print "\tsv_2mortal(ST(0));\n";
                    print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic;
                }
                else {

diff --git a/perl.c b/perl.c
index e2db42c..7be4185 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -147,15 +147,21 @@ perl_construct(register PerlInterpreter *sv_interp)
        sv_upgrade(linestr,SVt_PVIV);
 
        if (!SvREADONLY(&sv_undef)) {
+           /* set read-only and try to insure than we wont see REFCNT==0
+              very often */
+
            SvREADONLY_on(&sv_undef);
+           SvREFCNT(&sv_undef) = (~(U32)0)/2;
 
            sv_setpv(&sv_no,No);
            SvNV(&sv_no);
            SvREADONLY_on(&sv_no);
+           SvREFCNT(&sv_no) = (~(U32)0)/2;
 
            sv_setpv(&sv_yes,Yes);
            SvNV(&sv_yes);
            SvREADONLY_on(&sv_yes);
+           SvREFCNT(&sv_yes) = (~(U32)0)/2;
        }
 
        nrs = newSVpv("\n", 1);

diff --git a/pp.c b/pp.c
index b5a184a..44ddd26 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -2623,8 +2623,7 @@ PP(pp_splice)
            if (AvREAL(ary)) {
                EXTEND_MORTAL(length);
                for (i = length, dst = MARK; i; i--) {
-                   if (!SvIMMORTAL(*dst))
-                       sv_2mortal(*dst);       /* free them eventualy */
+                   sv_2mortal(*dst);   /* free them eventualy */
                    dst++;
                }
            }
@@ -2633,8 +2632,7 @@ PP(pp_splice)
        else {
            *MARK = AvARRAY(ary)[offset+length-1];
            if (AvREAL(ary)) {
-               if (!SvIMMORTAL(*MARK))
-                   sv_2mortal(*MARK);
+               sv_2mortal(*MARK);
                for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
                    SvREFCNT_dec(*dst++);       /* free them now */
            }
@@ -2722,8 +2720,7 @@ PP(pp_splice)
                if (AvREAL(ary)) {
                    EXTEND_MORTAL(length);
                    for (i = length, dst = MARK; i; i--) {
-                       if (!SvIMMORTAL(*dst))
-                           sv_2mortal(*dst);   /* free them eventualy */
+                       sv_2mortal(*dst);       /* free them eventualy */
                        dst++;
                    }
                }
@@ -2734,8 +2731,7 @@ PP(pp_splice)
        else if (length--) {
            *MARK = tmparyval[length];
            if (AvREAL(ary)) {
-               if (!SvIMMORTAL(*MARK))
-                   sv_2mortal(*MARK);
+               sv_2mortal(*MARK);
                while (length-- > 0)
                    SvREFCNT_dec(tmparyval[length]);
            }
@@ -2783,7 +2779,7 @@ PP(pp_pop)
     djSP;
     AV *av = (AV*)POPs;
     SV *sv = av_pop(av);
-    if (!SvIMMORTAL(sv) && AvREAL(av))
+    if (AvREAL(av))
        (void)sv_2mortal(sv);
     PUSHs(sv);
     RETURN;
@@ -2797,7 +2793,7 @@ PP(pp_shift)
     EXTEND(SP, 1);
     if (!sv)
        RETPUSHUNDEF;
-    if (!SvIMMORTAL(sv) && AvREAL(av))
+    if (AvREAL(av))
        (void)sv_2mortal(sv);
     PUSHs(sv);
     RETURN;

diff --git a/pp_hot.c b/pp_hot.c
index 7234f15..6218f85 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -673,7 +673,7 @@ PP(pp_aassign)
        default:
            if (SvTHINKFIRST(sv)) {
                if (SvREADONLY(sv) && curcop != &compiling) {
-                   if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no)
+                   if (!SvIMMORTAL(sv))
                        DIE(no_modify);
                    if (relem <= lastrelem)
                        relem++;

diff --git a/proto.h b/proto.h
index d5aeb00..0da072e 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -338,9 +338,7 @@ VIRTUAL OP* newLISTOP _((I32 type, I32 flags, OP* first, OP* last));
 VIRTUAL OP*    newPMOP _((I32 type, I32 flags));
 VIRTUAL OP*    newPVOP _((I32 type, I32 flags, char* pv));
 VIRTUAL SV*    newRV _((SV* pref));
-#if !defined(__GNUC__) && (defined(CRIPPLED_CC) || defined(USE_THREADS) || defined(PERL_OBJECT))
 VIRTUAL SV*    newRV_noinc _((SV *sv));
-#endif
 VIRTUAL SV*    newSV _((STRLEN len));
 VIRTUAL OP*    newSVREF _((OP* o));
 VIRTUAL OP*    newSVOP _((I32 type, I32 flags, SV* sv));

diff --git a/sv.c b/sv.c
index 94fb230..d4cac52 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2959,15 +2959,16 @@ sv_free(SV *sv)
 
     if (!sv)
        return;
-    if (SvREADONLY(sv)) {
-       if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
-           return;
-    }
     if (SvREFCNT(sv) == 0) {
        if (SvFLAGS(sv) & SVf_BREAK)
            return;
        if (in_clean_all) /* All is fair */
            return;
+       if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+           /* make sure SvREFCNT(sv)==0 happens very seldom */
+           SvREFCNT(sv) = (~(U32)0)/2;
+           return;
+       }
        warn("Attempt to free unreferenced scalar");
        return;
     }
@@ -2980,6 +2981,11 @@ sv_free(SV *sv)
        return;
     }
 #endif
+    if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+       /* make sure SvREFCNT(sv)==0 happens very seldom */
+       SvREFCNT(sv) = (~(U32)0)/2;
+       return;
+    }
     sv_clear(sv);
     if (! SvREFCNT(sv))
        del_SV(sv);
@@ -3602,8 +3608,8 @@ sv_2mortal(register SV *sv)
     dTHR;
     if (!sv)
        return sv;
-    if (SvREADONLY(sv) && curcop != &compiling)
-       croak(no_modify);
+    if (SvREADONLY(sv) && SvIMMORTAL(sv))
+       return;
     if (++tmps_ix >= tmps_max)
        sv_mortalgrow();
     tmps_stack[tmps_ix] = sv;
@@ -3683,7 +3689,7 @@ newSViv(IV i)
 }
 
 SV *
-newRV(SV *tmpRef)
+newRV_noinc(SV *tmpRef)
 {
     dTHR;
     register SV *sv;
@@ -3694,20 +3700,17 @@ newRV(SV *tmpRef)
     SvFLAGS(sv) = 0;
     sv_upgrade(sv, SVt_RV);
     SvTEMP_off(tmpRef);
-    SvRV(sv) = SvREFCNT_inc(tmpRef);
+    SvRV(sv) = tmpRef;
     SvROK_on(sv);
     return sv;
 }
 
-
-
 SV *
-Perl_newRV_noinc(SV *tmpRef)
+newRV(SV *tmpRef)
 {
     register SV *sv;
-
-    sv = newRV(tmpRef);
-    SvREFCNT_dec(tmpRef);
+    sv = newRV_noinc(tmpRef);
+    SvREFCNT_inc(tmpRef);
     return sv;
 }
 

diff --git a/sv.h b/sv.h
index 6bf7817..b33998b 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -630,16 +630,6 @@ struct xpvio {
 #endif /* !CRIPPLED_CC */
 
 #define newRV_inc(sv)  newRV(sv)
-#ifdef __GNUC__
-#  undef newRV_noinc
-#  define newRV_noinc(sv) ({SV *nsv=newRV((sv)); --SvREFCNT(SvRV(nsv)); nsv;})
-#else
-#  if defined(CRIPPLED_CC) || defined(USE_THREADS) || defined(PERL_OBJECT)
-#  else
-#    undef newRV_noinc
-#    define newRV_noinc(sv)    ((Sv = newRV(sv)), --SvREFCNT(SvRV(Sv)), Sv)
-#  endif
-#endif /* __GNUC__ */
 
 /* the following macros update any magic values this sv is associated with */