‘Nonelems’ for pushing sparse array on the stack

To avoid having to create deferred elements every time a sparse array
is pushed on to the stack, store a magic scalar in the array itself,
which av_exists and refto recognise as not existing.

This means there is only a one-time cost for putting such arrays on
the stack.

It also means that deferred elements that live long enough don’t
start pointing to the wrong array entry if the array gets shifted (or
unshifted/spliced) in the mean time.  Instead, the scalar is already
in the array, so it cannot lose its place.  This fix only applies
when the array as a whole is pushed on to the stack, but it could be
extended in future commits to apply to other places where we currently
use deferred elements.

12 files changed, 49 insertions, 2 deletions

diff --git a/av.c b/av.c
index ba97fed31c..f6ffea627b 100644
--- a/av.c
+++ b/av.c
@@ -1015,6 +1015,9 @@ Perl_av_exists(pTHX_ AV *av, SSize_t key)
 
     if (key <= AvFILLp(av) && AvARRAY(av)[key])
     {
+	if (SvSMAGICAL(AvARRAY(av)[key])
+	 && mg_find(AvARRAY(av)[key], PERL_MAGIC_nonelem))
+	    return FALSE;
 	return TRUE;
     }
     else
@@ -1070,6 +1073,16 @@ Perl_av_iter_p(pTHX_ AV *av) {
     }
 }
 
+SV *
+Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) {
+    SV * const sv = newSV(0);
+    PERL_ARGS_ASSERT_AV_NONELEM;
+    if (!av_store(av,ix,sv))
+	return sv_2mortal(sv); /* has tie magic */
+    sv_magic(sv, NULL, PERL_MAGIC_nonelem, NULL, 0);
+    return sv;
+}
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */
diff --git a/embed.fnc b/embed.fnc
index e748639e1a..3c66fa426b 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -282,6 +282,7 @@ ApdR	|SV**	|av_fetch	|NN AV *av|SSize_t key|I32 lval
 Apd	|void	|av_fill	|NN AV *av|SSize_t fill
 ApdR	|SSize_t|av_len		|NN AV *av
 ApdR	|AV*	|av_make	|SSize_t size|NN SV **strp
+p	|SV*	|av_nonelem	|NN AV *av|SSize_t ix
 Apd	|SV*	|av_pop		|NN AV *av
 ApdoxM	|void	|av_create_and_push|NN AV **const avp|NN SV *const val
 Apd	|void	|av_push	|NN AV *av|NN SV *val
@@ -1026,6 +1027,7 @@ p	|int	|magic_freearylen_p|NN SV* sv|NN MAGIC* mg
 p	|int	|magic_setdbline|NN SV* sv|NN MAGIC* mg
 p	|int	|magic_setdebugvar|NN SV* sv|NN MAGIC* mg
 p	|int	|magic_setdefelem|NN SV* sv|NN MAGIC* mg
+p	|int	|magic_setnonelem|NN SV* sv|NN MAGIC* mg
 p	|int	|magic_setenv	|NN SV* sv|NN MAGIC* mg
 dp	|int	|magic_sethint	|NN SV* sv|NN MAGIC* mg
 p	|int	|magic_setisa	|NN SV* sv|NN MAGIC* mg
diff --git a/embed.h b/embed.h
index b417aaf083..f964e99245 100644
--- a/embed.h
+++ b/embed.h
@@ -1169,6 +1169,7 @@
 #define amagic_is_enabled(a)	Perl_amagic_is_enabled(aTHX_ a)
 #define apply(a,b,c)		Perl_apply(aTHX_ a,b,c)
 #define av_extend_guts(a,b,c,d,e)	Perl_av_extend_guts(aTHX_ a,b,c,d,e)
+#define av_nonelem(a,b)		Perl_av_nonelem(aTHX_ a,b)
 #define bind_match(a,b,c)	Perl_bind_match(aTHX_ a,b,c)
 #define boot_core_PerlIO()	Perl_boot_core_PerlIO(aTHX)
 #define boot_core_UNIVERSAL()	Perl_boot_core_UNIVERSAL(aTHX)
@@ -1324,6 +1325,7 @@
 #define magic_setlvref(a,b)	Perl_magic_setlvref(aTHX_ a,b)
 #define magic_setmglob(a,b)	Perl_magic_setmglob(aTHX_ a,b)
 #define magic_setnkeys(a,b)	Perl_magic_setnkeys(aTHX_ a,b)
+#define magic_setnonelem(a,b)	Perl_magic_setnonelem(aTHX_ a,b)
 #define magic_setpack(a,b)	Perl_magic_setpack(aTHX_ a,b)
 #define magic_setpos(a,b)	Perl_magic_setpos(aTHX_ a,b)
 #define magic_setregexp(a,b)	Perl_magic_setregexp(aTHX_ a,b)
diff --git a/mg.c b/mg.c
index c8bb49e27b..331f96639e 100644
--- a/mg.c
+++ b/mg.c
@@ -2528,6 +2528,15 @@ Perl_vivify_defelem(pTHX_ SV *sv)
 }
 
 int
