This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
amigaos4/amigaos.c: Use memzero, not memset(0)
[perl5.git] / av.c
diff --git a/av.c b/av.c
index f915fef..03d793b 100644 (file)
--- a/av.c
+++ b/av.c
  *     [p.476 of _The Lord of the Rings_, III/iv: "Treebeard"]
  */
 
  *     [p.476 of _The Lord of the Rings_, III/iv: "Treebeard"]
  */
 
-/*
-=head1 Array Manipulation Functions
-*/
-
 #include "EXTERN.h"
 #define PERL_IN_AV_C
 #include "perl.h"
 #include "EXTERN.h"
 #define PERL_IN_AV_C
 #include "perl.h"
 void
 Perl_av_reify(pTHX_ AV *av)
 {
 void
 Perl_av_reify(pTHX_ AV *av)
 {
-    dVAR;
-    I32 key;
+    SSize_t key;
 
     PERL_ARGS_ASSERT_AV_REIFY;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (AvREAL(av))
 
     PERL_ARGS_ASSERT_AV_REIFY;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (AvREAL(av))
-       return;
+        return;
 #ifdef DEBUGGING
     if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
 #ifdef DEBUGGING
     if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
-       Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array");
+        Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array");
 #endif
     key = AvMAX(av) + 1;
     while (key > AvFILLp(av) + 1)
 #endif
     key = AvMAX(av) + 1;
     while (key > AvFILLp(av) + 1)
-       AvARRAY(av)[--key] = &PL_sv_undef;
+        AvARRAY(av)[--key] = NULL;
     while (key) {
     while (key) {
-       SV * const sv = AvARRAY(av)[--key];
-       assert(sv);
-       if (sv != &PL_sv_undef)
-           SvREFCNT_inc_simple_void_NN(sv);
+        SV * const sv = AvARRAY(av)[--key];
+        if (sv != &PL_sv_undef)
+            SvREFCNT_inc_simple_void(sv);
     }
     key = AvARRAY(av) - AvALLOC(av);
     while (key)
     }
     key = AvARRAY(av) - AvALLOC(av);
     while (key)
-       AvALLOC(av)[--key] = &PL_sv_undef;
+        AvALLOC(av)[--key] = NULL;
     AvREIFY_off(av);
     AvREAL_on(av);
 }
     AvREIFY_off(av);
     AvREAL_on(av);
 }
@@ -57,16 +51,20 @@ Perl_av_reify(pTHX_ AV *av)
 /*
 =for apidoc av_extend
 
 /*
 =for apidoc av_extend
 
-Pre-extend an array.  The C<key> is the index to which the array should be
-extended.
+Pre-extend an array so that it is capable of storing values at indexes
+C<0..key>. Thus C<av_extend(av,99)> guarantees that the array can store 100
+elements, i.e. that C<av_store(av, 0, sv)> through C<av_store(av, 99, sv)>
+on a plain array will work without any further memory allocation.
+
+If the av argument is a tied array then will call the C<EXTEND> tied
+array method with an argument of C<(key+1)>.
 
 =cut
 */
 
 void
 
 =cut
 */
 
 void
