diff options
| -rw-r--r-- | doio.c | 8 | ||||
| -rw-r--r-- | doop.c | 4 | ||||
| -rw-r--r-- | gv.c | 4 | ||||
| -rw-r--r-- | hv.c | 7 | ||||
| -rw-r--r-- | mg.c | 10 | ||||
| -rw-r--r-- | mro.c | 2 | ||||
| -rw-r--r-- | pod/perlapi.pod | 7 | ||||
| -rw-r--r-- | pp.c | 10 | ||||
| -rw-r--r-- | pp_hot.c | 4 | ||||
| -rw-r--r-- | pp_pack.c | 6 | ||||
| -rw-r--r-- | pp_sys.c | 2 | ||||
| -rw-r--r-- | regcomp.c | 7 | ||||
| -rw-r--r-- | sv.c | 74 | ||||
| -rw-r--r-- | toke.c | 6 | ||||
| -rw-r--r-- | utf8.c | 4 | ||||
| -rw-r--r-- | util.c | 2 |
16 files changed, 82 insertions, 75 deletions
@@ -176,7 +176,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, IoTYPE(io) = PerlIO_intmode2str(rawmode, &mode[ix], &writing); - namesv = sv_2mortal(newSVpvn(oname,len)); + namesv = newSVpvn_flags(oname, len, SVs_TEMP); num_svs = 1; svp = &namesv; type = NULL; @@ -399,7 +399,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, } else { if (!num_svs) { - namesv = sv_2mortal(newSVpvn(type,tend - type)); + namesv = newSVpvn_flags(type, tend - type, SVs_TEMP); num_svs = 1; svp = &namesv; type = NULL; @@ -432,7 +432,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, } else { if (!num_svs) { - namesv = sv_2mortal(newSVpvn(type,tend - type)); + namesv = newSVpvn_flags(type, tend - type, SVs_TEMP); num_svs = 1; svp = &namesv; type = NULL; @@ -511,7 +511,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, } else { if (!num_svs) { - namesv = sv_2mortal(newSVpvn(type,tend - type)); + namesv = newSVpvn_flags(type, tend - type, SVs_TEMP); num_svs = 1; svp = &namesv; type = NULL; @@ -1217,13 +1217,13 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) /* Avoid triggering overloading again by using temporaries. Maybe there should be a variant of sv_utf8_upgrade that takes pvn */ - right = sv_2mortal(newSVpvn(rsave, rightlen)); + right = newSVpvn_flags(rsave, rightlen, SVs_TEMP); sv_utf8_upgrade(right); rsave = rc = SvPV_nomg_const(right, rightlen); right_utf = TRUE; } else if (!left_utf && right_utf) { - left = sv_2mortal(newSVpvn(lsave, leftlen)); + left = newSVpvn_flags(lsave, leftlen, SVs_TEMP); sv_utf8_upgrade(left); lsave = lc = SvPV_nomg_const(left, leftlen); left_utf = TRUE; @@ -2057,8 +2057,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) PUSHs(lr>0? left: right); PUSHs( lr > 0 ? &PL_sv_yes : ( assign ? &PL_sv_undef : &PL_sv_no )); if (notfound) { - PUSHs( sv_2mortal(newSVpvn(AMG_id2name(method + assignshift), - AMG_id2namelen(method + assignshift)))); + PUSHs(newSVpvn_flags(AMG_id2name(method + assignshift), + AMG_id2namelen(method + assignshift), SVs_TEMP)); } PUSHs((SV*)cv); PUTBACK; @@ -350,8 +350,9 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, SV* obj = mg->mg_obj; if (!keysv) { - keysv = sv_2mortal(newSVpvn_utf8(key, klen, - flags & HVhek_UTF8)); + keysv = newSVpvn_flags(key, klen, SVs_TEMP | + ((flags & HVhek_UTF8) + ? SVf_UTF8 : 0)); } mg->mg_obj = keysv; /* pass key */ @@ -913,7 +914,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv, PERL_MAGIC_env)) { /* XXX This code isn't UTF8 clean. */ - keysv = sv_2mortal(newSVpvn(key,klen)); + keysv = newSVpvn_flags(key, klen, SVs_TEMP); if (k_flags & HVhek_FREEKEY) { Safefree(key); } @@ -1607,7 +1607,7 @@ S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags, int if (n > 1) { if (mg->mg_ptr) { if (mg->mg_len >= 0) - PUSHs(sv_2mortal(newSVpvn(mg->mg_ptr, mg->mg_len))); + PUSHs(newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP)); else if (mg->mg_len == HEf_SVKEY) PUSHs((SV*)mg->mg_ptr); } @@ -2305,9 +2305,9 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) /* Opening for input is more common than opening for output, so ensure that hints for input are sooner on linked list. */ - tmp = sv_2mortal(out ? newSVpvn(out + 1, start + len - out - 1) - : newSVpvs("")); - SvFLAGS(tmp) |= SvUTF8(sv); + tmp = out ? newSVpvn_flags(out + 1, start + len - out - 1, + SVs_TEMP | SvUTF8(sv)) + : newSVpvn_flags("", 0, SVs_TEMP | SvUTF8(sv)); tmp_he = Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash, @@ -2960,7 +2960,7 @@ Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg) { dVAR; SV *key = (mg->mg_len == HEf_SVKEY) ? (SV *)mg->mg_ptr - : sv_2mortal(newSVpvn(mg->mg_ptr, mg->mg_len)); + : newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP); /* mg->mg_obj isn't being used. If needed, it would be possible to store an alternative leaf in there, with PL_compiling.cop_hints being used if @@ -1049,7 +1049,7 @@ XS(XS_mro_nextcan) /* beyond here is just for cache misses, so perf isn't as critical */ stashname_len = subname - fq_subname - 2; - stashname = sv_2mortal(newSVpvn(fq_subname, stashname_len)); + stashname = newSVpvn_flags(fq_subname, stashname_len, SVs_TEMP); linear_av = mro_get_linear_isa_c3(selfstash, 0); /* has ourselves at the top of the list */ diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 8546d4f6df..d9a2eebcd3 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -5173,9 +5173,10 @@ Creates a new SV and copies a string into it. The reference count for the SV is set to 1. Note that if C<len> is zero, Perl will create a zero length string. You are responsible for ensuring that the source string is at least C<len> bytes long. If the C<s> argument is NULL the new SV will be undefined. -Currently the only flag bit accepted is SVf_UTF8. If this is set, then it -will be set on the new SV. C<newSVpvn_utf8()> is a convenience wrapper for -this function, defined as +Currently the only flag bits accepted are C<SVf_UTF8> and C<SVs_TEMP>. +If C<SVs_TEMP> is set, then C<sv2mortal()> is called on the result before +returning. If C<SVf_UTF8> is set, then it will be set on the new SV. +C<newSVpvn_utf8()> is a convenience wrapper for this function, defined as #define newSVpvn_utf8(s, len, u) \ newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0) @@ -449,7 +449,7 @@ PP(pp_prototype) if (defgv && str[n - 1] == '$') str[n - 1] = '_'; str[n++] = '\0'; - ret = sv_2mortal(newSVpvn(str, n - 1)); + ret = newSVpvn_flags(str, n - 1, SVs_TEMP); } else if (code) /* Non-Overridable */ goto set; @@ -461,7 +461,7 @@ PP(pp_prototype) } cv = sv_2cv(TOPs, &stash, &gv, 0); if (cv && SvPOK(cv)) - ret = sv_2mortal(newSVpvn(SvPVX_const(cv), SvCUR(cv))); + ret = newSVpvn_flags(SvPVX_const(cv), SvCUR(cv), SVs_TEMP); set: SETs(ret); RETURN; @@ -3312,7 +3312,8 @@ PP(pp_index) Otherwise I need to avoid calls to sv_pos_u2b(), which (dangerously) will trigger magic and overloading again, as will fbm_instr() */ - big = sv_2mortal(newSVpvn_utf8(big_p, biglen, big_utf8)); + big = newSVpvn_flags(big_p, biglen, + SVs_TEMP | (big_utf8 ? SVf_UTF8 : 0)); big_p = SvPVX(big); } if (SvGAMAGIC(little) || (is_index && !SvOK(little))) { @@ -3324,7 +3325,8 @@ PP(pp_index) This is all getting to messy. The API isn't quite clean enough, because data access has side effects. */ - little = sv_2mortal(newSVpvn_utf8(little_p, llen, little_utf8)); + little = newSVpvn_flags(little_p, llen, + SVs_TEMP | (little_utf8 ? SVf_UTF8 : 0)); little_p = SvPVX(little); } @@ -248,7 +248,7 @@ PP(pp_concat) /* mg_get(right) may happen here ... */ rpv = SvPV_const(right, rlen); rbyte = !DO_UTF8(right); - right = sv_2mortal(newSVpvn(rpv, rlen)); + right = newSVpvn_flags(rpv, rlen, SVs_TEMP); rpv = SvPV_const(right, rlen); /* no point setting UTF-8 here */ rcopied = TRUE; } @@ -287,7 +287,7 @@ PP(pp_concat) sv_utf8_upgrade_nomg(TARG); else { if (!rcopied) - right = sv_2mortal(newSVpvn(rpv, rlen)); + right = newSVpvn_flags(rpv, rlen, SVs_TEMP); sv_utf8_upgrade_nomg(right); rpv = SvPV_const(right, rlen); } @@ -2010,7 +2010,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c SHIFT_VAR(utf8, s, strend, aptr, datumtype); DO_BO_UNPACK_PC(aptr); /* newSVpvn generates undef if aptr is NULL */ - PUSHs(sv_2mortal(newSVpvn(aptr, len))); + PUSHs(newSVpvn_flags(aptr, len, SVs_TEMP)); } break; #ifdef HAS_QUAD @@ -2511,8 +2511,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) STRLEN len; const char *const pv = SvPV_const(*beglist, len); SV *const temp - = sv_2mortal(newSVpvn_flags(pv, len, - SvUTF8(*beglist))); + = newSVpvn_flags(pv, len, + SVs_TEMP | SvUTF8(*beglist)); *beglist = temp; } count = DO_UTF8(*beglist) ? @@ -4697,7 +4697,7 @@ PP(pp_ghostent) PUSHs(sv_2mortal(newSViv((IV)len))); #ifdef h_addr for (elem = hent->h_addr_list; elem && *elem; elem++) { - XPUSHs(sv_2mortal(newSVpvn(*elem, len))); + XPUSHs(newSVpvn_flags(*elem, len, SVs_TEMP)); } #else if (hent->h_addr) @@ -5249,8 +5249,9 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) { } if ( flags ) { - SV* sv_name = sv_2mortal(newSVpvn_utf8(name_start, - (int)(RExC_parse - name_start), UTF)); + SV* sv_name + = newSVpvn_flags(name_start, (int)(RExC_parse - name_start), + SVs_TEMP | (UTF ? SVf_UTF8 : 0)); if ( flags == REG_RSN_RETURN_NAME) return sv_name; else if (flags==REG_RSN_RETURN_DATA) { @@ -6742,7 +6743,7 @@ STATIC UV S_reg_recode(pTHX_ const char value, SV **encp) { STRLEN numlen = 1; - SV * const sv = sv_2mortal(newSVpvn(&value, numlen)); + SV * const sv = newSVpvn_flags(&value, numlen, SVs_TEMP); const char * const s = *encp ? sv_recode_to_utf8(sv, *encp) : SvPVX(sv); const STRLEN newlen = SvCUR(sv); UV uv = UNICODE_REPLACEMENT; @@ -4344,7 +4344,7 @@ Perl_sv_catsv_flags(pTHX_ SV *dsv, register SV *ssv, I32 flags) if (dutf8 != sutf8) { if (dutf8) { /* Not modifying source SV, so taking a temporary copy. */ - SV* const csv = sv_2mortal(newSVpvn(spv, slen)); + SV* const csv = newSVpvn_flags(spv, slen, SVs_TEMP); sv_utf8_upgrade(csv); spv = SvPV_const(csv, slen); @@ -6042,7 +6042,7 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2) * invalidate pv1, so we may need to make a copy */ if (sv1 == sv2 && (SvTHINKFIRST(sv1) || SvGMAGICAL(sv1))) { pv1 = SvPV_const(sv1, cur1); - sv1 = sv_2mortal(newSVpvn_flags(pv1, cur1, SvUTF8(sv2))); + sv1 = newSVpvn_flags(pv1, cur1, SVs_TEMP | SvUTF8(sv2)); } pv1 = SvPV_const(sv1, cur1); } @@ -6998,6 +6998,40 @@ Perl_sv_newmortal(pTHX) return sv; } + +/* +=for apidoc newSVpvn_flags + +Creates a new SV and copies a string into it. The reference count for the +SV is set to 1. Note that if C<len> is zero, Perl will create a zero length +string. You are responsible for ensuring that the source string is at least +C<len> bytes long. If the C<s> argument is NULL the new SV will be undefined. +Currently the only flag bits accepted are C<SVf_UTF8> and C<SVs_TEMP>. +If C<SVs_TEMP> is set, then C<sv2mortal()> is called on the result before +returning. If C<SVf_UTF8> is set, then it will be set on the new SV. +C<newSVpvn_utf8()> is a convenience wrapper for this function, defined as + + #define newSVpvn_utf8(s, len, u) \ + newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0) + +=cut +*/ + +SV * +Perl_newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags) +{ + dVAR; + register SV *sv; + + /* All the flags we don't support must be zero. + And we're new code so I'm going to assert this from the start. */ + 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; +} + /* =for apidoc sv_2mortal @@ -7068,38 +7102,6 @@ Perl_newSVpvn(pTHX_ const char *s, STRLEN len) } /* -=for apidoc newSVpvn_flags - -Creates a new SV and copies a string into it. The reference count for the -SV is set to 1. Note that if C<len> is zero, Perl will create a zero length -string. You are responsible for ensuring that the source string is at least -C<len> bytes long. If the C<s> argument is NULL the new SV will be undefined. -Currently the only flag bit accepted is SVf_UTF8. If this is set, then it -will be set on the new SV. C<newSVpvn_utf8()> is a convenience wrapper for -this function, defined as - - #define newSVpvn_utf8(s, len, u) \ - newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0) - -=cut -*/ - -SV * -Perl_newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags) -{ - dVAR; - register SV *sv; - - /* All the flags we don't support must be zero. - And we're new code so I'm going to assert this from the start. */ - assert(!(flags & ~SVf_UTF8)); - new_SV(sv); - sv_setpvn(sv,s,len); - SvFLAGS(sv) |= flags; - return sv; -} - -/* =for apidoc newSVhek Creates a new SV from the hash key structure. It will generate scalars that @@ -9529,7 +9531,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV } else { const STRLEN old_elen = elen; - SV * const nsv = sv_2mortal(newSVpvn(eptr, elen)); + SV * const nsv = newSVpvn_flags(eptr, elen, SVs_TEMP); sv_utf8_upgrade(nsv); eptr = SvPVX_const(nsv); elen = SvCUR(nsv); @@ -11782,7 +11784,7 @@ Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding, XPUSHs(dsv); XPUSHs(ssv); XPUSHs(offsv = sv_2mortal(newSViv(*offset))); - XPUSHs(sv_2mortal(newSVpvn(tstr, tlen))); + XPUSHs(newSVpvn_flags(tstr, tlen, SVs_TEMP)); PUTBACK; call_method("cat_decode", G_SCALAR); SPAGAIN; @@ -1570,7 +1570,7 @@ S_tokeq(pTHX_ SV *sv) goto finish; d = s; if ( PL_hints & HINT_NEW_STRING ) { - pv = sv_2mortal(newSVpvn_flags(SvPVX_const(pv), len, SvUTF8(sv))); + pv = newSVpvn_flags(SvPVX_const(pv), len, SVs_TEMP | SvUTF8(sv)); } while (s < send) { if (*s == '\\') { @@ -10551,9 +10551,9 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen, sv_2mortal(sv); /* Parent created it permanently */ cv = *cvp; if (!pv && s) - pv = sv_2mortal(newSVpvn(s, len)); + pv = newSVpvn_flags(s, len, SVs_TEMP); if (type && pv) - typesv = sv_2mortal(newSVpvn(type, typelen)); + typesv = newSVpvn_flags(type, typelen, SVs_TEMP); else typesv = &PL_sv_undef; @@ -1587,8 +1587,8 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits SPAGAIN; PUSHMARK(SP); EXTEND(SP,5); - PUSHs(sv_2mortal(newSVpvn(pkg, pkg_len))); - PUSHs(sv_2mortal(newSVpvn(name, name_len))); + PUSHs(newSVpvn_flags(pkg, pkg_len, SVs_TEMP)); + PUSHs(newSVpvn_flags(name, name_len, SVs_TEMP)); PUSHs(listsv); PUSHs(sv_2mortal(newSViv(minbits))); PUSHs(sv_2mortal(newSViv(none))); @@ -1216,7 +1216,7 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen) PUSHMARK(SP); EXTEND(SP,2); PUSHs(SvTIED_obj((SV*)io, mg)); - PUSHs(sv_2mortal(newSVpvn(message, msglen))); + PUSHs(newSVpvn_flags(message, msglen, SVs_TEMP)); PUTBACK; call_method("PRINT", G_SCALAR); |