add Perl_clear_defarray()

This function implements the less commonly used branch in the POPSUB()
macro that clears @_ in place, or abandons it and creates a new array
in pad slot 0 of the function (the common branch is where @_ hasn't been
reified, and so can be clered simply by setting fill to -1).

By moving this out to a separate function we can avoid repeating the same
code everywhere the POPSUB macro is used; but since its only used
in the less frequent cases, the extra overall of a function call doesn't
matter.

It has a currently unused arg, 'abandon', which will be used shortly.

diff --git a/cop.h b/cop.h
index 04e4d76..cedc560 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -660,14 +660,8 @@ struct block_format {
                         CvDEPTH(cx->blk_sub.cv)])) == PL_curpad);       \
            POP_SAVEARRAY();                                            \
            /* abandon @_ if it got reified */                          \
-           if (AvREAL(av)) {                                           \
-               const SSize_t fill = AvFILLp(av);                       \
-               SvREFCNT_dec_NN(av);                                    \
-                av = newAV();                                           \
-               av_extend(av, fill);                                    \
-               AvREIFY_only(av);                                       \
-                PAD_SVl(0) = MUTABLE_SV(av);                            \
-           }                                                           \
+           if (UNLIKELY(AvREAL(av)))                                   \
+                clear_defarray(av, 0);                                  \
            else {                                                      \
                CLEAR_ARGARRAY(av);                                     \
            }                                                           \

diff --git a/embed.fnc b/embed.fnc
index 0e02afe..32b04df 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2877,5 +2877,6 @@ Ei        |STRLEN |sv_or_pv_pos_u2b|NN SV *sv|NN const char *pv|STRLEN pos \
 #endif
 
 EMpPX  |SV*    |_get_encoding
+Xp     |void   |clear_defarray |NN AV* av|bool abandon
 
 : ex: set ts=8 sts=4 sw=4 noet:

diff --git a/embed.h b/embed.h
index 8b482e2..a6486be 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1155,6 +1155,7 @@
 #define ck_svconst(a)          Perl_ck_svconst(aTHX_ a)
 #define ck_tell(a)             Perl_ck_tell(aTHX_ a)
 #define ck_trunc(a)            Perl_ck_trunc(aTHX_ a)
+#define clear_defarray(a,b)    Perl_clear_defarray(aTHX_ a,b)
 #define closest_cop(a,b,c,d)   Perl_closest_cop(aTHX_ a,b,c,d)
 #define core_prototype(a,b,c,d)        Perl_core_prototype(aTHX_ a,b,c,d)
 #define coresub_op(a,b,c)      Perl_coresub_op(aTHX_ a,b,c)

diff --git a/pp_hot.c b/pp_hot.c
index b2922b1..c2ee827 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -3329,6 +3329,25 @@ PP(pp_leavesub)
     return cx->blk_sub.retop;
 }
 
+
+/* clear (if possible) or abandon the current @_. If 'abandon' is true,
+ * forces an abandon */
+
+void
+Perl_clear_defarray(pTHX_ AV* av, bool abandon)
+{
+    const SSize_t fill = AvFILLp(av);
+
+    PERL_ARGS_ASSERT_CLEAR_DEFARRAY;
+
+    SvREFCNT_dec_NN(av);
+    av = newAV();
+    av_extend(av, fill);
+    AvREIFY_only(av);
+    PAD_SVl(0) = MUTABLE_SV(av);
+}
+
+
 PP(pp_entersub)
 {
     dSP; dPOPss;

diff --git a/proto.h b/proto.h
index def673a..cef94b5 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -522,6 +522,9 @@ PERL_CALLCONV void  Perl_ck_warner_d(pTHX_ U32 err, const char* pat, ...)
 
 PERL_CALLCONV bool     Perl_ckwarn(pTHX_ U32 w);
 PERL_CALLCONV bool     Perl_ckwarn_d(pTHX_ U32 w);
+PERL_CALLCONV void     Perl_clear_defarray(pTHX_ AV* av, bool abandon);
+#define PERL_ARGS_ASSERT_CLEAR_DEFARRAY        \
+       assert(av)
 PERL_CALLCONV const COP*       Perl_closest_cop(pTHX_ const COP *cop, const OP *o, const OP *curop, bool opnext);
 #define PERL_ARGS_ASSERT_CLOSEST_COP   \
        assert(cop)