-Perl_av_extend(pTHX_ AV *av, I32 key)
+Perl_av_extend(pTHX_ AV *av, SSize_t key)
 {
 {
-    dVAR;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_AV_EXTEND;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_AV_EXTEND;
@@ -74,116 +72,137 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 
     mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied);
     if (mg) {
 
     mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied);
     if (mg) {
-       SV *arg1 = sv_newmortal();
-       sv_setiv(arg1, (IV)(key + 1));
-       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1,
-                           arg1);
-       return;
-    }
-    if (key > AvMAX(av)) {
-       SV** ary;
-       I32 tmp;
-       I32 newmax;
-
-       if (AvALLOC(av) != AvARRAY(av)) {
-           ary = AvALLOC(av) + AvFILLp(av) + 1;
-           tmp = AvARRAY(av) - AvALLOC(av);
-           Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
-           AvMAX(av) += tmp;
-           AvARRAY(av) = AvALLOC(av);
-           if (AvREAL(av)) {
-               while (tmp)
-                   ary[--tmp] = &PL_sv_undef;
-           }
-           if (key > AvMAX(av) - 10) {
-               newmax = key + AvMAX(av);
-               goto resize;
-           }
-       }
-       else {
-#ifdef PERL_MALLOC_WRAP
-           static const char oom_array_extend[] =
-             "Out of memory during array extend"; /* Duplicated in pp_hot.c */
-#endif
+        SV *arg1 = sv_newmortal();
+        /* NOTE: the API for av_extend() is NOT the same as the tie method EXTEND.
+         *
+         * The C function takes an *index* (assumes 0 indexed arrays) and ensures
+         * that the array is at least as large as the index provided.
+         *
+         * The tied array method EXTEND takes a *count* and ensures that the array
+         * is at least that many elements large. Thus we have to +1 the key when
+         * we call the tied method.
+         */
+        sv_setiv(arg1, (IV)(key + 1));
+        Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(EXTEND), G_DISCARD, 1,
+                            arg1);
+        return;
+    }
+    av_extend_guts(av,key,&AvMAX(av),&AvALLOC(av),&AvARRAY(av));
+}    
 
 
-           if (AvALLOC(av)) {
-#if !defined(STRANGE_MALLOC) && !defined(MYMALLOC)
-               MEM_SIZE bytes;
-               IV itmp;
-#endif
+/* The guts of av_extend.  *Not* for general use! */
+/* Also called directly from pp_assign, padlist_store, padnamelist_store */
+void
+Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp,
+                      SV ***arrayp)
+{
+    PERL_ARGS_ASSERT_AV_EXTEND_GUTS;
+
+    if (key < -1) /* -1 is legal */
+        Perl_croak(aTHX_
+            "panic: av_extend_guts() negative count (%" IVdf ")", (IV)key);
+
+    if (key > *maxp) {
+        SSize_t ary_offset = *maxp + 1;
+        SSize_t to_null = 0;
+        SSize_t newmax  = 0;
+
+        if (av && *allocp != *arrayp) { /* a shifted SV* array exists */
+            to_null = *arrayp - *allocp;
+            *maxp += to_null;
+            ary_offset = AvFILLp(av) + 1;
+
+            Move(*arrayp, *allocp, AvFILLp(av)+1, SV*);
+
+            if (key > *maxp - 10) {
+                newmax = key + *maxp;
+                goto resize;
+            }
+        } else if (*allocp) { /* a full SV* array exists */
 
 #ifdef Perl_safesysmalloc_size
 
 #ifdef Perl_safesysmalloc_size
-               /* Whilst it would be quite possible to move this logic around
-                  (as I did in the SV code), so as to set AvMAX(av) early,
-                  based on calling Perl_safesysmalloc_size() immediately after
-                  allocation, I'm not convinced that it is a great idea here.
-                  In an array we have to loop round setting everything to
-                  &PL_sv_undef, which means writing to memory, potentially lots
-                  of it, whereas for the SV buffer case we don't touch the
-                  "bonus" memory. So there there is no cost in telling the
-                  world about it, whereas here we have to do work before we can
-                  tell the world about it, and that work involves writing to
-                  memory that might never be read. So, I feel, better to keep
-                  the current lazy system of only writing to it if our caller
-                  has a need for more space. NWC  */
-               newmax = Perl_safesysmalloc_size((void*)AvALLOC(av)) /
-                   sizeof(const SV *) - 1;
-
-               if (key <= newmax) 
-                   goto resized;
+            /* Whilst it would be quite possible to move this logic around
+               (as I did in the SV code), so as to set AvMAX(av) early,
+               based on calling Perl_safesysmalloc_size() immediately after
+               allocation, I'm not convinced that it is a great idea here.
+               In an array we have to loop round setting everything to
+               NULL, which means writing to memory, potentially lots
+               of it, whereas for the SV buffer case we don't touch the
+               "bonus" memory. So there there is no cost in telling the
+               world about it, whereas here we have to do work before we can
+               tell the world about it, and that work involves writing to
+               memory that might never be read. So, I feel, better to keep
+               the current lazy system of only writing to it if our caller
+               has a need for more space. NWC  */
+            newmax = Perl_safesysmalloc_size((void*)*allocp) /
+                sizeof(const SV *) - 1;
+
+            if (key <= newmax)
+                goto resized;
 #endif 
 #endif 
-               newmax = key + AvMAX(av) / 5;
-             resize:
-               MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
-#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
-               Renew(AvALLOC(av),newmax+1, SV*);
+            /* overflow-safe version of newmax = key + *maxp/5 */
+            newmax = *maxp / 5;
+            newmax = (key > SSize_t_MAX - newmax)
+                        ? SSize_t_MAX : key + newmax;
+          resize:
+        {
+          /* it should really be newmax+1 here, but if newmax
+           * happens to equal SSize_t_MAX, then newmax+1 is
+           * undefined. This means technically we croak one
+           * index lower than we should in theory; in practice
+           * its unlikely the system has SSize_t_MAX/sizeof(SV*)
+           * bytes to spare! */
+          MEM_WRAP_CHECK_s(newmax, SV*, "Out of memory during array extend");
+        }
+#ifdef STRESS_REALLOC
+            {
+                SV ** const old_alloc = *allocp;
+                Newx(*allocp, newmax+1, SV*);
+                Copy(old_alloc, *allocp, *maxp + 1, SV*);
+                Safefree(old_alloc);
+            }
 #else
 #else
-               bytes = (newmax + 1) * sizeof(const SV *);
-#define MALLOC_OVERHEAD 16
-               itmp = MALLOC_OVERHEAD;
-               while ((MEM_SIZE)(itmp - MALLOC_OVERHEAD) < bytes)
-                   itmp += itmp;
-               itmp -= MALLOC_OVERHEAD;
-               itmp /= sizeof(const SV *);
-               assert(itmp > newmax);
-               newmax = itmp - 1;
-               assert(newmax >= AvMAX(av));
-               Newx(ary, newmax+1, SV*);
-               Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
-               if (AvMAX(av) > 64)
-                   offer_nice_chunk(AvALLOC(av),
-                                    (AvMAX(av)+1) * sizeof(const SV *));
-               else
-                   Safefree(AvALLOC(av));
-               AvALLOC(av) = ary;
+            Renew(*allocp,newmax+1, SV*);
 #endif
 #ifdef Perl_safesysmalloc_size
 #endif
 #ifdef Perl_safesysmalloc_size
-             resized:
+          resized:
 #endif
 #endif
-               ary = AvALLOC(av) + AvMAX(av) + 1;
-               tmp = newmax - AvMAX(av);
-               if (av == PL_curstack) {        /* Oops, grew stack (via av_store()?) */
-                   PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
-                   PL_stack_base = AvALLOC(av);
-                   PL_stack_max = PL_stack_base + newmax;
-               }
-           }
-           else {
-               newmax = key < 3 ? 3 : key;
-               MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
-               Newx(AvALLOC(av), newmax+1, SV*);
-               ary = AvALLOC(av) + 1;
-               tmp = newmax;
-               AvALLOC(av)[0] = &PL_sv_undef;  /* For the stacks */
-           }
-           if (AvREAL(av)) {
-               while (tmp)
-                   ary[--tmp] = &PL_sv_undef;
-           }
-           
-           AvARRAY(av) = AvALLOC(av);
-           AvMAX(av) = newmax;
-       }
+            to_null += newmax - *maxp;
+            *maxp = newmax;
+
+            /* See GH#18014 for discussion of when this might be needed: */
+            if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */
+                PL_stack_sp = *allocp + (PL_stack_sp - PL_stack_base);
+                PL_stack_base = *allocp;
+                PL_stack_max = PL_stack_base + newmax;
+            }
+        } else { /* there is no SV* array yet */
+            *maxp = key < 3 ? 3 : key;
+            {
+                /* see comment above about newmax+1*/
+                MEM_WRAP_CHECK_s(*maxp, SV*,
+                                 "Out of memory during array extend");
+            }
+            /* Newxz isn't used below because testing showed it to be slower
+             * than Newx+Zero (also slower than Newx + the previous while
+             * loop) for small arrays, which are very common in perl. */
+            Newx(*allocp, *maxp+1, SV*);
+            /* Stacks require only the first element to be &PL_sv_undef
+             * (set elsewhere). However, since non-stack AVs are likely
+             * to dominate in modern production applications, stacks
+             * don't get any special treatment here.
+             * See https://github.com/Perl/perl5/pull/18690 for more detail */
+            ary_offset = 0;
+            to_null = *maxp+1;
+            goto zero;
+        }
+
+        if (av && AvREAL(av)) {
+          zero:
+            Zero(*allocp + ary_offset,to_null,SV*);
+        }
+
+        *arrayp = *allocp;
     }
 }
 
     }
 }
 
@@ -191,82 +210,91 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 =for apidoc av_fetch
 
 Returns the SV at the specified index in the array.  The C<key> is the
 =for apidoc av_fetch
 
 Returns the SV at the specified index in the array.  The C<key> is the
