From: Joshua Pritikin Date: Wed, 1 Jul 1998 10:09:43 +0000 (-0400) Subject: fixes for mortalization bug in xsubpp, other efficiency tweaks X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d689ffdd6d1d8fd913b48f3cb3a376bd99e0a6cf;p=p5sagit%2Fp5-mst-13.2.git fixes for mortalization bug in xsubpp, other efficiency tweaks Message-Id: 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 */