Merge 4391e33 into 7ad5408

av.c

@@ -393,6 +393,44 @@ Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val)
     return &ary[key];
 }
 
+/*
+=for apidoc av_new_alloc
+
+Creates a new AV and allocates its SV* array.
+
+This is similar to but more efficient than doing:
+
+    AV *av = newAV();
+    av_extend(av, key);
+
+The zeroflag parameter controls whether the array is NULL initialized.
+
+Note that av_index() takes the desired AvMAX as its key parameter, but
+av_new_alloc() instead takes the desired size (so AvMAX + 1). This
+size must be at least 1.
+
+=cut
+*/
+
+AV *
+Perl_av_new_alloc(pTHX_ SSize_t size, bool zeroflag)
+{
+    AV * const av = newAV();
+    SV** ary;
+    PERL_ARGS_ASSERT_AV_NEW_ALLOC;
+    assert(size > 0);
+
+    Newx(ary, size, SV*); /* Newx performs the memwrap check */
+    AvALLOC(av) = ary;
+    AvARRAY(av) = ary;
+    AvMAX(av) = size - 1;
+
+    if (zeroflag)
+        Zero(ary, size, SV*);
+
+    return av;
+}
+
 /*
 =for apidoc av_make
 

av.h

@@ -108,6 +108,46 @@ Perl equivalent: C<my @array;>.
 
 #define newAV()	MUTABLE_AV(newSV_type(SVt_PVAV))
 
+/*
+=for apidoc newAV_alloc_x
+
+Similar to newAV(), but a SV* array is also allocated.
+
+This is similar to but more efficient than doing:
+
+    AV *av = newAV();
+    av_extend(av, key);
+
+Note that the actual size requested is allocated. This is unlike
+av_extend(), which takes the maximum desired array index (AvMAX) as its
+"key" parameter, and enforces a minimum value for that of 3.
+
+In other words, the following examples all result in an array that can
+fit four elements (indexes 0 .. 3):
+
+    AV *av = newAV();
+    av_extend(av, 1);
+
+    AV *av = newAV();
+    av_extend(av, 3);
+
+    AV *av = newAV_alloc_x(4);
+
+Whereas this will result in an array that can only fit one element:
+
+    AV *av = newAV_alloc_x(1);
+
+newAV_alloc_x does not initialize the array with NULL pointers.
+newAV_alloc_xz does do that initialization.
+
+These macros MUST NOT be called with a size less than 1.
+
+=cut
+*/
+
+#define newAV_alloc_x(size)  av_new_alloc(size,0)
+#define newAV_alloc_xz(size) av_new_alloc(size,1)
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */

embed.fnc

@@ -636,6 +636,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
+ApdR	|AV*	|av_new_alloc	|SSize_t size|bool zeroflag
 p	|SV*	|av_nonelem	|NN AV *av|SSize_t ix
 Apd	|SV*	|av_pop		|NN AV *av
 Apdoex	|void	|av_create_and_push|NN AV **const avp|NN SV *const val
@@ -1459,6 +1460,8 @@ Apx	|CV *	|newXS_flags	|NULLOK const char *name|NN XSUBADDR_t subaddr\
 ApdU	|CV*	|newXS		|NULLOK const char *name|NN XSUBADDR_t subaddr\
 				|NN const char *filename
 ApMdbR	|AV*	|newAV
+AmdR	|AV*	|newAV_alloc_x  |SSize_t key
+AmdR	|AV*	|newAV_alloc_xz |SSize_t key
 ApR	|OP*	|newAVREF	|NN OP* o
 ApdR	|OP*	|newBINOP	|I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last
 ApR	|OP*	|newCVREF	|I32 flags|NULLOK OP* o

embed.h

@@ -62,6 +62,7 @@
 #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)
+#define av_new_alloc(a,b)	Perl_av_new_alloc(aTHX_ a,b)
 #define av_pop(a)		Perl_av_pop(aTHX_ a)
 #define av_push(a,b)		Perl_av_push(aTHX_ a,b)
 #define av_shift(a)		Perl_av_shift(aTHX_ a)

pp_hot.c

@@ -4966,17 +4966,17 @@ PP(pp_leavesub)
 void
 Perl_clear_defarray(pTHX_ AV* av, bool abandon)
 {
-    const SSize_t fill = AvFILLp(av);
-
     PERL_ARGS_ASSERT_CLEAR_DEFARRAY;
 
     if (LIKELY(!abandon && SvREFCNT(av) == 1 && !SvMAGICAL(av))) {
         av_clear(av);
         AvREIFY_only(av);
     }
     else {
-        AV *newav = newAV();
-        av_extend(newav, fill);
+        const SSize_t size = AvFILLp(av) + 1;
+        /* The ternary gives consistency with av_extend() */
+        /* fill can be -1. The ternary gives consistency with av_extend() */
+        AV *newav = newAV_alloc_x(size < 4 ? 4 : size);
         AvREIFY_only(newav);
         PAD_SVl(0) = MUTABLE_SV(newav);
         SvREFCNT_dec_NN(av);

proto.h

@@ -285,6 +285,10 @@ PERL_CALLCONV AV*	Perl_av_make(pTHX_ SSize_t size, SV **strp)
 #define PERL_ARGS_ASSERT_AV_MAKE	\
 	assert(strp)
 
+PERL_CALLCONV AV*	Perl_av_new_alloc(pTHX_ SSize_t size, bool zeroflag)
+			__attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_AV_NEW_ALLOC
+
 PERL_CALLCONV SV*	Perl_av_nonelem(pTHX_ AV *av, SSize_t ix);
 #define PERL_ARGS_ASSERT_AV_NONELEM	\
 	assert(av)
@@ -2239,6 +2243,14 @@ PERL_CALLCONV OP*	Perl_newAVREF(pTHX_ OP* o)
 #define PERL_ARGS_ASSERT_NEWAVREF	\
 	assert(o)
 
+/* PERL_CALLCONV AV*	newAV_alloc_x(pTHX_ SSize_t key)
+			__attribute__warn_unused_result__; */
+#define PERL_ARGS_ASSERT_NEWAV_ALLOC_X
+
+/* PERL_CALLCONV AV*	newAV_alloc_xz(pTHX_ SSize_t key)
+			__attribute__warn_unused_result__; */
+#define PERL_ARGS_ASSERT_NEWAV_ALLOC_XZ
+
 PERL_CALLCONV OP*	Perl_newBINOP(pTHX_ I32 type, I32 flags, OP* first, OP* last)
 			__attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWBINOP