convert CX_PUSHSUB/POPSUB to inline fns
authorDavid Mitchell <davem@iabyn.com>
Wed, 30 Dec 2015 12:33:48 +0000 (12:33 +0000)
committerDavid Mitchell <davem@iabyn.com>
Wed, 3 Feb 2016 09:19:20 +0000 (09:19 +0000)
Replace CX_PUSHSUB() with cx_pushsub() etc.

No functional changes.

cop.h
embed.fnc
embed.h
inline.h
pp.c
pp_ctl.c
pp_hot.c
pp_sort.c
proto.h
t/op/args.t

diff --git a/cop.h b/cop.h
index 3a7afb5..d7ae2d6 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -595,20 +595,6 @@ struct block_format {
  * The context frame holds a reference to the CV so that it can't be
  * freed while we're executing it */
 
-#define CX_PUSHSUB_BASE(cx, cv, op, hasargs)                           \
-       ENTRY_PROBE(CvNAMED(cv)                                         \
-                       ? HEK_KEY(CvNAME_HEK(cv))                       \
-                       : GvENAME(CvGV(cv)),                            \
-               CopFILE((const COP *)CvSTART(cv)),                      \
-               CopLINE((const COP *)CvSTART(cv)),                      \
-               CopSTASHPV((const COP *)CvSTART(cv)));                  \
-                                                                       \
-       cx->blk_sub.cv = cv;                                            \
-       cx->blk_sub.olddepth = CvDEPTH(cv);                             \
-       cx->blk_sub.prevcomppad = PL_comppad;                           \
-       cx->cx_type |= (hasargs) ? CXp_HASARGS : 0;                     \
-       cx->blk_sub.retop = op;                                         \
-        SvREFCNT_inc_simple_void_NN(cv);
 
 #define CX_PUSHSUB_GET_LVALUE_MASK(func) \
        /* If the context is indeterminate, then only the lvalue */     \
@@ -620,20 +606,6 @@ struct block_format {
                   ? 0 : (U8)func(aTHX)                                 \
        )
 
-#define CX_PUSHSUB(cx, cv, op, hasargs)                                        \
-    {                                                                  \
-       U8 phlags = CX_PUSHSUB_GET_LVALUE_MASK(Perl_was_lvalue_sub);    \
-       CX_PUSHSUB_BASE(cx, cv, op, hasargs)                            \
-       cx->blk_u16 = PL_op->op_private &                               \
-                         (phlags|OPpDEREF);                            \
-    }
-
-/* variant for use by OP_DBSTATE, where op_private holds hint bits */
-#define CX_PUSHSUB_DB(cx, cv, op, hasargs)                             \
-       CX_PUSHSUB_BASE(cx, cv, op, hasargs)                            \
-       cx->blk_u16 = 0;
-
-
 #define CX_PUSHFORMAT(cx, cv, gv, retop)                               \
        cx->blk_format.cv = cv;                                         \
        cx->blk_format.gv = gv;                                         \
@@ -664,55 +636,6 @@ struct block_format {
     } STMT_END
 
 
-/* subsets of CX_POPSUB */
-
-#define CX_POPSUB_COMMON(cx) \
-    STMT_START {                                                       \
-        CV *cv;                                                         \
-        assert(CxTYPE(cx) == CXt_SUB);                                  \
-        PL_comppad = cx->blk_sub.prevcomppad;                           \
-        PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;    \
-        cv = cx->blk_sub.cv;                                            \
-        CvDEPTH(cv) = cx->blk_sub.olddepth;                             \
-        cx->blk_sub.cv = NULL;                                          \
-        SvREFCNT_dec(cv);                                               \
-    } STMT_END
-
-/* handle the @_ part of leaving a sub */
-
-#define CX_POPSUB_ARGS(cx) \
-    STMT_START {                                                       \
-        AV *av;                                                         \
-        assert(CxTYPE(cx) == CXt_SUB);                                  \
-        assert(AvARRAY(MUTABLE_AV(                                      \
-            PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[                    \
-                    CvDEPTH(cx->blk_sub.cv)])) == PL_curpad);           \
-        CX_POP_SAVEARRAY(cx);                                          \
-        av = MUTABLE_AV(PAD_SVl(0));                                    \
-        if (UNLIKELY(AvREAL(av)))                                      \
-            /* abandon @_ if it got reified */                         \
-            clear_defarray(av, 0);                                      \
-        else {                                                         \
-            CLEAR_ARGARRAY(av);                                                \
-        }                                                              \
-    } STMT_END
-
-#define CX_POPSUB(cx)                                                  \
-    STMT_START {                                                       \
-        assert(CxTYPE(cx) == CXt_SUB);                                  \
-       RETURN_PROBE(CvNAMED(cx->blk_sub.cv)                            \
-                       ? HEK_KEY(CvNAME_HEK(cx->blk_sub.cv))           \
-                       : GvENAME(CvGV(cx->blk_sub.cv)),                \
-               CopFILE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),      \
-               CopLINE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),      \
-               CopSTASHPV((COP*)CvSTART((const CV*)cx->blk_sub.cv)));  \
-                                                                       \
-       if (CxHASARGS(cx)) {                                            \
-            CX_POPSUB_ARGS(cx);                                         \
-       }                                                               \
-        CX_POPSUB_COMMON(cx);                                           \
-    } STMT_END
-
 #define CX_POPFORMAT(cx)                                               \
     STMT_START {                                                       \
        CV *cv;                                                         \
@@ -1299,7 +1222,7 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
        PUSHSTACKi(PERLSI_MULTICALL);                                   \
        cx = cx_pushblock((CXt_SUB|CXp_MULTICALL|flags), gimme,         \
                   PL_stack_sp, PL_savestack_ix);                       \
-       CX_PUSHSUB(cx, cv, NULL, hasargs);                              \
+       cx_pushsub(cx, cv, NULL, cBOOL(hasargs));                       \
        SAVEOP();                                                       \
         saveix_floor = PL_savestack_ix;                                 \
         if (!(flags & CXp_SUB_RE_FAKE))                                 \
@@ -1324,7 +1247,7 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
     STMT_START {                                                       \
        cx = CX_CUR();                                                  \
        CX_LEAVE_SCOPE(cx);                                             \
-        CX_POPSUB_COMMON(cx);                                           \
+        cx_popsub_common(cx);                                           \
         newsp = PL_stack_base + cx->blk_oldsp;                          \
         gimme = cx->blk_gimme;                                          \
         PERL_UNUSED_VAR(newsp); /* for API */                           \
@@ -1346,9 +1269,9 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
        PADLIST * const padlist = CvPADLIST(cv);                        \
        cx = CX_CUR();                                                  \
        assert(CxMULTICALL(cx));                                        \
-        CX_POPSUB_COMMON(cx);                                           \
+        cx_popsub_common(cx);                                           \
        cx->cx_type = (CXt_SUB|CXp_MULTICALL|flags);                    \
-        CX_PUSHSUB(cx, cv, NULL, hasargs);                             \
+        cx_pushsub(cx, cv, NULL, cBOOL(hasargs));                      \
         if (!(flags & CXp_SUB_RE_FAKE))                                 \
             CvDEPTH(cv)++;                                             \
        if (CvDEPTH(cv) >= 2)                                           \
index b51d2ef..8aa2f0b 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2875,7 +2875,7 @@ 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
+Ap     |void   |clear_defarray |NN AV* av|bool abandon
 
 ApM    |void   |leave_adjust_stacks|NN SV **from_sp|NN SV **to_sp \
                 |I32 gimme|int filter
@@ -2884,6 +2884,11 @@ ApM      |void   |leave_adjust_stacks|NN SV **from_sp|NN SV **to_sp \
 AiM    |PERL_CONTEXT * |cx_pushblock|U8 type|U8 gimme|NN SV** sp|I32 saveix
 AiM    |void   |cx_popblock|NN PERL_CONTEXT *cx
 AiM    |void   |cx_topblock|NN PERL_CONTEXT *cx
+AiM    |void   |cx_pushsub |NN PERL_CONTEXT *cx|NN CV *cv|NULLOK OP *retop \
+               |bool hasargs
+AiM    |void   |cx_popsub_common|NN PERL_CONTEXT *cx
+AiM    |void   |cx_popsub_args  |NN PERL_CONTEXT *cx
+AiM    |void   |cx_popsub       |NN PERL_CONTEXT *cx
 #endif
 
 : ex: set ts=8 sts=4 sw=4 noet:
diff --git a/embed.h b/embed.h
index 3eae8e6..54c0a64 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -87,6 +87,7 @@
 #define ck_warner              Perl_ck_warner
 #define ck_warner_d            Perl_ck_warner_d
 #endif
+#define clear_defarray(a,b)    Perl_clear_defarray(aTHX_ a,b)
 #ifndef PERL_IMPLICIT_CONTEXT
 #define croak                  Perl_croak
 #endif
 #define append_utf8_from_native_byte   S_append_utf8_from_native_byte
 #define av_top_index(a)                S_av_top_index(aTHX_ a)
 #define cx_popblock(a)         S_cx_popblock(aTHX_ a)
+#define cx_popsub(a)           S_cx_popsub(aTHX_ a)
+#define cx_popsub_args(a)      S_cx_popsub_args(aTHX_ a)
+#define cx_popsub_common(a)    S_cx_popsub_common(aTHX_ a)
 #define cx_pushblock(a,b,c,d)  S_cx_pushblock(aTHX_ a,b,c,d)
+#define cx_pushsub(a,b,c,d)    S_cx_pushsub(aTHX_ a,b,c,d)
 #define cx_topblock(a)         S_cx_topblock(aTHX_ a)
 #define is_safe_syscall(a,b,c,d)       S_is_safe_syscall(aTHX_ a,b,c,d)
 #endif
 #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)
index b8e3e8d..2e76626 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -473,6 +473,92 @@ S_cx_topblock(pTHX_ PERL_CONTEXT *cx)
 }
 
 
+PERL_STATIC_INLINE void
+S_cx_pushsub(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, bool hasargs)
+{
+    U8 phlags = CX_PUSHSUB_GET_LVALUE_MASK(Perl_was_lvalue_sub);
+
+    PERL_ARGS_ASSERT_CX_PUSHSUB;
+
+    ENTRY_PROBE(CvNAMED(cv)
+                    ? HEK_KEY(CvNAME_HEK(cv))
+                    : GvENAME(CvGV(cv)),
+                CopFILE((const COP *)CvSTART(cv)),
+                CopLINE((const COP *)CvSTART(cv)),
+                CopSTASHPV((const COP *)CvSTART(cv)));
+    cx->blk_sub.cv = cv;
+    cx->blk_sub.olddepth = CvDEPTH(cv);
+    cx->blk_sub.prevcomppad = PL_comppad;
+    cx->cx_type |= (hasargs) ? CXp_HASARGS : 0;
+    cx->blk_sub.retop = retop;
+    SvREFCNT_inc_simple_void_NN(cv);
+    cx->blk_u16 = PL_op->op_private & (phlags|OPpDEREF);
+}
+
+
+/* subsets of cx_popsub() */
+
+PERL_STATIC_INLINE void
+S_cx_popsub_common(pTHX_ PERL_CONTEXT *cx)
+{
+    CV *cv;
+
+    PERL_ARGS_ASSERT_CX_POPSUB_COMMON;
+    assert(CxTYPE(cx) == CXt_SUB);
+
+    PL_comppad = cx->blk_sub.prevcomppad;
+    PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;
+    cv = cx->blk_sub.cv;
+    CvDEPTH(cv) = cx->blk_sub.olddepth;
+    cx->blk_sub.cv = NULL;
+    SvREFCNT_dec(cv);
+}
+
+
+/* handle the @_ part of leaving a sub */
+
+PERL_STATIC_INLINE void
+S_cx_popsub_args(pTHX_ PERL_CONTEXT *cx)
+{
+    AV *av;
+
+    PERL_ARGS_ASSERT_CX_POPSUB_ARGS;
+    assert(CxTYPE(cx) == CXt_SUB);
+    assert(AvARRAY(MUTABLE_AV(
+        PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[
+                CvDEPTH(cx->blk_sub.cv)])) == PL_curpad);
+
+    CX_POP_SAVEARRAY(cx);
+    av = MUTABLE_AV(PAD_SVl(0));
+    if (UNLIKELY(AvREAL(av)))
+        /* abandon @_ if it got reified */
+        clear_defarray(av, 0);
+    else {
+        CLEAR_ARGARRAY(av);
+    }
+}
+
+
+PERL_STATIC_INLINE void
+S_cx_popsub(pTHX_ PERL_CONTEXT *cx)
+{
+    PERL_ARGS_ASSERT_CX_POPSUB;
+    assert(CxTYPE(cx) == CXt_SUB);
+
+    RETURN_PROBE(CvNAMED(cx->blk_sub.cv)
+                    ? HEK_KEY(CvNAME_HEK(cx->blk_sub.cv))
+                    : GvENAME(CvGV(cx->blk_sub.cv)),
+            CopFILE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),
+            CopLINE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),
+            CopSTASHPV((COP*)CvSTART((const CV*)cx->blk_sub.cv)));
+
+    if (CxHASARGS(cx))
+        cx_popsub_args(cx);
+    cx_popsub_common(cx);
+}
+
+
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */
diff --git a/pp.c b/pp.c
index c769f97..c699a79 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -6444,7 +6444,7 @@ PP(pp_coreargs)
                PERL_CONTEXT *cx = CX_CUR();
 
                 assert(CxHASARGS(cx));
