X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=ee78fbcbbe450133538fa873d518fbc1bb3d7812;hb=82dee7de92a0bd357037a76ff6e67939cc6e9adc;hp=a53669a32453fdf4afa04566a3ef2e3d6512d36f;hpb=6aff239d5283e5d4ba7b451221311e53b9690309;p=p5sagit%2Fp5-mst-13.2.git diff --git a/sv.c b/sv.c index a53669a..ee78fbc 100644 --- a/sv.c +++ b/sv.c @@ -7498,6 +7498,16 @@ Perl_sv_dec(pTHX_ register SV *const sv) sv_setnv(sv,Atof(SvPVX_const(sv)) - 1.0); /* punt */ } +/* this define is used to eliminate a chunk of duplicated but shared logic + * it has the suffix __SV_C to signal that it isnt API, and isnt meant to be + * used anywhere but here - yves + */ +#define PUSH_EXTEND_MORTAL__SV_C(AnSv) \ + STMT_START { \ + EXTEND_MORTAL(1); \ + PL_tmps_stack[++PL_tmps_ix] = (AnSv); \ + } STMT_END + /* =for apidoc sv_mortalcopy @@ -7522,8 +7532,7 @@ Perl_sv_mortalcopy(pTHX_ SV *const oldstr) new_SV(sv); sv_setsv(sv,oldstr); - EXTEND_MORTAL(1); - PL_tmps_stack[++PL_tmps_ix] = sv; + PUSH_EXTEND_MORTAL__SV_C(sv); SvTEMP_on(sv); return sv; } @@ -7547,8 +7556,7 @@ Perl_sv_newmortal(pTHX) new_SV(sv); SvFLAGS(sv) = SVs_TEMP; - EXTEND_MORTAL(1); - PL_tmps_stack[++PL_tmps_ix] = sv; + PUSH_EXTEND_MORTAL__SV_C(sv); return sv; } @@ -7582,8 +7590,22 @@ Perl_newSVpvn_flags(pTHX_ const char *const s, const STRLEN len, const U32 flags assert(!(flags & ~(SVf_UTF8|SVs_TEMP))); new_SV(sv); sv_setpvn(sv,s,len); - SvFLAGS(sv) |= (flags & SVf_UTF8); - return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv; + + /* This code used to a sv_2mortal(), however we now unroll the call to sv_2mortal() + * and do what it does outselves here. + * Since we have asserted that flags can only have the SVf_UTF8 and/or SVs_TEMP flags + * set above we can use it to enable the sv flags directly (bypassing SvTEMP_on), which + * in turn means we dont need to mask out the SVf_UTF8 flag below, which means that we + * eleminate quite a few steps than it looks - Yves (explaining patch by gfx) + */ + + SvFLAGS(sv) |= flags; + + if(flags & SVs_TEMP){ + PUSH_EXTEND_MORTAL__SV_C(sv); + } + + return sv; } /* @@ -7606,8 +7628,7 @@ Perl_sv_2mortal(pTHX_ register SV *const sv) return NULL; if (SvREADONLY(sv) && SvIMMORTAL(sv)) return sv; - EXTEND_MORTAL(1); - PL_tmps_stack[++PL_tmps_ix] = sv; + PUSH_EXTEND_MORTAL__SV_C(sv); SvTEMP_on(sv); return sv; } @@ -12147,7 +12168,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, /* utf8 character classes */ PL_utf8_alnum = sv_dup_inc(proto_perl->Iutf8_alnum, param); - PL_utf8_alnumc = sv_dup_inc(proto_perl->Iutf8_alnumc, param); PL_utf8_ascii = sv_dup_inc(proto_perl->Iutf8_ascii, param); PL_utf8_alpha = sv_dup_inc(proto_perl->Iutf8_alpha, param); PL_utf8_space = sv_dup_inc(proto_perl->Iutf8_space, param); @@ -12288,8 +12308,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, SV * const nsv = MUTABLE_SV(ptr_table_fetch(PL_ptr_table, proto_perl->Itmps_stack[i])); if (nsv && !SvREFCNT(nsv)) { - EXTEND_MORTAL(1); - PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple(nsv); + PUSH_EXTEND_MORTAL__SV_C(SvREFCNT_inc_simple(nsv)); } } }