-index.  If C<lval> is set then the fetch will be part of a store.  Check
-that the return value is non-null before dereferencing it to a C<SV*>.
+index.  If lval is true, you are guaranteed to get a real SV back (in case
+it wasn't real before), which you can then modify.  Check that the return
+value is non-null before dereferencing it to a C<SV*>.
 
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
 more information on how to use this function on tied arrays. 
 
 
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
 more information on how to use this function on tied arrays. 
 
+The rough perl equivalent is C<$myarray[$key]>.
+
 =cut
 */
 
 =cut
 */
 
+static bool
+S_adjust_index(pTHX_ AV *av, const MAGIC *mg, SSize_t *keyp)
+{
+    bool adjust_index = 1;
+    if (mg) {
+        /* Handle negative array indices 20020222 MJD */
+        SV * const ref = SvTIED_obj(MUTABLE_SV(av), mg);
+        SvGETMAGIC(ref);
+        if (SvROK(ref) && SvOBJECT(SvRV(ref))) {
+            SV * const * const negative_indices_glob =
+                hv_fetchs(SvSTASH(SvRV(ref)), NEGATIVE_INDICES_VAR, 0);
+
+            if (negative_indices_glob && isGV(*negative_indices_glob)
+             && SvTRUE(GvSV(*negative_indices_glob)))
+                adjust_index = 0;
+        }
+    }
+
+    if (adjust_index) {
+        *keyp += AvFILL(av) + 1;
+        if (*keyp < 0)
+            return FALSE;
+    }
+    return TRUE;
+}
+
 SV**
 SV**
-Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
+Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
 {
 {
-    dVAR;
+    SSize_t neg;
+    SSize_t size;
 
     PERL_ARGS_ASSERT_AV_FETCH;
     assert(SvTYPE(av) == SVt_PVAV);
 
 
     PERL_ARGS_ASSERT_AV_FETCH;
     assert(SvTYPE(av) == SVt_PVAV);
 
-    if (SvRMAGICAL(av)) {
+    if (UNLIKELY(SvRMAGICAL(av))) {
         const MAGIC * const tied_magic
         const MAGIC * const tied_magic
-           = mg_find((const SV *)av, PERL_MAGIC_tied);
+            = mg_find((const SV *)av, PERL_MAGIC_tied);
         if (tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata)) {
         if (tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata)) {
-           SV *sv;
-           if (key < 0) {
-               I32 adjust_index = 1;
-               if (tied_magic) {
-                   /* Handle negative array indices 20020222 MJD */
-                   SV * const * const negative_indices_glob =
-                       hv_fetch(SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(av),
-                                                        tied_magic))),
-                               NEGATIVE_INDICES_VAR, 16, 0);
-
-                   if (negative_indices_glob && SvTRUE(GvSV(*negative_indices_glob)))
-                       adjust_index = 0;
-               }
-
-               if (adjust_index) {
-                   key += AvFILL(av) + 1;
-                   if (key < 0)
-                       return NULL;
-               }
-           }
+            SV *sv;
+            if (key < 0) {
+                if (!S_adjust_index(aTHX_ av, tied_magic, &key))
+                        return NULL;
+            }
 
             sv = sv_newmortal();
 
             sv = sv_newmortal();
-           sv_upgrade(sv, SVt_PVLV);
-           mg_copy(MUTABLE_SV(av), sv, 0, key);
-           if (!tied_magic) /* for regdata, force leavesub to make copies */
-               SvTEMP_off(sv);
-           LvTYPE(sv) = 't';
-           LvTARG(sv) = sv; /* fake (SV**) */
-           return &(LvTARG(sv));
+            sv_upgrade(sv, SVt_PVLV);
+            mg_copy(MUTABLE_SV(av), sv, 0, key);
+            if (!tied_magic) /* for regdata, force leavesub to make copies */
+                SvTEMP_off(sv);
+            LvTYPE(sv) = 't';
+            LvTARG(sv) = sv; /* fake (SV**) */
+            return &(LvTARG(sv));
         }
     }
 
         }
     }
 
-    if (key < 0) {
-       key += AvFILL(av) + 1;
-       if (key < 0)
-           return NULL;
-    }
+    neg  = (key < 0);
+    size = AvFILLp(av) + 1;
+    key += neg * size; /* handle negative index without using branch */
 
 
-    if (key > AvFILLp(av)) {
-       if (!lval)
-           return NULL;
-       return av_store(av,key,newSV(0));
-    }
-    if (AvARRAY(av)[key] == &PL_sv_undef) {
-    emptyness:
-       if (lval)
-           return av_store(av,key,newSV(0));
-       return NULL;
+    /* the cast from SSize_t to Size_t allows both (key < 0) and (key >= size)
+     * to be tested as a single condition */
+    if ((Size_t)key >= (Size_t)size) {
+        if (UNLIKELY(neg))
+            return NULL;
+        goto emptyness;
     }
     }
-    else if (AvREIFY(av)
-            && (!AvARRAY(av)[key]      /* eg. @_ could have freed elts */
-                || SvIS_FREED(AvARRAY(av)[key]))) {
-       AvARRAY(av)[key] = &PL_sv_undef;        /* 1/2 reify */
-       goto emptyness;
+
+    if (!AvARRAY(av)[key]) {
+      emptyness:
+        return lval ? av_store(av,key,newSV(0)) : NULL;
     }
     }
+
     return &AvARRAY(av)[key];
 }
 
     return &AvARRAY(av)[key];
 }
 
@@ -274,12 +302,17 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
 =for apidoc av_store
 
 Stores an SV in an array.  The array index is specified as C<key>.  The
 =for apidoc av_store
 
 Stores an SV in an array.  The array index is specified as C<key>.  The
-return value will be NULL if the operation failed or if the value did not
+return value will be C<NULL> if the operation failed or if the value did not
 need to be actually stored within the array (as in the case of tied
 need to be actually stored within the array (as in the case of tied
-arrays). Otherwise it can be dereferenced to get the original C<SV*>.  Note
-that the caller is responsible for suitably incrementing the reference
+arrays).  Otherwise, it can be dereferenced
+to get the C<SV*> that was stored
+there (= C<val>)).
+
+Note that the caller is responsible for suitably incrementing the reference
 count of C<val> before the call, and decrementing it if the function
 count of C<val> before the call, and decrementing it if the function
-returned NULL.
+returned C<NULL>.
+
+Approximate Perl equivalent: C<splice(@myarray, $key, 1, $val)>.
 
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
 more information on how to use this function on tied arrays.
 
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
 more information on how to use this function on tied arrays.
@@ -288,9 +321,8 @@ more information on how to use this function on tied arrays.
 */
 
 SV**
 */
 
 SV**
-Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
+Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val)
 {
 {
-    dVAR;
     SV** ary;
 
     PERL_ARGS_ASSERT_AV_STORE;
     SV** ary;
 
     PERL_ARGS_ASSERT_AV_STORE;
@@ -300,72 +332,63 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
        (unicode_alternate may be NULL).
     */
 
        (unicode_alternate may be NULL).
     */
 
-    if (!val)
-       val = &PL_sv_undef;
-
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic = mg_find((const SV *)av, PERL_MAGIC_tied);
         if (tied_magic) {
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic = mg_find((const SV *)av, PERL_MAGIC_tied);
         if (tied_magic) {
-            /* Handle negative array indices 20020222 MJD */
             if (key < 0) {
             if (key < 0) {
-               bool adjust_index = 1;
-               SV * const * const negative_indices_glob =
-                    hv_fetch(SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(av), 
-                                                     tied_magic))), 
-                             NEGATIVE_INDICES_VAR, 16, 0);
-                if (negative_indices_glob
-                    && SvTRUE(GvSV(*negative_indices_glob)))
-                    adjust_index = 0;
-                if (adjust_index) {
-                    key += AvFILL(av) + 1;
-                    if (key < 0)
+                if (!S_adjust_index(aTHX_ av, tied_magic, &key))
                         return 0;
                         return 0;
-                }
             }
             }
-           if (val != &PL_sv_undef) {
-               mg_copy(MUTABLE_SV(av), val, 0, key);
-           }
-           return NULL;
+            if (val) {
+                mg_copy(MUTABLE_SV(av), val, 0, key);
+            }
+            return NULL;
         }
     }
 
 
     if (key < 0) {
         }
     }
 
 
     if (key < 0) {
-       key += AvFILL(av) + 1;
-       if (key < 0)
-           return NULL;
+        key += AvFILL(av) + 1;
+        if (key < 0)
+            return NULL;
     }
 
     if (SvREADONLY(av) && key >= AvFILL(av))
     }
 
     if (SvREADONLY(av) && key >= AvFILL(av))
-       Perl_croak(aTHX_ "%s", PL_no_modify);
+        Perl_croak_no_modify();
 
     if (!AvREAL(av) && AvREIFY(av))
 
     if (!AvREAL(av) && AvREIFY(av))
