This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perldiag: Don’t use L<<>>
[perl5.git] / cop.h
diff --git a/cop.h b/cop.h
index 9f3762e..041420c 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -387,7 +387,8 @@ struct cop {
     line_t      cop_line;       /* line # of this command */
     /* label for this construct is now stored in cop_hints_hash */
 #ifdef USE_ITHREADS
-    PADOFFSET  cop_stashoff;   /* package line was compiled in */
+    PADOFFSET  cop_stashoff;   /* offset into PL_stashpad, for the
+                                  package the line was compiled in */
     char *     cop_file;       /* file name the following line # is from */
 #else
     HV *       cop_stash;      /* package line was compiled in */
@@ -1179,6 +1180,12 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
     U8 hasargs = 0             /* used by PUSHSUB */
 
 #define PUSH_MULTICALL(the_cv) \
+    PUSH_MULTICALL_WITHDEPTH(the_cv, 1);
+
+/* Like PUSH_MULTICALL, but allows you to specify the CvDEPTH increment,
+ * rather than the default of 1 (this isn't part of the public API) */
+
+#define PUSH_MULTICALL_WITHDEPTH(the_cv, depth) \
     STMT_START {                                                       \
        CV * const _nOnclAshIngNamE_ = the_cv;                          \
        CV * const cv = _nOnclAshIngNamE_;                              \
@@ -1190,7 +1197,8 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
        PUSHSTACKi(PERLSI_SORT);                                        \
        PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp);              \
        PUSHSUB(cx);                                                    \
-       if (++CvDEPTH(cv) >= 2) {                                       \
+       CvDEPTH(cv) += depth;                                           \
+       if (CvDEPTH(cv) >= 2) {                                         \
            PERL_STACK_OVERFLOW_CHECK();                                \
            Perl_pad_push(aTHX_ padlist, CvDEPTH(cv));                  \
        }                                                               \
@@ -1208,8 +1216,9 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
 
 #define POP_MULTICALL \
     STMT_START {                                                       \
-       if (! --CvDEPTH(multicall_cv))                                  \
-           LEAVESUB(multicall_cv);                                     \
+       if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) {      \
+               LEAVESUB(multicall_cv);                                 \
+       }                                                               \
        POPBLOCK(cx,PL_curpm);                                          \
        POPSTACK;                                                       \
        CATCH_SET(multicall_oldcatch);                                  \
@@ -1217,6 +1226,31 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
        SPAGAIN;                                                        \
     } STMT_END
 
+/* Change the CV of an already-pushed MULTICALL CxSUB block.
+ * (this isn't part of the public API) */
+
+#define CHANGE_MULTICALL_WITHDEPTH(the_cv, depth) \
+    STMT_START {                                                       \
+       CV * const _nOnclAshIngNamE_ = the_cv;                          \
+       CV * const cv = _nOnclAshIngNamE_;                              \
+       AV * 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);                                 \
+       }                                                               \
+       cx->cx_type &= ~CXp_HASARGS;                                    \
+       PUSHSUB(cx);                                                    \
+       CvDEPTH(cv) += depth;                                           \
+       if (CvDEPTH(cv) >= 2) {                                         \
+           PERL_STACK_OVERFLOW_CHECK();                                \
+           Perl_pad_push(aTHX_ padlist, CvDEPTH(cv));                  \
+       }                                                               \
+       SAVECOMPPAD();                                                  \
+       PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));                       \
+       multicall_cv = cv;                                              \
+       multicall_cop = CvSTART(cv);                                    \
+    } STMT_END
 /*
  * Local variables:
  * c-indentation-style: bsd