PUSH_MULTICALL_WITHDEPTH becomes ..._FLAGS
authorDavid Mitchell <davem@iabyn.com>
Wed, 24 Apr 2013 10:14:39 +0000 (11:14 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 24 Apr 2013 15:39:47 +0000 (16:39 +0100)
Two non-API macros were added with 5.17.1 to support the more
complex calling conventions required by /({})/ code blocks:

    PUSH_MULTICALL_WITHDEPTH(the_cv, depth)
    CHANGE_MULTICALL_WITHDEPTH(the_cv, depth)

which allowed us to do the same as the API versions, but to optionally
not increment the caller depth, and to change the current CV.

Replace these with two new macros:

    PUSH_MULTICALL_FLAGS(the_cv, flags)
    CHANGE_MULTICALL_FLAGS(the_cv, flags)

which instead allow us to set extra flags in cx->cx_type.
The depth increment skip is handled by the new CXp_SUB_RE_FAKE flag,
and all (?{}) calls set the new CXp_SUB_RE flag.

These two new flags will shortly allow us to change how caller() and
__SUB__ handle code blocks.

cop.h
regexec.c

index b20eddb..a736768 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -968,6 +968,8 @@ struct context {
 
 /* private flags for CXt_SUB and CXt_FORMAT */
 #define CXp_HASARGS    0x20
+#define CXp_SUB_RE     0x40    /* code called within regex, i.e. (?{}) */
+#define CXp_SUB_RE_FAKE        0x80    /* fake sub CX for (?{}) in current scope */
 
 /* private flags for CXt_EVAL */
 #define CXp_REAL       0x20    /* truly eval'', not a lookalike */
@@ -1182,12 +1184,12 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
     U8 hasargs = 0             /* used by PUSHSUB */
 
 #define PUSH_MULTICALL(the_cv) \
-    PUSH_MULTICALL_WITHDEPTH(the_cv, 1);
+    PUSH_MULTICALL_FLAGS(the_cv, 0)
 
-/* 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) */
+/* Like PUSH_MULTICALL, but allows you to specify extra flags
+ * for the CX stack entry (this isn't part of the public API) */
 
-#define PUSH_MULTICALL_WITHDEPTH(the_cv, depth) \
+#define PUSH_MULTICALL_FLAGS(the_cv, flags) \
     STMT_START {                                                       \
        CV * const _nOnclAshIngNamE_ = the_cv;                          \
        CV * const cv = _nOnclAshIngNamE_;                              \
@@ -1197,9 +1199,10 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
        SAVETMPS; SAVEVPTR(PL_op);                                      \
        CATCH_SET(TRUE);                                                \
        PUSHSTACKi(PERLSI_SORT);                                        \
-       PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp);              \
+       PUSHBLOCK(cx, (CXt_SUB|CXp_MULTICALL|flags), PL_stack_sp);      \
        PUSHSUB(cx);                                                    \
-       CvDEPTH(cv) += depth;                                           \
+        if (!(flags & CXp_SUB_RE_FAKE))                                 \
+            CvDEPTH(cv)++;                                             \
        if (CvDEPTH(cv) >= 2) {                                         \
            PERL_STACK_OVERFLOW_CHECK();                                \
            Perl_pad_push(aTHX_ padlist, CvDEPTH(cv));                  \
@@ -1232,7 +1235,7 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
 /* 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) \
+#define CHANGE_MULTICALL_FLAGS(the_cv, flags) \
     STMT_START {                                                       \
        CV * const _nOnclAshIngNamE_ = the_cv;                          \
        CV * const cv = _nOnclAshIngNamE_;                              \
@@ -1242,9 +1245,10 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
        if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) {      \
                LEAVESUB(multicall_cv);                                 \
        }                                                               \
-       cx->cx_type &= ~CXp_HASARGS;                                    \
+       cx->cx_type = (CXt_SUB|CXp_MULTICALL|flags);                    \
        PUSHSUB(cx);                                                    \
-       CvDEPTH(cv) += depth;                                           \
+        if (!(flags & CXp_SUB_RE_FAKE))                                 \
+            CvDEPTH(cv)++;                                             \
        if (CvDEPTH(cv) >= 2) {                                         \
            PERL_STACK_OVERFLOW_CHECK();                                \
            Perl_pad_push(aTHX_ padlist, CvDEPTH(cv));                  \
index 45bd09e..bc38839 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -4911,12 +4911,13 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
                 * points to newcv's pad. */
                if (newcv != last_pushed_cv || PL_comppad != last_pad)
                {
-                   I32 depth = (newcv == caller_cv) ? 0 : 1;
+                    U8 flags = (CXp_SUB_RE |
+                                ((newcv == caller_cv) ? CXp_SUB_RE_FAKE : 0));
                    if (last_pushed_cv) {
-                       CHANGE_MULTICALL_WITHDEPTH(newcv, depth);
+                       CHANGE_MULTICALL_FLAGS(newcv, flags);
                    }
                    else {
-                       PUSH_MULTICALL_WITHDEPTH(newcv, depth);
+                       PUSH_MULTICALL_FLAGS(newcv, flags);
                    }
                    last_pushed_cv = newcv;
                }