diff --git a/av.c b/av.c index 03d793b31af7..afac896dda8d 100644 --- a/av.c +++ b/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 diff --git a/av.h b/av.h index 41cb6fefd896..93bc227deccf 100644 --- a/av.h +++ b/av.h @@ -108,6 +108,46 @@ Perl equivalent: C. #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 648545ac1691..2dc4dc301416 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 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 diff --git a/embed.h b/embed.h index 10214db1fb08..f925f5a5c039 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/pp_hot.c b/pp_hot.c index 3348afedf166..6cbbeb763ee7 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -4966,8 +4966,6 @@ 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))) { @@ -4975,8 +4973,10 @@ Perl_clear_defarray(pTHX_ AV* av, bool abandon) 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); diff --git a/proto.h b/proto.h index 56f7d42e7e0c..f292e9f32f22 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 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