add sv_set_undef() API function

This function is equivalent to sv_setsv(sv, &PL_sv_undef), but more
efficient.

Also change the obvious places in the core to use the new idiom.

11 files changed, 92 insertions, 22 deletions

diff --git a/embed.fnc b/embed.fnc
index 4743aedcf5..e03c4d2571 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -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
diff --git a/embed.h b/embed.h
index d54ed6c6d6..6061d553ed 100644
--- a/embed.h
+++ b/embed.h
@@ -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)
diff --git a/mg.c b/mg.c
index b7ce69d634..cbabcc6e17 100644
--- a/mg.c
+++ b/mg.c
@@ -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
 
diff --git a/pp.c b/pp.c
index ce589a0858..d406ee11fe 100644
--- a/pp.c
+++ b/pp.c
@@ -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 */
diff --git a/pp_hot.c b/pp_hot.c
index c614d29374..dd2c611e1f 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -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;
             }
diff --git a/proto.h b/proto.h
index 5ff6bfe32c..b760924114 100644
--- a/proto.h
+++ b/proto.h
@@ -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)
diff --git a/regcomp.c b/regcomp.c
index bb4b5024f3..095b13f3ea 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -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;
     }
 }
diff --git a/sv.c b/sv.c
index f3c057bd67..6a17049a9a 100644
--- a/sv.c
+++ b/sv.c
@@ -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   => '',
diff --git a/util.c b/util.c
index adbe51d940..02c84c854d 100644
--- a/util.c
+++ b/util.c
@@ -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;
 	}
     }