-       av_reify(av);
+        av_reify(av);
     if (key > AvMAX(av))
     if (key > AvMAX(av))
-       av_extend(av,key);
+        av_extend(av,key);
     ary = AvARRAY(av);
     if (AvFILLp(av) < key) {
     ary = AvARRAY(av);
     if (AvFILLp(av) < key) {
-       if (!AvREAL(av)) {
-           if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
-               PL_stack_sp = PL_stack_base + key;      /* XPUSH in disguise */
-           do {
-               ary[++AvFILLp(av)] = &PL_sv_undef;
-           } while (AvFILLp(av) < key);
-       }
-       AvFILLp(av) = key;
+        if (!AvREAL(av)) {
+            if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
+                PL_stack_sp = PL_stack_base + key;     /* XPUSH in disguise */
+            do {
+                ary[++AvFILLp(av)] = NULL;
+            } while (AvFILLp(av) < key);
+        }
+        AvFILLp(av) = key;
     }
     else if (AvREAL(av))
     }
     else if (AvREAL(av))
-       SvREFCNT_dec(ary[key]);
+        SvREFCNT_dec(ary[key]);
     ary[key] = val;
     if (SvSMAGICAL(av)) {
     ary[key] = val;
     if (SvSMAGICAL(av)) {
-       const MAGIC* const mg = SvMAGIC(av);
-       if (val != &PL_sv_undef) {
-           sv_magic(val, MUTABLE_SV(av), toLOWER(mg->mg_type), 0, key);
-       }
-       if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa)
-           PL_delaymagic |= DM_ARRAY;
-       else
-          mg_set(MUTABLE_SV(av));
+        const MAGIC *mg = SvMAGIC(av);
+        bool set = TRUE;
+        for (; mg; mg = mg->mg_moremagic) {
+          if (!isUPPER(mg->mg_type)) continue;
+          if (val) {
+            sv_magic(val, MUTABLE_SV(av), toLOWER(mg->mg_type), 0, key);
+          }
+          if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa) {
+            PL_delaymagic |= DM_ARRAY_ISA;
+            set = FALSE;
+          }
+        }
+        if (set)
+           mg_set(MUTABLE_SV(av));
     }
     return &ary[key];
 }
     }
     return &ary[key];
 }
@@ -374,39 +397,55 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
 =for apidoc av_make
 
 Creates a new AV and populates it with a list of SVs.  The SVs are copied
 =for apidoc av_make
 
 Creates a new AV and populates it with a list of SVs.  The SVs are copied
-into the array, so they may be freed after the call to av_make.  The new AV
+into the array, so they may be freed after the call to C<av_make>.  The new AV
 will have a reference count of 1.
 
 will have a reference count of 1.
 
+Perl equivalent: C<my @new_array = ($scalar1, $scalar2, $scalar3...);>
+
 =cut
 */
 
 AV *
 =cut
 */
 
 AV *
-Perl_av_make(pTHX_ register I32 size, register SV **strp)
+Perl_av_make(pTHX_ SSize_t size, SV **strp)
 {
 {
-    register AV * const av = MUTABLE_AV(newSV_type(SVt_PVAV));
+    AV * const av = newAV();
     /* sv_upgrade does AvREAL_only()  */
     PERL_ARGS_ASSERT_AV_MAKE;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (size) {                /* "defined" was returning undef for size==0 anyway. */
     /* sv_upgrade does AvREAL_only()  */
     PERL_ARGS_ASSERT_AV_MAKE;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (size) {                /* "defined" was returning undef for size==0 anyway. */
-        register SV** ary;
-        register I32 i;
-       Newx(ary,size,SV*);
-       AvALLOC(av) = ary;
-       AvARRAY(av) = ary;
-       AvFILLp(av) = AvMAX(av) = size - 1;
-       for (i = 0; i < size; i++) {
-           assert (*strp);
-
-           /* Don't let sv_setsv swipe, since our source array might
-              have multiple references to the same temp scalar (e.g.
-              from a list slice) */
-
-           ary[i] = newSV(0);
-           sv_setsv_flags(ary[i], *strp,
-                          SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL);
-           strp++;
-       }
+        SV** ary;
+        SSize_t i;
+        SSize_t orig_ix;
+
+        Newx(ary,size,SV*);
+        AvALLOC(av) = ary;
+        AvARRAY(av) = ary;
+        AvMAX(av) = size - 1;
+        /* avoid av being leaked if croak when calling magic below */
+        EXTEND_MORTAL(1);
+        PL_tmps_stack[++PL_tmps_ix] = (SV*)av;
+        orig_ix = PL_tmps_ix;
+
+        for (i = 0; i < size; i++) {
+            assert (*strp);
+
+            /* Don't let sv_setsv swipe, since our source array might
+               have multiple references to the same temp scalar (e.g.
+               from a list slice) */
+
+            SvGETMAGIC(*strp); /* before newSV, in case it dies */
+            AvFILLp(av)++;
+            ary[i] = newSV(0);
+            sv_setsv_flags(ary[i], *strp,
+                           SV_DO_COW_SVSETSV|SV_NOSTEAL);
+            strp++;
+        }
+        /* disarm av's leak guard */
+        if (LIKELY(PL_tmps_ix == orig_ix))
+            PL_tmps_ix--;
+        else
+            PL_tmps_stack[orig_ix] = &PL_sv_undef;
     }
     return av;
 }
     }
     return av;
 }
@@ -414,84 +453,121 @@ Perl_av_make(pTHX_ register I32 size, register SV **strp)
 /*
 =for apidoc av_clear
 
 /*
 =for apidoc av_clear
 
-Clears an array, making it empty.  Does not free the memory used by the
-array itself. Perl equivalent: C<@myarray = ();>.
+Frees all the elements of an array, leaving it empty.
+The XS equivalent of C<@array = ()>.  See also L</av_undef>.
+
+Note that it is possible that the actions of a destructor called directly
+or indirectly by freeing an element of the array could cause the reference
+count of the array itself to be reduced (e.g. by deleting an entry in the
+symbol table). So it is a possibility that the AV could have been freed
+(or even reallocated) on return from the call unless you hold a reference
+to it.
 
 =cut
 */
 
 void
 
 =cut
 */
 
 void
