This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
SvREFCNT_inc(cv) recursive subs
authorDavid Mitchell <davem@iabyn.com>
Thu, 25 Jun 2015 11:05:50 +0000 (12:05 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 3 Feb 2016 08:59:32 +0000 (08:59 +0000)
A CXt_SUB context frame owns 1 reference count to the CV being called,
but only if it's the bottom-level call to that CV; recursive calls don't
count.

This commit changes it so that every CXt_SUB frame owns a reference count.

This removes a lot of "if (CvDEPTH(cv) < 2)" type tests from the code and
makes things generally simpler and less bug-prone.

For ordinary (non-recursive) sub calls it will now be slightly faster, as
it no longer has to do the CvDEPTH check on sub entry and exit; for subs
being recursed into, it will probably be slightly slower, as although it
no longer has to the CvDEPTH check on entry and exit, it now has to do a
refcnt ++/-- instead.

This also means that a deeply recursing sub will have a very high ref
count; but there is no new additional danger of overflow, as sv_refcnt is
U32 while xcv_depth is I32: so the latter will still overflow earlier
anyway.

cop.h
pp_ctl.c
pp_sort.c
sv.c

diff --git a/cop.h b/cop.h
index 3eabd89..d7482f9 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -586,8 +586,7 @@ struct block_format {
        cx->blk_sub.olddepth = CvDEPTH(cv);                             \
        cx->cx_type |= (hasargs) ? CXp_HASARGS : 0;                     \
        cx->blk_sub.retop = NULL;                                       \
-       if (!CvDEPTH(cv))                                               \
-           SvREFCNT_inc_simple_void_NN(cv);
+        SvREFCNT_inc_simple_void_NN(cv);
 
 #define PUSHSUB_GET_LVALUE_MASK(func) \
        /* If the context is indeterminate, then only the lvalue */     \
@@ -619,7 +618,7 @@ struct block_format {
        cx->blk_format.retop = (retop);                                 \
        cx->blk_format.dfoutgv = PL_defoutgv;                           \
        cx->blk_u16 = 0;                                                \
-       if (!CvDEPTH(cv)) SvREFCNT_inc_simple_void_NN(cv);              \
+       SvREFCNT_inc_simple_void_NN(cv);                                \
        CvDEPTH(cv)++;                                                  \
        SvREFCNT_inc_void(cx->blk_format.dfoutgv)
 
@@ -668,8 +667,7 @@ struct block_format {
         }                                                               \
        sv = MUTABLE_SV(cx->blk_sub.cv);                                \
        LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]);               \
-       if (sv && (CvDEPTH((const CV*)sv) = olddepth))                  \
-           sv = NULL;                                          \
+        CvDEPTH((const CV*)sv) = olddepth;                              \
     } STMT_END
 
 #define LEAVESUB(sv)                                                   \
@@ -685,8 +683,8 @@ struct block_format {
         cx->blk_u16 |= CxPOPSUB_DONE;                                   \
        setdefout(dfuot);                                               \
        LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]);               \
-       if (!--CvDEPTH(cv))                                             \
-           SvREFCNT_dec_NN(cx->blk_format.cv);                         \
+       --CvDEPTH(cv);                                                  \
+       SvREFCNT_dec_NN(cx->blk_format.cv);                             \
        SvREFCNT_dec_NN(dfuot);                                         \
         }                                                               \
     } STMT_END
@@ -1243,9 +1241,8 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
 #define POP_MULTICALL \
     STMT_START {                                                       \
        cx = &cxstack[cxstack_ix];                                      \
-        if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) {     \
-               LEAVESUB(multicall_cv);                                 \
-       }                                                               \
+        CvDEPTH(multicall_cv) = cx->blk_sub.olddepth;                   \
+        LEAVESUB(multicall_cv);                                        \
        POPBLOCK(cx,PL_curpm);                                          \
        POPSTACK;                                                       \
        CATCH_SET(multicall_oldcatch);                                  \
@@ -1263,9 +1260,8 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
        PADLIST * const padlist = CvPADLIST(cv);                        \
        cx = &cxstack[cxstack_ix];                                      \
        assert(cx->cx_type & CXp_MULTICALL);                            \
-       if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) {      \
-               LEAVESUB(multicall_cv);                                 \
-       }                                                               \
+       CvDEPTH(multicall_cv) = cx->blk_sub.olddepth;                   \
+        LEAVESUB(multicall_cv);                                                \
        cx->cx_type = (CXt_SUB|CXp_MULTICALL|flags);                    \
        PUSHSUB(cx);                                                    \
         if (!(flags & CXp_SUB_RE_FAKE))                                 \
index 011da56..049bffc 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2742,9 +2742,10 @@ PP(pp_goto)
            }
            /* We donate this refcount later to the calleeā€™s pad. */
            SvREFCNT_inc_simple_void(arg);
-           if (CxTYPE(cx) == CXt_SUB &&
-               !(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
-               SvREFCNT_dec(cx->blk_sub.cv);
+           if (CxTYPE(cx) == CXt_SUB) {
+               CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth;
+                SvREFCNT_dec_NN(cx->blk_sub.cv);
+            }
            oldsave = PL_scopestack[PL_scopestack_ix - 1];
            LEAVE_SCOPE(oldsave);
 
@@ -2821,9 +2822,8 @@ PP(pp_goto)
                cx->blk_sub.olddepth = CvDEPTH(cv);
 
                CvDEPTH(cv)++;
-               if (CvDEPTH(cv) < 2)
-                   SvREFCNT_inc_simple_void_NN(cv);
-               else {
+                SvREFCNT_inc_simple_void_NN(cv);
+               if (CvDEPTH(cv) > 1) {
                    if (CvDEPTH(cv) == PERL_SUB_DEPTH_WARN && ckWARN(WARN_RECURSION))
                        sub_crush_depth(cv);
                    pad_push(padlist, CvDEPTH(cv));
index 51742f6..ace0a05 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1672,11 +1672,6 @@ PP(pp_sort)
            PUSHBLOCK(cx, CXt_NULL, PL_stack_base);
            if (!(flags & OPf_SPECIAL)) {
                cx->cx_type = CXt_SUB;
-               /* If our comparison routine is already active (CvDEPTH is
-                * is not 0),  then PUSHSUB does not increase the refcount,
-                * so we have to do it ourselves, because the LEAVESUB fur-
-                * ther down lowers it. */
-               if (CvDEPTH(cv)) SvREFCNT_inc_simple_void_NN(cv);
                PUSHSUB(cx);
                if (!is_xsub) {
                    PADLIST * const padlist = CvPADLIST(cv);
diff --git a/sv.c b/sv.c
index ad2208e..d71a45d 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -13942,9 +13942,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
            ncx->blk_oldcop = (COP*)any_dup(ncx->blk_oldcop, param->proto_perl);
            switch (CxTYPE(ncx)) {
            case CXt_SUB:
-               ncx->blk_sub.cv         = (ncx->blk_sub.olddepth == 0
-                                          ? cv_dup_inc(ncx->blk_sub.cv, param)
-                                          : cv_dup(ncx->blk_sub.cv,param));
+               ncx->blk_sub.cv         = cv_dup_inc(ncx->blk_sub.cv, param);
                if(CxHASARGS(ncx)){
                    ncx->blk_sub.argarray = av_dup_inc(ncx->blk_sub.argarray,param);
                    ncx->blk_sub.savearray = av_dup_inc(ncx->blk_sub.savearray,param);