-                CX_POPSUB_ARGS(cx);;
+                cx_popsub_args(cx);;
                cx->cx_type &= ~CXp_HASARGS;
            }
          }
index ced16d3..bc14287 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1366,7 +1366,7 @@ Perl_is_lvalue_sub(pTHX)
        return 0;
 }
 
-/* only used by CX_PUSHSUB */
+/* only used by cx_pushsub() */
 I32
 Perl_was_lvalue_sub(pTHX)
 {
@@ -1531,7 +1531,7 @@ Perl_dounwind(pTHX_ I32 cxix)
            CX_POPSUBST(cx);
            break;
        case CXt_SUB:
-           CX_POPSUB(cx);
+           cx_popsub(cx);
            break;
        case CXt_EVAL:
            CX_POPEVAL(cx);
@@ -2012,7 +2012,11 @@ PP(pp_dbstate)
        }
        else {
            cx = cx_pushblock(CXt_SUB, gimme, SP, PL_savestack_ix);
-           CX_PUSHSUB_DB(cx, cv, PL_op->op_next, 0);
+           cx_pushsub(cx, cv, PL_op->op_next, 0);
+            /* OP_DBSTATE's op_private holds hint bits rather than
+             * the lvalue-ish flags seen in OP_ENTERSUB. So cancel
+             * any CxLVAL() flags that have now been mis-calculated */
+            cx->blk_u16 = 0;
 
             SAVEI32(PL_debug);
             PL_debug = 0;
@@ -2347,7 +2351,7 @@ PP(pp_leavesublv)
     }
 
     CX_LEAVE_SCOPE(cx);
