X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=ee78fbcbbe450133538fa873d518fbc1bb3d7812;hb=efe15bf0980629945e70e47a4eaaffc5bdc49b7d;hp=b8daf815466dc89db0f8bbd59278c146b983a019;hpb=85dca89a8f321bc581a3d365d95ab0c56368ed78;p=p5sagit%2Fp5-mst-13.2.git diff --git a/sv.c b/sv.c index b8daf81..ee78fbc 100644 --- a/sv.c +++ b/sv.c @@ -5096,8 +5096,6 @@ Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how, case PERL_MAGIC_qr: vtable = &PL_vtbl_regexp; break; - case PERL_MAGIC_hints: - /* As this vtable is all NULL, we can reuse it. */ case PERL_MAGIC_sig: vtable = &PL_vtbl_sig; break; @@ -5140,6 +5138,9 @@ Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how, case PERL_MAGIC_hintselem: vtable = &PL_vtbl_hintselem; break; + case PERL_MAGIC_hints: + vtable = &PL_vtbl_hints; + break; case PERL_MAGIC_ext: /* Reserved for use by extensions not perl internals. */ /* Useful for attaching extension internal data to perl vars. */ @@ -7297,7 +7298,7 @@ Perl_sv_inc(pTHX_ register SV *const sv) d = SvPVX(sv); while (isALPHA(*d)) d++; while (isDIGIT(*d)) d++; - if (*d) { + if (d < SvEND(sv)) { #ifdef PERL_PRESERVE_IVUV /* Got to punt this as an integer if needs be, but we don't issue warnings. Probably ought to make the sv_iv_please() that does @@ -7497,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 @@ -7521,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; } @@ -7546,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; } @@ -7581,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; } /* @@ -7605,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; } @@ -12146,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); @@ -12287,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)); } } }