-Perl_av_clear(pTHX_ register AV *av)
+Perl_av_clear(pTHX_ AV *av)
 {
 {
-    dVAR;
-    I32 extra;
+    SSize_t extra;
+    bool real;
+    SSize_t orig_ix = 0;
 
     PERL_ARGS_ASSERT_AV_CLEAR;
     assert(SvTYPE(av) == SVt_PVAV);
 
 #ifdef DEBUGGING
     if (SvREFCNT(av) == 0) {
 
     PERL_ARGS_ASSERT_AV_CLEAR;
     assert(SvTYPE(av) == SVt_PVAV);
 
 #ifdef DEBUGGING
     if (SvREFCNT(av) == 0) {
-       Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
+        Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
     }
 #endif
 
     if (SvREADONLY(av))
     }
 #endif
 
     if (SvREADONLY(av))
-       Perl_croak(aTHX_ "%s", PL_no_modify);
+        Perl_croak_no_modify();
 
     /* Give any tie a chance to cleanup first */
     if (SvRMAGICAL(av)) {
 
     /* Give any tie a chance to cleanup first */
     if (SvRMAGICAL(av)) {
-       const MAGIC* const mg = SvMAGIC(av);
-       if (PL_delaymagic && mg && mg->mg_type == PERL_MAGIC_isa)
-           PL_delaymagic |= DM_ARRAY;
+        const MAGIC* const mg = SvMAGIC(av);
+        if (PL_delaymagic && mg && mg->mg_type == PERL_MAGIC_isa)
+            PL_delaymagic |= DM_ARRAY_ISA;
         else
         else
-           mg_clear(MUTABLE_SV(av)); 
+            mg_clear(MUTABLE_SV(av)); 
     }
 
     if (AvMAX(av) < 0)
     }
 
     if (AvMAX(av) < 0)
-       return;
-
-    if (AvREAL(av)) {
-       SV** const ary = AvARRAY(av);
-       I32 index = AvFILLp(av) + 1;
-       while (index) {
-           SV * const sv = ary[--index];
-           /* undef the slot before freeing the value, because a
-            * destructor might try to modify this array */
-           ary[index] = &PL_sv_undef;
-           SvREFCNT_dec(sv);
-       }
+        return;
+
+    if ((real = cBOOL(AvREAL(av)))) {
+        SV** const ary = AvARRAY(av);
+        SSize_t index = AvFILLp(av) + 1;
+
+        /* avoid av being freed when calling destructors below */
+        EXTEND_MORTAL(1);
+        PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av);
+        orig_ix = PL_tmps_ix;
+
+        while (index) {
+            SV * const sv = ary[--index];
+            /* undef the slot before freeing the value, because a
+             * destructor might try to modify this array */
+            ary[index] = NULL;
+            SvREFCNT_dec(sv);
+        }
     }
     extra = AvARRAY(av) - AvALLOC(av);
     if (extra) {
     }
     extra = AvARRAY(av) - AvALLOC(av);
     if (extra) {
-       AvMAX(av) += extra;
-       AvARRAY(av) = AvALLOC(av);
+        AvMAX(av) += extra;
+        AvARRAY(av) = AvALLOC(av);
     }
     AvFILLp(av) = -1;
     }
     AvFILLp(av) = -1;
-
+    if (real) {
+        /* disarm av's premature free guard */
+        if (LIKELY(PL_tmps_ix == orig_ix))
+            PL_tmps_ix--;
+        else
+            PL_tmps_stack[orig_ix] = &PL_sv_undef;
+        SvREFCNT_dec_NN(av);
+    }
 }
 
 /*
 =for apidoc av_undef
 
 }
 
 /*
 =for apidoc av_undef
 
-Undefines the array.  Frees the memory used by the array itself.
+Undefines the array. The XS equivalent of C<undef(@array)>.
+
+As well as freeing all the elements of the array (like C<av_clear()>), this
+also frees the memory used by the av to store its list of scalars.
+
+See L</av_clear> for a note about the array possibly being invalid on
+return.
 
 =cut
 */
 
 void
 
 =cut
 */
 
 void
-Perl_av_undef(pTHX_ register AV *av)
+Perl_av_undef(pTHX_ AV *av)
 {
 {
+    bool real;
+    SSize_t orig_ix = PL_tmps_ix; /* silence bogus warning about possible unitialized use */
+
     PERL_ARGS_ASSERT_AV_UNDEF;
     assert(SvTYPE(av) == SVt_PVAV);
 
     /* Give any tie a chance to cleanup first */
     if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied)) 
     PERL_ARGS_ASSERT_AV_UNDEF;
     assert(SvTYPE(av) == SVt_PVAV);
 
     /* Give any tie a chance to cleanup first */
     if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied)) 
-       av_fill(av, -1);
+        av_fill(av, -1);
+
+    real = cBOOL(AvREAL(av));
+    if (real) {
+        SSize_t key = AvFILLp(av) + 1;
+
+        /* avoid av being freed when calling destructors below */
+        EXTEND_MORTAL(1);
+        PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av);
+        orig_ix = PL_tmps_ix;
 
 
-    if (AvREAL(av)) {
-       register I32 key = AvFILLp(av) + 1;
-       while (key)
-           SvREFCNT_dec(AvARRAY(av)[--key]);
+        while (key)
+            SvREFCNT_dec(AvARRAY(av)[--key]);
     }
 
     Safefree(AvALLOC(av));
     }
 
     Safefree(AvALLOC(av));
@@ -500,6 +576,14 @@ Perl_av_undef(pTHX_ register AV *av)
     AvMAX(av) = AvFILLp(av) = -1;
 
     if(SvRMAGICAL(av)) mg_clear(MUTABLE_SV(av));
     AvMAX(av) = AvFILLp(av) = -1;
 
     if(SvRMAGICAL(av)) mg_clear(MUTABLE_SV(av));
+    if (real) {
+        /* disarm av's premature free guard */
+        if (LIKELY(PL_tmps_ix == orig_ix))
+            PL_tmps_ix--;
+        else
+            PL_tmps_stack[orig_ix] = &PL_sv_undef;
+        SvREFCNT_dec_NN(av);
+    }
 }
 
 /*
 }
 
 /*
@@ -518,36 +602,36 @@ Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val)
     PERL_ARGS_ASSERT_AV_CREATE_AND_PUSH;
 
     if (!*avp)
     PERL_ARGS_ASSERT_AV_CREATE_AND_PUSH;
 
     if (!*avp)
-       *avp = newAV();
+        *avp = newAV();
     av_push(*avp, val);
 }
 
 /*
 =for apidoc av_push
 
     av_push(*avp, val);
 }
 
 /*
 =for apidoc av_push
 
-Pushes an SV onto the end of the array.  The array will grow automatically
-to accommodate the addition. Like C<av_store>, this takes ownership of one
-reference count.
+Pushes an SV (transferring control of one reference count) onto the end of the
+array.  The array will grow automatically to accommodate the addition.
+
+Perl equivalent: C<push @myarray, $val;>.
 
 =cut
 */
 
 void
 
 =cut
 */
 
 void
-Perl_av_push(pTHX_ register AV *av, SV *val)
+Perl_av_push(pTHX_ AV *av, SV *val)
 {             
 {             
-    dVAR;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_AV_PUSH;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_AV_PUSH;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-       Perl_croak(aTHX_ "%s", PL_no_modify);
+        Perl_croak_no_modify();
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1,
-                           val);
-       return;
+        Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(PUSH), G_DISCARD, 1,
+                            val);
+        return;
     }
     av_store(av,AvFILLp(av)+1,val);
 }
     }
     av_store(av,AvFILLp(av)+1,val);
 }
@@ -555,16 +639,18 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
 /*
 =for apidoc av_pop
 
 /*
 =for apidoc av_pop
 
-Pops an SV off the end of the array.  Returns C<&PL_sv_undef> if the array
-is empty.
+Removes one SV from the end of the array, reducing its size by one and
+returning the SV (transferring control of one reference count) to the
+caller.  Returns C<&PL_sv_undef> if the array is empty.
+
+Perl equivalent: C<pop(@myarray);>
 
 =cut
 */
 
 SV *
 
 =cut
 */
 
 SV *
