diff options
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | embed.h | 1 | ||||
| -rw-r--r-- | mg.c | 28 | ||||
| -rw-r--r-- | pod/perldelta.pod | 3 | ||||
| -rw-r--r-- | pp.c | 2 | ||||
| -rw-r--r-- | pp_hot.c | 2 | ||||
| -rw-r--r-- | proto.h | 3 | ||||
| -rw-r--r-- | regcomp.c | 2 | ||||
| -rw-r--r-- | sv.c | 60 | ||||
| -rw-r--r-- | t/perf/benchmarks | 5 | ||||
| -rw-r--r-- | util.c | 7 |
11 files changed, 92 insertions, 22 deletions
@@ -2709,6 +2709,7 @@ sRM |U8* |swash_scan_list_line|NN U8* l|NN U8* const lend|NN UV* min \ AiMn |void |append_utf8_from_native_byte|const U8 byte|NN U8** dest #endif +Apd |void |sv_set_undef |NN SV *sv Apd |void |sv_setsv_flags |NN SV *dstr|NULLOK SV *sstr|const I32 flags Apd |void |sv_catpvn_flags|NN SV *const dstr|NN const char *sstr|const STRLEN len \ |const I32 flags @@ -664,6 +664,7 @@ #define sv_report_used() Perl_sv_report_used(aTHX) #define sv_reset(a,b) Perl_sv_reset(aTHX_ a,b) #define sv_rvweaken(a) Perl_sv_rvweaken(aTHX_ a) +#define sv_set_undef(a) Perl_sv_set_undef(aTHX_ a) #define sv_setiv(a,b) Perl_sv_setiv(aTHX_ a,b) #define sv_setiv_mg(a,b) Perl_sv_setiv_mg(aTHX_ a,b) #define sv_setnv(a,b) Perl_sv_setnv(aTHX_ a,b) @@ -725,7 +725,7 @@ Perl_emulate_cop_io(pTHX_ const COP *const c, SV *const sv) PERL_ARGS_ASSERT_EMULATE_COP_IO; if (!(CopHINTS_get(c) & (HINT_LEXICAL_IO_IN|HINT_LEXICAL_IO_OUT))) - sv_setsv(sv, &PL_sv_undef); + sv_set_undef(sv); else { SvPVCLEAR(sv); SvUTF8_off(sv); @@ -800,9 +800,9 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) if (PL_curpm && (rx = PM_GETRE(PL_curpm))) { do_numbuf_fetch: CALLREG_NUMBUF_FETCH(rx,paren,sv); - } else { - sv_setsv(sv,&PL_sv_undef); } + else + goto set_undef; return 0; } @@ -810,7 +810,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) switch (*mg->mg_ptr) { case '\001': /* ^A */ if (SvOK(PL_bodytarget)) sv_copypv(sv, PL_bodytarget); - else sv_setsv(sv, &PL_sv_undef); + else + sv_set_undef(sv); if (SvTAINTED(PL_bodytarget)) SvTAINTED_on(sv); break; @@ -994,8 +995,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) sv_setpvn(sv, WARN_NONEstring, WARNsize) ; } else if (PL_compiling.cop_warnings == pWARN_STD) { - sv_setsv(sv, &PL_sv_undef); - break; + goto set_undef; } else if (PL_compiling.cop_warnings == pWARN_ALL) { /* Get the bit mask for $warnings::Bits{all}, because @@ -1024,16 +1024,14 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) if (paren) goto do_numbuf_fetch; } - sv_setsv(sv,&PL_sv_undef); - break; + goto set_undef; case '\016': /* ^N */ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) { paren = RX_LASTCLOSEPAREN(rx); if (paren) goto do_numbuf_fetch; } - sv_setsv(sv,&PL_sv_undef); - break; + goto set_undef; case '.': if (GvIO(PL_last_in_gv)) { sv_setiv(sv, (IV)IoLINES(GvIOp(PL_last_in_gv))); @@ -1092,7 +1090,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) if (PL_ors_sv) sv_copypv(sv, PL_ors_sv); else - sv_setsv(sv, &PL_sv_undef); + goto set_undef; break; case '$': /* $$ */ { @@ -1138,6 +1136,10 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) break; } return 0; + + set_undef: + sv_set_undef(sv); + return 0; } int @@ -1341,7 +1343,7 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg) if(sigstate == (Sighandler_t) SIG_IGN) sv_setpvs(sv,"IGNORE"); else - sv_setsv(sv,&PL_sv_undef); + sv_set_undef(sv); PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv); SvTEMP_off(sv); } @@ -2189,7 +2191,7 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg) negrem ? -(IV)rem : (IV)rem, !negrem, &offs, &rem )) { Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string"); - sv_setsv_nomg(sv, &PL_sv_undef); + sv_set_undef(sv); return 0; } diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 9719550901..070fd4a57c 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -323,7 +323,8 @@ well. =item * -XXX +A new API function, C<sv_set_undef(sv)>, has been added. This is +equivalent to C<sv_setsv(sv, &PL_sv_undef)>, but is more efficient. =back @@ -3249,7 +3249,7 @@ PP(pp_length) } } else { if (!SvPADTMP(TARG)) { - sv_setsv_nomg(TARG, &PL_sv_undef); + sv_set_undef(TARG); } else { /* TARG is on stack at this point and is overwriten by SETs. This branch is the odd one out, so put TARG by default on stack earlier to let local SP go out of liveness sooner */ @@ -1776,7 +1776,7 @@ PP(pp_aassign) default: if (!SvIMMORTAL(lsv)) { - sv_setsv(lsv, &PL_sv_undef); + sv_set_undef(lsv); SvSETMAGIC(lsv); *relem++ = lsv; } @@ -3224,6 +3224,9 @@ PERL_CALLCONV void Perl_sv_resetpvn(pTHX_ const char* s, STRLEN len, HV *const s PERL_CALLCONV SV* Perl_sv_rvweaken(pTHX_ SV *const sv); #define PERL_ARGS_ASSERT_SV_RVWEAKEN \ assert(sv) +PERL_CALLCONV void Perl_sv_set_undef(pTHX_ SV *sv); +#define PERL_ARGS_ASSERT_SV_SET_UNDEF \ + assert(sv) PERL_CALLCONV void Perl_sv_sethek(pTHX_ SV *const sv, const HEK *const hek); #define PERL_ARGS_ASSERT_SV_SETHEK \ assert(sv) @@ -8139,7 +8139,7 @@ Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren, } } else { ret_undef: - sv_setsv(sv,&PL_sv_undef); + sv_set_undef(sv); return; } } @@ -4782,6 +4782,64 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) SvTAINT(dstr); } + +/* +=for apidoc sv_set_undef + +Equivalent to C<sv_setsv(sv, &PL_sv_undef)>, but more efficient. +Doesn't handle set magic. + +The perl equivalent is C<$sv = undef;>. Note that it doesn't free any string +buffer, unlike C<undef $sv>. + +Introduced in perl 5.26.0. + +=cut +*/ + +void +Perl_sv_set_undef(pTHX_ SV *sv) +{ + U32 type = SvTYPE(sv); + + PERL_ARGS_ASSERT_SV_SET_UNDEF; + + /* shortcut, NULL, IV, RV */ + + if (type <= SVt_IV) { + assert(!SvGMAGICAL(sv)); + if (SvREADONLY(sv)) + Perl_croak_no_modify(); + + if (SvROK(sv)) { + if (SvWEAKREF(sv)) + sv_unref_flags(sv, 0); + else { + SV *rv = SvRV(sv); + SvFLAGS(sv) = type; /* quickly turn off all flags */ + SvREFCNT_dec_NN(rv); + return; + } + } + SvFLAGS(sv) = type; /* quickly turn off all flags */ + return; + } + + if (SvIS_FREED(sv)) + Perl_croak(aTHX_ "panic: attempt to undefine a freed scalar %p", + (void *)sv); + + SV_CHECK_THINKFIRST_COW_DROP(sv); + + if (isGV_with_GP(sv)) + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), + "Undefined value assigned to typeglob"); + + SvOK_off(sv); +} + + + /* =for apidoc sv_setsv_mg @@ -10272,7 +10330,7 @@ Perl_sv_setref_pv(pTHX_ SV *const rv, const char *const classname, void *const p PERL_ARGS_ASSERT_SV_SETREF_PV; if (!pv) { - sv_setsv(rv, &PL_sv_undef); + sv_set_undef(rv); SvSETMAGIC(rv); } else diff --git a/t/perf/benchmarks b/t/perf/benchmarks index 6386f47e1e..92411a23c9 100644 --- a/t/perf/benchmarks +++ b/t/perf/benchmarks @@ -320,6 +320,11 @@ setup => 'my ($x,$y,$z)', code => '($x,$y,$z) = ()', }, + 'expr::aassign::3lref_empty' => { + desc => 'three lexical ref vars assigned empty', + setup => 'my ($x,$y,$z); my $r = []; ', + code => '($x,$y,$z) = ($r,$r,$r); ($x,$y,$z) = ()', + }, 'expr::aassign::pa_empty' => { desc => 'package array assigned empty', setup => '', @@ -4083,8 +4083,8 @@ Perl_my_strftime(pTHX_ const char *fmt, int sec, int min, int hour, int mday, in #define SV_CWD_RETURN_UNDEF \ -sv_setsv(sv, &PL_sv_undef); \ -return FALSE + sv_set_undef(sv); \ + return FALSE #define SV_CWD_ISDOT(dp) \ (dp->d_name[0] == '.' && (dp->d_name[1] == '\0' || \ @@ -4128,8 +4128,7 @@ Perl_getcwd_sv(pTHX_ SV *sv) return TRUE; } else { - sv_setsv(sv, &PL_sv_undef); - return FALSE; + SV_CWD_RETURN_UNDEF; } } |