fixes for mortalization bug in xsubpp, other efficiency tweaks

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

p4raw-id: //depot/perl@1306

7 files changed, 32 insertions, 43 deletions

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 7194ad2790..774ba79345 100755
--- 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 e2db42c84b..7be4185cc8 100644
--- 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 b5a184a4b9..44ddd26807 100644
--- 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 7234f15fdd..6218f85514 100644
--- 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 d5aeb00d4e..0da072ed72 100644
--- 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 94fb230bdc..d4cac52e9a 100644
--- 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 6bf7817cda..b33998b7a7 100644
--- 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 */