-Perl_av_pop(pTHX_ register AV *av)
+Perl_av_pop(pTHX_ AV *av)
 {
 {
-    dVAR;
     SV *retval;
     MAGIC* mg;
 
     SV *retval;
     MAGIC* mg;
 
@@ -572,20 +658,20 @@ Perl_av_pop(pTHX_ register AV *av)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-       Perl_croak(aTHX_ "%s", PL_no_modify);
+        Perl_croak_no_modify();
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0);
-       if (retval)
-           retval = newSVsv(retval);
-       return retval;
+        retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(POP), 0, 0);
+        if (retval)
+            retval = newSVsv(retval);
+        return retval;
     }
     if (AvFILL(av) < 0)
     }
     if (AvFILL(av) < 0)
-       return &PL_sv_undef;
+        return &PL_sv_undef;
     retval = AvARRAY(av)[AvFILLp(av)];
     retval = AvARRAY(av)[AvFILLp(av)];
-    AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
+    AvARRAY(av)[AvFILLp(av)--] = NULL;
     if (SvSMAGICAL(av))
     if (SvSMAGICAL(av))
-       mg_set(MUTABLE_SV(av));
-    return retval;
+        mg_set(MUTABLE_SV(av));
+    return retval ? retval : &PL_sv_undef;
 }
 
 /*
 }
 
 /*
@@ -605,7 +691,7 @@ Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val)
     PERL_ARGS_ASSERT_AV_CREATE_AND_UNSHIFT_ONE;
 
     if (!*avp)
     PERL_ARGS_ASSERT_AV_CREATE_AND_UNSHIFT_ONE;
 
     if (!*avp)
-       *avp = newAV();
+        *avp = newAV();
     av_unshift(*avp, 1);
     return av_store(*avp, 0, val);
 }
     av_unshift(*avp, 1);
     return av_store(*avp, 0, val);
 }
@@ -614,78 +700,80 @@ Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val)
 =for apidoc av_unshift
 
 Unshift the given number of C<undef> values onto the beginning of the
 =for apidoc av_unshift
 
 Unshift the given number of C<undef> values onto the beginning of the
-array.  The array will grow automatically to accommodate the addition.  You
-must then use C<av_store> to assign values to these new elements.
+array.  The array will grow automatically to accommodate the addition.
+
+Perl equivalent: S<C<unshift @myarray, ((undef) x $num);>>
 
 =cut
 */
 
 void
 
 =cut
 */
 
 void
-Perl_av_unshift(pTHX_ register AV *av, register I32 num)
+Perl_av_unshift(pTHX_ AV *av, SSize_t num)
 {
 {
-    dVAR;
-    register I32 i;
+    SSize_t i;
     MAGIC* mg;
 
     PERL_ARGS_ASSERT_AV_UNSHIFT;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
     MAGIC* mg;
 
     PERL_ARGS_ASSERT_AV_UNSHIFT;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-       Perl_croak(aTHX_ "%s", PL_no_modify);
+        Perl_croak_no_modify();
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT",
-                           G_DISCARD | G_UNDEF_FILL, num);
-       return;
+        Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(UNSHIFT),
+                            G_DISCARD | G_UNDEF_FILL, num);
+        return;
     }
 
     if (num <= 0)
       return;
     if (!AvREAL(av) && AvREIFY(av))
     }
 
     if (num <= 0)
       return;
     if (!AvREAL(av) && AvREIFY(av))
-       av_reify(av);
+        av_reify(av);
     i = AvARRAY(av) - AvALLOC(av);
     if (i) {
     i = AvARRAY(av) - AvALLOC(av);
     if (i) {
-       if (i > num)
-           i = num;
-       num -= i;
+        if (i > num)
+            i = num;
+        num -= i;
     
     
-       AvMAX(av) += i;
-       AvFILLp(av) += i;
-       AvARRAY(av) = AvARRAY(av) - i;
+        AvMAX(av) += i;
+        AvFILLp(av) += i;
+        AvARRAY(av) = AvARRAY(av) - i;
     }
     if (num) {
     }
     if (num) {
-       register SV **ary;
-       const I32 i = AvFILLp(av);
-       /* Create extra elements */
-       const I32 slide = i > 0 ? i : 0;
-       num += slide;
-       av_extend(av, i + num);
-       AvFILLp(av) += num;
-       ary = AvARRAY(av);
-       Move(ary, ary + num, i + 1, SV*);
-       do {
-           ary[--num] = &PL_sv_undef;
-       } while (num);
-       /* Make extra elements into a buffer */
-       AvMAX(av) -= slide;
-       AvFILLp(av) -= slide;
-       AvARRAY(av) = AvARRAY(av) + slide;
+        SV **ary;
+        const SSize_t i = AvFILLp(av);
+        /* Create extra elements */
+        const SSize_t slide = i > 0 ? i : 0;
+        num += slide;
+        av_extend(av, i + num);
+        AvFILLp(av) += num;
+        ary = AvARRAY(av);
+        Move(ary, ary + num, i + 1, SV*);
+        do {
+            ary[--num] = NULL;
+        } while (num);
+        /* Make extra elements into a buffer */
+        AvMAX(av) -= slide;
+        AvFILLp(av) -= slide;
+        AvARRAY(av) = AvARRAY(av) + slide;
     }
 }
 
 /*
 =for apidoc av_shift
 
     }
 }
 
 /*
 =for apidoc av_shift
 
-Shifts an SV off the beginning of the array. Returns C<&PL_sv_undef> if the 
-array is empty.
+Removes one SV from the start of the array, reducing its size by one and
+returning the SV (transferring control of one reference count) to the
+caller.  Returns C<&PL_sv_undef> if the array is empty.
+
+Perl equivalent: C<shift(@myarray);>
 
 =cut
 */
 
 SV *
 
 =cut
 */
 
 SV *
-Perl_av_shift(pTHX_ register AV *av)
+Perl_av_shift(pTHX_ AV *av)
 {
 {
-    dVAR;
     SV *retval;
     MAGIC* mg;
 
     SV *retval;
     MAGIC* mg;
 
@@ -693,144 +781,146 @@ Perl_av_shift(pTHX_ register AV *av)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-       Perl_croak(aTHX_ "%s", PL_no_modify);
+        Perl_croak_no_modify();
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0);
-       if (retval)
-           retval = newSVsv(retval);
-       return retval;
+        retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(SHIFT), 0, 0);
+        if (retval)
+            retval = newSVsv(retval);
+        return retval;
     }
     if (AvFILL(av) < 0)
       return &PL_sv_undef;
     retval = *AvARRAY(av);
     if (AvREAL(av))
     }
     if (AvFILL(av) < 0)
       return &PL_sv_undef;
     retval = *AvARRAY(av);
     if (AvREAL(av))
-       *AvARRAY(av) = &PL_sv_undef;
+        *AvARRAY(av) = NULL;
     AvARRAY(av) = AvARRAY(av) + 1;
     AvMAX(av)--;
     AvFILLp(av)--;
     if (SvSMAGICAL(av))
     AvARRAY(av) = AvARRAY(av) + 1;
     AvMAX(av)--;
     AvFILLp(av)--;
     if (SvSMAGICAL(av))
