‘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.

diff --git a/av.c b/av.c
index ba97fed..f6ffea6 100644 (file)
--- 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 e748639..3c66fa4 100644 (file)
--- 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 b417aaf..f964e99 100644 (file)
--- 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 c8bb49e..331f966 100644 (file)
--- 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 fde6872..7eb9033 100644 (file)
--- 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 b3e25d6..2f4863b 100644 (file)
--- 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 c71a988..e4f3f38 100644 (file)
--- 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 54a76da..5d11da6 100644 (file)
--- 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 b3bf35d..4c0a5b3 100644 (file)
--- 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 1b9fb94..9135e5d 100644 (file)
--- 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 80b9e24..d6c36a0 100644 (file)
--- 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 342f5e0..f5213b2 100644 (file)
--- 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'},