Merge 155df17 into cb222c4

embed.fnc

@@ -633,6 +633,7 @@ p	|void	|av_extend_guts	|NULLOK AV *av|SSize_t key \
 				|NN SSize_t *maxp \
 				|NN SV ***allocp|NN SV ***arrayp
 ApdR	|SV**	|av_fetch	|NN AV *av|SSize_t key|I32 lval
+CipdR	|SV**	|av_fetch_simple|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
@@ -645,6 +646,7 @@ Apd	|void	|av_push	|NN AV *av|NN SV *val
 EXp	|void	|av_reify	|NN AV *av
 ApdR	|SV*	|av_shift	|NN AV *av
 Apd	|SV**	|av_store	|NN AV *av|SSize_t key|NULLOK SV *val
+Cipd	|SV**	|av_store_simple|NN AV *av|SSize_t key|NULLOK SV *val
 AmdR	|SSize_t|av_top_index	|NN AV *av
 AidRp	|Size_t	|av_count	|NN AV *av
 AmdR	|SSize_t|av_tindex	|NN AV *av

embed.h

@@ -59,6 +59,7 @@
 #define av_exists(a,b)		Perl_av_exists(aTHX_ a,b)
 #define av_extend(a,b)		Perl_av_extend(aTHX_ a,b)
 #define av_fetch(a,b,c)		Perl_av_fetch(aTHX_ a,b,c)
+#define av_fetch_simple(a,b,c)	Perl_av_fetch_simple(aTHX_ a,b,c)
 #define av_fill(a,b)		Perl_av_fill(aTHX_ a,b)
 #define av_len(a)		Perl_av_len(aTHX_ a)
 #define av_make(a,b)		Perl_av_make(aTHX_ a,b)
@@ -67,6 +68,7 @@
 #define av_push(a,b)		Perl_av_push(aTHX_ a,b)
 #define av_shift(a)		Perl_av_shift(aTHX_ a)
 #define av_store(a,b,c)		Perl_av_store(aTHX_ a,b,c)
+#define av_store_simple(a,b,c)	Perl_av_store_simple(aTHX_ a,b,c)
 #define av_undef(a)		Perl_av_undef(aTHX_ a)
 #define av_unshift(a,b)		Perl_av_unshift(aTHX_ a,b)
 #define block_end(a,b)		Perl_block_end(aTHX_ a,b)

inline.h

@@ -57,6 +57,94 @@ Perl_av_count(pTHX_ AV *av)
     return AvFILL(av) + 1;
 }
 
+/* ------------------------------- av.c ------------------------------- */
+
+/*
+=for apidoc av_store_simple
+
+This is a cut-down version of av_store that assumes that the array is
+very straightforward - no magic, not readonly, and AvREAL - and that
+C<key> is not negative. This function MUST NOT be used in situations
+where any of those assumptions may not hold.
+
+Stores an SV in an array.  The array index is specified as C<key>.  The
+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
+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
+returned C<NULL>.
+
+Approximate Perl equivalent: C<splice(@myarray, $key, 1, $val)>.
+
+=cut
+*/
+
+PERL_STATIC_INLINE SV**
+Perl_av_store_simple(pTHX_ AV *av, SSize_t key, SV *val)
+{
+    SV** ary;
+
+    PERL_ARGS_ASSERT_AV_STORE_SIMPLE;
+    assert(SvTYPE(av) == SVt_PVAV);
+    assert(!SvMAGICAL(av));
+    assert(!SvREADONLY(av));
+    assert(AvREAL(av));
+    assert(key > -1);
+
+    ary = AvARRAY(av);
+
+    if (AvFILLp(av) < key) {
+        if (key > AvMAX(av)) {
+            av_extend(av,key);
+            ary = AvARRAY(av);
+        }
+        AvFILLp(av) = key;
+    } else
+        SvREFCNT_dec(ary[key]);
+
+    ary[key] = val;
+    return &ary[key];
+}
+
+/*
+=for apidoc av_fetch_simple
+
+This is a cut-down version of av_fetch that assumes that the array is
+very straightforward - no magic, not readonly, and AvREAL - and that
+C<key> is not negative. This function MUST NOT be used in situations
+where any of those assumptions may not hold.
+
+Returns the SV at the specified index in the array.  The C<key> is the
+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*>.
+
+The rough perl equivalent is C<$myarray[$key]>.
+
+=cut
+*/
+
+PERL_STATIC_INLINE SV**
+Perl_av_fetch_simple(pTHX_ AV *av, SSize_t key, I32 lval)
+{
+    PERL_ARGS_ASSERT_AV_FETCH_SIMPLE;
+    assert(SvTYPE(av) == SVt_PVAV);
+    assert(!SvMAGICAL(av));
+    assert(!SvREADONLY(av));
+    assert(AvREAL(av));
+    assert(key > -1);
+
+    if ( (key >= AvFILLp(av) + 1) || !AvARRAY(av)[key]) {
+        return lval ? av_store_simple(av,key,newSV(0)) : NULL;
+    } else {
+        return &AvARRAY(av)[key];
+    }
+}
+
 /* ------------------------------- cv.h ------------------------------- */
 
 /*

pad.c

@@ -719,7 +719,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
         pad_reset();
     if (tmptype == SVs_PADMY) { /* Not & because this ‘flag’ is 0.  */
         /* For a my, simply push a null SV onto the end of PL_comppad. */
-        sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
+        sv = *av_store_simple(PL_comppad, AvFILLp(PL_comppad) + 1, newSV(0));
         retval = (PADOFFSET)AvFILLp(PL_comppad);
     }
     else {
@@ -746,7 +746,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
             if (++retval <= names_fill &&
                    (pn = names[retval]) && PadnamePV(pn))
                 continue;
-            sv = *av_fetch(PL_comppad, retval, TRUE);
+            sv = *av_fetch_simple(PL_comppad, retval, TRUE);
             if (!(SvFLAGS(sv) &
 #ifdef USE_PAD_RESET
                     (konst ? SVs_PADTMP : 0)

proto.h

@@ -269,6 +269,13 @@ PERL_CALLCONV SV**	Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
 #define PERL_ARGS_ASSERT_AV_FETCH	\
 	assert(av)
 
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE SV**	Perl_av_fetch_simple(pTHX_ AV *av, SSize_t key, I32 lval)
+			__attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_AV_FETCH_SIMPLE	\
+	assert(av)
+#endif
+
 PERL_CALLCONV void	Perl_av_fill(pTHX_ AV *av, SSize_t fill);
 #define PERL_ARGS_ASSERT_AV_FILL	\
 	assert(av)
@@ -309,6 +316,11 @@ PERL_CALLCONV SV*	Perl_av_shift(pTHX_ AV *av)
 PERL_CALLCONV SV**	Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val);
 #define PERL_ARGS_ASSERT_AV_STORE	\
 	assert(av)
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE SV**	Perl_av_store_simple(pTHX_ AV *av, SSize_t key, SV *val);
+#define PERL_ARGS_ASSERT_AV_STORE_SIMPLE	\
+	assert(av)
+#endif
 /* PERL_CALLCONV SSize_t	av_tindex(pTHX_ AV *av)
 			__attribute__warn_unused_result__; */
 #define PERL_ARGS_ASSERT_AV_TINDEX