-       mg_set(MUTABLE_SV(av));
-    return retval;
+        mg_set(MUTABLE_SV(av));
+    return retval ? retval : &PL_sv_undef;
 }
 
 /*
 }
 
 /*
+=for apidoc av_tindex
+=for apidoc_item av_top_index
+
+These behave identically.
+If the array C<av> is empty, these return -1; otherwise they return the maximum
+value of the indices of all the array elements which are currently defined in
+C<av>.
+
+They process 'get' magic.
+
+The Perl equivalent for these is C<$#av>.
+
+Use C<L</av_count>> to get the number of elements in an array.
+
 =for apidoc av_len
 
 =for apidoc av_len
 
-Returns the highest index in the array.  The number of elements in the
-array is C<av_len(av) + 1>.  Returns -1 if the array is empty.
+Same as L</av_top_index>.  Note that, unlike what the name implies, it returns
+the maximum index in the array.  This is unlike L</sv_len>, which returns what
+you would expect.
+
+B<To get the true number of elements in the array, instead use C<L</av_count>>>.
 
 =cut
 */
 
 
 =cut
 */
 
-I32
+SSize_t
 Perl_av_len(pTHX_ AV *av)
 {
     PERL_ARGS_ASSERT_AV_LEN;
 Perl_av_len(pTHX_ AV *av)
 {
     PERL_ARGS_ASSERT_AV_LEN;
-    assert(SvTYPE(av) == SVt_PVAV);
 
 
-    return AvFILL(av);
+    return av_top_index(av);
 }
 
 /*
 =for apidoc av_fill
 
 Set the highest index in the array to the given number, equivalent to
 }
 
 /*
 =for apidoc av_fill
 
 Set the highest index in the array to the given number, equivalent to
-Perl's C<$#array = $fill;>.
+Perl's S<C<$#array = $fill;>>.
 
 
-The number of elements in the an array will be C<fill + 1> after
-av_fill() returns.  If the array was previously shorter then the
-additional elements appended are set to C<PL_sv_undef>.  If the array
-was longer, then the excess elements are freed.  C<av_fill(av, -1)> is
+The number of elements in the array will be S<C<fill + 1>> after
+C<av_fill()> returns.  If the array was previously shorter, then the
+additional elements appended are set to NULL.  If the array
+was longer, then the excess elements are freed.  S<C<av_fill(av, -1)>> is
 the same as C<av_clear(av)>.
 
 =cut
 */
 void
 the same as C<av_clear(av)>.
 
 =cut
 */
 void
-Perl_av_fill(pTHX_ register AV *av, I32 fill)
+Perl_av_fill(pTHX_ AV *av, SSize_t fill)
 {
 {
-    dVAR;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_AV_FILL;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (fill < 0)
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_AV_FILL;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (fill < 0)
-       fill = -1;
+        fill = -1;
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       SV *arg1 = sv_newmortal();
-       sv_setiv(arg1, (IV)(fill + 1));
-       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
-                           1, arg1);
-       return;
+        SV *arg1 = sv_newmortal();
+        sv_setiv(arg1, (IV)(fill + 1));
+        Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(STORESIZE), G_DISCARD,
+                            1, arg1);
+        return;
     }
     if (fill <= AvMAX(av)) {
     }
     if (fill <= AvMAX(av)) {
-       I32 key = AvFILLp(av);
-       SV** const ary = AvARRAY(av);
-
-       if (AvREAL(av)) {
-           while (key > fill) {
-               SvREFCNT_dec(ary[key]);
-               ary[key--] = &PL_sv_undef;
-           }
-       }
-       else {
-           while (key < fill)
-               ary[++key] = &PL_sv_undef;
-       }
-           
-       AvFILLp(av) = fill;
-       if (SvSMAGICAL(av))
-           mg_set(MUTABLE_SV(av));
+        SSize_t key = AvFILLp(av);
+        SV** const ary = AvARRAY(av);
+
+        if (AvREAL(av)) {
+            while (key > fill) {
+                SvREFCNT_dec(ary[key]);
+                ary[key--] = NULL;
+            }
+        }
+        else {
+            while (key < fill)
+                ary[++key] = NULL;
+        }
+            
+        AvFILLp(av) = fill;
+        if (SvSMAGICAL(av))
+            mg_set(MUTABLE_SV(av));
     }
     else
     }
     else
-       (void)av_store(av,fill,&PL_sv_undef);
+        (void)av_store(av,fill,NULL);
 }
 
 /*
 =for apidoc av_delete
 
 }
 
 /*
 =for apidoc av_delete
 
-Deletes the element indexed by C<key> from the array.  Returns the
-deleted element. If C<flags> equals C<G_DISCARD>, the element is freed
-and null is returned. Perl equivalent: C<my $elem = delete($myarray[$idx]);>
-for the non-C<G_DISCARD> version and a void-context C<delete($myarray[$idx]);>
-for the C<G_DISCARD> version.
+Deletes the element indexed by C<key> from the array, makes the element
+mortal, and returns it.  If C<flags> equals C<G_DISCARD>, the element is
+freed and NULL is returned. NULL is also returned if C<key> is out of
+range.
+
+Perl equivalent: S<C<splice(@myarray, $key, 1, undef)>> (with the
+C<splice> in void context if C<G_DISCARD> is present).
 
 =cut
 */
 SV *
 
 =cut
 */
 SV *
-Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
+Perl_av_delete(pTHX_ AV *av, SSize_t key, I32 flags)
 {
 {
-    dVAR;
     SV *sv;
 
     PERL_ARGS_ASSERT_AV_DELETE;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
     SV *sv;
 
     PERL_ARGS_ASSERT_AV_DELETE;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-       Perl_croak(aTHX_ "%s", PL_no_modify);
+        Perl_croak_no_modify();
 
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic
 
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic
-           = mg_find((const SV *)av, PERL_MAGIC_tied);
+            = mg_find((const SV *)av, PERL_MAGIC_tied);
         if ((tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata))) {
         if ((tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata))) {
-            /* Handle negative array indices 20020222 MJD */
             SV **svp;
             if (key < 0) {
             SV **svp;
             if (key < 0) {
-                unsigned adjust_index = 1;
-                if (tied_magic) {
-                   SV * const * const negative_indices_glob =
-                        hv_fetch(SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(av), 
-                                                         tied_magic))), 
-                                 NEGATIVE_INDICES_VAR, 16, 0);
-                    if (negative_indices_glob
-                        && SvTRUE(GvSV(*negative_indices_glob)))
-                        adjust_index = 0;
-                }
-                if (adjust_index) {
-                    key += AvFILL(av) + 1;
-                    if (key < 0)
-                       return NULL;
-                }
+                if (!S_adjust_index(aTHX_ av, tied_magic, &key))
+                        return NULL;
             }
             svp = av_fetch(av, key, TRUE);
             if (svp) {
             }
             svp = av_fetch(av, key, TRUE);
             if (svp) {
@@ -840,40 +930,40 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
                     sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
                     return sv;
                 }
                     sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
                     return sv;
                 }
-               return NULL;
+                return NULL;
             }
         }
     }
 
     if (key < 0) {
             }
         }
     }
 
     if (key < 0) {
-       key += AvFILL(av) + 1;
-       if (key < 0)
-           return NULL;
+        key += AvFILL(av) + 1;
+        if (key < 0)
+            return NULL;
     }
 
     if (key > AvFILLp(av))
     }
 
     if (key > AvFILLp(av))
