From a7bd49b77db73f2d2adc70090554af35afb6157f Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Mon, 19 Apr 2021 21:27:03 +0100 Subject: [PATCH 1/3] Add Perl_av_new_alloc() function and newAV_alloc_x/z() macros av.c: add Perl_av_new_alloc --- av.c | 33 +++++++++++++++++++++++++++++++++ av.h | 20 ++++++++++++++++++++ embed.fnc | 3 +++ embed.h | 1 + proto.h | 12 ++++++++++++ 5 files changed, 69 insertions(+) diff --git a/av.c b/av.c index 03d793b31af7..a436029e3446 100644 --- a/av.c +++ b/av.c @@ -393,6 +393,39 @@ 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. + +=cut +*/ + +AV * +Perl_av_new_alloc(pTHX_ SSize_t size, bool zeroflag) +{ + AV * const av = newAV(); + SV** ary; + PERL_ARGS_ASSERT_AV_NEW_ALLOC; + + Newx(ary, size, SV*); + 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..9056536974a1 100644 --- a/av.h +++ b/av.h @@ -108,6 +108,26 @@ Perl equivalent: C. #define newAV() MUTABLE_AV(newSV_type(SVt_PVAV)) +/* +=for apidoc newAV_alloc_x + +Similar to newAV(), but the SV* array is also allocated. + +This is similar to but more efficient than doing: + + AV *av = newAV(); + av_extend(av, key); + +Note that these the actual size requested is allocated. This is unlike +av_extend(), which enforces a minimum size of 3, and always does a +1 +to the requested/minimum size when allocating. + +=cut +*/ + +#define newAV_alloc_x(key) av_new_alloc(key,0) +#define newAV_alloc_xz(key) av_new_alloc(key,1) + /* * ex: set ts=8 sts=4 sw=4 et: */ diff --git a/embed.fnc b/embed.fnc index 551d46880562..22c6dc08fc0b 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 +ApMdR |AV* |newAV_alloc_x |SSize_t key +ApMdR |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/proto.h b/proto.h index faca6d1366e1..661a0d18b985 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* Perl_newAV_alloc_x(pTHX_ SSize_t key) + __attribute__warn_unused_result__; +#define PERL_ARGS_ASSERT_NEWAV_ALLOC_X + +PERL_CALLCONV AV* Perl_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 From 1b89776613c69dac39c9dea0179396a047fd4578 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Mon, 19 Apr 2021 21:28:01 +0100 Subject: [PATCH 2/3] Perl_clear_defarray: faster array creation via new macro+function --- pp_hot.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pp_hot.c b/pp_hot.c index 5119638b9ff6..2c470fcf61a5 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -4975,8 +4975,8 @@ Perl_clear_defarray(pTHX_ AV* av, bool abandon) AvREIFY_only(av); } else { - AV *newav = newAV(); - av_extend(newav, fill); + /* fill can be -1. The ternary gives consistency with av_extend() */ + AV *newav = newAV_alloc_xz(fill < 3 ? 4 : fill); AvREIFY_only(newav); PAD_SVl(0) = MUTABLE_SV(newav); SvREFCNT_dec_NN(av); From ff11f44ef294896c714b86a25c82157e5fa474a0 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Tue, 20 Apr 2021 19:00:49 +0100 Subject: [PATCH 3/3] Should it be m not Mp in embed.fnc? --- embed.fnc | 4 ++-- proto.h | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/embed.fnc b/embed.fnc index 22c6dc08fc0b..27a6c56545f5 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1460,8 +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 -ApMdR |AV* |newAV_alloc_x |SSize_t key -ApMdR |AV* |newAV_alloc_xz |SSize_t key +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/proto.h b/proto.h index 661a0d18b985..c7314a1027b2 100644 --- a/proto.h +++ b/proto.h @@ -2243,12 +2243,12 @@ PERL_CALLCONV OP* Perl_newAVREF(pTHX_ OP* o) #define PERL_ARGS_ASSERT_NEWAVREF \ assert(o) -PERL_CALLCONV AV* Perl_newAV_alloc_x(pTHX_ SSize_t key) - __attribute__warn_unused_result__; +/* PERL_CALLCONV AV* newAV_alloc_x(pTHX_ SSize_t key) + __attribute__warn_unused_result__; */ #define PERL_ARGS_ASSERT_NEWAV_ALLOC_X -PERL_CALLCONV AV* Perl_newAV_alloc_xz(pTHX_ SSize_t key) - __attribute__warn_unused_result__; +/* 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)