-    CX_POPSUB(cx);     /* Stack values are safe: release CV and @_ ... */
+    cx_popsub(cx);     /* Stack values are safe: release CV and @_ ... */
     cx_popblock(cx);
     retop =  cx->blk_sub.retop;
     CX_POP(cx);
@@ -2723,7 +2727,7 @@ PP(pp_goto)
             CX_LEAVE_SCOPE(cx);
 
            if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
-                /* this is part of CX_POPSUB_ARGS() */
+                /* this is part of cx_popsub_args() */
                AV* av = MUTABLE_AV(PAD_SVl(0));
                 assert(AvARRAY(MUTABLE_AV(
                     PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[
@@ -2823,7 +2827,7 @@ PP(pp_goto)
 
                 SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
 
-                /* partial unrolled CX_PUSHSUB(): */
+                /* partial unrolled cx_pushsub(): */
 
                cx->blk_sub.cv = cv;
                cx->blk_sub.olddepth = CvDEPTH(cv);
index 4a5daee..8d554f4 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -3639,7 +3639,7 @@ PP(pp_leavesub)
         leave_adjust_stacks(oldsp, oldsp, gimme, 0);
 
     CX_LEAVE_SCOPE(cx);
-    CX_POPSUB(cx);     /* Stack values are safe: release CV and @_ ... */
+    cx_popsub(cx);     /* Stack values are safe: release CV and @_ ... */
     cx_popblock(cx);
     retop = cx->blk_sub.retop;
     CX_POP(cx);
@@ -3763,9 +3763,9 @@ PP(pp_entersub)
     }
 
     /* At this point we want to save PL_savestack_ix, either by doing a
-     * CX_PUSHSUB, or for XS, doing an ENTER. But we don't yet know the final
+     * cx_pushsub(), or for XS, doing an ENTER. But we don't yet know the final
      * CV we will be using (so we don't know whether its XS, so we can't
-     * CX_PUSHSUB or ENTER yet), and determining cv may itself push stuff on
+     * cx_pushsub() or ENTER yet), and determining cv may itself push stuff on
      * the save stack. So remember where we are currently on the save
      * stack, and later update the CX or scopestack entry accordingly. */
     old_savestack_ix = PL_savestack_ix;
@@ -3854,7 +3854,7 @@ PP(pp_entersub)
         gimme = GIMME_V;
        cx = cx_pushblock(CXt_SUB, gimme, MARK, old_savestack_ix);
         hasargs = cBOOL(PL_op->op_flags & OPf_STACKED);
-       CX_PUSHSUB(cx, cv, PL_op->op_next, hasargs);
+       cx_pushsub(cx, cv, PL_op->op_next, hasargs);
 
        padlist = CvPADLIST(cv);
        if (UNLIKELY((depth = ++CvDEPTH(cv)) >= 2))
@@ -3871,7 +3871,7 @@ PP(pp_entersub)
 
             /* it's the responsibility of whoever leaves a sub to ensure
              * that a clean, empty AV is left in pad[0]. This is normally
-             * done by CX_POPSUB() */
+             * done by cx_popsub() */
             assert(!AvREAL(av) && AvFILLp(av) == -1);
 
             items = SP - MARK;
index 66b4b44..13bcf9f 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1671,7 +1671,7 @@ PP(pp_sort)
            cx = cx_pushblock(CXt_NULL, gimme, PL_stack_base, old_savestack_ix);
            if (!(flags & OPf_SPECIAL)) {
                cx->cx_type = CXt_SUB|CXp_MULTICALL;
-               CX_PUSHSUB(cx, cv, NULL, hasargs);
+               cx_pushsub(cx, cv, NULL, hasargs);
                if (!is_xsub) {
                    PADLIST * const padlist = CvPADLIST(cv);
 
@@ -1703,7 +1703,7 @@ PP(pp_sort)
             CX_LEAVE_SCOPE(cx);
            if (!(flags & OPf_SPECIAL)) {
                 assert(CxTYPE(cx) == CXt_SUB);
-                CX_POPSUB(cx);
+                cx_popsub(cx);
            }
             else
                 assert(CxTYPE(cx) == CXt_NULL);
diff --git a/proto.h b/proto.h
index dd34417..925b631 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3721,9 +3721,21 @@ PERL_STATIC_INLINE SSize_t       S_av_top_index(pTHX_ AV *av)
 PERL_STATIC_INLINE void        S_cx_popblock(pTHX_ PERL_CONTEXT *cx);
 #define PERL_ARGS_ASSERT_CX_POPBLOCK   \
        assert(cx)
+PERL_STATIC_INLINE void        S_cx_popsub(pTHX_ PERL_CONTEXT *cx);
+#define PERL_ARGS_ASSERT_CX_POPSUB     \
+       assert(cx)
+PERL_STATIC_INLINE void        S_cx_popsub_args(pTHX_ PERL_CONTEXT *cx);
+#define PERL_ARGS_ASSERT_CX_POPSUB_ARGS        \
+       assert(cx)
+PERL_STATIC_INLINE void        S_cx_popsub_common(pTHX_ PERL_CONTEXT *cx);
+#define PERL_ARGS_ASSERT_CX_POPSUB_COMMON      \
+       assert(cx)
 PERL_STATIC_INLINE PERL_CONTEXT *      S_cx_pushblock(pTHX_ U8 type, U8 gimme, SV** sp, I32 saveix);
 #define PERL_ARGS_ASSERT_CX_PUSHBLOCK  \
        assert(sp)
+PERL_STATIC_INLINE void        S_cx_pushsub(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, bool hasargs);
+#define PERL_ARGS_ASSERT_CX_PUSHSUB    \
+       assert(cx); assert(cv)
 PERL_STATIC_INLINE void        S_cx_topblock(pTHX_ PERL_CONTEXT *cx);
 #define PERL_ARGS_ASSERT_CX_TOPBLOCK   \
        assert(cx)
index 2349b84..23b5505 100644 (file)
@@ -42,7 +42,7 @@ sub new4 { goto &new2 }
     is("@$y","a b c y", 'goto: multiple elements');
 }
 
-# see if CX_POPSUB gets to see the right pad across a dounwind() with
+# see if cx_popsub() gets to see the right pad across a dounwind() with
 # a reified @_
 
 sub methimpl {
@@ -63,7 +63,7 @@ sub try {
 
 for (1..5) { try() }
 is($failcount, 5,
-    'CX_POPSUB sees right pad across a dounwind() with reified @_');
+    'cx_popsub sees right pad across a dounwind() with reified @_');
 
 # bug #21542 local $_[0] causes reify problems and coredumps