+Perl_magic_setnonelem(pTHX_ SV *sv, MAGIC *mg)
+{
+    PERL_ARGS_ASSERT_MAGIC_SETNONELEM;
+    PERL_UNUSED_ARG(mg);
+    sv_unmagic(sv, PERL_MAGIC_nonelem);
+    return 0;
+}
+
+int
 Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
 {
     PERL_ARGS_ASSERT_MAGIC_KILLBACKREFS;
diff --git a/mg_names.inc b/mg_names.inc
index fde6872fa9..7eb9033675 100644
--- a/mg_names.inc
+++ b/mg_names.inc
@@ -45,6 +45,7 @@
 	{ PERL_MAGIC_vec,            "vec(v)" },
 	{ PERL_MAGIC_utf8,           "utf8(w)" },
 	{ PERL_MAGIC_substr,         "substr(x)" },
+	{ PERL_MAGIC_nonelem,        "nonelem(Y)" },
 	{ PERL_MAGIC_defelem,        "defelem(y)" },
 	{ PERL_MAGIC_lvref,          "lvref(\\)" },
 	{ PERL_MAGIC_checkcall,      "checkcall(])" },
diff --git a/mg_raw.h b/mg_raw.h
index b3e25d646b..2f4863b08e 100644
--- a/mg_raw.h
+++ b/mg_raw.h
@@ -78,6 +78,8 @@
       "/* utf8 'w' Cached UTF-8 information */" },
     { 'x', "want_vtbl_substr | PERL_MAGIC_VALUE_MAGIC",
       "/* substr 'x' substr() lvalue */" },
+    { 'Y', "want_vtbl_nonelem | PERL_MAGIC_VALUE_MAGIC",
+      "/* nonelem 'Y' Array element that does not exist */" },
     { 'y', "want_vtbl_defelem | PERL_MAGIC_VALUE_MAGIC",
       "/* defelem 'y' Shadow \"foreach\" iterator variable / smart parameter vivification */" },
     { '\\', "want_vtbl_lvref",
diff --git a/mg_vtable.h b/mg_vtable.h
index c71a988cf7..e4f3f3889d 100644
--- a/mg_vtable.h
+++ b/mg_vtable.h
@@ -52,6 +52,7 @@
 #define PERL_MAGIC_vec            'v' /* vec() lvalue */
 #define PERL_MAGIC_utf8           'w' /* Cached UTF-8 information */
 #define PERL_MAGIC_substr         'x' /* substr() lvalue */
+#define PERL_MAGIC_nonelem        'Y' /* Array element that does not exist */
 #define PERL_MAGIC_defelem        'y' /* Shadow "foreach" iterator variable /
                                          smart parameter vivification */
 #define PERL_MAGIC_lvref          '\\' /* Lvalue reference constructor */
@@ -76,6 +77,7 @@ enum {		/* pass one of these to get_vtbl */
     want_vtbl_lvref,
     want_vtbl_mglob,
     want_vtbl_nkeys,
+    want_vtbl_nonelem,
     want_vtbl_ovrld,
     want_vtbl_pack,
     want_vtbl_packelem,
@@ -112,6 +114,7 @@ EXTCONST char * const PL_magic_vtable_names[magic_vtable_max] = {
     "lvref",
     "mglob",
     "nkeys",
+    "nonelem",
     "ovrld",
     "pack",
     "packelem",
@@ -171,6 +174,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max] = {
   { 0, Perl_magic_setlvref, 0, 0, 0, 0, 0, 0 },
   { 0, Perl_magic_setmglob, 0, 0, 0, 0, 0, 0 },
   { Perl_magic_getnkeys, Perl_magic_setnkeys, 0, 0, 0, 0, 0, 0 },
+  { 0, Perl_magic_setnonelem, 0, 0, 0, 0, 0, 0 },
   { 0, 0, 0, 0, Perl_magic_freeovrld, 0, 0, 0 },
   { 0, 0, Perl_magic_sizepack, Perl_magic_wipepack, 0, 0, 0, 0 },
   { Perl_magic_getpack, Perl_magic_setpack, 0, Perl_magic_clearpack, 0, 0, 0, 0 },
@@ -216,6 +220,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max];
 #define PL_vtbl_lvref PL_magic_vtables[want_vtbl_lvref]
 #define PL_vtbl_mglob PL_magic_vtables[want_vtbl_mglob]
 #define PL_vtbl_nkeys PL_magic_vtables[want_vtbl_nkeys]
+#define PL_vtbl_nonelem PL_magic_vtables[want_vtbl_nonelem]
 #define PL_vtbl_ovrld PL_magic_vtables[want_vtbl_ovrld]
 #define PL_vtbl_pack PL_magic_vtables[want_vtbl_pack]
 #define PL_vtbl_packelem PL_magic_vtables[want_vtbl_packelem]
diff --git a/pod/perlguts.pod b/pod/perlguts.pod
index 54a76dac45..5d11da6bfc 100644
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -1271,6 +1271,8 @@ will be lost.
  v  PERL_MAGIC_vec            vtbl_vec       vec() lvalue
  w  PERL_MAGIC_utf8           vtbl_utf8      Cached UTF-8 information
  x  PERL_MAGIC_substr         vtbl_substr    substr() lvalue
+ Y  PERL_MAGIC_nonelem        vtbl_nonelem   Array element that does not
+                                             exist
  y  PERL_MAGIC_defelem        vtbl_defelem   Shadow "foreach" iterator
                                              variable / smart parameter
                                              vivification
diff --git a/pp.c b/pp.c
index b3bf35d17e..4c0a5b34b7 100644
--- a/pp.c
+++ b/pp.c
@@ -467,6 +467,8 @@ S_refto(pTHX_ SV *sv)
     else if (SvPADTMP(sv)) {
         sv = newSVsv(sv);
     }
+    else if (UNLIKELY(SvSMAGICAL(sv) && mg_find(sv, PERL_MAGIC_nonelem)))
+        sv_unmagic(SvREFCNT_inc_simple_NN(sv), PERL_MAGIC_nonelem);
     else {
 	SvTEMP_off(sv);
 	SvREFCNT_inc_void_NN(sv);
diff --git a/pp_hot.c b/pp_hot.c
index 1b9fb9427a..9135e5d2d3 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1167,7 +1167,7 @@ S_pushav(pTHX_ AV* const av)
             SP[i+1] = LIKELY(svp)
                        ? *svp
                        : UNLIKELY(PL_op->op_flags & OPf_MOD)
-                          ? newSVavdefelem(av,i,1)
+                          ? av_nonelem(av,i)
                           : &PL_sv_undef;
         }
     }
@@ -1178,7 +1178,7 @@ S_pushav(pTHX_ AV* const av)
 	    SP[i+1] = LIKELY(sv)
                        ? sv
                        : UNLIKELY(PL_op->op_flags & OPf_MOD)
-                          ? newSVavdefelem(av,i,1)
+                          ? av_nonelem(av,i)
                           : &PL_sv_undef;
         }
     }