-       return NULL;
+        return NULL;
     else {
     else {
-       if (!AvREAL(av) && AvREIFY(av))
-           av_reify(av);
-       sv = AvARRAY(av)[key];
-       if (key == AvFILLp(av)) {
-           AvARRAY(av)[key] = &PL_sv_undef;
-           do {
-               AvFILLp(av)--;
-           } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
-       }
-       else
-           AvARRAY(av)[key] = &PL_sv_undef;
-       if (SvSMAGICAL(av))
-           mg_set(MUTABLE_SV(av));
-    }
-    if (flags & G_DISCARD) {
-       SvREFCNT_dec(sv);
-       sv = NULL;
+        if (!AvREAL(av) && AvREIFY(av))
+            av_reify(av);
+        sv = AvARRAY(av)[key];
+        AvARRAY(av)[key] = NULL;
+        if (key == AvFILLp(av)) {
+            do {
+                AvFILLp(av)--;
+            } while (--key >= 0 && !AvARRAY(av)[key]);
+        }
+        if (SvSMAGICAL(av))
+            mg_set(MUTABLE_SV(av));
+    }
+    if(sv != NULL) {
+        if (flags & G_DISCARD) {
+            SvREFCNT_dec_NN(sv);
+            return NULL;
+        }
+        else if (AvREAL(av))
+            sv_2mortal(sv);
     }
     }
-    else if (AvREAL(av))
-       sv = sv_2mortal(sv);
     return sv;
 }
 
     return sv;
 }
 
@@ -883,70 +973,71 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
 Returns true if the element indexed by C<key> has been initialized.
 
 This relies on the fact that uninitialized array elements are set to
 Returns true if the element indexed by C<key> has been initialized.
 
 This relies on the fact that uninitialized array elements are set to
-C<&PL_sv_undef>.
+C<NULL>.
+
+Perl equivalent: C<exists($myarray[$key])>.
 
 =cut
 */
 bool
 
 =cut
 */
 bool
-Perl_av_exists(pTHX_ AV *av, I32 key)
+Perl_av_exists(pTHX_ AV *av, SSize_t key)
 {
 {
-    dVAR;
     PERL_ARGS_ASSERT_AV_EXISTS;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic
     PERL_ARGS_ASSERT_AV_EXISTS;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic
-           = mg_find((const SV *)av, PERL_MAGIC_tied);
-        if (tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata)) {
-           SV * const sv = sv_newmortal();
+            = mg_find((const SV *)av, PERL_MAGIC_tied);
+        const MAGIC * const regdata_magic
+            = mg_find((const SV *)av, PERL_MAGIC_regdata);
+        if (tied_magic || regdata_magic) {
             MAGIC *mg;
             /* Handle negative array indices 20020222 MJD */
             if (key < 0) {
             MAGIC *mg;
             /* Handle negative array indices 20020222 MJD */
             if (key < 0) {
-                unsigned adjust_index = 1;
-                if (tied_magic) {
-                   SV * const * const negative_indices_glob =
-                        hv_fetch(SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(av), 
-                                                         tied_magic))), 
-                                 NEGATIVE_INDICES_VAR, 16, 0);
-                    if (negative_indices_glob
-                        && SvTRUE(GvSV(*negative_indices_glob)))
-                        adjust_index = 0;
-                }
-                if (adjust_index) {
-                    key += AvFILL(av) + 1;
-                    if (key < 0)
+                if (!S_adjust_index(aTHX_ av, tied_magic, &key))
                         return FALSE;
                         return FALSE;
-                }
             }
 
             }
 
-            mg_copy(MUTABLE_SV(av), sv, 0, key);
-            mg = mg_find(sv, PERL_MAGIC_tiedelem);
-            if (mg) {
-                magic_existspack(sv, mg);
-                return cBOOL(SvTRUE(sv));
+            if(key >= 0 && regdata_magic) {
+                if (key <= AvFILL(av))
+                    return TRUE;
+                else
+                    return FALSE;
+            }
+            {
+                SV * const sv = sv_newmortal();
+                mg_copy(MUTABLE_SV(av), sv, 0, key);
+                mg = mg_find(sv, PERL_MAGIC_tiedelem);
+                if (mg) {
+                    magic_existspack(sv, mg);
+                    {
+                        I32 retbool = SvTRUE_nomg_NN(sv);
+                        return cBOOL(retbool);
+                    }
+                }
             }
             }
-
         }
     }
 
     if (key < 0) {
         }
     }
 
     if (key < 0) {
-       key += AvFILL(av) + 1;
-       if (key < 0)
-           return FALSE;
+        key += AvFILL(av) + 1;
+        if (key < 0)
+            return FALSE;
     }
 
     }
 
-    if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
-       && AvARRAY(av)[key])
+    if (key <= AvFILLp(av) && AvARRAY(av)[key])
     {
     {
-       return TRUE;
+        if (SvSMAGICAL(AvARRAY(av)[key])
+         && mg_find(AvARRAY(av)[key], PERL_MAGIC_nonelem))
+            return FALSE;
+        return TRUE;
     }
     else
     }
     else
-       return FALSE;
+        return FALSE;
 }
 
 static MAGIC *
 S_get_aux_mg(pTHX_ AV *av) {
 }
 
 static MAGIC *
 S_get_aux_mg(pTHX_ AV *av) {
-    dVAR;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_GET_AUX_MG;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_GET_AUX_MG;
@@ -955,11 +1046,11 @@ S_get_aux_mg(pTHX_ AV *av) {
     mg = mg_find((const SV *)av, PERL_MAGIC_arylen_p);
 
     if (!mg) {
     mg = mg_find((const SV *)av, PERL_MAGIC_arylen_p);
 
     if (!mg) {
-       mg = sv_magicext(MUTABLE_SV(av), 0, PERL_MAGIC_arylen_p,
-                        &PL_vtbl_arylen_p, 0, 0);
-       assert(mg);
-       /* sv_magicext won't set this for us because we pass in a NULL obj  */
-       mg->mg_flags |= MGf_REFCOUNTED;
+        mg = sv_magicext(MUTABLE_SV(av), 0, PERL_MAGIC_arylen_p,
+                         &PL_vtbl_arylen_p, 0, 0);
+        assert(mg);
+        /* sv_magicext won't set this for us because we pass in a NULL obj  */
+        mg->mg_flags |= MGf_REFCOUNTED;
     }
     return mg;
 }
     }
     return mg;
 }
@@ -981,25 +1072,29 @@ Perl_av_iter_p(pTHX_ AV *av) {
     PERL_ARGS_ASSERT_AV_ITER_P;
     assert(SvTYPE(av) == SVt_PVAV);
 
     PERL_ARGS_ASSERT_AV_ITER_P;
     assert(SvTYPE(av) == SVt_PVAV);
 
-#if IVSIZE == I32SIZE
-    return (IV *)&(mg->mg_len);
-#else
-    if (!mg->mg_ptr) {
-       IV *temp;
-       mg->mg_len = IVSIZE;
-       Newxz(temp, 1, IV);
-       mg->mg_ptr = (char *) temp;
+    if (sizeof(IV) == sizeof(SSize_t)) {
+        return (IV *)&(mg->mg_len);
+    } else {
+        if (!mg->mg_ptr) {
+            IV *temp;
+            mg->mg_len = IVSIZE;
+            Newxz(temp, 1, IV);
+            mg->mg_ptr = (char *) temp;
+        }
+        return (IV *)mg->mg_ptr;
     }
     }
-    return (IV *)mg->mg_ptr;
-#endif
+}
+
+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;
 }
 
 /*
 }
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: t
- * End:
- *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */
  */