Add Perl_av_new_alloc() function and newAV_alloc_x/z() macros

5 files changed, 94 insertions, 0 deletions

diff --git a/av.c b/av.c
index 03d793b31a..afac896dda 100644
--- a/av.c
+++ b/av.c
@@ -394,6 +394,44 @@ Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val)
 }
 
 /*
+=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
 
 Creates a new AV and populates it with a list of SVs.  The SVs are copied
diff --git a/av.h b/av.h
index 41cb6fefd8..93bc227dec 100644
--- a/av.h
+++ b/av.h
@@ -109,5 +109,45 @@ 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:
  */
diff --git a/embed.fnc b/embed.fnc
index 648545ac16..f897db06c5 100644
--- a/embed.fnc
+++ b/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 size
+AmdR	|AV*	|newAV_alloc_xz |SSize_t size
 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
diff --git a/embed.h b/embed.h
index 10214db1fb..f925f5a5c0 100644
--- a/embed.h
+++ b/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)
diff --git a/proto.h b/proto.h
index 56f7d42e7e..b174b3346c 100644
--- a/proto.h
+++ b/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 size)
+			__attribute__warn_unused_result__; */
+#define PERL_ARGS_ASSERT_NEWAV_ALLOC_X
+
+/* PERL_CALLCONV AV*	newAV_alloc_xz(pTHX_ SSize_t size)
+			__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