diff --git a/proto.h b/proto.h
index 80b9e240b5..d6c36a08fa 100644
--- a/proto.h
+++ b/proto.h
@@ -220,6 +220,9 @@ PERL_CALLCONV AV*	Perl_av_make(pTHX_ SSize_t size, SV **strp)
 #define PERL_ARGS_ASSERT_AV_MAKE	\
 	assert(strp)
 
+PERL_CALLCONV SV*	Perl_av_nonelem(pTHX_ AV *av, SSize_t ix);
+#define PERL_ARGS_ASSERT_AV_NONELEM	\
+	assert(av)
 PERL_CALLCONV SV*	Perl_av_pop(pTHX_ AV *av);
 #define PERL_ARGS_ASSERT_AV_POP	\
 	assert(av)
@@ -1943,6 +1946,9 @@ PERL_CALLCONV int	Perl_magic_setmglob(pTHX_ SV* sv, MAGIC* mg);
 PERL_CALLCONV int	Perl_magic_setnkeys(pTHX_ SV* sv, MAGIC* mg);
 #define PERL_ARGS_ASSERT_MAGIC_SETNKEYS	\
 	assert(sv); assert(mg)
+PERL_CALLCONV int	Perl_magic_setnonelem(pTHX_ SV* sv, MAGIC* mg);
+#define PERL_ARGS_ASSERT_MAGIC_SETNONELEM	\
+	assert(sv); assert(mg)
 PERL_CALLCONV int	Perl_magic_setpack(pTHX_ SV* sv, MAGIC* mg);
 #define PERL_ARGS_ASSERT_MAGIC_SETPACK	\
 	assert(sv); assert(mg)
diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl
index 342f5e04c4..f5213b2c21 100644
--- a/regen/mg_vtable.pl
+++ b/regen/mg_vtable.pl
@@ -92,6 +92,8 @@ my %mg =
 		 desc => 'substr() lvalue' },
      defelem => { char => 'y', vtable => 'defelem', value_magic => 1,
 		  desc => "Shadow \"foreach\" iterator variable /\nsmart parameter vivification" },
+     nonelem => { char => 'Y', vtable => 'nonelem', value_magic => 1,
+		  desc => "Array element that does not exist" },
      arylen => { char => '#', vtable => 'arylen', value_magic => 1,
 		 desc => 'Array length ($#ary)' },
      pos => { char => '.', vtable => 'pos', value_magic => 1,
@@ -137,6 +139,7 @@ my %sig =
      'pos' => {get => 'getpos', set => 'setpos'},
      'uvar' => {get => 'getuvar', set => 'setuvar'},
      'defelem' => {get => 'getdefelem', set => 'setdefelem'},
+     'nonelem' => {set => 'setnonelem'},
      'regexp' => {set => 'setregexp', alias => [qw(bm fm)]},
      'regdata' => {len => 'regdata_cnt'},
      'regdatum' => {get => 'regdatum_get', set => 'regdatum_set'},